modules.t 12 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359
  1. # -*- cperl -*-
  2. # t/modules.t [OPTIONS] [t/mymodules]
  3. # check if some common CPAN modules exist and
  4. # can be compiled successfully. Only B::C is fatal,
  5. # CC and Bytecode optional. Use -all for all three (optional), and
  6. # -log for the reports (now default).
  7. #
  8. # OPTIONS:
  9. # -all - run also B::CC and B::Bytecode
  10. # -subset - run only random 10 of all modules. default if ! -d .svn
  11. # -no-subset - all 100 modules
  12. # -no-date - no date added at the logfile
  13. # -t - run also tests
  14. # -log - save log file. default on test10 and without subset
  15. # -keep - keep the source, perlcc -S
  16. #
  17. # The list in t/mymodules comes from two bigger projects.
  18. # Recommended general lists are Task::Kensho and http://ali.as/top100/
  19. # We are using 10 problematic modules from the latter.
  20. # We are NOT running the full module testsuite yet with -t, we can do that
  21. # in another author test to burn CPU for a few hours resp. days.
  22. #
  23. # Reports:
  24. # for p in 5.6.2 5.8.9 5.10.1 5.12.2; do make -S clean; perl$p Makefile.PL; make; perl$p -Mblib t/modules.t -log; done
  25. #
  26. # How to installed skip modules:
  27. # grep ^skip log.modules-bla|perl -lane'print $F[1]'| xargs perlbla -S cpan
  28. # or t/testm.sh -s
  29. use strict;
  30. use Test::More;
  31. use File::Temp;
  32. # Try some simple XS module which exists in 5.6.2 and blead
  33. # otherwise we'll get a bogus 40% failure rate
  34. my $staticxs = '';
  35. BEGIN {
  36. $staticxs = '--staticxs';
  37. # check whether linking with xs works at all. Try with and without --staticxs
  38. if ($^O eq 'darwin') { $staticxs = ''; goto BEGIN_END; }
  39. my $X = $^X =~ m/\s/ ? qq{"$^X"} : $^X;
  40. my $tmp = File::Temp->new(TEMPLATE => 'pccXXXXX');
  41. my $out = $tmp->filename;
  42. my $Mblib = $^O eq 'MSWin32' ? '-Iblib\arch -Iblib\lib' : "-Iblib/arch -Iblib/lib";
  43. my $result = `$X $Mblib blib/script/perlcc -O3 --staticxs -o$out -e"use Data::Dumper;"`;
  44. my $exe = $^O eq 'MSWin32' ? "$out.exe" : $out;
  45. unless (-e $exe or -e 'a.out') {
  46. my $result = `$X $Mblib blib/script/perlcc -O3 -o$out -e"use Data::Dumper;"`;
  47. unless (-e $out or -e 'a.out') {
  48. plan skip_all => "perlcc cannot link XS module Data::Dumper. Most likely wrong ldopts.";
  49. unlink $out;
  50. exit;
  51. } else {
  52. $staticxs = '';
  53. }
  54. } else {
  55. diag "-O3 --staticxs ok";
  56. }
  57. BEGIN_END:
  58. unshift @INC, 't';
  59. }
  60. our %modules;
  61. our $log = 0;
  62. use modules;
  63. require "test.pl";
  64. my $opts_to_test = 1;
  65. my $do_test;
  66. $opts_to_test = 3 if grep /^-all$/, @ARGV;
  67. $do_test = 1 if grep /^-t$/, @ARGV;
  68. # Determine list of modules to action.
  69. our @modules = get_module_list();
  70. my $test_count = scalar @modules * $opts_to_test * ($do_test ? 5 : 4);
  71. # $test_count -= 4 * $opts_to_test * (scalar @modules - scalar(keys %modules));
  72. plan tests => $test_count;
  73. use Config;
  74. use B::C;
  75. use POSIX qw(strftime);
  76. eval { require IPC::Run; };
  77. my $have_IPC_Run = defined $IPC::Run::VERSION;
  78. log_diag("Warning: IPC::Run is not available. Error trapping will be limited, no timeouts.")
  79. unless $have_IPC_Run;
  80. my @opts = (""); # only B::C
  81. @opts = ("", "-O", "-B") if grep /-all/, @ARGV; # all 3 compilers
  82. my $perlversion = perlversion();
  83. $log = 0 if @ARGV;
  84. $log = 1 if grep /top100$/, @ARGV;
  85. $log = 1 if grep /-log/, @ARGV or $ENV{TEST_LOG};
  86. my $nodate = 1 if grep /-no-date/, @ARGV;
  87. my $keep = 1 if grep /-keep/, @ARGV;
  88. if ($log) {
  89. $log = (@ARGV and !$nodate)
  90. ? "log.modules-$perlversion-".strftime("%Y%m%d-%H%M%S",localtime)
  91. : "log.modules-$perlversion";
  92. if (-e $log) {
  93. use File::Copy;
  94. copy $log, "$log.bak";
  95. }
  96. open(LOG, ">", "$log");
  97. close LOG;
  98. }
  99. unless (is_subset) {
  100. my $svnrev = "";
  101. if (-d '.svn') {
  102. local $ENV{LC_MESSAGES} = "C";
  103. $svnrev = `svn info|grep Revision:`;
  104. chomp $svnrev;
  105. $svnrev =~ s/Revision:\s+/r/;
  106. my $svnstat = `svn status lib/B/C.pm t/test.pl t/*.t`;
  107. chomp $svnstat;
  108. $svnrev .= " M" if $svnstat;
  109. } elsif (-d '.git') {
  110. local $ENV{LC_MESSAGES} = "C";
  111. $svnrev = `git log -1 --pretty=format:"%h %ad | %s" --date=short`;
  112. chomp $svnrev;
  113. my $gitdiff = `git diff lib/B/C.pm t/test.pl t/*.t`;
  114. chomp $gitdiff;
  115. $svnrev .= " M" if $gitdiff;
  116. }
  117. log_diag("B::C::VERSION = $B::C::VERSION $svnrev");
  118. log_diag("perlversion = $perlversion");
  119. log_diag("path = $^X");
  120. my $bits = 8 * $Config{ptrsize};
  121. log_diag("platform = $^O $bits"."bit ".(
  122. $Config{'useithreads'} ? "threaded"
  123. : $Config{'usemultiplicity'} ? "multi"
  124. : "non-threaded").
  125. ($Config{ccflags} =~ m/-DDEBUGGING/ ? " debug" : ""));
  126. }
  127. my $module_count = 0;
  128. my ($skip, $pass, $fail, $todo) = (0,0,0,0);
  129. my $Mblib = $^O eq 'MSWin32' ? '-Iblib\arch -Iblib\lib' : "-Iblib/arch -Iblib/lib";
  130. MODULE:
  131. for my $module (@modules) {
  132. $module_count++;
  133. local($\, $,); # guard against -l and other things that screw with
  134. # print
  135. # Possible binary files.
  136. my $name = $module;
  137. $name =~ s/::/_/g;
  138. $name =~ s{(install|setup|update)}{substr($1,0,4)}ie;
  139. my $out = 'pcc'.$name;
  140. my $out_c = "$out.c";
  141. my $out_pl = "$out.pl";
  142. $out = "$out.exe" if $^O eq 'MSWin32';
  143. SKIP: {
  144. # if is a special module that can't be required like others
  145. unless ($modules{$module}) {
  146. $skip++;
  147. log_pass("skip", "$module", 0);
  148. skip("$module not installed", 4 * scalar @opts);
  149. next MODULE;
  150. }
  151. if (is_skip($module)) { # !$have_IPC_Run is not really helpful here
  152. my $why = is_skip($module);
  153. $skip++;
  154. log_pass("skip", "$module #$why", 0);
  155. skip("$module $why", 4 * scalar @opts);
  156. next MODULE;
  157. }
  158. $module = 'if(1) => "Sys::Hostname"' if $module eq 'if';
  159. TODO: {
  160. my $s = is_todo($module);
  161. local $TODO = $s if $s;
  162. $todo++ if $TODO;
  163. open F, ">", $out_pl or die;
  164. print F "use $module;\nprint 'ok';\n" or die;
  165. close F or die;
  166. my ($result, $stdout, $err);
  167. my $module_passed = 1;
  168. my $runperl = $^X =~ m/\s/ ? qq{"$^X"} : $^X;
  169. foreach (0..$#opts) {
  170. my $opt = $opts[$_];
  171. $opt .= " --testsuite --no-spawn" if $module =~ /^Test::/ and $opt !~ / --testsuite/;
  172. $opt .= " -S" if $keep and $opt !~ / -S\b/;
  173. # TODO ./a often hangs but perlcc not
  174. my @cmd = grep {!/^$/}
  175. $runperl,split(/ /,$Mblib),"blib/script/perlcc",split(/ /,$opt),$staticxs,"-o$out","-r",$out_pl;
  176. my $cmd = "$runperl $Mblib blib/script/perlcc $opt $staticxs -o$out -r"; # only for the msg
  177. # Esp. darwin-2level has insane link times
  178. ($result, $stdout, $err) = run_cmd(\@cmd, 720); # in secs.
  179. ok(-s $out,
  180. "$module_count: use $module generates non-zero binary")
  181. or $module_passed = 0;
  182. is($result, 0, "$module_count: use $module $opt exits with 0")
  183. or $module_passed = 0;
  184. $err =~ s/^Using .+blib\n//m if $] < 5.007;
  185. like($stdout, qr/ok$/ms, "$module_count: use $module $opt gives expected 'ok' output");
  186. unless ($stdout =~ /ok$/ms) { # crosscheck for a perlcc problem (XXX not needed anymore)
  187. my ($r, $err1);
  188. $module_passed = 0;
  189. @cmd = ($runperl,$Mblib,"-MO=C,-o$out_c",$out_pl);
  190. ($r, $stdout, $err1) = run_cmd(\@cmd, 60); # in secs
  191. @cmd = ($runperl,$Mblib,"script/cc_harness","-o$out",$out_c);
  192. ($r, $stdout, $err1) = run_cmd(\@cmd, 360); # in secs
  193. @cmd = ($^O eq 'MSWin32' ? "$out" : "./$out");
  194. ($r, $stdout, $err1) = run_cmd(\@cmd, 20); # in secs
  195. if ($stdout =~ /ok$/ms) {
  196. $module_passed = 1;
  197. diag "crosscheck that only perlcc $staticxs failed. With -MO=C + cc_harness => ok";
  198. }
  199. }
  200. log_pass($module_passed ? "pass" : "fail", $module, $TODO);
  201. if ($module_passed) {
  202. $pass++;
  203. } else {
  204. diag "Failed: $cmd -e 'use $module; print \"ok\"'";
  205. $fail++;
  206. }
  207. TODO: {
  208. local $TODO = 'STDERR from compiler warnings in work' if $err;
  209. is($err, '', "$module_count: use $module no error output compiling")
  210. && ($module_passed)
  211. or log_err($module, $stdout, $err)
  212. }
  213. }
  214. if ($do_test) {
  215. TODO: {
  216. local $TODO = 'all module tests';
  217. `$runperl $Mblib -It -MCPAN -Mmodules -e "CPAN::Shell->testcc("$module")"`;
  218. }
  219. }
  220. for ($out_pl, $out, $out_c, $out_c.".lst") {
  221. unlink $_ if -f $_ ;
  222. }
  223. }}
  224. }
  225. my $count = scalar @modules - $skip;
  226. log_diag("$count / $module_count modules tested with B-C-${B::C::VERSION} - perl-$perlversion");
  227. log_diag(sprintf("pass %3d / %3d (%s)", $pass, $count, percent($pass,$count)));
  228. log_diag(sprintf("fail %3d / %3d (%s)", $fail, $count, percent($fail,$count)));
  229. log_diag(sprintf("todo %3d / %3d (%s)", $todo, $fail, percent($todo,$fail)));
  230. log_diag(sprintf("skip %3d / %3d (%s not installed)\n",
  231. $skip, $module_count, percent($skip,$module_count)));
  232. exit;
  233. # t/todomod.pl
  234. # for t in $(cat t/top100); do perl -ne"\$ARGV=~s/log.modules-//;print \$ARGV,': ',\$_ if / $t\s/" t/modules.t `ls log.modules-5.0*|grep -v .err`; read; done
  235. sub is_todo {
  236. my $module = shift or die;
  237. my $DEBUGGING = ($Config{ccflags} =~ m/-DDEBUGGING/);
  238. # ---------------------------------------
  239. #foreach(qw(
  240. # ExtUtils::CBuilder
  241. #)) { return 'overlong linking time' if $_ eq $module; }
  242. #if ($] < 5.007) { foreach(qw(
  243. # ExtUtils::CBuilder
  244. #)) { return '5.6' if $_ eq $module; }}
  245. if ($] >= 5.008004 and $] < 5.0080006) { foreach(qw(
  246. Module::Pluggable
  247. )) { return '5.8.5 CopFILE_set' if $_ eq $module; }}
  248. # restricted v_string hash?
  249. if ($] eq '5.010000') { foreach(qw(
  250. IO
  251. Path::Class
  252. DateTime::TimeZone
  253. )) { return '5.10.0 restricted hash/...' if $_ eq $module; }}
  254. # fixed between v5.15.6-210-g5343a61 and v5.15.6-233-gfb7aafe
  255. if ($] > 5.015 and $] < 5.015006) { foreach(qw(
  256. B::Hooks::EndOfScope
  257. )) { return '> 5.15' if $_ eq $module; }}
  258. #if ($] > 5.015) { foreach(qw(
  259. # Moose
  260. # MooseX::Types
  261. # DateTime
  262. #)) { return '> 5.15 (unshare_hek)' if $_ eq $module; }}
  263. if ($] >= 5.018) { foreach(qw(
  264. ExtUtils::ParseXS
  265. Module::Build
  266. )) { return '>= 5.18' if $_ eq $module; }}
  267. # ---------------------------------------
  268. if ($Config{useithreads}) {
  269. if (!$DEBUGGING) { foreach(qw(
  270. Test::Tester
  271. )) { return 'non-debugging with threads' if $_ eq $module; }}
  272. if ($] >= 5.008005 and $] < 5.008006) { foreach(qw(
  273. Module::Build
  274. Test::NoWarnings
  275. Test::Warn
  276. Test::Simple
  277. Test::Exception
  278. Test::Tester
  279. Test::Deep
  280. )) { return '5.8.4-5 shared_scalar n-magic (\156)' if $_ eq $module; }}
  281. if ($] > 5.008001 and $] < 5.008009) { foreach(qw(
  282. Test::Pod
  283. )) { return '5.8.1-5.8.8 with threads' if $_ eq $module; }}
  284. if ($] >= 5.009 and $] < 5.012) { foreach(qw(
  285. Carp::Clan
  286. DateTime
  287. Encode
  288. ExtUtils::Install
  289. Module::Build
  290. MooseX::Types
  291. Pod::Text
  292. Template::Stash
  293. )) { return '5.10 with threads' if $_ eq $module; }}
  294. # XXX 5.12.0 not tested recently
  295. if ($] eq 5.012000) { foreach(qw(
  296. DBI
  297. DateTime
  298. DateTime::Locale
  299. Filter::Util::Call
  300. Storable
  301. Sub::Name
  302. )) { return '5.12.0 with threads' if $_ eq $module; }}
  303. if ($] >= 5.018) { foreach(qw(
  304. ExtUtils::CBuilder
  305. )) { return '>= 5.18 with threads' if $_ eq $module; }}
  306. } else { #no threads --------------------------------
  307. # This was related to aelemfast->sv with SPECIAL pads fixed with 033d200
  308. if ($] > 5.008004 and $] <= 5.008005) { foreach(qw(
  309. DateTime
  310. )) { return '5.8.5 without threads' if $_ eq $module; }}
  311. #if ($] > 5.015) { foreach(qw(
  312. # DateTime::TimeZone
  313. #)) { return '> 5.15 without threads' if $_ eq $module; }}
  314. }
  315. # ---------------------------------------
  316. }
  317. sub is_skip {
  318. my $module = shift or die;
  319. if ($] >= 5.011004) {
  320. #foreach (qw(Attribute::Handlers)) {
  321. # return 'fails $] >= 5.011004' if $_ eq $module;
  322. #}
  323. if ($Config{useithreads}) { # hangs and crashes threaded since 5.12
  324. foreach (qw( )) {
  325. # Old: Recursive inheritance detected in package 'Moose::Object' at /usr/lib/perl5/5.13.10/i686-debug-cygwin/DynaLoader.pm line 103
  326. # Update: Moose works ok with r1013
  327. return 'hangs threaded, $] >= 5.011004' if $_ eq $module;
  328. }
  329. }
  330. }
  331. }