├── t ├── testcc.sh ├── nowarn.pl ├── perlall-modules.sh ├── z_pod.t ├── test10 ├── coreall.sh ├── qr_loaded_module.pm ├── coverage.sh ├── Ccode354i.pm ├── issue144.t ├── issue403.t ├── issue97.t ├── issue183.t ├── issue37.t ├── issue237.t ├── issue211.t ├── issue330.t ├── pg.pl ├── release-testing.sh ├── issue185.t ├── issue234.t ├── issue141.t ├── issue184.t ├── bblock.t ├── manifest.t ├── issue232.t ├── issue240.t ├── issue46.t ├── critical.sh ├── issue229.t ├── issue220.t ├── issue52.t ├── issue105.t ├── c_o2.t ├── issue32.t ├── issue44.t ├── issue47.t ├── issue259.t ├── issue39.t ├── issue38.t ├── issue348.t ├── issue242.t ├── issue48.t ├── issue312.t ├── issue391.t ├── c_o1.t ├── issue273.t ├── issue51.t ├── issue293.t ├── issue318.t ├── issue76.t ├── c_o4.t ├── issue201.t ├── cc_o2.t ├── issue287.t ├── issue2741.t ├── cc_o1.t ├── issue368.t ├── issue148.t ├── c_o3.t ├── issue390.t ├── c.t ├── issue159.t ├── sigs.t ├── core-init.sh ├── issue306.t ├── issue206.t ├── issue42.t ├── issue272.t ├── issue350.t ├── issue172.t ├── issue235.t ├── issue203.t ├── issue81.t ├── issue340.t ├── issue281.t ├── todomod.pl ├── issue354.t ├── issue369.t ├── issue31.t ├── cc.t ├── issue274.t ├── issue45.t ├── issue238.t ├── issue200.t ├── issue36.t ├── issue308.t ├── issue49.t ├── issue282.t ├── issue338.t ├── issue212.t ├── issue208.t ├── issue245.t ├── issue50.t ├── issue143.t ├── issue54.t ├── stashes.t ├── moose-test.pl ├── issue68.t ├── issue169.t ├── issue219.t ├── mock ├── issue34.t ├── issue96.t ├── fast-testing.sh ├── c_allow_opts.t ├── issue251.t ├── issue301.t ├── regex-dna.pl ├── issue130.t ├── issue59.t ├── top100 ├── issue27.t ├── issue98.t ├── issue35.t ├── c_cross.t ├── issue197.t ├── issue93.t ├── cc_last.t ├── issue305.t ├── c_argv.t ├── issue29.t ├── issue71.t ├── issue24.t └── issue90.t ├── .perldb ├── .gitmodules ├── .github └── FUNDING.yml ├── ramblings ├── B-CC-yapceu2013.pdf ├── yapceu2015 │ ├── B-C.m0.png │ ├── B-C.p0.png │ └── B-C.p1.png ├── mk-slides.sh ├── reg.alloc ├── curcop.runtime ├── Carp-wo-B.patch ├── revert-B-load-BEGIN-514.patch ├── more-opts.md ├── revert-B-load-BEGIN-5160.patch ├── revert-B-load-BEGIN-516.patch ├── revert-B-load-BEGIN-517-B141.patch ├── Export-DynaLoader-symbols-from-libperl-again.patch ├── cc.notes ├── flip-flop └── blogs-debugging-article3.pod ├── ByteLoader ├── hints │ ├── sunos.pl │ └── 522_patched.pl ├── Makefile.PL └── ByteLoader.pm ├── hints ├── darwin.pl └── openbsd.pl ├── .whitesource ├── Stash ├── Makefile.PL └── Stash.xs ├── appveyor.yml ├── log.modules-5.028002-nt ├── .gitignore ├── regen_lib.pl ├── typemap ├── store_rpt ├── script ├── assemble └── disassemble ├── .travis.yml ├── .gdbinit ├── log.modules-5.020003 ├── log.modules-5.014004 ├── log.modules-5.018004 ├── log.modules-5.010001-nt ├── log.modules-5.012005-nt ├── log.modules-5.014004-nt ├── log.modules-5.020003-nt ├── log.modules-5.022004-nt ├── log.modules-5.028002c-nt ├── log.modules-5.018004-nt ├── log.modules-5.016003-nt ├── log.modules-5.008009 ├── log.modules-5.024004c-nt ├── log.modules-5.008005-nt ├── log.modules-5.008009-nt └── log.modules-5.012005 /t/testcc.sh: -------------------------------------------------------------------------------- 1 | testc.sh -------------------------------------------------------------------------------- /.perldb: -------------------------------------------------------------------------------- 1 | $DB::deep=500; 2 | -------------------------------------------------------------------------------- /t/nowarn.pl: -------------------------------------------------------------------------------- 1 | #!./perl -w 2 | BEGIN { $SIG{__WARN__} = sub { die @_ }; } 3 | print "ok\n"; 4 | -------------------------------------------------------------------------------- /.gitmodules: -------------------------------------------------------------------------------- 1 | [submodule "t/CORE"] 2 | path = t/CORE 3 | url = git://github.com/perl11/p5-coretests.git 4 | -------------------------------------------------------------------------------- /.github/FUNDING.yml: -------------------------------------------------------------------------------- 1 | # These are supported funding model platforms 2 | 3 | github: rurban 4 | patreon: rurban 5 | -------------------------------------------------------------------------------- /ramblings/B-CC-yapceu2013.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rurban/perl-compiler/HEAD/ramblings/B-CC-yapceu2013.pdf -------------------------------------------------------------------------------- /ramblings/yapceu2015/B-C.m0.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rurban/perl-compiler/HEAD/ramblings/yapceu2015/B-C.m0.png -------------------------------------------------------------------------------- /ramblings/yapceu2015/B-C.p0.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rurban/perl-compiler/HEAD/ramblings/yapceu2015/B-C.p0.png -------------------------------------------------------------------------------- /ramblings/yapceu2015/B-C.p1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rurban/perl-compiler/HEAD/ramblings/yapceu2015/B-C.p1.png -------------------------------------------------------------------------------- /ByteLoader/hints/sunos.pl: -------------------------------------------------------------------------------- 1 | $self->{CCFLAGS} = $Config{ccflags} . ' -DNEED_FGETC_PROTOTYPE -DNEED_FREAD_PROTOTYPE'; 2 | 3 | -------------------------------------------------------------------------------- /t/perlall-modules.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # creates log.modules files with date added 3 | perlall -m --nogit make '-Mblib t/modules.t t/top100' 4 | -------------------------------------------------------------------------------- /hints/darwin.pl: -------------------------------------------------------------------------------- 1 | # gcc -O3 (and -O2) get overly excited over B.c in MacOS X 10.1.4. 2 | $self->{OPTIMIZE} = '-O1' if `/usr/bin/uname -v` =~ /10.1.4/; 3 | -------------------------------------------------------------------------------- /hints/openbsd.pl: -------------------------------------------------------------------------------- 1 | # gcc -O3 (and -O2) get overly excited over B.c in OpenBSD 3.3/sparc 64 2 | $self->{OPTIMIZE} = '-O1' if $Config{ARCH} eq 'sparc64'; 3 | -------------------------------------------------------------------------------- /t/z_pod.t: -------------------------------------------------------------------------------- 1 | # -*- perl -*- 2 | use Test::More; 3 | eval "use Test::Pod 1.00"; 4 | plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; 5 | all_pod_files_ok(); 6 | -------------------------------------------------------------------------------- /.whitesource: -------------------------------------------------------------------------------- 1 | { 2 | "generalSettings": { 3 | "shouldScanRepo": true 4 | }, 5 | "checkRunSettings": { 6 | "vulnerableCheckRunConclusionLevel": "failure" 7 | } 8 | } -------------------------------------------------------------------------------- /t/test10: -------------------------------------------------------------------------------- 1 | ExtUtils::Install 2 | Test::Harness 3 | autodie 4 | IO::Socket 5 | Scalar::Util 6 | Pod::Perldoc 7 | Pod::Usage 8 | Pod::Simple 9 | parent 10 | Locale::Maketext 11 | -------------------------------------------------------------------------------- /t/coreall.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # run all perls on a single core test 3 | t=${1:-t/CORE/v5.22/comp/proto.t} 4 | echo perlall='5.*-nt' perlall -m --nolog do $t 5 | perlall='5.*-nt' perlall -m --nolog do $t 2>&1 | egrep '(^not ok|/perl5.)' 6 | -------------------------------------------------------------------------------- /t/qr_loaded_module.pm: -------------------------------------------------------------------------------- 1 | # This has to be in a seperate file to test for the previous 5.6 breakage 2 | package qr_loaded_module; 3 | my $var = 1; 4 | my $qr_with_var = qr/^_?[^\W_0-9]\w*$var/; 5 | sub qr_called_in_sub { 6 | $_[0] =~ $qr_with_var; 7 | } 8 | 1; 9 | 10 | -------------------------------------------------------------------------------- /t/coverage.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | cover -delete 4 | 5 | OLD_HARNESS_PERL_SWITCHES=$HARNESS_PERL_SWITCHES 6 | HARNESS_PERL_SWITCHES=-MDevel::Cover 7 | export HARNESS_PERL_SWITCHES 8 | 9 | make test 10 | 11 | HARNESS_PERL_SWITCHES=$OLD_HARNESS_PERL_SWITCHES 12 | cover 13 | -------------------------------------------------------------------------------- /t/Ccode354i.pm: -------------------------------------------------------------------------------- 1 | # This needs to be in a seperate file. 2 | # See t/issue354.t 3 | package Ccode354i; 4 | my %h = ( abcd => { code => sub { return q{abcdef} }, }); 5 | sub check { 6 | my ($token) = @_; 7 | return qq{ok\n} if defined $h{ $token->{expansion} }; 8 | return qq{KO\n}; 9 | } 10 | 1 11 | -------------------------------------------------------------------------------- /t/issue144.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=144 3 | # BM search for \0 4 | use Test::More tests => 1; 5 | use strict; 6 | BEGIN { 7 | unshift @INC, 't'; 8 | require TestBC; 9 | } 10 | 11 | ctestok(1, "C", 'ccode144i', 'print "ok" if 12 == index("long message\0xx","\0")', "BM search for \\0"); 12 | -------------------------------------------------------------------------------- /t/issue403.t: -------------------------------------------------------------------------------- 1 | # https://github.com/rurban/perl-compiler/issues/403 2 | # fixed with B-C 1.54_17 3 | use strict; 4 | BEGIN { 5 | unshift @INC, 't'; 6 | require TestBC; 7 | } 8 | use Test::More tests => 1; 9 | use Config; 10 | 11 | ctestok(1,'C,-O3','ccode403i',<<'EOF', 'use constant AV'); 12 | use constant _OPTIONS => ( 'o', 'k' ); 13 | eval q{ print join "", _OPTIONS(); }; 14 | EOF 15 | 16 | -------------------------------------------------------------------------------- /t/issue97.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=97 3 | # require without op_first in use v5.12 4 | use strict; 5 | BEGIN { 6 | unshift @INC, 't'; 7 | require TestBC; 8 | } 9 | use Test::More tests => 1; 10 | 11 | my $source = $] < 5.012 ? "use 5.006; print q(ok);" : "use v5.12; print q(ok);"; 12 | 13 | plctestok(1, "ccode97i", $source, "BC require v5.12"); 14 | -------------------------------------------------------------------------------- /t/issue183.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=183 3 | # Special case: ->import should fail silently 4 | use strict; 5 | BEGIN { 6 | unshift @INC, 't'; 7 | require TestBC; 8 | } 9 | use Test::More tests => 1; 10 | 11 | use B::C (); 12 | my $when = "1.42_61"; 13 | ctestok(1,'C,-O3','ccode183i','main->import();print q(ok)', 14 | ($B::C::VERSION lt $when ? "TODO " : "").'#183 ->import should fail silently'); 15 | -------------------------------------------------------------------------------- /t/issue37.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=37 3 | # orassign ||= with old B::CC 4 | use Test::More tests => 1; 5 | use strict; 6 | BEGIN { 7 | unshift @INC, 't'; 8 | require TestBC; 9 | } 10 | 11 | my $script = <<'EOF'; 12 | my $x; 13 | $x ||= 1; 14 | print "ok" if $x; 15 | EOF 16 | 17 | use B::CC; 18 | ctestok(1, "CC", "ccode37i", $script, 19 | $B::CC::VERSION < 1.08 ? "TODO B::CC issue 37" : "orassign ||="); 20 | -------------------------------------------------------------------------------- /t/issue237.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=237 3 | # NULL in strings (pv->PVX problem) 4 | use strict; 5 | BEGIN { 6 | unshift @INC, 't'; 7 | require TestBC; 8 | } 9 | use Test::More tests => 2; 10 | my $cmt = '#237 NULL in strings'; 11 | my $script = 'print "\000\000\000\000_"'; 12 | my $exp = "^\000\000\000\000_\$"; 13 | ctest(1, $exp, 'C,-O3', 'ccode237i', $script, 'C '.$cmt); 14 | plctest(2, $exp, 'ccode237i', $script, "BC ".$cmt); 15 | -------------------------------------------------------------------------------- /t/issue211.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=211 3 | # eval die and stderr/stdout order 4 | BEGIN{ 5 | if ($ENV{HARNESS_ACTIVE}) { 6 | print "1..0 #skip under harness\n"; 7 | exit 0; 8 | } 9 | } 10 | my $X = $^X =~ m/\s/ ? qq{"$^X"} : $^X; 11 | system(qq{ 12 | $X -Mblib script/perlcc -occode211i -O3 -r -e'print "1..3\n";print "ok 1 - howdy\n";print "ok 2 - dooty\n"; 13 | eval { die "foo" }; warn "ok 3 - wazzup \$\@\n" if \$\@;' 14 | }); 15 | -------------------------------------------------------------------------------- /t/issue330.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=330 3 | # initialize op_ppaddr before init 4 | 5 | use strict; 6 | BEGIN { 7 | unshift @INC, 't'; 8 | require TestBC; 9 | } 10 | use Test::More tests => 2; 11 | 12 | my $cmt = '#330 m//i SWASHINIT'; 13 | my $script = '"\x{101}a" =~ qr/\x{100}/i && print "ok\n"'; 14 | ctestok(1, 'C,-O1', 'ccode330i', $script, 'C -fppaddr '.$cmt); 15 | ctestok(2, 'C,-O0', 'ccode330i', $script, 'C -fno-ppaddr '.$cmt); 16 | -------------------------------------------------------------------------------- /t/pg.pl: -------------------------------------------------------------------------------- 1 | #! perl 2 | use strict; 3 | $ENV{DBI_TRACE} = 127 unless exists $ENV{DBI_TRACE}; 4 | use DBI; 5 | # faster if compiled in, but does not work 6 | #use DBD::Pg; 7 | 8 | my $user = $ENV{USER} || 'postgres'; 9 | my ($db, $port) = ($user, 5432); 10 | my $dbh = DBI->connect("dbi:Pg:dbname=$db;port=$port", $user, '', 11 | { 12 | 'RaiseError' => 1, 13 | 'PrintError' => 1 14 | } 15 | ) && print "ok\n"; 16 | -------------------------------------------------------------------------------- /t/release-testing.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # test locally 3 | if `which perlall-maketest-m`; then 4 | perlall-maketest-m 5 | else 6 | if `which perlall-maketest`; then 7 | perlall-maketest 8 | else 9 | perlall -m maketest -v 10 | fi 11 | # creates log.modules files with date added 12 | #perlall --nolog -m make '-Iblib/arch -Iblib/lib t/modules.t -no-subset -no-date t/top100' 13 | fi 14 | 15 | # t/todomod.pl 16 | 17 | # test vm's 18 | #perlall testvm --all 19 | 20 | ./status_upd -fqd 21 | -------------------------------------------------------------------------------- /t/issue185.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=185 3 | # bytes_heavy 4 | use strict; 5 | BEGIN { 6 | unshift @INC, 't'; 7 | require TestBC; 8 | } 9 | use Test::More tests => 1; 10 | use B::C (); 11 | my $when = "1.43_03"; 12 | 13 | ctestok(1,'C,-O3','ccode185i',<<'EOF',($B::C::VERSION lt $when ? "TODO " : "").'#185 bytes_heavy'); 14 | my $a = pack("U", 0xFF); 15 | use bytes; 16 | print "not " unless $a eq "\xc3\xbf" && bytes::length($a) == 2; 17 | print "ok\n" 18 | EOF 19 | -------------------------------------------------------------------------------- /Stash/Makefile.PL: -------------------------------------------------------------------------------- 1 | use ExtUtils::MakeMaker; 2 | use Config; 3 | use File::Spec; 4 | use 5.006; 5 | use Carp; 6 | 7 | WriteMakefile( 8 | 'NAME' => "B::Stash", 9 | 'VERSION_FROM' => "Stash.pm", 10 | 'AUTHOR' => 'Reini Urban ', 11 | 'ABSTRACT' => 'Perl compiler', 12 | 'LICENSE' => 'perl', 13 | 'SIGN' => 1, 14 | ); 15 | 16 | # Local Variables: 17 | # mode: cperl 18 | # cperl-indent-level: 4 19 | # fill-column: 100 20 | # End: 21 | # vim: expandtab shiftwidth=4: 22 | -------------------------------------------------------------------------------- /t/issue234.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=234 3 | # new-cog edge-case: pv2iv conversion with negative numeric strings 4 | use strict; 5 | BEGIN { 6 | unshift @INC, 't'; 7 | require TestBC; 8 | } 9 | use Test::More tests => 1; 10 | 11 | use B::C; 12 | my $when = "1.42_61"; 13 | ctest(1,'^4$','C,-O3','ccode234i','$c = 0; for ("-3" .. "0") { $c++ } ; print "$c"', 14 | ($B::C::VERSION lt $when ? "TODO " : ""). 15 | '#234 -O3 pv2iv conversion for negative numeric strings'); 16 | -------------------------------------------------------------------------------- /t/issue141.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=141 3 | # C,-O3 stativ pv fails with conversion to IV: char* "1" => 0 < 5.17.5, branch new-cog 4 | use Test::More tests => 1; 5 | use strict; 6 | BEGIN { 7 | unshift @INC, 't'; 8 | require TestBC; 9 | } 10 | 11 | use B::C; 12 | my $todo = ($B::C::VERSION lt '1.42_57' ? "TODO " : ""); 13 | $todo = "" if $] > 5.017005; 14 | ctestok(1, "C,-O3", 'ccode141i', '@x=(0..1);print "ok" if $#x == "1"', "${todo}C,-O3 pv2iv conversion with static strings"); 15 | -------------------------------------------------------------------------------- /t/issue184.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=184 3 | # sub overload, no warnings redefine 4 | use strict; 5 | BEGIN { 6 | unshift @INC, 't'; 7 | require TestBC; 8 | } 9 | use Test::More tests => 1; 10 | 11 | ctestok(1,'C,-O3','ccode184i',<<'EOF','#184 no warnings redefine'); 12 | use warnings; 13 | sub xyz { no warnings 'redefine'; *xyz = sub { $a <=> $b }; &xyz } 14 | eval { @b = sort xyz 4,1,3,2 }; 15 | print defined $b[0] && $b[0] == 1 && $b[1] == 2 && $b[2] == 3 && $b[3] == 4 ? "ok\n" : "fail\n"; 16 | EOF 17 | -------------------------------------------------------------------------------- /t/bblock.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl -w 2 | # blead cannot run -T 3 | 4 | BEGIN { 5 | if ($ENV{PERL_CORE}) { 6 | push @INC, ('.', '../../lib'); 7 | } 8 | require Config; 9 | if ($ENV{PERL_CORE} and ($Config::Config{'extensions'} !~ /\bB\b/) ){ 10 | print "1..0 # Skip -- Perl configured without B module\n"; 11 | exit 0; 12 | } 13 | } 14 | 15 | use Test::More tests => 1; 16 | 17 | use_ok('B::Bblock', qw(find_leaders)); 18 | 19 | # For now only test loading Bblock works. 20 | # We could add tests to split op groups by Basic Blocks for CC. 21 | -------------------------------------------------------------------------------- /t/manifest.t: -------------------------------------------------------------------------------- 1 | # -*- perl -*- 2 | use Test::More; 3 | if (!-d ".git" or $^O != /^(linux|.*bsd|darwin|solaris|sunos)$/) { 4 | plan skip_all => "requires a git checkout and a unix for git and diff"; 5 | } 6 | plan tests => 1; 7 | 8 | system("git ls-tree -r --name-only HEAD | egrep -v '(.gitmodules|t/CORE)' >MANIFEST.git"); 9 | if (-e "MANIFEST.git") { 10 | diag "MANIFEST.git created with git ls-tree"; 11 | is(`diff -bu MANIFEST.git MANIFEST`, "", "MANIFEST.git compared to MANIFEST") 12 | and unlink "MANIFEST.git"; 13 | } else { 14 | ok(1, "skip no git"); 15 | } 16 | -------------------------------------------------------------------------------- /t/issue232.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=232 3 | # Carp::longmess broken with C,-O0. -O3 is fine 4 | use strict; 5 | BEGIN { 6 | unshift @INC, 't'; 7 | require TestBC; 8 | } 9 | use Test::More tests => 1; 10 | use Config (); 11 | my $ITHREADS = $Config::Config{useithreads}; 12 | 13 | use B::C (); 14 | my $when = "1.42_61"; 15 | ctestok(1,'C,-O0','ccode232i','use Carp (); exit unless Carp::longmess(); print qq{ok\n}', 16 | (($B::C::VERSION lt $when) ? "TODO " : ""). 17 | '#234 Carp::longmess with C,-O0'); 18 | -------------------------------------------------------------------------------- /t/issue240.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=240 3 | # not repro. fails only as file 4 | use strict; 5 | BEGIN { 6 | unshift @INC, 't'; 7 | require TestBC; 8 | } 9 | use Test::More; 10 | #plan skip_all => "no 5.26 support yet" if $] > 5.025003; 11 | plan tests => 1; 12 | 13 | ctestok(1,'C,-O3','ccode240i',<<'EOF','#240 not repro unicode race condition with \U'); 14 | my $a = "\x{100}\x{101}Aa"; 15 | print "ok\n" if "\U$a" eq "\x{100}\x{100}AA"; 16 | my $b = "\U\x{149}cD"; # no pb without that line 17 | __END__ 18 | EOF 19 | -------------------------------------------------------------------------------- /t/issue46.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=46 3 | use Test::More tests => 1; 4 | use strict; 5 | BEGIN { 6 | unshift @INC, 't'; 7 | require TestBC; 8 | } 9 | 10 | # crashes non-threaded pp_ctl.c:248 cLOGOP->op_first being 0 11 | my $script = <<'EOF'; 12 | my $pattern = 'x'; 'foo' =~ /$pattern/o; 13 | print "ok"; 14 | EOF 15 | 16 | use B::CC; 17 | ctestok(1, "CC", "ccode46i", $script, 18 | (($Config{useithreads} or $B::CC::VERSION >= 1.08) 19 | ? "" : "TODO "). "issue46 m//o cLOGOP->op_first fixed with r610, threaded only"); 20 | -------------------------------------------------------------------------------- /t/critical.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | p=$(perl -ane'print $F[2] if /^FULLPERL =/' Makefile); 3 | log=log.critical-`basename $p`-g`git rev-parse HEAD|cut -c1-8` 4 | test -f $log && mv $log $log~ 5 | # 91 = issue 59 6 | tests="15 27 29 511 224 227 72 74 91 95" 7 | echo $p | tee $log 8 | git log --oneline -1 | tee $log 9 | 10 | t/testc.sh -q -O0 $tests 2>&1 | tee -a $log 11 | t/testc.sh -q -O3 $tests 2>&1 | tee -a $log 12 | $p -Iblib/arch -Iblib/lib t/perldoc.t 2>&1 | tee -a $log 13 | t/testm.sh -q DateTime 2>&1 | tee -a $log 14 | 15 | git log --oneline -1 >> $log 16 | git diff >> $log 17 | $p -V >> $log 18 | -------------------------------------------------------------------------------- /t/issue229.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=229 3 | # walker misses &main::yyy 4 | BEGIN { 5 | unless (-d '.git' and !$ENV{NO_AUTHOR} and !$ENV{HARNESS_ACTIVE}) { 6 | print "1..0 #SKIP Only for author\n"; 7 | exit; 8 | } 9 | } 10 | use strict; 11 | use Test::More tests => 1; 12 | 13 | my $X = $^X =~ m/\s/ ? qq{"$^X"} : $^X; 14 | my $perlcc = "$X -Iblib/arch -Iblib/lib blib/script/perlcc"; 15 | is(`$perlcc --no-spawn -O3 -UB -r -occode229i -e 'sub yyy () { "yyy" } print "ok" if( eval q{yyy} eq "yyy");'`, 16 | "ok", "walker misses &main::yyy"); 17 | -------------------------------------------------------------------------------- /t/issue220.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # GH #220, COP->hints_hash 3 | use strict; 4 | BEGIN { 5 | unshift @INC, 't'; 6 | require TestBC; 7 | } 8 | use Test::More ($] >= 5.010 ? (tests => 1) : (skip_all => '%^H requires v5.10')); 9 | my $script = <<'EOF'; 10 | BEGIN { $^H{dooot} = 1 } 11 | sub hint_fetch { 12 | my $key = shift; 13 | my @results = caller(0); 14 | $results[10]->{$key}; 15 | } 16 | print qq{ok\n} if hint_fetch("dooot"); 17 | EOF 18 | 19 | use B::C (); 20 | my $todo = ($B::C::VERSION ge '1.52_22') ? "" : "TODO "; 21 | 22 | ctestok(1, 'C', 'ccode200i', $script, 23 | $todo.'#200 hints hash saved'); 24 | -------------------------------------------------------------------------------- /t/issue52.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=52 3 | # B:CC errors on variable with numeric value used in second expression of 'and' 4 | use Test::More tests => 1; 5 | use strict; 6 | BEGIN { 7 | unshift @INC, 't'; 8 | require TestBC; 9 | } 10 | 11 | my $script = <<'EOF'; 12 | my $x; 13 | my $y = 1; 14 | $x and $y == 2; 15 | print $y == 1 ? "ok\n" : "fail\n"; 16 | EOF 17 | 18 | use B::CC; 19 | ctestok(1, "CC", "ccode52i", $script, 20 | $B::CC::VERSION < 1.08 21 | ? "TODO B:CC numeric value used in second expression of 'and' - issue52 fixed with r692" 22 | : undef); 23 | -------------------------------------------------------------------------------- /t/issue105.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=105 3 | # v5.16 Missing bc imports 4 | use strict; 5 | BEGIN { 6 | unshift @INC, 't'; 7 | require TestBC; 8 | } 9 | use Test::More tests => 1; 10 | use Config (); 11 | my $ITHREADS = $Config::Config{useithreads}; 12 | 13 | my $source = 'package A; 14 | use Storable qw/dclone/; 15 | 16 | my $a = \""; 17 | dclone $a; 18 | print q(ok)'; 19 | 20 | my $cmt = "BC missing import 5.16"; 21 | my $todo = ($] =~ /^5.016/ and $Config{useithreads}) ? "TODO " : ""; 22 | $todo = "TODO " if $] < 5.007; 23 | plctestok(1, "ccode105i", $source, $todo.$cmt); 24 | -------------------------------------------------------------------------------- /t/c_o2.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # better use testc.sh -O2 for debugging 3 | BEGIN { 4 | unless (-d '.git' and !$ENV{NO_AUTHOR}) { 5 | print "1..0 #SKIP Only if -d .git\n"; 6 | exit; 7 | } 8 | if ($ENV{PERL_CORE}) { 9 | @INC = ('t', '../../lib'); 10 | } else { 11 | unshift @INC, 't'; 12 | } 13 | require TestBC; 14 | } 15 | use strict; 16 | #my $DEBUGGING = ($Config{ccflags} =~ m/-DDEBUGGING/); 17 | #my $ITHREADS = ($Config{useithreads}); 18 | 19 | prepare_c_tests(); 20 | 21 | my @todo = todo_tests_default("c_o2"); 22 | my @skip; 23 | #push @skip, 29 if $] > 5.015; #hangs 24 | 25 | run_c_tests("C,-O2", \@todo, \@skip); 26 | -------------------------------------------------------------------------------- /t/issue32.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=32 3 | # use open and @ARGV 4 | use strict; 5 | use Test::More; 6 | plan skip_all => "$] has no IO discipline" if $] < 5.006; 7 | plan tests => 1; 8 | BEGIN { 9 | unshift @INC, 't'; 10 | require TestBC; 11 | } 12 | my $name = 'ccode32i.pl'; 13 | open my $fh, '>', $name or die; 14 | print $fh 'use open ":encoding(utf8)";my $x;print @ARGV'; 15 | close $fh; 16 | 17 | my $X = $^X =~ m/\s/ ? qq{"$^X" -Iblib/arch -Iblib/lib} : "$^X -Iblib/arch -Iblib/lib"; 18 | is(`$X blib/script/perlcc -O3 -occode32i -r $name 1 2 3`, 19 | '123', "use open and \@ARGV"); 20 | 21 | -------------------------------------------------------------------------------- /t/issue44.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=44 3 | # pp_aelemfast not implemented for local vars OPf_SPECIAL 4 | use Test::More tests => 1; 5 | use strict; 6 | BEGIN { 7 | unshift @INC, 't'; 8 | require TestBC; 9 | } 10 | 11 | # fails to compile non-threaded, wrong result threaded 12 | my $script = <<'EOF'; 13 | my @a = (1,2); 14 | print $a[0], "\n"; 15 | EOF 16 | 17 | use B::CC; 18 | ctest(1, '^1$', "CC", "ccode44i", $script, # fixed with B::CC 1.08 r601 (B-C-1.28) 19 | ($B::CC::VERSION < 1.08 ? "TODO " : "") 20 | . "pp_aelemfast not implemented for local vars OPf_SPECIAL, fixed with B-C-1.28"); 21 | -------------------------------------------------------------------------------- /t/issue47.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=47 3 | # B::CC gets lost of anonymous function using "while" and "return" 4 | use Test::More tests => 1; 5 | use strict; 6 | BEGIN { 7 | unshift @INC, 't'; 8 | require TestBC; 9 | } 10 | 11 | my $script = <<'EOF'; 12 | my $f = sub { 13 | while (1) { 14 | return (1); 15 | } 16 | }; 17 | print $f->(), "\n"; 18 | EOF 19 | 20 | use B::CC; 21 | TODO: { 22 | local $TODO = "broken with 5.24" if $] > 5.023007; 23 | ctest(1, '^1$', "CC", "ccode47i", $script, 24 | ($B::CC::VERSION < 1.08 ? "TODO ":"")."CC anonsub in while fixed with r618"); 25 | } 26 | -------------------------------------------------------------------------------- /t/issue259.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=259 3 | # enforce atttrbutes to be loaded before JSON::XS 4 | 5 | use strict; 6 | BEGIN { 7 | unshift @INC, 't'; 8 | require TestBC; 9 | } 10 | use Test::More; 11 | eval "use JSON::XS;"; 12 | if ($@) { 13 | plan skip_all => "JSON::XS required for testing issue259" ; 14 | } else { 15 | plan tests => 1; 16 | } 17 | use B::C (); 18 | my $todo = ($B::C::VERSION ge '1.43_02' or $] < 5.009) ? "" : "TODO "; 19 | 20 | ctestok(1,'C,-O3','ccode259i',<<'EOF',$todo.'attributes load-order #259'); 21 | use JSON::XS; 22 | print q(ok) if q([false]) eq encode_json([\0]); 23 | EOF 24 | -------------------------------------------------------------------------------- /t/issue39.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=39 3 | # B::CC generated code aborts with "Bizarre copy of ARRAY in leavesub" 4 | use Test::More tests => 1; 5 | use strict; 6 | BEGIN { 7 | unshift @INC, 't'; 8 | require TestBC; 9 | } 10 | 11 | my $script = <<'EOF'; 12 | sub f1 { 0 } 13 | sub f2 { 14 | my $x; 15 | if ( f1() ) {} 16 | if ($x) {} else { [$x] } 17 | } 18 | my @a = f2(); 19 | print "ok"; 20 | EOF 21 | 22 | TODO: { 23 | local $TODO = "broken with 5.24" if $] > 5.023007; 24 | ctestok(1, "CC", "ccode39i", $script, 25 | "CC Bizarre copy of ARRAY in leavesub fixed with r596"); 26 | } 27 | -------------------------------------------------------------------------------- /ramblings/mk-slides.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # cpan Pod::S5 3 | 4 | #perl -MTest::Pod -e'pod_file_ok q(frozenperl_2010.pod)' && \ 5 | #pod2s5 --theme rurban --creation "Minneapolis Sat Feb 7, 2010" \ 6 | # --name "Frozen Perl 2010" \ 7 | # --where "Reini Urban" frozenperl_2010.pod 8 | 9 | perl -MTest::Pod -e'pod_file_ok q(yapceu_2010.pod)' && \ 10 | pod2s5 --theme rurban --creation "Pisa Wed Aug 4, 2010" \ 11 | --name "YAPC::EU 2010" \ 12 | --where "Reini Urban" yapceu_2010.pod 13 | 14 | #perl -MTest::Pod -e'pod_file_ok q(cp_light.pod)' && \ 15 | #pod2s5 --theme rurban --creation "Austin Tue Oct 11, 2011" \ 16 | # --name "bootcamp 2011" \ 17 | # --where "Reini Urban" cp_light.pod 18 | -------------------------------------------------------------------------------- /t/issue38.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=38 3 | # $x = $x || 3 didn't work with B::CC 4 | use Test::More tests => 1; 5 | use strict; 6 | BEGIN { 7 | unshift @INC, 't'; 8 | require TestBC; 9 | } 10 | 11 | # we should return the value (2) not just 0/1 (false/true) 12 | my $script = <<'EOF'; 13 | my $x = 2; 14 | $x = $x || 3; 15 | print "ok\n" if $x == 2; 16 | EOF 17 | 18 | use B::CC; 19 | ctestok(1, "CC", "ccode38i", $script, 20 | $B::CC::VERSION < 1.08 21 | ? "TODO B::CC issue 38 fixed with B-C-1.28 r559 (B::CC 1.08) by Heinz Knutzen" 22 | : 'CC $x = $x || 3 should return the value not return true/false'); 23 | -------------------------------------------------------------------------------- /t/issue348.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=348 3 | # walker: missing packages 4 | 5 | use strict; 6 | BEGIN { 7 | unshift @INC, 't'; 8 | require TestBC; 9 | } 10 | use Test::More tests => 1; 11 | 12 | # 5.10 fixed with 1.48 13 | #my $todo = ($] > 5.009 and $] < 5.011) ? "TODO " : ""; 14 | ctestok(1, 'C,-O3', 'ccode348i', <<'EOF', 'C #348 do not drop method-only user pkgs'); 15 | package Foo::Bar; 16 | sub baz { 1 } 17 | 18 | package Foo; 19 | sub new { bless {}, shift } 20 | sub method { print "ok\n"; } 21 | 22 | package main; 23 | Foo::Bar::baz(); 24 | my $foo = sub { 25 | Foo->new 26 | }->(); 27 | $foo->method; 28 | EOF 29 | 30 | 31 | -------------------------------------------------------------------------------- /appveyor.yml: -------------------------------------------------------------------------------- 1 | version: 1.0.{build} 2 | skip_tags: true 3 | clone_depth: 1 4 | init: 5 | - git config --global core.autocrlf input 6 | # Mingw and Cygwin now builtin: http://www.appveyor.com/updates/2015/05/30 7 | #os: MinGW 8 | # TODO still broken. rather try MSVC 9 | build_script: 10 | - set PATH=C:\windows\system32;C:\Perl\site\bin;C:\Perl\bin;C:\windows;C:\MinGW\bin 11 | - ppm install dmake 12 | - perl Makefile.PL MAKE=dmake 13 | - dmake 14 | test_script: 15 | - dmake test 16 | notifications: 17 | - provider: Email 18 | to: 19 | - rurban@cpan.org 20 | subject: B-C windows build 21 | on_build_success: true 22 | on_build_failure: true 23 | on_build_status_changed: false 24 | -------------------------------------------------------------------------------- /t/issue242.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=242 3 | # -fno-fold and OP_UCFIRST 4 | use strict; 5 | BEGIN { 6 | unshift @INC, 't'; 7 | require TestBC; 8 | } 9 | use Test::More tests => 2; 10 | # in branch swashnew-273 ($init1) fails since 5.16 11 | 12 | # need -uDynaLoader or -ffold 13 | my $script = <<'EOF'; 14 | $xyz = ucfirst("\x{3C2}"); # no problem without that line 15 | $a = "\x{3c3}foo.bar"; 16 | ($c = $a) =~ s/(\p{IsWord}+)/ucfirst($1)/ge; 17 | print "ok\n" if $c eq "\x{3a3}foo.Bar"; 18 | EOF 19 | 20 | ctestok(1,'C','ccode242i',$script, '#242 C,-O0 ucfirst demandloads unicore/To/Title.pl'); 21 | ctestok(2,'C,-O3','ccode242i',$script, '#242 -O3'); 22 | -------------------------------------------------------------------------------- /t/issue48.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=48 3 | # B:CC takes wrong truth value for array assignment in boolean context 4 | use Test::More tests => 1; 5 | use strict; 6 | BEGIN { 7 | unshift @INC, 't'; 8 | require TestBC; 9 | } 10 | 11 | my $script = <<'EOF'; 12 | sub f { () } 13 | print((my ($v) = f()) ? 1 : 2, "\n"); 14 | EOF 15 | 16 | use B::CC; 17 | TODO: { 18 | local $TODO = "broken with 5.24" if $] > 5.023007; 19 | ctest(1, '^2', "CC", "ccode48i", $script, # fixed with B::CC 1.08 r614 20 | ($B::CC::VERSION < 1.08 ? "TODO " : "") 21 | . "CC wrong truth value for array assignment in boolean context, fixed with B-C-1.28"); 22 | } 23 | -------------------------------------------------------------------------------- /log.modules-5.028002-nt: -------------------------------------------------------------------------------- 1 | # B::C::VERSION = 1.56 10c899f0 2019-05-05 | more log.modules 2 | # perlversion = 5.028002-nt 3 | # path = /usr/local/bin/perl5.28.2-nt 4 | # platform = linux 64bit non-threaded 5 | pass Exporter 6 | pass Text::Tabs 7 | fail Text::Wrap 8 | fail Test::Harness 9 | pass Pod::Escapes 10 | pass Pod::Simple 11 | fail IO 12 | fail Scalar::Util 13 | pass Getopt::Long 14 | pass Pod::Parser 15 | fail ExtUtils::MakeMaker 16 | fail Test::Simple 17 | fail ExtUtils::Manifest 18 | fail Pod::Text 19 | pass constant 20 | pass Test 21 | fail Data::Dumper 22 | fail File::Spec 23 | fail File::Temp 24 | fail ExtUtils::Install 25 | pass Text::ParseWords 26 | fail ExtUtils::CBuilder 27 | fail ExtUtils::ParseXS 28 | -------------------------------------------------------------------------------- /t/issue312.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=312 3 | # --staticxs: dynamic loading not available in this perl -DNO_DYNAMIC_LOADING 4 | use strict; 5 | BEGIN { 6 | unshift @INC, 't'; 7 | require TestBC; 8 | } 9 | use Test::More tests => 2; 10 | 11 | my $X = $^X =~ m/\s/ ? qq{"$^X"} : $^X; 12 | my $perlcc = "$X -Iblib/arch -Iblib/lib blib/script/perlcc"; 13 | 14 | is(`$perlcc -O3 --staticxs -o ccode312i -r -e 'require Scalar::Util; eval "require List::Util"; print "ok"'`, "ok", 15 | "#312 dynamic loading not available in this perl"); 16 | is(`$perlcc -O3 --staticxs -o ccode312i -r -e 'require IO; eval "require List::Util"; print "ok"'`, "ok", 17 | "#312"); 18 | -------------------------------------------------------------------------------- /t/issue391.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # GH #391 3 | use strict; 4 | my @plan; 5 | BEGIN { 6 | if ($ENV{PERL_CORE}) { 7 | unshift @INC, ('t', '../../lib'); 8 | } else { 9 | unshift @INC, 't', "blib/arch", "blib/lib"; 10 | } 11 | require TestBC; 12 | 13 | if ($^O eq 'MSWin32' and $ENV{APPVEYOR}) { 14 | @plan = (skip_all => 'Overlong tests, timeout on Appveyor CI'); 15 | } else { 16 | @plan = (tests => 1); 17 | } 18 | } 19 | use Test::More @plan; 20 | use B::C (); 21 | my $todo = ($] >= 5.018 and $B::C::VERSION lt '1.52_18') ? "TODO 5.18-5.22" : ""; 22 | 23 | ctestok(1,'C,-O3','ccode391i',<<'EOF',$todo.'#391 doeval_compile'); 24 | use warnings 'closed'; 25 | eval "warn 'ok'" 26 | EOF 27 | 28 | -------------------------------------------------------------------------------- /t/c_o1.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # better use testc.sh -O1 for debugging 3 | BEGIN { 4 | unless (-d '.git' and !$ENV{NO_AUTHOR}) { 5 | print "1..0 #SKIP Only if -d .git\n"; 6 | exit; 7 | } 8 | if ($ENV{PERL_CORE}) { 9 | @INC = ('t', '../../lib'); 10 | } else { 11 | unshift @INC, 't'; 12 | } 13 | require TestBC; 14 | } 15 | use strict; 16 | my $DEBUGGING = ($Config{ccflags} =~ m/-DDEBUGGING/); 17 | my $ITHREADS = ($Config{useithreads}); 18 | 19 | prepare_c_tests(); 20 | 21 | my @todo = todo_tests_default("c_o1"); 22 | my @skip = (); 23 | push @skip, 15 if $] == 5.010000 and $ITHREADS and !$DEBUGGING; # hanging; 24 | #push @skip, 29 if $] > 5.015; #hangs 25 | 26 | run_c_tests("C,-O1", \@todo, \@skip); 27 | -------------------------------------------------------------------------------- /t/issue273.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=273 3 | # PVMG RV should not overwrite PV slot 4 | 5 | use strict; 6 | BEGIN { 7 | unshift @INC, 't'; 8 | require TestBC; 9 | } 10 | use Test::More tests => 1; 11 | use B::C (); 12 | 13 | my $todo = ($B::C::VERSION ge '1.43_07') ? "" : "TODO "; 14 | # $todo = "TODO 5.22 " if $] > 5.021; # fixed with 1.52_09 15 | 16 | ctest(1,'11','C,-O3','ccode273i',<<'EOF',$todo.'#273 PVMG RV vs PV'); 17 | package Foo; 18 | use overload; 19 | sub import { overload::constant "integer" => sub { return shift }}; 20 | package main; 21 | BEGIN { $INC{"Foo.pm"} = "/lib/Foo.pm" }; 22 | use Foo; 23 | my $result = eval "5+6"; 24 | print "$result\n"; 25 | EOF 26 | -------------------------------------------------------------------------------- /t/issue51.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=51 3 | # B::CC errors on nested if statement with test on multiple variables 4 | use Test::More tests => 1; 5 | use strict; 6 | BEGIN { 7 | unshift @INC, 't'; 8 | require TestBC; 9 | } 10 | 11 | my $script = <<'EOF'; 12 | my ($p1, $p2) = (80, 80); 13 | if ($p1 <= 23 && 23 <= $p2) { 14 | print "telnet\n"; 15 | } 16 | elsif ($p1 <= 80 && 80 <= $p2) { 17 | print "http\n"; 18 | } 19 | else { 20 | print "fail\n" 21 | } 22 | EOF 23 | 24 | use B::CC; 25 | ctest(1, '^http$', "CC", "ccode51i", $script, 26 | ($B::CC::VERSION < 1.08 ? "TODO " : "") 27 | . "CC nested if on multiple variables - issue51. Fixed with B-C-1.28 r659"); 28 | -------------------------------------------------------------------------------- /Stash/Stash.xs: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | 5 | MODULE=B__Stash PACKAGE=B::Stash 6 | 7 | PROTOTYPES: DISABLE 8 | 9 | # cvname is not a constXSUB 10 | bool 11 | CvIsXSUB(cvname) 12 | SV* cvname; 13 | CODE: 14 | CV *cv; 15 | #if PERLVERSION < 7 16 | GV *const gv = gv_fetchpv(SvPVX(cvname), 0, SVt_PVCV); 17 | #else 18 | GV *const gv = gv_fetchsv(cvname, 0, SVt_PVCV); 19 | #endif 20 | RETVAL = FALSE; 21 | if (gv && (cv = GvCV(gv))) { 22 | if (CvXSUB(cv)) { 23 | #if PERLVERSION < 7 24 | RETVAL = TRUE; 25 | #else 26 | if (!(CvFLAGS(cv) & CVf_CONST) || (CvFLAGS(cv) & CVf_ANON)) { 27 | RETVAL = TRUE; 28 | } 29 | #endif 30 | } 31 | } 32 | OUTPUT: 33 | RETVAL 34 | -------------------------------------------------------------------------------- /t/issue293.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=293 3 | # Empty &Coro::State::_jit and READONLY no_modify double-init run-time errors 4 | use strict; 5 | BEGIN { 6 | unshift @INC, 't'; 7 | require TestBC; 8 | } 9 | use Test::More; 10 | use Config; 11 | eval "use Coro;"; 12 | if ($@) { 13 | plan skip_all => "Coro required for testing issue #293"; 14 | } else { 15 | plan tests => 1; 16 | } 17 | 18 | use B::C (); 19 | my $cmt = '#293 boot Coro::State'; 20 | my $todo = $B::C::VERSION ge '1.46_04' ? "" : "TODO "; 21 | $todo = "TODO 5.10thr " if $] =~ /^5\.010001/ and $Config{useithreads}; 22 | my $script = 'use Coro; print q(ok)'; 23 | 24 | ctestok(1, 'C,-O3', 'ccode293i', $script, $todo.'C '.$cmt); 25 | -------------------------------------------------------------------------------- /t/issue318.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # GH #318 utf8 labels 3 | 4 | use strict; 5 | BEGIN { 6 | unshift @INC, 't'; 7 | require TestBC; 8 | } 9 | use Test::More; 10 | if ($] < 5.016) { 11 | plan skip_all => "No utf8 labels perl-$]"; 12 | exit; 13 | } else { 14 | plan tests => 3; 15 | } 16 | 17 | use B::C (); 18 | # fixed with 1.52_16 19 | my $todo = $B::C::VERSION lt '1.52_16' ? "TODO " : ""; 20 | my $cmt = '#318 utf8 labels'; 21 | my $script = 'use utf8; ＬＯＯＰ: { last ＬＯＯＰ } print qq(ok\n)'; 22 | 23 | ctestok(1, 'C,-O3', 'ccode318i', $script, $todo."C $cmt"); 24 | ctestok(2, 'CC', 'ccode318i', $script, $todo."CC $cmt"); 25 | 26 | TODO: { 27 | local $TODO = 'not yet' if $] < 5.022; 28 | plctestok(3, "ccode318i", $script, "BC $cmt"); 29 | } 30 | -------------------------------------------------------------------------------- /t/issue76.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=76 3 | # Fix lexical warnings: warn->sv 4 | use Test::More tests => 3; 5 | use strict; 6 | use Config; 7 | BEGIN { 8 | unshift @INC, 't'; 9 | require TestBC; 10 | } 11 | my $script = <<'EOF'; 12 | use warnings; 13 | { 14 | no warnings q(void); # issue76 lexwarn 15 | length "ok"; 16 | print "ok" 17 | } 18 | EOF 19 | 20 | ok(1, "bytecode LEXWARN skip"); 21 | 22 | use B::C; 23 | ctestok(2, "C", "ccode76i", $script, 24 | (($B::C::VERSION lt '1.36' or ($] =~ /^5\.010/ and $Config{useithreads})) ? "TODO " : ""). 25 | "C LEXWARN implemented with B-C-1.36" 26 | ); 27 | 28 | use B::CC; 29 | ctestok(3, "CC", "ccode76i", $script, "CC LEXWARN"); 30 | -------------------------------------------------------------------------------- /t/c_o4.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # better use testc.sh -O4 for debugging 3 | BEGIN { 4 | unless (-d '.git' and !$ENV{NO_AUTHOR}) { 5 | print "1..0 #SKIP Only if -d .git\n"; 6 | exit; 7 | } 8 | if ($ENV{PERL_CORE}) { 9 | @INC = ('t', '../../lib'); 10 | } else { 11 | unshift @INC, 't'; 12 | } 13 | require TestBC; 14 | } 15 | use strict; 16 | my $DEBUGGING = ($Config{ccflags} =~ m/-DDEBUGGING/); 17 | #my $ITHREADS = ($Config{useithreads}); 18 | 19 | prepare_c_tests(); 20 | 21 | my @todo = todo_tests_default("c_o4"); 22 | my @skip = (#15, # DynaLoader::dl_load_file() 23 | #27, # DynaLoader::dl_load_file() 24 | $DEBUGGING ? () : 29, # issue 78 if not DEBUGGING > 5.15 25 | ); 26 | 27 | run_c_tests("C,-O4", \@todo, \@skip); 28 | -------------------------------------------------------------------------------- /t/issue201.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=201 3 | # broken %INC. Subroutine import redefined at .../Config.pm line 38 4 | BEGIN { 5 | unless (-d '.git' and !$ENV{NO_AUTHOR}) { 6 | print "1..0 #SKIP Only if -d .git\n"; 7 | exit; 8 | } 9 | } 10 | use strict; 11 | use Test::More tests => 2; 12 | 13 | my $X = $^X =~ m/\s/ ? qq{"$^X"} : $^X; 14 | my $perlcc = "$X -Iblib/arch -Iblib/lib blib/script/perlcc"; 15 | 16 | my $result = `$perlcc -O3 -UB -occode201i -r -e 'sub can {require Config; Config->import;return \$Config{d_flock}}use IO::File;can();print "ok\n"' 2>pccerr`; 17 | my $err = do { local $/; open my $fh, "pccerr"; <$fh> }; 18 | is($err, "", "stderr"); 19 | is($result, "ok\n"); 20 | END { unlink "pccerr" } 21 | -------------------------------------------------------------------------------- /t/cc_o2.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # better use testcc.sh -O2 for debugging 3 | BEGIN { 4 | use Config; 5 | unless (-d '.git' and !$ENV{NO_AUTHOR}) { 6 | print "1..0 #SKIP Only if -d .git\n"; 7 | exit; 8 | } 9 | if ($ENV{PERL_CORE}) { 10 | @INC = ('t', '../../lib'); 11 | } else { 12 | unshift @INC, 't'; 13 | } 14 | require TestBC; 15 | } 16 | use strict; 17 | #my $DEBUGGING = ($Config{ccflags} =~ m/-DDEBUGGING/); 18 | #my $ITHREADS = ($Config{useithreads}); 19 | 20 | prepare_c_tests(); 21 | 22 | my @todo = todo_tests_default("cc_o2"); 23 | # skip core dump causing known limitations, like custom sort or runtime labels 24 | my @skip = (14,21,24,25,27,30,31,46,103,105); 25 | # fails >=5.16 with -faelem 26 | 27 | run_c_tests("CC,-O2", \@todo, \@skip); 28 | -------------------------------------------------------------------------------- /ramblings/reg.alloc: -------------------------------------------------------------------------------- 1 | while ($i--) { 2 | foo(); 3 | } 4 | exit 5 | 6 | PP code if i an int register if i an int but not a 7 | (i.e. can't be register (i.e. can be 8 | implicitly invalidated) implicitly invalidated) 9 | nextstate 10 | enterloop 11 | 12 | 13 | loop: 14 | gvsv GV (0xe6078) *i validates i validates i 15 | postdec invalidates $i invalidates $i 16 | and if_false goto out; 17 | i valid; $i invalid i valid; $i invalid 18 | 19 | i valid; $i invalid i valid; $i invalid 20 | nextstate 21 | pushmark 22 | gv GV (0xe600c) *foo 23 | entersub validates $i; invals i 24 | 25 | unstack 26 | goto loop: 27 | 28 | i valid; $i invalid 29 | out: 30 | leaveloop 31 | nextstate 32 | exit 33 | -------------------------------------------------------------------------------- /t/issue287.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # https://github.com/rurban/perl-compiler/issues/287 3 | # handle Inf,Nan stored in variables 4 | use strict; 5 | BEGIN { 6 | unshift @INC, 't'; 7 | require TestBC; 8 | } 9 | use Test::More tests => 3; 10 | use Config; 11 | use B::C (); 12 | my $when = "1.52_06"; 13 | my $todo = $B::C::VERSION lt $when ? "TODO " : ""; 14 | 15 | ctestok(1,'C,-O3','ccode287i',<<'EOF',$todo.'C #287 inf/nan'); 16 | my $i = "Inf" + 0; print $i <= 0 ? "not " : "", "ok 1 #".int($i)."\n"; 17 | EOF 18 | 19 | ctestok(2,'CC','ccode287i',<<'EOF',$todo.'CC #287 inf/nan'); 20 | my $i = "Inf" + 0; print qq/ok\n/ if $i > 0; 21 | EOF 22 | 23 | plctestok(3,'ccode287i',<<'EOF',($]>5.021?'TODO ':'').'BC #287 inf/nan'); 24 | my $i = "Inf" + 0; print qq/ok\n/ if $i > 0; 25 | EOF 26 | -------------------------------------------------------------------------------- /t/issue2741.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # GH #274, custom op Devel_Peek_Dump 3 | 4 | use strict; 5 | BEGIN { 6 | unshift @INC, 't'; 7 | require TestBC; 8 | } 9 | use Test::More; 10 | plan skip_all => 'custom op Dump since 5.19.3' if $] < 5.019003; 11 | plan tests => 2; 12 | 13 | use B::C (); 14 | my $todo = ($B::C::VERSION ge '1.52_11') ? "" : "TODO "; 15 | $todo = "" if $] < 5.019003; 16 | 17 | ctest(1, "ok", 'C','ccode2741i',<<'EOF',$todo.'custom op'); 18 | use Devel::Peek; my %hash = ( a => 1 ); Dump(%hash); print "ok\n" 19 | EOF 20 | 21 | ctest(2, "ok", 'C,-O1','ccode2741i',<<'EOF',$todo.'custom op -O1'); 22 | use Devel::Peek; my %hash = ( a => 1 ); Dump(%hash); print "ok\n" 23 | EOF 24 | 25 | # no tests yet for other custom ops, with the address via Perl_custom_op_xop( $$op ) 26 | -------------------------------------------------------------------------------- /t/cc_o1.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # better use testcc.sh -O1 for debugging 3 | BEGIN { 4 | unless (-d '.git' and !$ENV{NO_AUTHOR}) { 5 | print "1..0 #SKIP Only if -d .git\n"; 6 | exit; 7 | } 8 | if ($ENV{PERL_CORE}) { 9 | @INC = ('t', '../../lib'); 10 | } else { 11 | unshift @INC, 't'; 12 | } 13 | require TestBC; 14 | } 15 | use strict; 16 | my $DEBUGGING = ($Config{ccflags} =~ m/-DDEBUGGING/); 17 | my $ITHREADS = ($Config{useithreads}); 18 | 19 | my @todo = todo_tests_default("cc_o1"); 20 | # skip core dump causing known limitations, like custom sort or runtime labels 21 | my @skip = (14,21,24,31,46); 22 | push @skip, 103 if $] == 5.010000 and $ITHREADS and !$DEBUGGING; # hanging 23 | push @skip, 105 if $] > 5.015; 24 | 25 | run_c_tests("CC,-O1", \@todo, \@skip); 26 | -------------------------------------------------------------------------------- /t/issue368.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=293 3 | # Empty &Coro::State::_jit and READONLY no_modify double-init run-time errors 4 | use strict; 5 | BEGIN { 6 | unshift @INC, 't'; 7 | require TestBC; 8 | } 9 | use Test::More; 10 | use Config; 11 | eval "use EV;"; 12 | if ($@) { 13 | plan skip_all => "EV required for testing issue #368"; 14 | } else { 15 | plan tests => 1; 16 | } 17 | 18 | use B::C (); 19 | my $cmt = '#368 boot EV'; 20 | my $todo = $B::C::VERSION ge '1.51' ? "" : "TODO "; 21 | $todo = "TODO 5.10thr " if $] =~ /^5\.010001/ and $Config{useithreads}; 22 | $todo = "TODO cperl " if $Config{usecperl} || $] >= 5.022; 23 | my $script = 'use EV; print q(ok)'; 24 | 25 | ctestok(1, 'C,-O3', 'ccode368i', $script, $todo.'C '.$cmt); 26 | 27 | -------------------------------------------------------------------------------- /t/issue148.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=148 3 | # Opening Bareword Filehandles for Writing does not work 4 | use Test::More tests => 2; 5 | use strict; 6 | BEGIN { 7 | unshift @INC, 't'; 8 | require TestBC; 9 | } 10 | # failed 5.10 only (B::FM object for GvFORM) 11 | #my $todo = ($] =~ /^5\.010/) ? "TODO " : ""; 12 | my $todo = ""; # fixed with 1.45_08 13 | 14 | my $tmp = "ccode148i.tmp"; 15 | ctestok(1, "C,-O3", 'ccode148i', '$tmp="ccode148i.tmp";open(FH,">",$tmp);print FH "1\n";close FH;print "ok" if -s $tmp', "#148 bareword IO") and unlink $tmp; 16 | 17 | ctestok(2, "C,-O3", 'ccode149i', <<'EOF', $todo.'#149 format with bareword IO'); 18 | format Comment = 19 | ok 20 | . 21 | 22 | { 23 | local $~ = "Comment"; 24 | write; 25 | } 26 | EOF 27 | -------------------------------------------------------------------------------- /t/c_o3.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # better use testc.sh -O3 for debugging 3 | BEGIN { 4 | #unless (-d '.git' and !$ENV{NO_AUTHOR}) { 5 | # print "1..0 #SKIP Only if -d .git\n"; 6 | # exit; 7 | #} 8 | if ($ENV{PERL_CORE}) { 9 | unshift @INC, ('t', '../../lib'); 10 | } else { 11 | unshift @INC, 't'; 12 | } 13 | require TestBC; 14 | } 15 | use strict; 16 | my $DEBUGGING = ($Config{ccflags} =~ m/-DDEBUGGING/); 17 | #my $ITHREADS = ($Config{useithreads}); 18 | $ENV{SKIP_SLOW_TESTS} = 1 if $Config{ccflags} =~ /-flto|-fsanitize/; 19 | 20 | prepare_c_tests(); 21 | 22 | my @todo = todo_tests_default("c_o3"); 23 | my @skip = ( 24 | $DEBUGGING ? () : 29, # issue 78 if not DEBUGGING > 5.15 25 | ); 26 | push @skip, (21,38) if $^O eq 'cygwin'; #hangs 27 | 28 | run_c_tests("C,-O3", \@todo, \@skip); 29 | -------------------------------------------------------------------------------- /t/issue390.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # GH #390 wrong PERL_MAGIC_backref REFCOUNTED mg_flags 3 | use strict; 4 | my @plan; 5 | BEGIN { 6 | if ($ENV{PERL_CORE}) { 7 | unshift @INC, ('t', '../../lib'); 8 | } else { 9 | unshift @INC, 't', "blib/arch", "blib/lib"; 10 | } 11 | require TestBC; 12 | 13 | if ($^O eq 'MSWin32' and $ENV{APPVEYOR}) { 14 | @plan = (skip_all => 'Overlong tests, timeout on Appveyor CI'); 15 | } else { 16 | @plan = (tests => 1); 17 | } 18 | } 19 | use Test::More @plan; 20 | #use B::C (); 21 | #my $todo = ($B::C::VERSION le '1.56') ? "TODO" : ""; 22 | my $todo = "TODO"; 23 | 24 | ctestok(1,'C,-O3','ccode390i',<<'EOF',$todo.' \#390 backref REFCOUNTED flag'); 25 | print test(); print test(); 26 | sub test() { 27 | *test = sub () { "k" }; 28 | "o"; 29 | } 30 | EOF 31 | 32 | -------------------------------------------------------------------------------- /t/c.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # better use testc.sh for debugging 3 | use Config; 4 | use File::Spec; 5 | BEGIN { 6 | if ($ENV{PERL_CORE}) { 7 | unshift @INC, ('t', '../../lib'); 8 | } else { 9 | unshift @INC, 't'; 10 | } 11 | require TestBC; 12 | } 13 | use strict; 14 | #my $DEBUGGING = ($Config{ccflags} =~ m/-DDEBUGGING/); 15 | #my $ITHREADS = ($Config{useithreads}); 16 | $ENV{SKIP_SLOW_TESTS} = 1 if $Config{ccflags} =~ /-flto|-fsanitize/; 17 | 18 | prepare_c_tests(); 19 | 20 | my @todo = todo_tests_default("c"); 21 | my @skip = (); 22 | #push @skip, 29 if $] > 5.015; #hangs at while Perl_hfree_next_entry hv.c:1670 23 | push @skip, (21,38) if $^O eq 'cygwin'; #hangs 24 | # 38 hangs in IO reading from /dev/null 25 | push @todo, (27,41,44,45,49) if $^O eq 'cygwin'; #SEGV 26 | 27 | run_c_tests("C", \@todo, \@skip); 28 | -------------------------------------------------------------------------------- /t/issue159.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=159 3 | # wrong ISA with empty packages, and wrong dumping of unfound methods 4 | use Test::More tests => 2; 5 | use strict; 6 | BEGIN { 7 | unshift @INC, 't'; 8 | require TestBC; 9 | } 10 | 11 | use B::C; 12 | my $when = "1.42_61"; 13 | ctestok(1, "C,-O3", 'ccode159i_c', 14 | 'BEGIN{@X::ISA="Y";sub Y::z{"Y::z"}} print "ok\n" if X->z eq "Y::z";delete $X::{z};exit', 15 | ($B::C::VERSION lt $when ? "TODO " : ""). 16 | "wrong ISA with empty packages fixed with B-C-$when"); 17 | ctestok(2, "C,-O3", 'ccode159i_r', 18 | '@X::ISA="Y";sub Y::z{"Y::z"} print "ok\n" if X->z eq "Y::z";delete $X::{z};exit', 19 | ($B::C::VERSION lt $when ? "TODO " : ""). 20 | "wrong method dispatch by dumping unfound methods fixed with B-C-$when"); 21 | -------------------------------------------------------------------------------- /t/sigs.t: -------------------------------------------------------------------------------- 1 | # cperl or perl signatures 2 | use strict; 3 | BEGIN { 4 | unshift @INC, 't'; 5 | require TestBC; 6 | } 7 | use Test::More; 8 | use Config; 9 | 10 | plan skip_all => "no sigs before 5.20" if $] < 5.020; 11 | plan tests => 4; 12 | 13 | my $src = 'sub x($x){ print $x } x("ok")'; 14 | my ($todo, $todocc) = ('',''); 15 | 16 | if (!$Config{usecperl}) { 17 | $todo = 'TODO ' if $] >= 5.025; 18 | $todocc = 'TODO ' if $] > 5.023007; 19 | # experimental was first released with perl v5.19.11 20 | $src = < 4; 10 | use Config; 11 | use B::C (); 12 | my $todo = ($B::C::VERSION ge '1.52_12') ? "" : "TODO "; 13 | $todo = "TODO 5.22-thr " if $] > 5.021 and $Config{useithreads}; 14 | my $todoc = ""; 15 | $todoc = "TODO cperl unopaux" if $Config{usecperl}; 16 | my $script = <<'EOF'; 17 | INIT { $SIG{__WARN__} = sub { die } } print "ok\n"; 18 | EOF 19 | 20 | ctestok(1, 'C', 'ccode306i', $script, $todo.'C init_av warnfree'); 21 | ctestok(2, 'C,-O3','ccode306i', $script, $todo.$todoc.'C,-O3 init_av warnfree'); 22 | $script =~ s/INIT /END /; 23 | ctestok(3, 'C', 'ccode306i', $script, $todo.'C end_av warnfree'); 24 | ctestok(4, 'C,-O3','ccode306i', $script, $todo.'C,-O3 end_av warnfree'); 25 | -------------------------------------------------------------------------------- /t/issue206.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # GH #208 utf8 symbols and stashes > 5.16 3 | # get_cvn_flags, gv_fetchpvn_flags, gv_stashpvn_flags 4 | use strict; 5 | BEGIN { 6 | unshift @INC, 't'; 7 | require TestBC; 8 | } 9 | use Test::More; 10 | plan skip_all => 'unicode symbols with 5.16' if $] < 5.016; 11 | plan tests => 3; 12 | use B::C (); 13 | my $todo = ($B::C::VERSION lt '1.52_03' ? "TODO " : ""); 14 | 15 | ctestok(1,'C','ccode206i',<<'EOF',$todo.'#206 utf8 symbols'); 16 | use utf8;package 텟ţ::ᴼ; sub ᴼ_or_Ḋ { "ok" } print ᴼ_or_Ḋ; 17 | EOF 18 | 19 | ctestok(2,'C,-O3','ccode206i',<<'EOF',$todo.'#206 utf8 symbols'); 20 | use utf8;package 텟ţ::ᴼ; sub ᴼ_or_Ḋ { "ok" } print ᴼ_or_Ḋ; 21 | EOF 22 | 23 | ctestok(3,'C,-O3','ccode206i',<<'EOF',$todo.'#206 utf8 symbols'); 24 | use utf8;package ƂƂƂƂ; sub ƟK { "ok" } 25 | package ƦƦƦƦ; use base "ƂƂƂƂ"; my $x = bless {}, "ƦƦƦƦ"; 26 | print $x->ƟK(); 27 | EOF 28 | -------------------------------------------------------------------------------- /t/issue42.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=42 3 | # B::CC uses value from void context in next list context 4 | use Test::More tests => 1; 5 | use strict; 6 | BEGIN { 7 | unshift @INC, 't'; 8 | require TestBC; 9 | } 10 | 11 | # Explanation: 12 | # - f1 is called, it puts value 1 on the stack. 13 | # - f2 should discard this value, because f1 is called in void context. 14 | # - But if a block follows, this value is accidently added to the list 15 | # of return values of f2. 16 | my $script = <<'EOF'; 17 | sub f1 { 1 } 18 | f1(); 19 | print do { 7; 2 }, "\n"; 20 | EOF 21 | 22 | TODO: { 23 | local $TODO = "broken with 5.24" if $] > 5.023007; 24 | # fixed with r596. remove enter/leave from %no_stack, sp sync. 25 | ctest(1, '^2$', "CC", "ccode42i", $script, 26 | 'CC uses value from void context in next list context, fixed with r596'); 27 | } 28 | -------------------------------------------------------------------------------- /ramblings/curcop.runtime: -------------------------------------------------------------------------------- 1 | PP code uses of curcop 2 | ---------------------- 3 | 4 | pp_rv2gv 5 | when a new glob is created for an OPpLVAL_INTRO, 6 | curcop->cop_line is stored as GvLINE() in the new GP. 7 | pp_bless 8 | curcop->cop_stash is used as the stash in the one-arg form of bless 9 | 10 | pp_repeat 11 | tests (curcop != &compiling) to warn "Can't x= to readonly value" 12 | 13 | pp_pos 14 | pp_substr 15 | pp_index 16 | pp_rindex 17 | pp_aslice 18 | pp_lslice 19 | pp_splice 20 | curcop->cop_arybase 21 | 22 | pp_sort 23 | curcop->cop_stash used to determine whether to gv_fetchpv $a and $b 24 | 25 | pp_caller 26 | tests (curcop->cop_stash == debstash) to determine whether 27 | to set DB::args 28 | 29 | pp_reset 30 | resets vars in curcop->cop_stash 31 | 32 | pp_dbstate 33 | sets curcop = (COP*)op 34 | 35 | doeval 36 | compiles into curcop->cop_stash 37 | 38 | pp_nextstate 39 | sets curcop = (COP*)op 40 | -------------------------------------------------------------------------------- /t/issue272.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=272 3 | # "" HV key SvLEN=0 => sharedhash 4 | # if SvIsCOW(sv) && SvLEN(sv) == 0 => sharedhek (key == "") 5 | # >= 5.10: SvSHARED_HASH keysv: PV offset to hek_hash 6 | 7 | use strict; 8 | BEGIN { 9 | unshift @INC, 't'; 10 | require TestBC; 11 | } 12 | use Test::More tests => 2; 13 | use B::C (); 14 | #use Config; 15 | 16 | my $todo = ($B::C::VERSION ge '1.43_02' or $] < 5.009) ? "" : "TODO "; 17 | #$todo = "TODO 5.10 " if $] =~ /^5\.010/; 18 | #my $rtodo = $todo; 19 | #if ($Config{ccflags} =~ /DEBUGGING/ and $] > 5.009) { 20 | # $rtodo = "TODO hek assertion "; 21 | #} 22 | 23 | ctestok(1,'C,-O3','ccode272i',<<'EOF',$todo.'empty run-time HV key #272'); 24 | $d{""} = qq{ok\n}; print $d{""} 25 | EOF 26 | 27 | ctestok(2,'C,-O3','ccode272i',<<'EOF',$todo.'empty compile-time HV key #272'); 28 | BEGIN{ $d{""} = qq{ok\n};} print $d{""} 29 | EOF 30 | -------------------------------------------------------------------------------- /t/issue350.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=350 3 | # special-case Moose XS. walker: missing packages 4 | # see also t/moose-test.pl 5 | 6 | use strict; 7 | BEGIN { 8 | unless (-d '.git' and !$ENV{NO_AUTHOR}) { 9 | print "1..0 #SKIP Compile Moose only if -d .git\n"; 10 | exit; 11 | } 12 | unshift @INC, 't'; 13 | require TestBC; 14 | } 15 | use Test::More; 16 | use Config; 17 | eval "use Moose;"; 18 | 19 | if ($@) { 20 | plan skip_all => "Moose required for testing issue 350" ; 21 | } else { 22 | plan tests => 1; 23 | } 24 | 25 | # my $DEBUGGING = ($Config::Config{ccflags} =~ m/-DDEBUGGING/); 26 | my $todo = ($] > 5.017) ? "TODO " : ""; 27 | ctestok(1, 'C,-O3', 'ccode350i', <<'EOF', $todo.'C #350 Moose deps'); 28 | package Foo::Moose; 29 | use Moose; 30 | has bar => (is => "rw", isa => "Int"); 31 | package main; 32 | my $moose = Foo::Moose->new; 33 | print "ok" if 32 == $moose->bar(32); 34 | EOF 35 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | MYMETA.json 3 | MYMETA.yml 4 | *.bs 5 | *.o 6 | C.bs 7 | C.c 8 | C.o 9 | Stash/Stash.c 10 | Makefile 11 | Makefile.old 12 | ByteLoader/ByteLoader.c 13 | ByteLoader/byterun.* 14 | lib/B/Asmdata.pm 15 | a 16 | a.c 17 | a.c.lst 18 | ccode* 19 | cccode* 20 | a.plc 21 | *.log 22 | log.*.err 23 | pm_to_blib 24 | nohup.out 25 | t/reports 26 | t/CORE/*/*.bin 27 | t/CORE/*/*.c 28 | t/test-*.sh 29 | t/*.c 30 | script/perlcc 31 | ramblings/How-perl-compiles-subs-and-methods.md 32 | ramblings/cp_light.pod 33 | ramblings/cp_meet1.pod 34 | ramblings/mk-sl* 35 | ramblings/cp_meet201110_compiler.tar.gz 36 | ramblings/cplight/ 37 | ramblings/cpmeet1/ 38 | ramblings/frozenperl2010/ 39 | ramblings/yapceu2010/ 40 | blib 41 | lib/B/C/Flags.pm 42 | MANIFEST.files 43 | TAGS 44 | GPATH 45 | GRTAGS 46 | GTAGS 47 | log.test-* 48 | log.make-* 49 | log.do-* 50 | log.critical-* 51 | status.1* 52 | .DS_Store 53 | B-C-*.tar.gz 54 | .commit 55 | *.patch 56 | x*.p 57 | .gdb_history 58 | -------------------------------------------------------------------------------- /t/issue172.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=172 3 | # miss to mark empty overloaded package 4 | # See also t/issue219.t 5 | use strict; 6 | BEGIN { 7 | unshift @INC, 't'; 8 | require TestBC; 9 | } 10 | use Test::More tests => 2; 11 | my $script = <<'EOF'; 12 | package Foo; 13 | use overload q("") => sub { "Foo" }; 14 | package main; 15 | my $foo = bless {}, "Foo"; 16 | print "ok\n" if "$foo" eq "Foo"; 17 | print "$foo\n"; 18 | EOF 19 | 20 | # fixed with 1.42_67, and for 5.18 with 1.52_18 21 | use B::C (); 22 | my $todo = ($B::C::VERSION ge '1.42_67' and $] < 5.018) ? "" : "TODO "; 23 | $todo = ($] >= 5.018 and $B::C::VERSION lt '1.52_18') ? "TODO 5.18-5.22" : ""; 24 | 25 | ctest(1, "ok\nFoo",'C','ccode172i',$script, 26 | $todo.'#172 miss to mark empty overloaded package'); 27 | ctest(2, "ok\nFoo",'C,-uFoo','ccode172i',$script, 28 | ($] >= 5.018 ? $todo : "").'#172 -uFoo includes overloaded package'); 29 | -------------------------------------------------------------------------------- /t/issue235.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=235 3 | # branch empty-cv: assert !CvCVGV_RC(cv) in function Perl_newATTRSUB. again. 4 | # skip saving empty CVs 5 | # But note #246 edge-case conflict: skipping empty CVs needs still prototypes 6 | # to be stored if existing, to be able to catch prototype errors. 7 | use strict; 8 | BEGIN { 9 | unshift @INC, 't'; 10 | require TestBC; 11 | } 12 | use Test::More tests => 2; 13 | 14 | use B::C; 15 | my $when = "1.42_61"; 16 | ctest(1,'6','C,-O3,-UCarp','ccode235i',<<'EOF',($B::C::VERSION lt $when ? "TODO #235 assert !CvCVGV_RC(cv)" : "#235 bytes::length")); 17 | BEGIN{$INC{Carp.pm}++} 18 | my ($d,$ol); $d = pack("U*", 0xe3, 0x81, 0xAF); { use bytes; $ol = bytes::length($d) } print $ol 19 | EOF 20 | 21 | ctest(2,'^Not enough arguments for main','C,-O3','ccode235i',<<'EOF',"#246 missing proto decl for empty subs"); 22 | sub foo($\@); eval q/foo "s"/; print $@ 23 | EOF 24 | -------------------------------------------------------------------------------- /t/issue203.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=203 3 | # perlio layers via use open attributes not stored 4 | BEGIN { 5 | unless (-d '.git') { 6 | print "1..0 #SKIP Only if -d .git\n"; 7 | exit; 8 | } 9 | if ($] >= 5.024) { 10 | print "1..0 #SKIP use open encoding deprecated\n"; 11 | exit; 12 | } 13 | unshift @INC, 't'; 14 | require TestBC; 15 | } 16 | use strict; 17 | use Test::More tests => 1; 18 | 19 | use B::C (); 20 | my $when = "1.53_03"; 21 | my $todo = ($B::C::VERSION lt $when ? "TODO " : ""); 22 | $todo = "TODO " if $] < 5.024; # oops, some time ago 5.22 worked fine. 5.24 broke it upstream 23 | ctestok(1,'C,-O0','ccode203i',<<'EOF',$todo.'#203 restore compile-time perlio layers via use open'); 24 | use open(IN => ":crlf", OUT => ":encoding(cp1252)"); 25 | open F, "<", "/dev/null"; 26 | my %l = map {$_=>1} PerlIO::get_layers(F, input => 1); 27 | print $l{crlf} ? q(ok) : keys(%l); 28 | EOF 29 | -------------------------------------------------------------------------------- /t/issue81.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=81 3 | # store cv prototypes (illegal wth cperl) 4 | use Test::More; 5 | plan skip_all => "illegal prototypes with cperl" if $^V =~ /c$/; 6 | plan tests => 3; 7 | use strict; 8 | BEGIN { 9 | unshift @INC, 't'; 10 | require TestBC; 11 | } 12 | my $name='ccode81i'; 13 | my $script = <<'EOF'; 14 | sub int::check {1} #create int package for types 15 | sub x(int,int) { @_ } #cvproto 16 | print "o" if prototype \&x eq "int,int"; 17 | sub y($) { @_ } #cvproto 18 | print "k" if prototype \&y eq "\$"; 19 | EOF 20 | 21 | use B::C; 22 | my $todo = ($B::C::VERSION lt '1.37' ? "TODO " : ""); 23 | my $todocc = ($B::C::VERSION lt '1.42_61' ? "TODO " : ""); 24 | plctestok(1, $name, $script, "${todo}BC cvproto"); 25 | ctestok(2, "C", $name, $script, "${todo}C cvproto"); 26 | 27 | $todocc = "TODO 5.24 " if $] > 5.023007; 28 | ctestok(3, "CC", $name, $script, "${todocc}CC cvproto"); 29 | 30 | -------------------------------------------------------------------------------- /t/issue340.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=340 3 | # SUPER on run-time loaded IO::Socket does not find compiled IO::Handle->autoflush 4 | # major walker rewrite 5 | # also test that -O3 warnings will not crash when being written to at run-time 6 | 7 | use strict; 8 | BEGIN { 9 | unshift @INC, 't'; 10 | require TestBC; 11 | } 12 | use Test::More; 13 | unless (eval{require Net::DNS;} and eval{require IO::Socket::INET6;}) { 14 | plan skip_all => "require Net::DNS and IO::Socket::INET6"; 15 | exit(0); 16 | } 17 | plan tests => 1; 18 | 19 | # TODO: still prints compile-time Carp reloading cruft 20 | ctestok(1, 'C,-O3', 'ccode340i', <<'EOF', 'C #340 inc cleanup'); 21 | eval q/use Net::DNS/; 22 | my $new = "IO::Socket::INET6"->can("new") or die "die at new"; 23 | my $inet = $new->("IO::Socket::INET6", LocalAddr => q/localhost/, Proto => "udp", LocalPort => undef); 24 | print q(ok) if ref($inet) eq "IO::Socket::INET6"; 25 | EOF 26 | -------------------------------------------------------------------------------- /t/issue281.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=281 3 | # wrong @- values: issues 90, 220, 281, 295 4 | use strict; 5 | BEGIN { 6 | unshift @INC, 't'; 7 | require TestBC; 8 | } 9 | use Test::More; 10 | plan tests => 3; 11 | use B::C (); 12 | use Config; 13 | my $cmt = 'wrong @- values'; 14 | # fixed with 1.45_11 for >= 5.10 15 | $cmt = "TODO ".$cmt if $] > 5.025003; 16 | 17 | # was previously issue90.t test 16 18 | ctestok(1, 'C,-O3', 'ccode281i', <<'EOF', $cmt." #220"); 19 | my $content = "ok\n"; 20 | while ( $content =~ m{\w}g ) { 21 | $_ .= "$-[0]$+[0]"; 22 | } 23 | print "ok" if $_ eq "0112"; 24 | EOF 25 | 26 | ctestok(2, 'C,-O3', 'ccode281i', <<'EOF', $cmt." #281"); 27 | "I like pie" =~ /(I) (like) (pie)/; 28 | "@-" eq "0 0 2 7" and print "ok\n"; 29 | #print "\@- = @-\n\@+ = @+\n" 30 | EOF 31 | 32 | ctestok(3, 'C,-O3', 'ccode281i', <<'EOF', $cmt. ' #295'); 33 | "zzaaabbb" =~ m/(a+)(b+)/; 34 | print "ok\n" if "@-" eq "2 2 5" 35 | EOF 36 | -------------------------------------------------------------------------------- /t/todomod.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | # check and adjust t/modules.t TODO list 3 | use Term::ANSIColor ':constants'; 4 | print "press ",RED,"ENTER",RESET," after each module\n"; 5 | my $gfail; 6 | for $t (`cat t/top100`) { 7 | chomp $t; 8 | local $Term::ANSIColor::AUTORESET = 1; 9 | local @ARGV = grep !/\.(err|bak)/, "t/modules.t", glob "log.modules-5.0*"; 10 | my ($fail,$f,$f1); 11 | while (<>) { 12 | if (!$f or ($f ne $ARGV)) { 13 | $f = $f1 = $ARGV; 14 | $f1 =~ s/log.modules-//; 15 | } 16 | if (/ $t\s/) { 17 | my $reset; 18 | printf "%-20s: ", $f1; 19 | if (/fail / and !/TODO/) { 20 | $reset++; $fail++; 21 | print RED; 22 | } 23 | if (/pass / and /TODO/) { 24 | $reset++; 25 | print GREEN; 26 | } 27 | print $_; 28 | print RESET if $reset; 29 | } 30 | } 31 | print "--\n"; 32 | my $enter = if $fail; 33 | $gfail += $fail if $fail; 34 | } 35 | 36 | print "$gfail fail\n"; 37 | -------------------------------------------------------------------------------- /t/issue354.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # https://github.com/rurban/perl-compiler/issues/354 3 | # defined hashref 4 | use strict; 5 | BEGIN { 6 | unshift @INC, 't'; 7 | require TestBC; 8 | } 9 | use Test::More tests => 1; 10 | use Config; 11 | 12 | my $pm = "Ccode354i.pm"; 13 | open FH, ">", $pm; 14 | print FH <<'EOF'; 15 | package Ccode354i; 16 | my %h = ( 17 | abcd => { code => sub { return q{abcdef} }, }, 18 | ); 19 | sub check { 20 | my ($token) = @_; 21 | return qq{ok\n} if defined $h{ $token->{expansion} }; 22 | return qq{KO\n}; 23 | } 24 | 1 25 | EOF 26 | close FH; 27 | 28 | my $script = <<'EOF'; 29 | BEGIN { require "./Ccode354i.pm"; } 30 | my $token = { expansion => "abcd", }; 31 | print Ccode354i::check($token); 32 | EOF 33 | 34 | use B::C (); 35 | my $cmt = '#354 defined hashref >=5.20'; 36 | # fails since 5.20 37 | my $todo = ($] > 5.019 and $B::C::VERSION lt '1.53_02') ? "TODO " : ""; 38 | 39 | ctestok(1, 'C,-O3', 'ccode354i', $script, $todo.'C '.$cmt); 40 | 41 | END { unlink $pm; } 42 | -------------------------------------------------------------------------------- /t/issue369.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=369 3 | # Coro::State transfer run-time stack corruption 4 | use strict; 5 | BEGIN { 6 | unshift @INC, 't'; 7 | require TestBC; 8 | } 9 | use Test::More; 10 | use Config; 11 | eval "use Coro; use EV;"; 12 | if ($@) { 13 | plan skip_all => "Coro and EV are required for testing issue #369"; 14 | } else { 15 | plan tests => 1; 16 | } 17 | 18 | use B::C (); 19 | my $cmt = '#369 Coro::State transfer run-time stack corruption'; 20 | my $todo = "TODO "; 21 | #my $todo = $B::C::VERSION ge '1.52' ? "" : "TODO "; 22 | #$todo = "TODO 5.10thr " if $] =~ /^5\.010001/ and $Config{useithreads}; 23 | 24 | ctestok(1, 'C,-O3', 'ccode369i', <<'EOF', $todo.'C '.$cmt); 25 | use EV; 26 | use Coro; 27 | use Coro::Timer; 28 | my @a; 29 | push @a, async { 30 | while() { 31 | warn $c++; 32 | Coro::Timer::sleep 1; 33 | }; 34 | }; 35 | push @a, async { 36 | while() { 37 | warn $d++; 38 | Coro::Timer::sleep 0.5; 39 | }; 40 | }; 41 | schedule; 42 | EOF 43 | -------------------------------------------------------------------------------- /t/issue31.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=31 3 | # B:CC Regex in pkg var fails on 5.6 and 5.10 4 | use Test::More tests => 2; 5 | use strict; 6 | BEGIN { 7 | unshift @INC, 't'; 8 | require TestBC; 9 | } 10 | 11 | my $pm = "Ccode31i.pm"; 12 | open FH, ">", $pm; 13 | print FH <<'EOF'; 14 | package Ccode31i; 15 | my $regex = qr/\w+/; 16 | sub test { 17 | #print "$regex\n"; 18 | print ("word" =~ m/^$regex$/o ? "ok\n" : "not ok\n"); 19 | } 20 | 1 21 | EOF 22 | close FH; 23 | 24 | my $script = <<'EOF'; 25 | BEGIN { require "./Ccode31i.pm"; } 26 | &Ccode31i::test(); 27 | EOF 28 | 29 | use B::C (); 30 | # $]<5.007: same as test 33 31 | my $todo = ($] >= 5.010 and $] < 5.011) ? "TODO #31 5.10 " : ""; 32 | ctestok(1, "CC", "ccode31i", $script, 33 | ($B::C::VERSION lt '1.42_55') 34 | ? "TODO B:CC Regex in pkg var fails with 5.6 and >5.10 since 1.35 until 1.42_54" 35 | : $todo."B:CC Regex in pkg var"); 36 | ctestok(2, "C,-O3", "ccode31i", $script, $todo."B:C Regex in pkg var"); 37 | 38 | END { unlink $pm; } 39 | -------------------------------------------------------------------------------- /t/cc.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # better use testcc.sh for debugging 3 | BEGIN { 4 | if ($ENV{PERL_CORE}) { 5 | unshift @INC, ('t', '../../lib'); 6 | } else { 7 | unshift @INC, 't', "blib/arch", "blib/lib"; 8 | } 9 | require TestBC; # for run_perl() 10 | } 11 | use strict; 12 | my $DEBUGGING = ($Config{ccflags} =~ m/-DDEBUGGING/); 13 | #my $ITHREADS = ($Config{useithreads}); 14 | $ENV{SKIP_SLOW_TESTS} = 1 if $Config{ccflags} =~ /-flto|-fsanitize/; 15 | $ENV{SKIP_SLOW_TESTS} = 1 if is_CI() && $^O eq 'cygwin'; 16 | 17 | prepare_c_tests(); 18 | 19 | my @todo = todo_tests_default("cc"); 20 | # skip core dumps and endless loops, like custom sort or runtime labels 21 | my @skip = (14,21,30, 22 | 46, # unsupported: HvKEYS(%Exporter::) is 0 unless Heavy is included also 23 | 103, # hangs with non-DEBUGGING (importing B) 24 | ((!$DEBUGGING and $] > 5.010) ? (105) : ()), 25 | ); 26 | push @skip, (38) if $^O eq 'cygwin'; #hangs 27 | 28 | run_c_tests("CC", \@todo, \@skip); 29 | #run_cc_test(105, 'CC', 'my $s=q{ok};END{print $s}END{$x = 0}', 'ok'); 30 | -------------------------------------------------------------------------------- /t/issue274.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=274 3 | # multiple match once 4 | 5 | use strict; 6 | BEGIN { 7 | unshift @INC, 't'; 8 | require TestBC; 9 | } 10 | use Test::More tests => 1; 11 | use B::C (); 12 | my $todo = ($B::C::VERSION ge '1.43_06') ? "" : "TODO "; 13 | # currently also fails on: cPanel perl5.14, cygwin 5.14. No idea yet why 14 | my $todo = "TODO " if $] < 5.010; 15 | #$todo = "" if $] >= 5.020; 16 | 17 | ctest(1,"1..5\nok 1\nok 2\nok 3\nok 4\nok 5", 'C,-O3','ccode274i',<<'EOF',$todo.'multiple match once #274'); 18 | package Foo; 19 | 20 | sub match { shift =~ m?xyz? ? 1 : 0; } 21 | sub match_reset { reset; } 22 | 23 | package Bar; 24 | 25 | sub match { shift =~ m?xyz? ? 1 : 0; } 26 | sub match_reset { reset; } 27 | 28 | package main; 29 | print "1..5\n"; 30 | 31 | print "ok 1\n" if Bar::match("xyz"); 32 | print "ok 2\n" unless Bar::match("xyz"); 33 | print "ok 3\n" if Foo::match("xyz"); 34 | print "ok 4\n" unless Foo::match("xyz"); 35 | 36 | Foo::match_reset(); 37 | print "ok 5\n" if Foo::match("xyz"); 38 | EOF 39 | -------------------------------------------------------------------------------- /t/issue45.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=45 3 | # dorassign //= failed until B::CC 1.09 (B-C-1.30) 4 | BEGIN { 5 | unless (-d ".git" and !$ENV{NO_AUTHOR}) { 6 | print "1..0 #SKIP Only if -d .git\n"; exit; 7 | } 8 | } 9 | use Test::More tests => 4; 10 | use strict; 11 | BEGIN { 12 | unshift @INC, 't'; 13 | require TestBC; 14 | } 15 | 16 | use B::CC; 17 | SKIP: { 18 | skip "dorassign was added with perl 5.10.0", 4 if $] < 5.010; 19 | # other: define it 20 | ctestok(1, "CC", "ccode45i", 'my $x; $x//=1; print q(ok) if $x;', 21 | ($B::CC::VERSION < 1.09 ? "TODO " : ""). "dorassign other fixed with B-C-1.30"); 22 | # next: already defined 23 | ctestok(2, "CC", "ccode45i", 'my $x=1; $x//=0; print q(ok) if $x;', 24 | ($B::CC::VERSION < 1.09 ? "TODO " : ""). "dorassign next fixed with B-C-1.30"); 25 | 26 | # dor never failed but test it here for regressions 27 | ctestok(3, "CC", "ccode45i", 'my ($x,$y); $x=$y//1;print "ok" if $x;'); 28 | ctestok(4, "CC", "ccode45i", 'my $y=1; my $x=$y//0;print "ok" if $x;'); 29 | } 30 | -------------------------------------------------------------------------------- /t/issue238.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=238 239 3 | # format STDOUT: t/CORE/comp/form_scope.t + t/CORE/io/defout.t 4 | use strict; 5 | BEGIN { 6 | unshift @INC, 't'; 7 | require TestBC; 8 | } 9 | use Test::More tests => 4; 10 | # 5.10 fixed with 1.48 11 | my $todo = ""; # ($] =~ /^5\.010/) ? "TODO " : ""; 12 | 13 | ctestok(1,'C,-O3','ccode238i',<<'EOF',$todo.'#238 format f::STDOUT'); 14 | sub f ($); 15 | sub f ($) { 16 | my $test = $_[0]; 17 | write; 18 | format STDOUT = 19 | ok @<<<<<<< 20 | $test 21 | . 22 | } 23 | f(''); 24 | EOF 25 | 26 | ctestok(2,'C,-O3','ccode239i',<<'EOF',$todo.'#239,#285 format main::STDOUT'); 27 | my $x="1"; 28 | format STDOUT = 29 | ok @<<<<<<< 30 | $x 31 | . 32 | write;print "\n"; 33 | EOF 34 | 35 | ctestok(3,'C,-O3','ccode277i',<<'EOF',$todo.'#277,#284 format -O3 ~~'); 36 | format OUT = 37 | bar ~~ 38 | . 39 | open(OUT, ">/dev/null"); write(OUT); close OUT; 40 | print "ok\n"; 41 | EOF 42 | 43 | ctestok(4,'C,-O3','ccode283i',<<'EOF',$todo.'#283 implicit format STDOUT'); 44 | format = 45 | ok 46 | . 47 | write 48 | EOF 49 | 50 | -------------------------------------------------------------------------------- /ramblings/Carp-wo-B.patch: -------------------------------------------------------------------------------- 1 | Recommended for 5.14 2 | 3 | Remove huge B dependency from Carp, introduced with 5.14 to detect 4 | incomplete caller override. 5 | 6 | This reduces the memory and run-time footprint in case of errors, 7 | and enables the compiler not to include B. 8 | 9 | diff -u Carp.pm.orig Carp.pm 10 | --- Carp.pm.orig 2011-12-31 18:13:12.000000000 -0600 11 | +++ Carp.pm 2011-12-31 18:13:47.000000000 -0600 12 | @@ -107,7 +107,12 @@ 13 | local $@; 14 | my $where = eval { 15 | my $func = $cgc or return ''; 16 | - my $gv = B::svref_2object($func)->GV; 17 | + my $gv = 18 | + *{ 19 | + ( $::{"B::"} || return '') # B stash 20 | + ->{svref_2object} || return '' # entry in stash 21 | + }{CODE} # coderef in entry 22 | + ->($func)->GV; 23 | my $package = $gv->STASH->NAME; 24 | my $subname = $gv->NAME; 25 | return unless defined $package && defined $subname; 26 | -------------------------------------------------------------------------------- /t/issue200.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=200 3 | # utf8 hash keys. still broken compile-time on 5.8 4 | use strict; 5 | BEGIN { 6 | unshift @INC, 't'; 7 | require TestBC; 8 | } 9 | use Test::More; 10 | use Config; 11 | if ( $] =~ /^5\.00800[45]/ ) { 12 | plan skip_all => "compile-time utf8 hek hack NYI for $]"; 13 | exit; 14 | } 15 | plan tests => 6; 16 | 17 | my $i=0; 18 | sub test3 { 19 | my $name = shift; 20 | my $script = shift; 21 | my $cmt = join('',@_); 22 | my $todo = ""; 23 | $todo = 'TODO' if $name eq 'ccode200i_c'; # or ($] >= 5.018); 24 | my $todoc = $] < 5.010 ? "TODO 5.8 " : ""; 25 | $todoc = "" if $name eq 'ccode200i_r'; 26 | plctestok($i*3+1, $name, $script, $todo." BC $cmt"); 27 | ctestok($i*3+2, "C", $name, $script, $todoc."C $cmt"); 28 | ctestok($i*3+3, "CC", $name, $script, $todoc."CC $cmt"); 29 | $i++; 30 | } 31 | 32 | test3('ccode200i_r', '%u=("\x{123}"=>"fo"); print "ok" if $u{"\x{123}"} eq "fo"', 'run-time utf8 hek'); 33 | test3('ccode200i_c', 'BEGIN{%u=("\x{123}"=>"fo")} print "ok" if $u{"\x{123}"} eq "fo"', 'compile-time utf8 hek'); 34 | -------------------------------------------------------------------------------- /t/issue36.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=36 3 | # B::CC fails on some loops 4 | # The problem seems to be non deterministic. 5 | # Some runs of B::CC succeed, some fail and others give a warning. 6 | use B::CC; 7 | use Test::More tests => $B::CC::VERSION < 1.08 ? 5 : 1; 8 | use strict; 9 | BEGIN { 10 | unshift @INC, 't'; 11 | require TestBC; 12 | } 13 | 14 | # panic: leaveloop, no cxstack at /usr/local/lib/perl/5.10.1/B/CC.pm line 1977 15 | my $script = <<'EOF'; 16 | sub f { shift == 2 } 17 | sub test { 18 | while (1) { 19 | last if f(2); 20 | } 21 | while (1) { 22 | last if f(2); 23 | } 24 | } 25 | EOF 26 | 27 | use B::CC; 28 | # The problem seems to be non deterministic. 29 | # Some runs of B::CC succeed, some fail and others give a warning. 30 | if ($B::CC::VERSION < 1.08) { 31 | ccompileok($_, "CC", "ccode36i", $script, 32 | "TODO B::CC issue 36 fixed with B-C-1.28 r556 (B::CC 1.08) by Heinz Knutzen") 33 | for 1..5; 34 | } else { 35 | ccompileok($_, "CC", "ccode36i", $script, 36 | "CC fails sometimes on some loops (fixed with B-C-1.28 r556)"); 37 | } 38 | 39 | -------------------------------------------------------------------------------- /t/issue308.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=308 3 | # run-time load of some packages - missing DynaLoader::bootstrap 4 | # DynaLoader and AutoLoader 5 | # core: IPC::SysV DB_File 6 | # cpan: Net::LibIDN Net::SSLeay BSD::Resource 7 | use strict; 8 | BEGIN { 9 | unshift @INC, 't'; 10 | require TestBC; 11 | } 12 | use Test::More tests => 2; 13 | 14 | my $script = 'print (eval q{require BSD::Resource;} ? qq{ok\n} : $@);'; 15 | my $exp = "ok"; 16 | if (eval "require BSD::Resource;") { 17 | ctest(1, $exp, 'C,-O3', 'ccode308i', $script, 'C #308 run-time load BSD::Resource - missing DynaLoader::bootstrap'); 18 | } else { 19 | ok(1, "skip BSD::Resource not installed"); 20 | } 21 | 22 | $script = 'print (eval q{require Net::SSLeay;} ? qq{ok\n} : $@);'; 23 | if (eval "require Net::SSLeay;") { 24 | # works with -O3 25 | ctest(2, $exp, 'C', 'ccode308i', $script, 'C run-time load Net::SSLeay - missing %Config in Errno.pm'); 26 | } else { 27 | ok(1, "skip Net::SSLeay not installed"); 28 | } 29 | 30 | # 'print $_,": ",(eval q{require }.$_.q{;} ? qq{ok\n} : $@) for qw(BSD::Resource IPC::SysV DB_File Net::LibIDN Net::SSLeay);' 31 | -------------------------------------------------------------------------------- /t/issue49.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=49 3 | # B::CC Can't "last" outside a loop block 4 | use Test::More tests => 1; 5 | use strict; 6 | BEGIN { 7 | unshift @INC, 't'; 8 | require TestBC; 9 | } 10 | 11 | # The op "leaveloop" is not handled by B::CC because it is dead code. 12 | # Hence @cxstack only is increased by "enterloop", but never 13 | # decreased. Hence the second op "last" in the test program reads 14 | # loop data from the wrong context and jumps to the end of the inner 15 | # loop by mistake. This issue is similar to issue 47 but not fixable 16 | # that easy. We either have to rethink handling of dead code or have 17 | # to pop @cxstack not only for "leavesub" but somehow for op "last" as 18 | # well. But that is difficult, because there can be multiple "last" 19 | # ops. 20 | my $script = <<'EOF'; 21 | while (1) { 22 | while (1) { 23 | last; 24 | } 25 | last; 26 | } 27 | EOF 28 | 29 | use B::CC; 30 | ccompileok(1, "CC", "ccode49i", $script, # fixed with B::CC 1.08 r625 31 | ($B::CC::VERSION < 1.08 ? "TODO " : "") 32 | . "CC Can't \"last\" outside a loop block, fixed with B-C-1.28"); 33 | -------------------------------------------------------------------------------- /regen_lib.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | use vars qw($Is_W32 $Is_OS2 $Is_Cygwin $Is_NetWare $Needs_Write); 4 | use Config; # Remember, this is running using an existing perl 5 | 6 | # Common functions needed by the regen scripts 7 | 8 | $Is_W32 = $^O eq 'MSWin32'; 9 | $Is_OS2 = $^O eq 'os2'; 10 | $Is_Cygwin = $^O eq 'cygwin'; 11 | $Is_NetWare = $Config{osname} eq 'NetWare'; 12 | if ($Is_NetWare) { 13 | $Is_W32 = 0; 14 | } 15 | 16 | $Needs_Write = $Is_OS2 || $Is_W32 || $Is_Cygwin || $Is_NetWare; 17 | 18 | sub safer_unlink { 19 | my @names = @_; 20 | my $cnt = 0; 21 | 22 | my $name; 23 | foreach $name (@names) { 24 | next unless -e $name; 25 | chmod 0777, $name if $Needs_Write; 26 | ( CORE::unlink($name) and ++$cnt 27 | or warn "Couldn't unlink $name: $!\n" ); 28 | } 29 | return $cnt; 30 | } 31 | 32 | sub safer_rename_silent { 33 | my ($from, $to) = @_; 34 | 35 | # Some dosish systems can't rename over an existing file: 36 | safer_unlink $to; 37 | chmod 0600, $from if $Needs_Write; 38 | rename $from, $to; 39 | } 40 | 41 | sub safer_rename { 42 | my ($from, $to) = @_; 43 | safer_rename_silent($from, $to) or die "renaming $from to $to: $!"; 44 | } 45 | 1; 46 | -------------------------------------------------------------------------------- /typemap: -------------------------------------------------------------------------------- 1 | B::MAGIC T_MG_OBJ 2 | B::REGEXP T_RX_OBJ 3 | B::COP T_OP_OBJ 4 | B::OP T_OP_OBJ 5 | B::HV T_SV_OBJ 6 | B::PADNAME T_SV_OBJ 7 | B::PADLIST T_SV_OBJ 8 | B::PADNAMELIST T_SV_OBJ 9 | 10 | INPUT 11 | T_RX_OBJ 12 | if (SvROK($arg)) { 13 | int type = SvTYPE(SvRV($arg)); 14 | if (type == SVt_REGEXP || type == SVt_PVMG) { 15 | IV tmp = SvIV((SV*)SvRV($arg)); 16 | $var = INT2PTR($type,tmp); 17 | } 18 | else 19 | croak(\"ref to $var is of type %d, not a reference to REGEXP\", type); 20 | } 21 | else 22 | croak(\"$var is of type %d, not a reference to REGEXP\", SvTYPE($arg)); 23 | T_MG_OBJ 24 | if (SvROK($arg)) { 25 | IV tmp = SvIV((SV*)SvRV($arg)); 26 | $var = INT2PTR($type,tmp); 27 | } 28 | else 29 | croak(\"$var is not a reference\") 30 | 31 | T_OP_OBJ 32 | if (SvROK($arg)) { 33 | IV tmp = SvIV((SV*)SvRV($arg)); 34 | $var = INT2PTR($type,tmp); 35 | } 36 | else 37 | croak(\"$var is not a reference\") 38 | 39 | T_SV_OBJ 40 | if (SvROK($arg)) { 41 | IV tmp = SvIV((SV*)SvRV($arg)); 42 | $var = INT2PTR($type,tmp); 43 | } 44 | else 45 | croak(\"$var is not a reference\") 46 | -------------------------------------------------------------------------------- /t/issue282.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=282 3 | # glob_assign_glob: gp_free of the gp->FILE hek 4 | use strict; 5 | BEGIN { 6 | unshift @INC, 't'; 7 | require TestBC; 8 | } 9 | use Test::More tests => 2; 10 | use Config; 11 | my $DEBUGGING = ($Config{ccflags} =~ m/-DDEBUGGING/); 12 | use B::C (); 13 | # passed on linux non-DEBUGGING, but fails on other system with better malloc libraries 14 | # use after free 15 | my $todo = $B::C::VERSION lt '1.52_07' ? "TODO " : ""; #fixed with hek refcounting 16 | #my $todo = ((!$DEBUGGING or $] < 5.012) and $^O eq 'linux') ? "" : "TODO "; 17 | # $todo = "" if $] > 5.021; 18 | 19 | ctestok(1,'C,-O3','ccode282i',<<'EOF',$todo.'#282 ref assign hek assert/use-after-free'); 20 | use vars qw($glook $smek $foof); 21 | $glook = 3; 22 | $smek = 4; 23 | $foof = "halt and cool down"; 24 | my $rv = \*smek; 25 | *glook = $rv; 26 | my $pv = ""; 27 | $pv = \*smek; 28 | *foof = $pv; 29 | print "ok\n"; 30 | EOF 31 | 32 | ctestok(2,'C,-O3','ccode282i',<<'EOF',$todo.'#282 glob=glob assign hek assert/use-after-free'); 33 | { 34 | $glook = 3; 35 | $smek = 4; 36 | *rv = *smek; 37 | *glook = *smek; 38 | $pv = ""; 39 | *foof = *pv; 40 | } 41 | print "ok\n"; 42 | EOF 43 | -------------------------------------------------------------------------------- /t/issue338.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=338 3 | # set qr UTF8 flags, t/testc.sh -q -O3 -A -c 20 39 44 71 131 143 1431 1432 330 333 338 4 | 5 | use strict; 6 | BEGIN { 7 | unshift @INC, 't'; 8 | require TestBC; 9 | } 10 | use Test::More tests => 2; 11 | use Config; 12 | 13 | my $todo = ($] > 5.009 and $] < 5.011) ? "TODO " : ""; 14 | ctestok(1, 'C,-O3', 'ccode338i', <<'EOF', $todo.'C #338 qr utf8'); 15 | use utf8; my $l = "ñ"; my $re = qr/ñ/; print $l =~ $re ? qq{ok\n} : length($l)."\n".ord($l)."\n"; 16 | EOF 17 | 18 | # $todo = ($] > 5.021) ? "TODO " : $todo; # 5.22 fixed with B-C-1.52_13 19 | if ($[ < 5.025 or $Config{usecperl}) { 20 | ctestok(2, 'C,-O3', 'ccode333i', <<'EOF', $todo.'C #333 qr utf8'); 21 | use encoding "utf8"; 22 | my @hiragana = map {chr} ord("ぁ")..ord("ん"); 23 | my @katakana = map {chr} ord("ァ")..ord("ン"); 24 | my $hiragana = join(q{} => @hiragana); 25 | my $katakana = join(q{} => @katakana); 26 | my %h2k; @h2k{@hiragana} = @katakana; 27 | $str = $hiragana; 28 | $str =~ s/([ぁ-ん])/$h2k{$1}/go; 29 | print $str eq $katakana ? "ok\n" : "not ok\n$hiragana\n$katakana\n"; 30 | EOF 31 | } else { 32 | ok(1, "SKIP encoding pragma removed in v5.26 (hint: use cperl)"); 33 | } 34 | -------------------------------------------------------------------------------- /store_rpt: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | # ./store_rpt mv -v 1.34 3 | function do_cp { 4 | for r in $r 5 | do 6 | for f in $(grep -l "$grep$r" $m) 7 | do 8 | mkdir -p t/reports/$v/$r 9 | if test "$move" = "1" 10 | then 11 | mv $f t/reports/$v/$r/ 12 | else 13 | cp -p $f t/reports/$v/$r/ 14 | fi 15 | done 16 | done 17 | } 18 | 19 | if test "$1" = "mv"; then move=1; shift; fi 20 | if test "$1" = "-v"; then 21 | v=$2 22 | else 23 | v=`perl -ane'print $F[2] if /^VERSION =/' Makefile` 24 | fi 25 | 26 | m=$(ls log.modules-5.*|egrep -v ".(orig|err)") 27 | if [ -n "$m" ]; then 28 | r=$(perl -lane "print substr(\$F[4],1) if /VERSION = $v r/" $m) 29 | if [ -n "$r" ]; then 30 | grep="VERSION = $v r" 31 | else 32 | r=$(perl -lane "print \$F[4] if /^# B::C::VERSION = 1.\\d\\w+ \\w+ /" $m) 33 | grep="VERSION = $v " 34 | fi 35 | do_cp 36 | fi 37 | 38 | m=$(ls log.test-*-5.*|egrep -v ".(orig|err)") 39 | if [ -n "$m" ]; then 40 | r=$(perl -lane "print \$F[1] if /^Revision: \\d+\$/" $m) 41 | if [ -n "$r" ]; then 42 | # svn 43 | grep="Revision: " 44 | else 45 | # git 46 | r=$(perl -lane "print \$F[4] if /^# B::C::VERSION = 1.\\d\\w+ \\w+ /" $m) 47 | grep=" " 48 | fi 49 | do_cp 50 | fi 51 | -------------------------------------------------------------------------------- /t/issue212.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=212 3 | # need to share GPs for stashes 4 | use strict; 5 | BEGIN { 6 | unshift @INC, 't'; 7 | require TestBC; 8 | } 9 | use Test::More tests => 3; 10 | use Config (); 11 | use B::C (); 12 | my $ITHREADS = $Config::Config{useithreads}; 13 | my $todo1 = ($B::C::VERSION lt '1.45_03' and ($]>=5.018 and $ITHREADS)) ? "TODO 5.18thr ": ""; 14 | # fixed with 1.45_04: non-destructive get_isa for 5.8 15 | my $todo3 = ($] < 5.007) ? "TODO 5.6 ": ""; 16 | 17 | ctestok(1,'C,-O3,-UB','ccode212i',<<'EOF',$todo1.'#212 shared GP'); 18 | $blurfl = 123; 19 | { 20 | package abc; 21 | $blurfl = 5; 22 | } 23 | $abc = join(':', sort(keys %abc::)); 24 | 25 | package abc; 26 | $blurfl; 27 | print q(ok) if eval q/$blurfl/ == 5; 28 | EOF 29 | 30 | ctestok(2,'C,-O3,-UB','ccode209i',<<'EOF','#209 empty keys %main::'); 31 | $s = join(":", sort(keys %::)); 32 | print q(ok) if $s; 33 | EOF 34 | 35 | ctestok(3,'C,-O3,-UB','ccode210i',<<'EOF',$todo3.'#210 keys %package return an invalid list'); 36 | $a = 123; 37 | package xyz; 38 | sub xsub {bless [];} 39 | $x1 = 1; $x2 = 2; 40 | $s = join(":", sort(keys %xyz::)); 41 | package abc; 42 | my $foo; 43 | print q(ok) if $xyz::s eq 's:x1:x2:xsub'; 44 | EOF 45 | -------------------------------------------------------------------------------- /t/issue208.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=208 3 | # missing DESTROY call at DESTRUCT time 4 | use strict; 5 | BEGIN { 6 | unshift @INC, 't'; 7 | require TestBC; 8 | } 9 | use Test::More tests => 2; 10 | my $script = <<'EOF'; 11 | sub MyKooh::DESTROY { print "${^GLOBAL_PHASE} MyKooh " } my $k=bless {}, MyKooh; 12 | sub OurKooh::DESTROY { print "${^GLOBAL_PHASE} OurKooh" } our $k=bless {}, OurKooh; 13 | EOF 14 | my $expected = ($] >= 5.014 ? 'RUN MyKooh DESTRUCT OurKooh' : ' MyKooh OurKooh'); 15 | 16 | # fixed with 1.42_66, 5.16+5.18 17 | # for older perls and -O3 fixed with 1.45_02 18 | use B::C (); 19 | my $todo = ($] > 5.015 and $B::C::VERSION gt '1.42_65') ? "" : "TODO "; 20 | if ($] < 5.015) { 21 | $todo = ($B::C::VERSION gt '1.45_01') ? "" : "TODO "; 22 | } 23 | my $todo_o3 = ($] < 5.013 and $B::C::VERSION gt '1.45_01') ? "" : "TODO "; 24 | $todo_o3 = "" if $B::C::VERSION gt '1.45_08'; 25 | #if ($B::C::VERSION gt '1.45_03') { #broken with 1c5062f53 which enabled -ffast-destruct on -O0 26 | # $todo = $todo_o3 = $] > 5.013 ? "TODO " : ""; 27 | #} 28 | 29 | ctest(1, $expected,'C','ccode208i',$script,$todo.'#208 missing DESTROY call at DESTRUCT time'); 30 | ctest(2, $expected,'C,-O3','ccode208i',$script,$todo_o3.'#208 -ffast-destruct'); 31 | -------------------------------------------------------------------------------- /t/issue245.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=245 3 | # unicode value not preserved when passed to a function with -O3 4 | # lc("\x{1E9E}") and "\x{df}" were hashed as the same string in const %strtable 5 | use strict; 6 | use Config; 7 | my @plan; 8 | BEGIN { 9 | if ($ENV{PERL_CORE}) { 10 | unshift @INC, ('t', '../../lib'); 11 | } else { 12 | unshift @INC, 't', "blib/arch", "blib/lib"; 13 | } 14 | require TestBC; 15 | 16 | $ENV{SKIP_SLOW_TESTS} = 1 if $Config{ccflags} =~ /-flto/; 17 | $ENV{SKIP_SLOW_TESTS} = 1 if $^O =~ /MSWin32|cygwin/ and is_CI(); 18 | 19 | if ($ENV{SKIP_SLOW_TESTS}) { 20 | @plan = (skip_all => 'SKIP_SLOW_TESTS, timeout on CI'); 21 | } else { 22 | @plan = (tests => 1); 23 | } 24 | } 25 | use Test::More @plan; 26 | 27 | use B::C; 28 | # passes threaded and <5.10 29 | my $fixed_with = "1.42_70"; 30 | my $TODO = "TODO " if $B::C::VERSION lt $fixed_with; 31 | $TODO = "" if $Config{useithreads}; 32 | $TODO = "" if $] < 5.010; 33 | my $todomsg = '#245 2nd static unicode char'; 34 | # this is now with 5.24.0.c also a test for FAKE_SIGNATURES 35 | ctest(1,"b: 223", 'C,-O3','ccode245i', <<'EOF', $TODO.$todomsg); 36 | sub foo { 37 | my ( $a, $b ) = @_; 38 | print "b: ".ord($b); 39 | } 40 | foo(lc("\x{1E9E}"), "\x{df}"); 41 | EOF 42 | -------------------------------------------------------------------------------- /t/issue50.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=50 3 | # B::CC UV for << 4 | use Test::More tests => 1; 5 | use strict; 6 | BEGIN { 7 | unshift @INC, 't'; 8 | require TestBC; 9 | } 10 | 11 | use Config; 12 | my $ivsize = $Config{ivsize}; 13 | 14 | my $script = <<'EOF'; 15 | my $ok = 1; 16 | sub check { 17 | my $m = shift; 18 | my $s = sprintf("%lx $m\n", $m); 19 | $ok = 0 if $s =~ /fffe -2/; 20 | } 21 | 22 | my $maxuv = 0xffffffff if $ivsize == 4; 23 | $maxuv = 0xffffffffffffffff if $ivsize == 8; 24 | $maxuv = 0xffff if $ivsize == 2; 25 | die "1..1 skipped, unknown ivsize\n" unless $maxuv; 26 | my $maxiv = 0x7fffffff if $ivsize == 4; 27 | $maxiv = 0x7fffffffffffffff if $ivsize == 8; 28 | $maxiv = 0x7fff if $ivsize == 2; 29 | 30 | check($maxuv); 31 | check(($maxuv & $maxiv) << 1); 32 | 33 | my $mask = $maxuv; 34 | check($mask); 35 | my $mask1 = ($mask & $maxiv) << 1; 36 | check($mask1); 37 | $mask1 &= $maxuv; 38 | check($mask1); 39 | print "ok\n" if $ok; 40 | EOF 41 | 42 | $script =~ s/\$ivsize/$ivsize/eg; 43 | 44 | use B::CC; 45 | TODO: { 46 | local $TODO = "broken with 5.24" if $] > 5.023007; 47 | ctestok(1, "CC", "ccode50i", $script, # fixed with r633 48 | ($B::CC::VERSION < 1.08 ? "TODO ":"") 49 | . "perlcc UV << issue50 - fixed with B-C-1.28"); 50 | } 51 | -------------------------------------------------------------------------------- /t/issue143.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=143 3 | # wrong length after double regex compilation 4 | use Test::More tests => 3; 5 | use strict; 6 | BEGIN { 7 | unshift @INC, 't'; 8 | require TestBC; 9 | } 10 | use Config (); 11 | # broken on 5.10.1 with 1.48 12 | my $todo = "TODO #143 " if $]>=5.010 and $]<5.012; 13 | $todo = "TODO Free to wrong pool with MSVC " if $^O eq 'MSWin32' and $Config{cc} =~ 'cl'; 14 | 15 | ctestok(1, "C,-O3", 'ccode143i', <<'EOS', "wrong length after double regex compilation"); 16 | BEGIN { 17 | package Net::IDN::Encode; 18 | our $DOT = qr/[\.]/; 19 | my $RE = qr/xx/; 20 | sub domain_to_ascii { 21 | my $x = shift || ""; 22 | $x =~ m/$RE/o; 23 | return split( qr/($DOT)/o, $x); 24 | } 25 | } 26 | package main; 27 | Net::IDN::Encode::domain_to_ascii(42); 28 | print q(ok); 29 | EOS 30 | 31 | SKIP: 32 | { 33 | skip "SKIP_SLOW_TESTS timeout on CI", 2 34 | if (is_CI() 35 | and ($Config{ccflags} =~ /-flto/ or $ENV{SKIP_SLOW_TESTS}) 36 | and $ENV{PERL_CORE}); 37 | 38 | ctestok(2, "C,-O3", 'ccode143i', 'BEGIN{package Foo;our $DOT=qr/[.]/;};package main;print "ok\n" if "dot.dot" =~ m/($Foo::DOT)/', 39 | $todo."our qr"); 40 | ctestok(3, "C,-O3", 'ccode143i', 'BEGIN{$DOT=qr/[.]/}print "ok\n" if "dot.dot" =~ m/($DOT)/', 41 | $todo."global qr"); 42 | } 43 | -------------------------------------------------------------------------------- /t/issue54.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=54 3 | # pad_swipe error with package pmcs 4 | use strict; 5 | my $name = "ccode54p"; 6 | use Test::More tests => 1; 7 | use B::C::Config; 8 | 9 | my $pkg = <<"EOF"; 10 | package $name; 11 | sub test { 12 | \$abc='ok'; 13 | print "\$abc\\n"; 14 | } 15 | 1; 16 | EOF 17 | 18 | open F, ">", "$name.pm"; 19 | print F $pkg; 20 | close F; 21 | 22 | my $expected = "ok"; 23 | my $runperl = $^X =~ m/\s/ ? qq{"$^X"} : $^X; 24 | my $Mblib = "-Iblib/arch -Iblib/lib"; 25 | if ($] < 5.008) { 26 | system "$runperl -MO=Bytecode,-o$name.pmc $name.pm"; 27 | } else { 28 | system "$runperl $Mblib -MO=-qq,Bytecode,-H,-o$name.pmc $name.pm"; 29 | } 30 | unless (-e "$name.pmc") { 31 | print "not ok 1 #B::Bytecode failed.\n"; 32 | exit; 33 | } 34 | my $runexe = "$runperl $Mblib -I. -M$name -e\"$name\::test\""; 35 | $runexe = "$runperl -MByteLoader -I. -M$name -e\"$name\::test\"" if $] < 5.008; 36 | my $result = `$runexe`; 37 | $result =~ s/\n$//; 38 | 39 | SKIP: { 40 | skip "no pmc on 5.6 (yet)", 1 if $] < 5.008; 41 | skip "perl5.22 broke ByteLoader", 1 42 | if $] > 5.021006 and !$B::C::Config::have_byteloader; 43 | ok($result eq $expected, "issue54 - pad_swipe error with package pmcs"); 44 | } 45 | 46 | END { 47 | unlink($name, "$name.pmc", "$name.pm") 48 | if $result eq $expected; 49 | } 50 | -------------------------------------------------------------------------------- /t/stashes.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # testc.sh 46, GH # 3 | use strict; 4 | BEGIN { 5 | if ($ENV{PERL_CORE}) { 6 | unshift @INC, ('t', '../../lib'); 7 | } else { 8 | unshift @INC, 't', "blib/arch", "blib/lib"; 9 | } 10 | require TestBC; 11 | } 12 | use Config; 13 | use Test::More; 14 | $ENV{SKIP_SLOW_TESTS} = 1 if $Config{ccflags} =~ /-flto/; 15 | plan skip_all => "MSWin32" if $ENV{PERL_CORE} and $^O eq 'MSWin32'; 16 | plan tests => 6; 17 | my $i=0; 18 | #use B::C (); 19 | 20 | ctestok($i++, "C,-O3", "ccode46g", <<'EOF', "empty stash"); 21 | print 'ok' unless keys %Dummy::; 22 | EOF 23 | 24 | ctestok($i++, "C", "ccode46g", <<'EOF', "if stash -O0"); 25 | print 'ok' unless %Exporter::; 26 | EOF 27 | 28 | SKIP: { 29 | skip "slow tests", 4 if $ENV{SKIP_SLOW_TESTS}; 30 | 31 | ctestok($i++, "C,-O3", "ccode46g", <<'EOF', "if stash -O3"); 32 | print 'ok' unless %Exporter::; 33 | EOF 34 | 35 | ctestok($i++, "C,-O3", "ccode46g", <<'EOF', "empy keys stash, no %INC"); 36 | print 'ok' if keys %Exporter:: < 2; 37 | EOF 38 | 39 | ctestok($i++, "C,-O3", "ccode46g", <<'EOF', "TODO use should not skip, special but in %INC"); 40 | use Exporter; print 'ok' if keys %Exporter:: > 2; 41 | EOF 42 | 43 | my $TODO = $^O eq 'cygwin' ? " TODO " : ""; 44 | ctestok($i++, "C,-O3", "ccode46g", <<'EOF', "$TODO use should not skip, in %INC"); 45 | use Devel::Peek; print 'ok' if keys %Devel::Peek:: > 2; 46 | EOF 47 | 48 | } 49 | 50 | -------------------------------------------------------------------------------- /t/moose-test.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | # proof that moose types suck, they do only checks but no optimizations. 3 | # see also #350 4 | # 5 | # with an older B::C < ~1.40 out of memory while compiling. 6 | # endless recursion with B::HV::save 7 | # 7 0x521293e4 in Perl_pp_entersub () at pp_hot.c:2806 8 | # GVGV::GV = 0x14c3ad0 "B::HV" :: "save", DEPTH = 44817 9 | 10 | { 11 | package Foo::Moose; 12 | use Moose; 13 | has bar => (is => 'rw'); 14 | __PACKAGE__->meta->make_immutable; 15 | } 16 | { 17 | package TypedFoo::Moose; 18 | use Moose; 19 | has bar => (is => 'rw', isa => 'Int'); 20 | __PACKAGE__->meta->make_immutable; 21 | } 22 | { 23 | package Foo::Manual; 24 | sub new { bless {} => shift } 25 | sub bar { 26 | my $self = shift; 27 | return $self->{bar} unless @_; 28 | $self->{bar} = shift; 29 | } 30 | } 31 | my $foo1 = Foo::Moose->new; 32 | sub moose { 33 | $foo1->bar(32); 34 | my $x = $foo1->bar; 35 | } 36 | my $foo2 = TypedFoo::Moose->new; 37 | sub moosetyped { 38 | $foo2->bar(32); 39 | my $x = $foo2->bar; 40 | } 41 | my $foo = Foo::Manual->new; 42 | sub manual { 43 | $foo->bar(32); 44 | my $x = $foo->bar; 45 | } 46 | use Benchmark 'timethese'; 47 | 48 | print "Testing Perl $]\n"; 49 | timethese( 50 | 50_000, 51 | { 52 | moose => \&moose, 53 | moosetyped => \&moosetyped, 54 | manual => \&manual, 55 | } 56 | ); 57 | -------------------------------------------------------------------------------- /ramblings/revert-B-load-BEGIN-514.patch: -------------------------------------------------------------------------------- 1 | --- ext/B/B.pm.orig 2011-06-16 19:06:09.000000000 -0500 2 | +++ ext/B/B.pm 2011-06-21 18:21:13.000000000 -0500 3 | @@ -6,26 +6,16 @@ 4 | # License or the Artistic License, as specified in the README file. 5 | # 6 | package B; 7 | -use strict; 8 | 9 | +require XSLoader; 10 | require Exporter; 11 | -@B::ISA = qw(Exporter); 12 | +@ISA = qw(Exporter); 13 | 14 | # walkoptree_slow comes from B.pm (you are there), 15 | # walkoptree comes from B.xs 16 | 17 | -BEGIN { 18 | - $B::VERSION = '1.29'; 19 | - @B::EXPORT_OK = (); 20 | - 21 | - # Our BOOT code needs $VERSION set, and will append to @EXPORT_OK. 22 | - # Want our constants loaded before the compiler meets OPf_KIDS below, as 23 | - # the combination of having the constant stay a Proxy Constant Subroutine 24 | - # and its value being inlined saves a little over .5K 25 | - 26 | - require XSLoader; 27 | - XSLoader::load(); 28 | -} 29 | +$B::VERSION = '1.29_01'; 30 | +@EXPORT_OK = (); 31 | 32 | push @B::EXPORT_OK, (qw(minus_c ppname save_BEGINs 33 | class peekop cast_I32 cstring cchar hash threadsv_names 34 | @@ -38,6 +28,9 @@ 35 | @specialsv_name 36 | ), $] > 5.009 && 'unitcheck_av'); 37 | 38 | +sub OPf_KIDS (); 39 | +use strict; 40 | + 41 | @B::SV::ISA = 'B::OBJECT'; 42 | @B::NULL::ISA = 'B::SV'; 43 | @B::PV::ISA = 'B::SV'; 44 | @@ -332,6 +325,8 @@ 45 | } 46 | } 47 | 48 | +XSLoader::load(); 49 | + 50 | 1; 51 | 52 | __END__ 53 | -------------------------------------------------------------------------------- /t/issue68.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=68 3 | # newPMOP assertion >=5.10 threaded 4 | use strict; 5 | use Test::More; 6 | use B::C::Config; 7 | Test::More->import($] <= 5.021006 || $B::C::Config::have_byteloader 8 | ? (tests => 1) : (skip_all => 'perl5.22 broke ByteLoader')); 9 | use Config; 10 | 11 | my $name = "ccode68i"; 12 | my $source = <<'EOF'; 13 | package A; 14 | sub test { 15 | use Data::Dumper (); 16 | 17 | $_ =~ /^(.*?)\d+$/; 18 | "Some::Package"->new(); 19 | } 20 | print q(ok); 21 | EOF 22 | 23 | open F, ">", "$name.pl"; 24 | print F $source; 25 | close F; 26 | 27 | my $expected = "ok"; 28 | my $runperl = $^X =~ m/\s/ ? qq{"$^X"} : $^X; 29 | my $Mblib = "-Iblib/arch -Iblib/lib"; 30 | if ($] < 5.008) { 31 | system "$runperl -MO=Bytecode,-o$name.plc $name.pl"; 32 | } else { 33 | system "$runperl $Mblib -MO=-qq,Bytecode,-H,-o$name.plc $name.pl"; 34 | } 35 | unless (-e "$name.plc") { 36 | print "not ok 1 #B::Bytecode failed.\n"; 37 | exit; 38 | } 39 | my $runexe = ($] < 5.008) 40 | ? "$runperl -MByteLoader $name.plc" 41 | : "$runperl $Mblib $name.plc"; 42 | my $result = `$runexe`; 43 | $result =~ s/\n$//; 44 | 45 | TODO: { 46 | local $TODO = "threaded >= 5.010" if $] >= 5.010 and $Config{useithreads}; 47 | ok($result eq $expected, "issue68 - newPMOP assert"); 48 | } 49 | 50 | END { 51 | unlink($name, "$name.plc", "$name.pl") 52 | if $result eq $expected; 53 | } 54 | -------------------------------------------------------------------------------- /ramblings/more-opts.md: -------------------------------------------------------------------------------- 1 | pp_dlload as op (core) 2 | 3 | Implement DynaLoader in C 4 | One should not call perl to load a shared library. 5 | 6 | Implement a sane XSLoader API using that. 7 | http://blogs.perl.org/users/rurban/2011/10/the-two-worst-perl-apis.html 8 | 9 | -fcarp-as-warn (core) 10 | 11 | Replace the 4 Carp calls with ops, which do die/warn and display 12 | the backtrace as op. Carp autoloads XS Carp::Heavy, and one 13 | usecase is Carp in Dynaloader failing code. It also has too much 14 | dependencies 15 | 16 | -fno-warnings (B::C, B::CC) 17 | 18 | Production perl wants to choose no run-time warnings overhead. 19 | fix current B::CC -fno-warnings -Uwarnings 20 | 21 | nop warnings calls. some modules use warnif and fail with the 22 | current -fno-warnings. E.g. Find::File 23 | 24 | compile-time utf8 folding tables 25 | 26 | do not defer swash_init to run-time. mark the ops (lc,uc,fc,match) 27 | as utf8 or ascii or undecided. implement the folding tables as 28 | shared objects, created at build-time (as Encode does) 29 | 30 | implement exists symbol as op (lexical or global) 31 | 32 | symbols should not be created when asking if a symbol exists. 33 | 34 | implement last out of grep/map 35 | 36 | tail recursion 37 | 38 | implement the taint flag bit for HEKs 39 | 40 | implement the run-time part for oplines 41 | 42 | search for the upper cop in case of warnings/errors for the filename 43 | -------------------------------------------------------------------------------- /ramblings/revert-B-load-BEGIN-5160.patch: -------------------------------------------------------------------------------- 1 | RT#81332 revert 744aaba0 bloats the B compilers 2 | For 5.16.0 3 | 4 | diff -u ext/B/B.pm.orig ext/B/B.pm 5 | --- ext/B/B.pm.orig 2012-05-23 17:40:02.167549196 -0500 6 | +++ ext/B/B.pm 2013-01-09 13:15:10.391328942 -0600 7 | @@ -8,24 +8,15 @@ 8 | package B; 9 | use strict; 10 | 11 | +require XSLoader; 12 | require Exporter; 13 | @B::ISA = qw(Exporter); 14 | 15 | # walkoptree_slow comes from B.pm (you are there), 16 | # walkoptree comes from B.xs 17 | 18 | -BEGIN { 19 | - $B::VERSION = '1.34'; 20 | - @B::EXPORT_OK = (); 21 | - 22 | - # Our BOOT code needs $VERSION set, and will append to @EXPORT_OK. 23 | - # Want our constants loaded before the compiler meets OPf_KIDS below, as 24 | - # the combination of having the constant stay a Proxy Constant Subroutine 25 | - # and its value being inlined saves a little over .5K 26 | - 27 | - require XSLoader; 28 | - XSLoader::load(); 29 | -} 30 | +$B::VERSION = '1.34_01'; 31 | +@B::EXPORT_OK = (); 32 | 33 | push @B::EXPORT_OK, (qw(minus_c ppname save_BEGINs 34 | class peekop cast_I32 cstring cchar hash threadsv_names 35 | @@ -38,6 +29,9 @@ 36 | @specialsv_name 37 | ), $] > 5.009 && 'unitcheck_av'); 38 | 39 | +sub OPf_KIDS (); 40 | +use strict; 41 | + 42 | @B::SV::ISA = 'B::OBJECT'; 43 | @B::NULL::ISA = 'B::SV'; 44 | @B::PV::ISA = 'B::SV'; 45 | @@ -332,6 +326,8 @@ 46 | } 47 | } 48 | 49 | +XSLoader::load(); 50 | + 51 | 1; 52 | 53 | __END__ 54 | -------------------------------------------------------------------------------- /t/issue169.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=169 3 | # Attribute::Handlers 4 | use strict; 5 | BEGIN { 6 | unshift @INC, 't'; 7 | require TestBC; 8 | } 9 | use Test::More tests => 3; 10 | use Config; 11 | use B::C (); 12 | my $CPERL = $Config{usecperl}; 13 | #my $todo = ($B::C::VERSION ge '1.46') ? "" : "TODO "; 14 | my $todo = "TODO "; 15 | 16 | ctestok(1,'C,-O3','ccode169i',<<'EOF',$todo.'Attribute::Handlers #169'); 17 | package MyTest; 18 | 19 | use Attribute::Handlers; 20 | 21 | sub Check :ATTR { 22 | #print "called\n"; 23 | print "o" if ref $_[4] eq 'ARRAY' && join(',', @{$_[4]}) eq join(',', qw/a b c/); 24 | } 25 | 26 | sub a_sub :Check(qw/a b c/) { 27 | return "k"; 28 | } 29 | 30 | print a_sub()."\n"; 31 | EOF 32 | 33 | $todo = "" if $] > 5.021006; 34 | $todo = "TODO 5.26 " if $] > 5.025003; 35 | ctestok(2,'C,-O3','ccode169i',<<'EOF',$todo.'run-time attributes::get #278'); 36 | our $anon1; 37 | eval q/$anon1 = sub : method { $_[0]++ }/; 38 | use attributes; 39 | @attrs = eval q/attributes::get $anon1/; 40 | print qq{ok\n} if "@attrs" eq "method"; 41 | #print "@attrs" 42 | EOF 43 | 44 | $todo = "TODO 5.10 " if $] < 5.012; 45 | $todo = "TODO 5.25 " if $] > 5.025 and !$CPERL; 46 | ctestok(3,'C,-O3','ccode169i',<<'EOF',$todo.'compile-time attributes::get #278'); 47 | use attributes; 48 | our $anon = sub : method { $_[0]++ }; 49 | @attrs = attributes::get $anon; 50 | print qq{ok\n} if "@attrs" eq "method"; 51 | EOF 52 | -------------------------------------------------------------------------------- /ramblings/revert-B-load-BEGIN-516.patch: -------------------------------------------------------------------------------- 1 | RT#81332 revert 744aaba0 bloats the B compilers 2 | For 5.16.1 and 5.16.2 3 | 4 | diff -u ext/B/B.pm.orig ext/B/B.pm 5 | --- ext/B/B.pm.orig 2013-01-09 13:06:02.400814216 -0600 6 | +++ ext/B/B.pm 2013-01-09 13:09:57.898447521 -0600 7 | @@ -8,24 +8,15 @@ 8 | package B; 9 | use strict; 10 | 11 | +require XSLoader; 12 | require Exporter; 13 | @B::ISA = qw(Exporter); 14 | 15 | # walkoptree_slow comes from B.pm (you are there), 16 | # walkoptree comes from B.xs 17 | 18 | -BEGIN { 19 | - $B::VERSION = '1.35'; 20 | - @B::EXPORT_OK = (); 21 | - 22 | - # Our BOOT code needs $VERSION set, and will append to @EXPORT_OK. 23 | - # Want our constants loaded before the compiler meets OPf_KIDS below, as 24 | - # the combination of having the constant stay a Proxy Constant Subroutine 25 | - # and its value being inlined saves a little over .5K 26 | - 27 | - require XSLoader; 28 | - XSLoader::load(); 29 | -} 30 | +$B::VERSION = '1.35_01'; 31 | +@B::EXPORT_OK = (); 32 | 33 | push @B::EXPORT_OK, (qw(minus_c ppname save_BEGINs 34 | class peekop cast_I32 cstring cchar hash threadsv_names 35 | @@ -38,6 +29,9 @@ 36 | @specialsv_name 37 | ), $] > 5.009 && 'unitcheck_av'); 38 | 39 | +sub OPf_KIDS (); 40 | +use strict; 41 | + 42 | @B::SV::ISA = 'B::OBJECT'; 43 | @B::NULL::ISA = 'B::SV'; 44 | @B::PV::ISA = 'B::SV'; 45 | @@ -332,6 +326,8 @@ 46 | } 47 | } 48 | 49 | +XSLoader::load(); 50 | + 51 | 1; 52 | 53 | __END__ 54 | -------------------------------------------------------------------------------- /script/assemble: -------------------------------------------------------------------------------- 1 | #! perl 2 | use B::Assembler qw(assemble_fh); 3 | use FileHandle; 4 | 5 | =pod 6 | 7 | =head1 NAME 8 | 9 | assemble - Assemble Perl bytecode 10 | 11 | =head1 SYNOPSIS 12 | 13 | assemble [-d] [bytecode.asm | -] [bytecode.plc] 14 | 15 | =head1 DESCRIPTION 16 | 17 | Compiles an ascii bytecode as produced by L to binary bytecode assembler. 18 | 19 | C is a binary file wih either the magic 4 bytes 'PLBC' 20 | at the start, or something like "#! /usr/bin/perl\n 21 | use ByteLoader '0.07'", typically with the F<.plc> or F<.pmc> extension. 22 | 23 | If filename is -, the input is read from STDIN and 24 | you can still provide an output filename. 25 | 26 | =head1 OPTION -d 27 | 28 | Prints some debugging information. 29 | 30 | =cut 31 | 32 | 33 | my ($filename, $fh, $out); 34 | 35 | if ($ARGV[0] eq "-d") { 36 | B::Assembler::debug(1); 37 | shift; 38 | } 39 | 40 | $out = \*STDOUT; 41 | 42 | if (@ARGV == 0) { 43 | $fh = \*STDIN; 44 | $filename = "-"; 45 | } elsif (@ARGV == 1) { 46 | $filename = $ARGV[0]; 47 | $fh = new FileHandle "<$filename"; 48 | } elsif (@ARGV == 2) { 49 | $filename = $ARGV[0]; 50 | $fh = new FileHandle "<$filename"; 51 | $out = new FileHandle ">$ARGV[1]"; 52 | } else { 53 | die "Usage: assemble [-d] [filename | -] [outfilename]\n"; 54 | } 55 | 56 | binmode $out; 57 | $SIG{__WARN__} = sub { warn "$filename:@_" }; 58 | $SIG{__DIE__} = sub { die "$filename: @_" }; 59 | assemble_fh($fh, sub { print $out @_ }); 60 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: "perl" 2 | sudo: false 3 | perl: 4 | - "5.24" 5 | - "5.22" 6 | - "5.14" 7 | - "5.24-dbg" 8 | - "5.28" 9 | - "5.26" 10 | - "5.20" 11 | - "5.18" 12 | - "5.16" 13 | - "5.12" 14 | - "5.10" 15 | - "5.8" 16 | #- "5.14-thr" 17 | - "5.22-thr" 18 | #- "dev" 19 | #- "blead" 20 | 21 | # "cperl-5.24.0"/"5.24c" not yet 22 | 23 | # fast_finish: http://blog.travis-ci.com/2013-11-27-fast-finishing-builds/ 24 | matrix: 25 | fast_finish: true 26 | allow_failures: 27 | - perl: "5.28" 28 | - perl: "5.26" 29 | - perl: "5.24-dbg" 30 | - perl: "5.22-thr" 31 | - perl: "5.8" 32 | - perl: "5.28.1c" 33 | - perl: "5.26.4c" 34 | #- perl: "blead" 35 | 36 | before_install: 37 | - mkdir /home/travis/bin || true 38 | - ln -s `which true` /home/travis/bin/cpansign 39 | - rm t/CORE/v5.14/C-COMPILED/{testc,template}.pl 40 | - eval $(curl https://travis-perl.github.io/init) --auto 41 | 42 | install: 43 | - export COVERAGE=0 AUTOMATED_TESTING=1 44 | - cpan-install --deps 45 | - cpan-install IPC::Run B::Flags Opcodes IO::Socket::SSL JSON::XS LWP::UserAgent 46 | - cpan-install Net::SSLeay Net::LibIDN Net::IDN::Encode Net::DNS EV 47 | - cpan-install Coro || cpan-install RURBAN/Coro-6.4801.tar.gz 48 | 49 | script: "perl Makefile.PL && make && make testfast" 50 | 51 | notifications: 52 | irc: "irc.perl.org#compiler" 53 | recipients: 54 | - perl-compiler@googlegroups.com 55 | email: 56 | on_success: change 57 | on_failure: always 58 | 59 | -------------------------------------------------------------------------------- /t/issue219.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # GH #219 overload stringify failed 5.18-5.22 3 | # See also t/issue172.t 4 | use strict; 5 | use Config; 6 | my @plan; 7 | BEGIN { 8 | if ($ENV{PERL_CORE}) { 9 | unshift @INC, ('t', '../../lib'); 10 | } else { 11 | unshift @INC, 't', "blib/arch", "blib/lib"; 12 | } 13 | require TestBC; 14 | $ENV{SKIP_SLOW_TESTS} = 1 if $Config{ccflags} =~ /-flto/; 15 | $ENV{SKIP_SLOW_TESTS} = 1 if $^O eq 'MSWin32' and $ENV{APPVEYOR}; 16 | 17 | if ($ENV{SKIP_SLOW_TESTS}) { 18 | @plan = (skip_all => 'SKIP_SLOW_TESTS, timeout on CI'); 19 | } else { 20 | @plan = (tests => 3); 21 | } 22 | } 23 | use Test::More @plan; 24 | use B::C (); 25 | my $todo = ($] >= 5.018 and $B::C::VERSION lt '1.52_18') ? "TODO 5.18-5.22" : ""; 26 | 27 | ctestok(1,'C,-O3','ccode219i',<<'EOF',$todo.'#219 overload stringify, testc 172'); 28 | package Foo; 29 | use overload q("") => sub { "Foo" }; 30 | package main; 31 | my $foo = bless {}, "Foo"; 32 | print "ok\n" if "$foo" eq "Foo"; 33 | EOF 34 | 35 | ctestok(2,'C,-O3','ccode219i',<<'EOF',$todo.'#219 overload stringify'); 36 | package OverloadTest; 37 | use overload qw("") => sub { ${$_[0]} }; 38 | package main; 39 | my $foo = bless \(my $bar = "ok"), "OverloadTest"; 40 | print $foo."\n"; 41 | EOF 42 | 43 | ctestok(3,'C,-O3','ccode219i',<<'EOF','#219 overload integer, testc 2731'); 44 | package Foo; 45 | use overload; 46 | sub import { overload::constant "integer" => sub { return shift }}; 47 | package main; 48 | BEGIN { $INC{"Foo.pm"} = "/lib/Foo.pm" }; 49 | use Foo; 50 | print "ok\n" if 11 == eval "5+6"; 51 | EOF 52 | -------------------------------------------------------------------------------- /ramblings/revert-B-load-BEGIN-517-B141.patch: -------------------------------------------------------------------------------- 1 | RT#81332 revert 744aaba0 bloats the B compilers 2 | For 5.17.7-8, B-1.41 3 | 4 | diff -u ext/B/B.pm.orig ext/B/B.pm 5 | --- ext/B/B.pm.orig 2012-11-28 16:28:25.376657707 -0600 6 | +++ ext/B/B.pm 2013-01-09 13:35:28.247382145 -0600 7 | @@ -6,26 +6,16 @@ 8 | # License or the Artistic License, as specified in the README file. 9 | # 10 | package B; 11 | -use strict; 12 | 13 | +require XSLoader; 14 | require Exporter; 15 | @B::ISA = qw(Exporter); 16 | 17 | # walkoptree_slow comes from B.pm (you are there), 18 | # walkoptree comes from B.xs 19 | 20 | -BEGIN { 21 | - $B::VERSION = '1.41'; 22 | - @B::EXPORT_OK = (); 23 | - 24 | - # Our BOOT code needs $VERSION set, and will append to @EXPORT_OK. 25 | - # Want our constants loaded before the compiler meets OPf_KIDS below, as 26 | - # the combination of having the constant stay a Proxy Constant Subroutine 27 | - # and its value being inlined saves a little over .5K 28 | - 29 | - require XSLoader; 30 | - XSLoader::load(); 31 | -} 32 | +$B::VERSION = '1.41_01'; 33 | +@B::EXPORT_OK = (); 34 | 35 | push @B::EXPORT_OK, (qw(minus_c ppname save_BEGINs 36 | class peekop cast_I32 cstring cchar hash threadsv_names 37 | @@ -37,6 +27,9 @@ 38 | defstash curstash warnhook diehook inc_gv @optype 39 | @specialsv_name unitcheck_av)); 40 | 41 | +sub OPf_KIDS (); 42 | +use strict; 43 | + 44 | @B::SV::ISA = 'B::OBJECT'; 45 | @B::NULL::ISA = 'B::SV'; 46 | @B::PV::ISA = 'B::SV'; 47 | @@ -330,6 +323,8 @@ 48 | } 49 | } 50 | 51 | +XSLoader::load(); 52 | + 53 | 1; 54 | 55 | __END__ 56 | -------------------------------------------------------------------------------- /t/mock: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | # for p in perl$perlall; do perl$p t/mock --logdir=t/reports/1.28/r584 t/*.t; done 3 | # 4 | # Replay results from stored log files to test the result of the 5 | # current TODO status. 6 | # 7 | # Currently perl compiler tests are stored in two formats: 8 | # 9 | # 1. log.test-$arch-$perlversion 10 | # 11 | # 2. log.modules-$perlversion 12 | # 13 | # When running the Mock tests the actual tests are not executed, 14 | # instead the results from log file are used instead for the result of ok. 15 | # A typical perl-compiler testrun lasts several hours, with Mock 16 | # several seconds. 17 | 18 | use strict; 19 | BEGIN { 20 | unshift @INC, 't'; 21 | } 22 | use Mock; 23 | use modules; 24 | 25 | my $X = $^X =~ m/\s/ ? qq{"$^X"} : $^X; 26 | unless (eval "require Test::Harness::Straps;") { 27 | print "Installing Test::Harness::Straps via cpan...\n"; 28 | system("$X -S cpan Test::Harness::Straps"); 29 | } 30 | 31 | my ($logdir) = grep /--logdir=(.+)/, @ARGV; 32 | my ($arch) = grep /--arch=(.+)/, @ARGV; 33 | $logdir = "." unless $logdir; 34 | my @mod = find_modules_report($logdir); 35 | my @tst = find_test_report($logdir, $arch); 36 | 37 | my @tests = @ARGV ? @ARGV : glob "t/*.t"; 38 | for my $test (@tests) { 39 | my $version = perlversion; 40 | my @files = $test =~ /modules\.t/ ? @mod : @tst; 41 | @files = () if $test =~ /issue34\.t/; # ignore handmade test 42 | @files = () if $test =~ /bytecode\.t/; # XXX make it into a sub from test.pl 43 | for my $log (@files) { 44 | #my $rpt = parse_report($_); 45 | # XXX run mock test and use result 46 | mock_harness($log, $test); 47 | } 48 | } 49 | -------------------------------------------------------------------------------- /t/issue34.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=34 3 | # B::C -O4 ignores $/ = undef 4 | use Test::More tests => 2; 5 | use strict; 6 | my $base = "ccode34i"; 7 | 8 | sub test { 9 | my ($num, $script, $expected, $todo) = @_; 10 | my $name = $base."_$num"; 11 | unlink($name, "$name.c", "$name.pl", "$name.exe"); 12 | open F, ">", "$name.pl"; 13 | print F $script; 14 | close F; 15 | 16 | my $runperl = $^X =~ m/\s/ ? qq{"$^X"} : $^X; 17 | $runperl .= " -Iblib/arch -Iblib/lib"; 18 | my $b = $] > 5.008 ? "-qq,CC" : "CC"; 19 | system "$runperl -MO=$b,-o$name.c $name.pl"; 20 | unless (-e "$name.c") { 21 | print "not ok 1 #B::CC failed\n"; 22 | exit; 23 | } 24 | system "$runperl blib/script/cc_harness -q -o $name $name.c"; 25 | my $runexe = $^O eq 'MSWin32' ? "$name.exe" : "./$name"; 26 | ok(-e $runexe, "$runexe exists"); 27 | my $result = `$runexe`; 28 | my $ok = $result eq $expected; 29 | if ($todo) { 30 | TODO: { 31 | local $TODO = $todo; 32 | ok($ok); 33 | } 34 | } else { 35 | ok($ok); 36 | } 37 | if ($ok) { 38 | unlink($runexe, "$name.c", "$name.pl", "$name.dat"); 39 | } 40 | } 41 | 42 | my $script = <<'EOF'; 43 | $/ = undef; 44 | open FILE, 'ccode34i.dat'; 45 | my $first = ; 46 | my $rest = ; 47 | print "1:\n$first"; 48 | print "2:\n$rest"; 49 | EOF 50 | 51 | open F, ">", "ccode34i.dat"; 52 | print F "line1\n"; 53 | print F "line2\n"; 54 | close F; 55 | 56 | my $expected = <<'EOF1'; 57 | 1: 58 | line1 59 | line2 60 | 2: 61 | EOF1 62 | 63 | test(1, $script, $expected, 'B::CC issue 34 $/=undef ignored'); 64 | -------------------------------------------------------------------------------- /ramblings/Export-DynaLoader-symbols-from-libperl-again.patch: -------------------------------------------------------------------------------- 1 | Required for 5.15.2 and 5.15.3 only 2 | 3 | From 4497a11a0d2e48af795e0e4d8f8c185e48d87b10 Mon Sep 17 00:00:00 2001 4 | From: Reini Urban 5 | Date: Tue, 27 Sep 2011 06:45:37 -0500 6 | Subject: [PATCH] Export DynaLoader symbols from libperl again 7 | MIME-Version: 1.0 8 | Content-Type: multipart/mixed; boundary="------------1.7.6.1" 9 | 10 | This is a multi-part message in MIME format. 11 | --------------1.7.6.1 12 | Content-Type: text/plain; charset=UTF-8; format=fixed 13 | Content-Transfer-Encoding: 8bit 14 | 15 | 16 | With 5.15.2 and the new xubpp, DynaLoader symbols were XS_INTERNAL, before 17 | they were effectively XS_EXTERNAL. This broke B::C and possibly other 18 | embedded apps which link to DynaLoader functions. 19 | --- 20 | ext/DynaLoader/dlutils.c | 1 + 21 | 1 files changed, 1 insertions(+), 0 deletions(-) 22 | 23 | 24 | --------------1.7.6.1 25 | Content-Type: text/x-patch; name="0001-Export-DynaLoader-symbols-from-libperl-again.patch" 26 | Content-Transfer-Encoding: 8bit 27 | Content-Disposition: attachment; filename="0001-Export-DynaLoader-symbols-from-libperl-again.patch" 28 | 29 | diff --git a/ext/DynaLoader/dlutils.c b/ext/DynaLoader/dlutils.c 30 | index 1ba9a61..574ccad 100644 31 | --- a/ext/DynaLoader/dlutils.c 32 | +++ b/ext/DynaLoader/dlutils.c 33 | @@ -8,6 +8,7 @@ 34 | * files when the interpreter exits 35 | */ 36 | 37 | +#define PERL_EUPXS_ALWAYS_EXPORT 38 | #ifndef START_MY_CXT /* Some IDEs try compiling this standalone. */ 39 | # include "EXTERN.h" 40 | # include "perl.h" 41 | 42 | --------------1.7.6.1-- 43 | 44 | 45 | -------------------------------------------------------------------------------- /t/issue96.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=96 3 | # defined &gv should not store the gv->CV 4 | use strict; 5 | BEGIN { 6 | unshift @INC, 't'; 7 | require TestBC; 8 | } 9 | use Test::More; 10 | use Config; 11 | plan tests => 3; 12 | #plan skip_all => 'defined &gv optimization temp. disabled'; exit; 13 | 14 | my $ITHREADS = $Config{useithreads}; 15 | my $script = 'defined(&B::OP::name) || print q(ok)'; 16 | 17 | sub compile_check { 18 | my ($num,$b,$base,$script,$cmt) = @_; 19 | my $name = $base."_$num"; 20 | unlink("$name.c", "$name.pl"); 21 | open F, ">", "$name.pl"; 22 | print F $script; 23 | close F; 24 | my $X = $^X =~ m/\s/ ? qq{"$^X"} : $^X; 25 | my ($result,$out,$stderr) = 26 | run_cmd("$X -Iblib/arch -Iblib/lib -MO=$b,-o$name.c $name.pl", 20); 27 | unless (-e "$name.c") { 28 | print "not ok $num # $name B::$b failed\n"; 29 | exit; 30 | } 31 | # check stderr for "blocking not found" 32 | #diag length $stderr," ",length $out; 33 | if (!$stderr and $out) { 34 | $stderr = $out; 35 | } 36 | $stderr =~ s/main::stderr.*//s; 37 | 38 | if ($ITHREADS) { # padop, not gvop 39 | like($stderr,qr/skip saving defined\(&/, "detect defined(&B::OP::name)"); 40 | ok(1, "#skip save *B::OP::name with padop threads"); 41 | } else { 42 | like($stderr,qr/skip saving defined\(&B::OP::name\)/, "detect defined(&B::OP::name)"); 43 | like($stderr,qr/GV::save \*B::OP::name done/, "should save *B::OP::name"); 44 | } 45 | unlike($stderr,qr/GV::save &B::OP::name/, "should not save &B::OP::name"); 46 | } 47 | 48 | compile_check(1,'C,-O3,-DGC','ccode96i',$script,""); 49 | -------------------------------------------------------------------------------- /ByteLoader/hints/522_patched.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | # run with >=5.22 to check if $have_byteloader is already probed in B::C::Config 3 | # and probe if not. 4 | # we need to run this after make to be able to use ByteLoader already 5 | 6 | my ($fr, $fw, $s); 7 | open $fr, "<", "lib/B/C/Config.pm" or die "lib/B/C/Config.pm does not exist $!"; 8 | while (<$fr>) { 9 | if (/\$have_byteloader = undef;/) { # not yet probed 10 | open $fw, ">", "lib/B/C/Config.tmp" or die "cannot write lib/B/C/Config.tmp $!"; 11 | my $check = probe_byteloader(); # returns 1 or 0 12 | s/\$have_byteloader = undef;/\$have_byteloader = $check;/; 13 | print $fw $s; # write what we read until now 14 | } 15 | if ($fw) { 16 | print $fw $_ ; 17 | } else { 18 | $s .= $_; 19 | } 20 | } 21 | close $fr; 22 | if ($fw) { 23 | close $fw; 24 | unlink "lib/B/C/Config.bak" if -e "lib/B/C/Config.bak"; 25 | rename "lib/B/C/Config.pm", "lib/B/C/Config.bak"; 26 | rename "lib/B/C/Config.tmp", "lib/B/C/Config.pm"; 27 | } 28 | 29 | sub probe_byteloader { 30 | my $out = "probe.plc"; 31 | # This requires the dynamic/static target C.so to be built before [cpan #120161] 32 | if ($] > 5.021) { 33 | require Config; 34 | system "$Config::Config{make} linkext"; 35 | } 36 | system "$^X -Mblib -MO=-qq,Bytecode,-H,-o$out -e\"print q(ok)\""; 37 | return "0" unless -s $out; 38 | my $ret = `$^X -Mblib $out`; 39 | unlink $out; 40 | if ($ret ne "ok") { 41 | warn "Warning: Broken perl5.22, unpatched for ByteLoader.\n". 42 | " Try 'cpan App::perlall; perlall build 5.22.0 --patches=Compiler'\n". 43 | " or try cperl\n"; 44 | return "0"; 45 | } 46 | return "1"; 47 | } 48 | -------------------------------------------------------------------------------- /ramblings/cc.notes: -------------------------------------------------------------------------------- 1 | At entry to each basic block, the following can be assumed (and hence 2 | must be forced where necessary at the end of each basic block): 3 | 4 | The shadow stack @stack is empty. 5 | For each lexical object in @pad, VALID_IV holds for each T_INT, 6 | VALID_NUM holds for each T_NUM and VALID_SV holds otherwise. 7 | The C shadow variable sp holds the stack pointer (not necessarily stack_sp). 8 | 9 | write_back_stack 10 | Writes the contents of the shadow stack @stack back to the real stack. 11 | A write-back of each object in the stack is forced so that its 12 | backing SV contains the right value and that SV is then pushed onto the 13 | real stack. On return, @stack is empty. 14 | 15 | write_back_lexicals 16 | Forces a write-back (i.e. achieves VALID_SV), where necessary, for each 17 | lexical object in @pad. Objects with the TEMPORARY flag are skipped. If 18 | write_back_lexicals is called with an (optional) argument, then it is 19 | taken to be a bitmask of more flags: any lexical object with one of those 20 | flags set is also skipped and not written back to its SV. 21 | 22 | invalidate_lexicals($avoid) 23 | The VALID_INT and VALID_NUM flags are turned off for each lexical 24 | object in @pad whose flags field doesn't overlap with $avoid. 25 | 26 | reload_lexicals 27 | For each necessary lexical object in @pad, makes sure that VALID_IV 28 | holds for objects of type T_INT, VALID_NUM holds for objects for 29 | type T_NUM, and VALID_SV holds for other objects. An object is 30 | considered for reloading if its flags field does not overlap with the 31 | (optional) argument passed to reload_lexicals. 32 | 33 | -------------------------------------------------------------------------------- /t/fast-testing.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | # usage: t/fast-testing.sh [--watch] 3 | 4 | test -f Makefile || perl Makefile.PL 5 | V=$(perl -ane'print $F[2] if /^VERSION =/' Makefile) 6 | R=$(git log -1 --pretty=format:"%h") 7 | D=$(git describe --long --tags --dirty --always) 8 | lock=fast-testing.lock 9 | w= 10 | echo $$ > $lock 11 | trap "rm $lock; exit 255" SIGINT SIGTERM 12 | 13 | # need to kill rogue processes since we cannot use run_cmd. it disturbs stdout/err order # 14 | # bash-4 only 15 | if [ x$1 = x--watch ]; then 16 | if ((BASH_VERSINFO[0] < 4)); then 17 | echo "only bash-3: no coproc watchdog processkiller" 18 | else 19 | #TODO check our tty 20 | eval "coproc (while true; do 21 | sleep 1; 22 | code=`ps axw|egrep ' \./(ccode|cccode|a |aa |a.out|perldoc)'|grep -v grep` 23 | pid=`echo $code|perl -ane'print $F[0]'` 24 | test -n \"$pid\" && (echo $code; sleep 1s; kill $pid 2>/dev/null); 25 | sleep 5; done)" 26 | w=${COPROC_PID} 27 | fi 28 | fi 29 | 30 | # test locally, ~5:45hr (17*20min). with 1.46: 2:20hr-3hr 31 | PERLCC_TIMEOUT=15 NO_AUTHOR=1 perlall -mq make '-S prove -b -j4' 32 | 33 | if [ x$1 = x--watch ]; then 34 | kill -9 $w 35 | fi 36 | 37 | # creates log.modules files with date added 38 | # perlall -m make '-Iblib/arch -Iblib/lib t/modules.t -no-subset -no-date t/top100' 39 | 40 | logs=`find . -maxdepth 1 -newer $lock -name log.make-\*` 41 | if [ -n "$logs" ]; then 42 | rdir=t/reports/$V/$D 43 | mkdir -p $rdir 44 | cp -p $logs $rdir/ 45 | rename 's/log\.make-/log\.test-/' $rdir/log.make-* 46 | ./status_upd -ad $rdir >> status.$D 47 | git diff >> status.$D 48 | cp -p status.$D $rdir/ 49 | fi 50 | rm $lock 51 | -------------------------------------------------------------------------------- /ramblings/flip-flop: -------------------------------------------------------------------------------- 1 | PP(pp_range) 2 | { 3 | if (GIMME == G_ARRAY) 4 | return NORMAL; 5 | if (SvTRUEx(PAD_SV(PL_op->op_targ))) 6 | return cLOGOP->op_other; 7 | else 8 | return NORMAL; 9 | } 10 | 11 | pp_range is a LOGOP. 12 | In list context, it just returns op_next. 13 | In scalar context it checks the truth of targ and returns 14 | op_other if true, op_next if false. 15 | 16 | flip is an UNOP. 17 | It "looks after" its child which is always a pp_range LOGOP. 18 | In list context, it just returns the child's op_other. 19 | In scalar context, there are three possible outcomes: 20 | (1) set child's targ to 1, our targ to 1 and return op_next. 21 | (2) set child's targ to 1, our targ to 0, sp-- and return child's op_other. 22 | (3) Blank targ and TOPs and return op_next. 23 | Case 1 happens for a "..." with a matching lineno... or true TOPs. 24 | Case 2 happens for a ".." with a matching lineno... or true TOPs. 25 | Case 3 happens for a non-matching lineno or false TOPs. 26 | 27 | $a = lhs..rhs; 28 | 29 | ,-------> range 30 | ^ / \ 31 | | true/ \false 32 | | / \ 33 | first| lhs rhs 34 | | \ first / 35 | ^--- flip <----- flop 36 | \ / 37 | \ / 38 | sassign 39 | 40 | 41 | /* range */ 42 | if (SvTRUE(curpad[op->op_targ])) 43 | goto label(op_other); 44 | /* op_next */ 45 | ... 46 | /* flip */ 47 | /* For "..." returns op_next. For ".." returns op_next or op_first->op_other */ 48 | /* end of basic block */ 49 | goto out; 50 | label(range op_other): 51 | ... 52 | /* flop */ 53 | out: 54 | ... 55 | -------------------------------------------------------------------------------- /t/c_allow_opts.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # test -DALLOW_PERL_OPTIONS 3 | BEGIN { 4 | print "1..4\n"; 5 | } 6 | use strict; 7 | 8 | my $pl = "t/allow.pl"; 9 | my $d = ; 10 | open F, ">", $pl; 11 | print F $d; 12 | close F; 13 | my $exe = $^O eq 'MSWin32' ? 'ccallow.exe' : './ccallow'; 14 | my $C = $] > 5.007 ? "-qq,C" : "C"; 15 | my $X = $^X =~ m/\s/ ? qq{"$^X" -Iblib/arch -Iblib/lib} : "$^X -Iblib/arch -Iblib/lib"; 16 | system "$X -MO=$C,-O3,-occallow.c $pl"; 17 | # see if the ldopts libs are picked up correctly. This really depends on your perl package. 18 | system "$X script/cc_harness -q -DALLOW_PERL_OPTIONS ccallow.c -o $exe"; 19 | unless (-e $exe) { 20 | print "ok 1 #skip wrong ldopts for cc_harness. Try -Bdynamic or -Bstatic or fix your ldopts.\n"; 21 | print "ok 2 #skip ditto\n"; 22 | print "ok 3 #skip\n"; 23 | print "ok 4 #skip\n"; 24 | exit; 25 | } 26 | my $ok = `$exe -s -abc=2 -def 2>&1`; 27 | chomp $ok; 28 | print "not " if $ok !~ /Unrecognized switch: -bc=2/; 29 | print "ok 1\n"; 30 | 31 | $ok = `$exe -s -- -abc=2 -def`; 32 | chomp $ok; 33 | my $exp = "21-"; 34 | print $ok ne $exp ? "not " : "", "ok 2", 35 | $ok ne $exp ? "# want: $exp got: $ok\n" : "\n"; 36 | 37 | system "$X script/cc_harness -q ccallow.c -o $exe"; 38 | $ok = `$exe -s -- -abc=2 -def`; 39 | $exp = "---"; 40 | chomp $ok; 41 | print $ok ne $exp ? "not " : "", "ok 3", $ok ne $exp ? " # want: $exp got: $ok\n" : "\n"; 42 | $ok = `$exe -s -abc=2 -def 2>&1`; 43 | chomp $ok; 44 | print $ok ne $exp ? "not " : "", "ok 4", $ok ne $exp ? " # want: $exp got: $ok\n" : "\n"; 45 | 46 | END { 47 | unlink($exe, "ccallow.c", $pl); 48 | } 49 | 50 | __DATA__ 51 | for (qw/abc def ghi/) {print defined $$_ ? $$_ : q(-)}; 52 | -------------------------------------------------------------------------------- /t/issue251.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=251 3 | # empty cvs, exists and defined &cv 4 | use strict; 5 | BEGIN { 6 | unshift @INC, 't'; 7 | require TestBC; 8 | } 9 | use Test::More tests => 7; 10 | use Config; 11 | my $name = 'ccode251i'; 12 | use B::C (); 13 | my $todo = ($B::C::VERSION ge '1.43_06') ? "" : "TODO "; 14 | 15 | ctestok(1,'C,-O3',$name,<<'EOF', $todo.'#251 simple predeclaration'); 16 | sub f;$e=exists &f;$d=defined &f;print "ok" if "-$e-$d-" eq "-1--"; 17 | EOF 18 | 19 | ctestok(2,'C,-O3',$name,<<'EOF', ($] >= 5.018 ? "TODO 5.18 " : "").$todo.'#251 lvalue predeclaration'); 20 | sub f :lvalue;$e=exists &f;$d=defined &f;print "ok" if "-$e-$d-" eq "-1--"; 21 | EOF 22 | 23 | ctestok(3,'C,-O3',$name,<<'EOF', $todo.'#251 empty proto predeclaration'); 24 | sub f ();$e=exists &f;$d=defined &f;print "ok" if "-$e-$d-" eq "-1--"; 25 | EOF 26 | 27 | ctestok(4,'C,-O3',$name,<<'EOF', $todo.'#251 proto predeclaration'); 28 | sub f ($);$e=exists &f;$d=defined &f;print "ok" if "-$e-$d-" eq "-1--"; 29 | EOF 30 | 31 | ctestok(5,'C,-O3',$name,<<'EOF', '#251 regular cv definition'); 32 | sub f{1};$e=exists &f;$d=defined &f;print "ok" if "-$e-$d-" eq "-1-1-"; 33 | EOF 34 | 35 | # similar but not same as test 1 36 | # passes now threaded >= 5.8.9 37 | my $todo6 = ($] < 5.008009 or !$Config{useithreads}) ? "TODO " : ""; 38 | ctestok(6,'C,-O3','ccode290i',<<'EOF', $todo6.'#290 empty sub exists && not defined'); 39 | sub f; print "ok" if exists &f && not defined &f; 40 | EOF 41 | 42 | # and this works ok 43 | ctestok(7,'C,-O3','ccode290i',<<'EOF', '#290 empty sub not defined && exists'); 44 | sub f; print "ok" if not defined &f && exists &f; 45 | EOF 46 | 47 | -------------------------------------------------------------------------------- /t/issue301.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=301 3 | # detect (maybe|next)::(method|can) mro method calls 4 | # also check #326 maybe::next::method() 5 | use strict; 6 | BEGIN { 7 | unshift @INC, 't'; 8 | require TestBC; 9 | } 10 | use Test::More; 11 | use Config; 12 | plan skip_all => "no NEXT on $]" if $] <= 5.007003; 13 | plan tests => 2; 14 | 15 | my $script = <next::method() } 25 | } 26 | print qq{ok} if C->foo eq 'A::foo' 27 | EOF 28 | 29 | if ($] < 5.010) { 30 | $script =~ s/mro/NEXT/m; 31 | $script =~ s/next::/NEXT::/m; 32 | $script =~ s/method/foo/m; 33 | } 34 | use B::C (); 35 | # fixed with 1.52_17 36 | my $todo = ($] > 5.021 and $B::C::VERSION lt '1.52_17') 37 | ? "TODO " : ""; 38 | 39 | # mro since 5.10 only 40 | ctestok(1, 'C,-O3', 'ccode301i', $script, $todo.'#301 next::method detection'); 41 | 42 | $script = < " . ((shift)->maybe::next::method() || 0) } 49 | package main; print "ok\n" if Diamond_D->maybe; 50 | EOF 51 | if ($] < 5.010) { 52 | $script =~ s/mro/NEXT/m; 53 | $script =~ s/maybe::next::/NEXT::DISTINCT::/m; 54 | $script =~ s/::method/::maybe/m; 55 | } 56 | $todo = (($] > 5.021 and $B::C::VERSION lt '1.52_17') 57 | or $Config{usethreads}) # flapping with 5.14.4d 58 | ? "TODO thr " : ""; 59 | ctestok(2, 'C,-O3', 'ccode326i', $script, $todo.'#326 maybe::next::method detection'); 60 | -------------------------------------------------------------------------------- /t/regex-dna.pl: -------------------------------------------------------------------------------- 1 | # The Computer Language Benchmarks Game 2 | # http://shootout.alioth.debian.org/ 3 | # contributed by Danny Sauer 4 | # completely rewritten and 5 | # cleaned up for speed and fun by Mirco Wahab 6 | # improved STDIN read, regex clean up by Jake Berner 7 | 8 | use strict; 9 | use warnings; 10 | 11 | my $l_file = -s STDIN; 12 | my $content; read STDIN, $content, $l_file; 13 | # this is significantly faster than using <> in this case 14 | 15 | my $dispose = qr/(^>.*)?\n/m; # slight performance gain here 16 | $content =~ s/$dispose//g; 17 | my $l_code = length $content; 18 | 19 | my @seq = ( 'agggtaaa|tttaccct', 20 | '[cgt]gggtaaa|tttaccc[acg]', 21 | 'a[act]ggtaaa|tttacc[agt]t', 22 | 'ag[act]gtaaa|tttac[agt]ct', 23 | 'agg[act]taaa|ttta[agt]cct', 24 | 'aggg[acg]aaa|ttt[cgt]ccct', 25 | 'agggt[cgt]aa|tt[acg]accct', 26 | 'agggta[cgt]a|t[acg]taccct', 27 | 'agggtaa[cgt]|[acg]ttaccct' ); 28 | 29 | my @cnt = (0) x @seq; 30 | for my $k (0..$#seq) { 31 | ++$cnt[$k] while $content=~/$seq[$k]/gi; 32 | printf "$seq[$k] $cnt[$k]\n" 33 | } 34 | 35 | my %iub = ( B => '(c|g|t)', D => '(a|g|t)', 36 | H => '(a|c|t)', K => '(g|t)', M => '(a|c)', 37 | N => '(a|c|g|t)', R => '(a|g)', S => '(c|g)', 38 | V => '(a|c|g)', W => '(a|t)', Y => '(c|t)' ); 39 | 40 | # using $& and no submatch marginally improves the 41 | # speed here, but mentioning $& causes perl to 42 | # define that value for the @seq patterns too, which 43 | # slows those down considerably. No change. 44 | 45 | my $findiub = '(['.(join '', keys %iub).'])'; 46 | 47 | $content =~ s/$findiub/$iub{$1}/g; 48 | 49 | printf "\n%d\n%d\n%d\n", $l_file, $l_code, length $content; 50 | -------------------------------------------------------------------------------- /t/issue130.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=120 3 | # support lexsubs and its various B::CV::GV changes 4 | use strict; 5 | BEGIN { 6 | unshift @INC, 't'; 7 | require TestBC; 8 | } 9 | use Test::More; 10 | if ($] < 5.018) { 11 | plan skip_all => "lexical subs since 5.18"; 12 | exit; 13 | } 14 | plan tests => 4; 15 | use Config; 16 | 17 | my $issue = <<'EOF'; 18 | no warnings "experimental::lexical_subs"; 19 | use feature 'lexical_subs'; 20 | my sub p{q(ok)}; my $a=\&p; 21 | print p; 22 | EOF 23 | 24 | sub compile_check { 25 | my ($num,$b,$base,$script,$cmt) = @_; 26 | my $name = $base."_$num"; 27 | unlink("$name.c", "$name.pl"); 28 | open F, ">", "$name.pl"; 29 | print F $script; 30 | close F; 31 | my $X = $^X =~ m/\s/ ? qq{"$^X"} : $^X; 32 | $b .= ',-DCsp,-v'; 33 | my $Mblib = Mblib; 34 | my ($result,$out,$stderr) = 35 | run_cmd("$X $Mblib -MO=$b,-o$name.c $name.pl", 20); 36 | unless (-e "$name.c") { 37 | print "not ok $num # $name B::$b failed\n"; 38 | exit; 39 | } 40 | # check stderr for "Can't locate object method "STASH" via package "B::SPECIAL" 41 | # or crashes 42 | if (!$stderr and $out) { 43 | $stderr = $out; 44 | } 45 | my $notfound = $stderr =~ /Can't locate object method/; 46 | ok(!$notfound, $cmt); 47 | } 48 | 49 | compile_check(1,'C,-O3,-UB','ccode130i',$issue,"lexsubs compile ok"); 50 | ctestok(2,'C,-O3,-UB,-Uwarnings,-UCarp,-UExporter,-UConfig','ccode130i',$issue, 51 | "lexsubs run C ok"); 52 | ctestok(3,'CC,-UB,-Uwarnings,-UCarp,-UExporter,-UConfig','cccode130i',$issue, 53 | ($]>5.021?"TODO 5.22 ":"")."lexsubs run CC ok"); 54 | 55 | plctestok(4,'ccode130i',$issue,"TODO lexsubs run BC ok"); # needs xcv_name_hek 56 | -------------------------------------------------------------------------------- /ByteLoader/Makefile.PL: -------------------------------------------------------------------------------- 1 | use ExtUtils::MakeMaker; 2 | use Config; 3 | my $core = grep { $_ eq 'PERL_CORE=1' } @ARGV; 4 | my $ccflags = $Config{ccflags}; 5 | my $lddlflags = $Config{lddlflags}; 6 | 7 | if ( -d '.svn' or -d '.git' ) { 8 | $ccflags .= ' -ansi -Wall -Wextra' if $Config{cc} =~ /\bgcc/ and $Config{gccversion}; 9 | } 10 | if ($] < 5.007) { 11 | # We are not called by ../Makefile.PL, but be sure about that for now. 12 | print "perl 5.6 does still use the builtin Bytecode compiler and ByteLoader\n"; 13 | ExtUtils::MakeMaker::WriteEmptyMakefile; 14 | exit; 15 | } 16 | WriteMakefile( 17 | NAME => 'ByteLoader', 18 | VERSION_FROM => 'ByteLoader.pm', 19 | XSPROTOARG => '-noprototypes', 20 | OBJECT => 'byterun$(OBJ_EXT) ByteLoader$(OBJ_EXT)', 21 | LDDLFLAGS => $lddlflags, 22 | CCFLAGS => $ccflags, 23 | clean => { FILES => 24 | "byterun.* *.core *.stackdump a.out *.c *.o *~ dll.base dll.exp"}, 25 | 26 | ); 27 | 28 | sub MY::depend { 29 | my $up = File::Spec->updir; 30 | my $bytecode_pl = File::Spec->catdir( '..', 'bytecode.pl' ); 31 | return " 32 | \$(INST_LIB)/ByteLoader.pm : ByteLoader.pm 33 | \$(NOECHO) \$(ABSPERLRUN) -MExtUtils::Install -e 'pm_to_blib({@ARGV}, '\''$(INST_LIB)/auto'\'', '\''$(PM_FILTER)'\'')' -- \ 34 | ByteLoader.pm \$(INST_LIB)/ByteLoader.pm 35 | 36 | byterun.c : $bytecode_pl Makefile bytecode.h 37 | cd $up && \$(MAKE) \$(USEMAKEFILE) \$(FIRST_MAKEFILE) ByteLoader/byterun.c \$(PASTHRU) 38 | 39 | byterun.h : $bytecode_pl Makefile 40 | cd $up && \$(MAKE) \$(USEMAKEFILE) \$(FIRST_MAKEFILE) ByteLoader/byterun.h \$(PASTHRU) 41 | 42 | ByteLoader.c: byterun.h Makefile 43 | 44 | ByteLoader\$(OBJ_EXT) : byterun.h byterun.c bytecode.h Makefile 45 | 46 | " 47 | } 48 | -------------------------------------------------------------------------------- /t/issue59.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=59 3 | # Problems compiling scripts that use IO::Socket 4 | use Test::More tests => 3; 5 | use strict; 6 | BEGIN { 7 | unshift @INC, 't'; 8 | require TestBC; 9 | } 10 | use Config; 11 | 12 | my $name = "ccode59i"; 13 | my $script = <<'EOF'; 14 | use strict; 15 | use warnings; 16 | use IO::Socket; 17 | my $remote = IO::Socket::INET->new( Proto => "tcp", PeerAddr => "perl.org", PeerPort => "80" ); 18 | if ($remote) { 19 | print $remote "GET / HTTP/1.0" . "\r\n\r\n"; 20 | my $result = <$remote>; 21 | $result =~ m|HTTP/1.1 200 OK| ? print "ok" : print $result; 22 | close $remote; 23 | } 24 | EOF 25 | 26 | open F, "> $name.pl"; 27 | print F $script; 28 | close F; 29 | 30 | my $expected = "ok"; 31 | my $runperl = $^X =~ m/\s/ ? qq{"$^X"} : $^X; 32 | my $q = $] < 5.008001 ? "" : "-qq,"; 33 | my $result = qx($runperl $name.pl); 34 | my $canconnect = $result eq $expected ? 1 : 0; 35 | my $cmt = "connect to http://perl.org:80 via IO::Socket"; 36 | 37 | SKIP: { 38 | skip "cannot $cmt", 3 if !$canconnect; 39 | #skip "eats memory on 5.6", 2 if $] <= 5.008001; 40 | #skip "fails 5.14 threaded", 2 41 | # if $] > 5.014 and $] < 5.015 and $Config{'useithreads'} and (!-d ".git" or $ENV{NO_AUTHOR}); 42 | 43 | plctestok(1, $name, $script, ($] >= 5.018 ? "TODO ":"")."BC $name ".$cmt); 44 | 45 | #$cmt = "TODO 5.14thr" if $] > 5.014 and $] < 5.015 and $Config{'useithreads'}; 46 | #$cmt = "TODO >=5.16" if $] >= 5.016; # fixed with 1.45_04 47 | $cmt = "TODO <5.10 " if $] < 5.010; # no idea why 48 | $cmt = "TODO 5.26 " if $] > 5.025003; 49 | ctestok(2, "C", $name, $script, "C $name $cmt"); 50 | $cmt = $] > 5.021 ? "TODO 5.22" : $cmt; 51 | ctestok(3, "CC", $name, $script, "CC $name $cmt"); 52 | } 53 | -------------------------------------------------------------------------------- /t/top100: -------------------------------------------------------------------------------- 1 | Exporter 2 | Text::Tabs 3 | Text::Wrap 4 | Test::Harness 5 | Pod::Escapes 6 | Pod::Simple 7 | IO 8 | Scalar::Util 9 | Getopt::Long 10 | Pod::Parser 11 | ExtUtils::MakeMaker 12 | Test::Simple 13 | ExtUtils::Manifest 14 | Pod::Text 15 | constant 16 | Test 17 | Data::Dumper 18 | File::Spec 19 | File::Temp 20 | ExtUtils::Install 21 | Text::ParseWords 22 | ExtUtils::CBuilder 23 | ExtUtils::ParseXS 24 | Module::Build 25 | File::Path 26 | XSLoader 27 | MIME::Base64 28 | Digest 29 | Digest::MD5 30 | Sub::Uplevel 31 | URI 32 | HTML::Tagset 33 | HTML::Parser 34 | Test::Exception 35 | Net::Cmd 36 | Compress::Raw::Zlib 37 | Compress::Raw::Bzip2 38 | IO::Compress::Base 39 | LWP 40 | Storable 41 | base 42 | List::MoreUtils 43 | Params::Util 44 | Task::Weaken 45 | Class::Accessor 46 | Test::Tester 47 | Sub::Install 48 | Attribute::Handlers 49 | Data::OptList 50 | Sub::Exporter 51 | Test::NoWarnings 52 | version 53 | Params::Validate 54 | Sub::Name 55 | Filter::Util::Call 56 | Algorithm::C3 57 | Class::C3 58 | Scope::Guard 59 | MRO::Compat 60 | Time::HiRes 61 | Class::Data::Inheritable 62 | Try::Tiny 63 | Devel::GlobalDestruction 64 | Class::MOP 65 | Moose 66 | Test::Deep 67 | Carp::Clan 68 | Module::Pluggable 69 | if 70 | Text::Balanced 71 | DBI 72 | Time::Local 73 | IO::Scalar 74 | Sub::Identify 75 | Class::ISA 76 | FCGI 77 | Tree::DAG_Node 78 | Path::Class 79 | Test::Warn 80 | Encode 81 | Variable::Magic 82 | CGI 83 | B::Hooks::EndOfScope 84 | Test::Pod 85 | Digest::SHA1 86 | namespace::clean 87 | Class::Inspector 88 | Clone 89 | XML::NamespaceSupport 90 | XML::SAX 91 | YAML 92 | MooseX::Types 93 | Class::Singleton 94 | DateTime::TimeZone 95 | DateTime::Locale 96 | DateTime 97 | IO::String 98 | AppConfig 99 | UNIVERSAL::require 100 | Template::Stash 101 | -------------------------------------------------------------------------------- /t/issue27.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=27 3 | # run-time require fails at *DynaLoader::Config = *Config::Config 4 | use strict; 5 | BEGIN { 6 | unless (eval "require LWP::UserAgent;") { 7 | print "1..0 #skip LWP::UserAgent not installed\n"; 8 | exit; 9 | } 10 | } 11 | use Test::More tests => 3; 12 | 13 | my $X = $^X =~ m/\s/ ? qq{"$^X" -Iblib/arch -Iblib/lib} : "$^X -Iblib/arch -Iblib/lib"; 14 | my $perlcc = $^O eq 'MSWin32' ? "blib\\script\\perlcc" : 'blib/script/perlcc'; 15 | my $opt = ''; 16 | $opt .= ",-fno-warnings" if $] >= 5.013005; 17 | $opt .= ",-fno-fold" if $] >= 5.013009; 18 | $opt = "-Wb=".substr($opt,1) if $opt; 19 | 20 | # -fno-warnings order: Carp requires DynaLoader 21 | #TODO: { 22 | # fixed with 1.48 23 | # local $TODO = 'use -fno-warnings, always and save 550KB for small scripts' if $] >= 5.013005; 24 | # Attempt to reload Config.pm aborted. 25 | # Global symbol "%Config" requires explicit package name at 5.8.9/Time/Local.pm line 36 26 | # 5.15: Undefined subroutine &utf8::SWASHNEW called at /usr/local/lib/perl5/5.15.3/constant.pm line 36 27 | # old: &Config::AUTOLOAD failed on Config::launcher at Config.pm line 72. 28 | is(`$X $perlcc -O2 -occodei27_o2 -r -e"require LWP::UserAgent;print q(ok);"`, 'ok', 29 | "-O2 require LWP::UserAgent without -fno-warnings"); 30 | #} 31 | 32 | # fine with -fno-warnings 33 | is(`$X $perlcc $opt -occodei27 -r -e"require LWP::UserAgent;print q(ok);"`, 'ok', 34 | "require LWP::UserAgent $opt"); 35 | # With -O3 ditto (includes -fno-warnings) 36 | is(`$X $perlcc -O3 -occodei27_o3 -r -e"require LWP::UserAgent;print q(ok);"`, 'ok', 37 | "-O3 require LWP::UserAgent"); 38 | 39 | END { 40 | unlink qw(ccodei27 ccodei27.c); 41 | unlink qw(ccodei27_o2 ccodei27_o2.c); 42 | unlink qw(ccodei27_o3 ccodei27_o3.c); 43 | } 44 | -------------------------------------------------------------------------------- /script/disassemble: -------------------------------------------------------------------------------- 1 | #! perl 2 | use B::Disassembler qw(disassemble_fh); 3 | use FileHandle; 4 | 5 | =pod 6 | 7 | =head1 NAME 8 | 9 | disassemble 10 | 11 | =head1 SYNOPSIS 12 | 13 | disassemble [--bare] [bytecode.plc] > bytecode.asm 14 | assemble bytecode.asm > bytecode.plc 15 | 16 | =head1 DESCRIPTION 17 | 18 | Decompiles binary bytecode to readable and recompilable 19 | bytecode assembler. 20 | 21 | byteocde is a binary file wih either the magic 4 bytes 'PLBC' 22 | at the start, or something like "#! /usr/bin/perl\n 23 | use ByteLoader '0.07'" 24 | 25 | Without the filename uses STDIN. 26 | 27 | =head1 OPTION --bare 28 | 29 | Without the option --bare the output will be commented. 30 | 31 | Note that older assembler, before B::Assembler version 0.07, i.e. 32 | up to perl-5.8.x, will not be able to parse this commented 33 | assembler. 34 | 35 | But --bare is only optional, so the default is not backwards 36 | compatible. Rationale: Disassembling is primarily done to make 37 | binary bytecode readable, and not necessarily recompilable with 38 | older assemblers. 39 | 40 | =cut 41 | 42 | BEGIN { 43 | if ($B::Disassembler::VERSION > '1.05') { 44 | B::Disassembler->import('print_insn'); 45 | } else { 46 | sub print_insn { 47 | my ($insn, $arg) = @_; 48 | if (defined($arg)) { 49 | printf "%s %s\n", $insn, $arg; 50 | } else { 51 | print $insn, "\n"; 52 | } 53 | } 54 | } 55 | } 56 | 57 | my $verbose = '1'; 58 | if ($ARGV[0] eq "--bare") { 59 | shift; 60 | $verbose = 0; 61 | *print_insn = *B::Disassembler::print_insn_bare; 62 | } 63 | 64 | my $fh; 65 | if (@ARGV == 0) { 66 | $fh = \*STDIN; 67 | } elsif (@ARGV == 1) { 68 | $fh = new FileHandle "<$ARGV[0]"; 69 | } else { 70 | die "Usage: disassemble [--bare] [filename]\n"; 71 | } 72 | 73 | disassemble_fh($fh, \&print_insn, $verbose); 74 | 75 | -------------------------------------------------------------------------------- /t/issue98.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=98 3 | # v5.15 Bytecode Attempt to access disallowed key 'strict/subs' in a restricted hash 4 | use strict; 5 | my $name = "ccode98i"; 6 | use Test::More; 7 | use B::C::Config; 8 | Test::More->import($] <= 5.021006 || $B::C::Config::have_byteloader 9 | ? (tests => 1) : (skip_all => 'perl5.22 broke ByteLoader')); 10 | use Config; 11 | 12 | # New bug reported by Zloysystem 13 | # This is common-sense.pm 14 | my $source = 'BEGIN { 15 | local $^W; # work around perl 5.16 spewing out warnings for next statement 16 | # use warnings 17 | ${^WARNING_BITS} ^= ${^WARNING_BITS} ^ ""; 18 | # use strict, use utf8; use feature; 19 | $^H |= 0x1c820ec0; 20 | @^H{qw(feature___SUB__ feature_fc feature_unicode feature_evalbytes feature_say feature_state feature_switch)} = (1) x 7;} 21 | sub test { eval(""); } 22 | print q(ok);'; 23 | # old bug reported by Zloysystem 24 | #$source = "use strict; eval(\@_);print q(ok);"; 25 | 26 | open F, ">", "$name.pl"; 27 | print F $source; 28 | close F; 29 | 30 | my $expected = "ok"; 31 | my $runperl = $^X =~ m/\s/ ? qq{"$^X"} : $^X; 32 | my $Mblib = "-Iblib/arch -Iblib/lib"; 33 | if ($] < 5.008) { 34 | system "$runperl -MO=Bytecode,-o$name.plc $name.pl"; 35 | } else { 36 | system "$runperl $Mblib -MO=-qq,Bytecode,-H,-o$name.plc $name.pl"; 37 | } 38 | unless (-e "$name.plc") { 39 | print "not ok 1 #B::Bytecode failed.\n"; 40 | exit; 41 | } 42 | my $runexe = $] < 5.008 43 | ? "$runperl -MByteLoader $name.plc" 44 | : "$runperl $Mblib $name.plc"; 45 | my $result = `$runexe`; 46 | $result =~ s/\n$//; 47 | 48 | SKIP: { 49 | skip "no features on 5.6", 1 if $] < 5.008; 50 | ok($result eq $expected, "issue98 - set feature hash"); 51 | } 52 | 53 | END { 54 | unlink($name, "$name.plc", "$name.pl") 55 | if $result eq $expected; 56 | } 57 | -------------------------------------------------------------------------------- /t/issue35.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=35 3 | # B::CC generates wrong C code for same variable in different scope 4 | use Test::More tests => 2; 5 | use strict; 6 | use Config; 7 | my $ITHREADS = $Config{useithreads}; 8 | my $base = "ccode35i"; 9 | 10 | sub test { 11 | my ($num, $script, $todo) = @_; 12 | my $name = $base."_$num"; 13 | unlink($name, "$name.c", "$name.pl", "$name.exe"); 14 | open F, ">", "$name.pl"; 15 | print F $script; 16 | close F; 17 | 18 | my $runperl = $^X =~ m/\s/ ? qq{"$^X"} : $^X; 19 | $runperl .= " -Iblib/arch -Iblib/lib"; 20 | my $b = $] > 5.008 ? "-qq,CC" : "CC"; 21 | system "$runperl -MO=$b,-o$name.c $name.pl"; 22 | unless (-e "$name.c") { 23 | print "not ok 1 #B::CC failed\n"; 24 | exit; 25 | } 26 | system "$runperl blib/script/cc_harness -q -o $name $name.c"; 27 | my $ok = -e $name or -e "$name.exe"; 28 | if ($todo) { 29 | TODO: { 30 | local $TODO = $todo; 31 | ok($ok, 'CC same variable in different scope'); 32 | } 33 | } else { 34 | ok($ok, 'CC same variable in different scope'); 35 | } 36 | if ($ok) { 37 | unlink($name, "$name.c", "$name.pl", "$name.exe"); 38 | } 39 | } 40 | 41 | # error: redeclaration of ‘d_x’ with no linkage 42 | my $script = <<'EOF'; 43 | sub new {} 44 | sub test { 45 | { my $x = 1; my $y = $x + 1;} 46 | my $x = 2; 47 | if ($x != 3) { 4; } 48 | } 49 | EOF 50 | 51 | #fixed with B-C-1.28 r527 (B::CC 1.08) 52 | use B::CC; 53 | test(1, $script, $B::CC::VERSION < 1.08 ? "B::CC issue 35" : undef); 54 | 55 | # error: redeclaration of ‘d_tmp5’ with no linkage 56 | $script = <<'EOF'; 57 | sub test { 58 | my $tmp5 = 1; 59 | my $x = $tmp5 + 1; 60 | if ($x != 3) { 4; } 61 | } 62 | EOF 63 | 64 | # passes non-threaded (5.8.9d-nt, perl5.10.1d-nt) 65 | test(2, $script, ($B::CC::VERSION < 1.08 and $ITHREADS) ? "B::CC issue 35 fail3.pl" : undef); 66 | -------------------------------------------------------------------------------- /.gdbinit: -------------------------------------------------------------------------------- 1 | #directory /usr/src/perl/perl-5.10.1/perl-5.10.1 2 | #directory /usr/src/perl/perl-5.6.2 3 | #add-auto-load-safe-path /lib/x86_64-linux-gnu/libthread_db-1.0.so 4 | 5 | set breakpoint pending on 6 | #source .gdb/dashboard 7 | source .gdb/perl 8 | 9 | b malloc_error_break 10 | b Perl_pp_multiconcat 11 | b XS_B__UNOP_AUX_aux_list 12 | 13 | #b perl_destruct 14 | #command 15 | #p PL_compiling 16 | #end 17 | #b perl.c:1175 18 | #command 19 | #p PL_compiling 20 | #end 21 | #b Perl_ckwarn_d 22 | 23 | #b Perl_pp_const 24 | #command 25 | #p sv_list[1] 26 | #end 27 | 28 | #b dl_boot 29 | #b dl_generic_private_init 30 | #b av.c 31 | 32 | #break __asan_report_error 33 | #b Perl_pp_multideref 34 | 35 | # note: StashHANDLER() is unused in 5.20 36 | #b hv.c:764 37 | #b Perl_Gv_AMupdate 38 | #b Perl_amagic_call 39 | #b Perl_pp_method_redir 40 | #b XS_B__HV_name_count 41 | 42 | #b Perl_pp_defined 43 | 44 | #b Perl_pp_entereval 45 | #command 46 | #p/x *PL_comppad_name 47 | #p *(PL_comppad_name->xpadnl_alloc)[1] 48 | #end 49 | 50 | #b Perl_newPADNAMEouter 51 | #command 52 | #macro expand (PADNAME_FROM_PV(PadnamePV(outer)) 53 | #p (long)(&(((struct padname_with_str *)0)->xpadn_str)) 54 | #p *outer 55 | #end 56 | 57 | #b dump.c:2384 58 | #command 59 | #echo actions\n 60 | #p/x actions 61 | #echo action&mask MDEREF_HV_gvhv_helem=13\n 62 | #p actions&MDEREF_ACTION_MASK 63 | #echo items\n 64 | #p *items 65 | #echo sv\n 66 | #p sv 67 | #end 68 | 69 | #b bset_obj_store 70 | #command 71 | #b Perl_padnamelist_store 72 | #c 73 | #end 74 | 75 | #b XS_DBI__install_method 76 | break Perl_croak_no_modify 77 | #break XS_B__CC__autovivification 78 | #break B.xs:1398 79 | #break B.c:2044 80 | #break B.xs:1858 81 | #break oplist 82 | #break Perl_do_openn 83 | # require %INC 84 | #break pp_ctl.c:3599 85 | #run 86 | #p/x sv_list[3299] 87 | # panic free from wrong pool 5.18.1 88 | #b util.c:252 89 | #b sv.c:3737 if (GV*)dstr->sv_u.svu_gp 90 | 91 | r 92 | -------------------------------------------------------------------------------- /t/c_cross.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # test -cross=path 3 | use strict; 4 | use Config; 5 | use Test::More; 6 | plan tests => 9; 7 | 8 | # This should exist for the last test: 9 | my $crossarch = '/usr/lib/cperl/5.29.1/armv4l-linux/CORE'; 10 | 11 | sub check_cross { 12 | my ($file) = @_; 13 | my $f; 14 | unless (open($f, "<", $file)) { 15 | ok(0, "$file $!"); 16 | return; 17 | } 18 | # perlpath in config.sh-arm-linux 19 | while (<$f>) { 20 | if (m{"", GV_ADD\|GV_NOTQUAL\), "(.+)"\);}) { 21 | is ($1, "/usr/bin/perl", "perlpath"); 22 | next; 23 | } 24 | if (m{/\* cross \@INC \*/}) { 25 | $_ = <$f>; 26 | $_ = <$f>; 27 | like($_, qr{/armv4l-linux}, 'cross \@INC'); 28 | next; 29 | } 30 | } 31 | close $f; 32 | } 33 | 34 | my $pl = "t/cross.pl"; 35 | my $d = ; 36 | open F, ">", $pl; 37 | print F $d; 38 | close F; 39 | my $exe = $^O eq 'MSWin32' ? 'ccross.exe' : './ccross'; 40 | my $C = $] > 5.007 ? "-qq,C" : "C"; 41 | my $X = $^X =~ m/\s/ ? qq{"$^X" -Iblib/arch -Iblib/lib} : "$^X -Iblib/arch -Iblib/lib"; 42 | 43 | system "$X -MO=$C,-cross=t/config.sh-arm-linux,-occross.c $pl"; 44 | 45 | # now grep the result for the right $^X, $^O and @INC 46 | check_cross('ccross.c', 1); 47 | 48 | system "$X -MO=$C,-O3,-cross=t/config.sh-arm-linux,-occross.c $pl"; 49 | check_cross('ccross.c'); 50 | 51 | $C = $] > 5.007 ? "-qq,CC" : "CC"; 52 | system "$X -MO=$C,-O,-cross=t/config.sh-arm-linux,-occross.c $pl"; 53 | check_cross('ccross.c'); 54 | 55 | system "$X script/perlcc -S --cross=t/config.sh-arm-linux -o ccross $pl"; 56 | check_cross('ccross.c'); 57 | 58 | if (-d $crossarch and `which arm-linux-gnueabihf-gcc`) { 59 | my $opts = "-I$crossarch"; 60 | system("arm-linux-gnueabihf-gcc -c $opts ccross.c"); 61 | } else { 62 | ok (1, "skip no arm-linux-gnueabihf-gcc or $crossarch"); 63 | } 64 | 65 | unlink $pl; 66 | 67 | __DATA__ 68 | require vars; 69 | vars->import($c); 70 | print "ok\n"; 71 | -------------------------------------------------------------------------------- /t/issue197.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=197 3 | # missing package DESTROY 4 | use strict; 5 | BEGIN { 6 | unshift @INC, 't'; 7 | require TestBC; 8 | } 9 | use Test::More tests => 5; 10 | 11 | my $exp = "ok - dynamic destruction 12 | ok - lexical destruction 13 | ok - package destruction"; 14 | 15 | use B::C (); 16 | my $todo = ($] >= 5.018 or $B::C::VERSION ge "1.45_01") ? "" : "TODO "; 17 | my $todo280 = ($B::C::VERSION ge "1.45_08") ? "" : "TODO "; #-O3 fixed with 49bd030 18 | my $script197 = <<'EOF'; 19 | package FINALE; 20 | { 21 | $ref3 = bless ["ok - package destruction"]; 22 | my $ref2 = bless ["ok - lexical destruction\n"]; 23 | local $ref1 = bless ["ok - dynamic destruction\n"]; 24 | 1; 25 | } 26 | DESTROY { 27 | print $_[0][0]; 28 | } 29 | EOF 30 | 31 | ctest(1,$exp,'C,-O2','ccode197i',$script197,$todo.'missing package DESTROY #197'); 32 | ctest(2,$exp,'C,-O3','ccode197i',$script197,$todo280.'missing -O3 package DESTROY #197, #280'); 33 | 34 | $exp = $] > 5.013005 ? "RUN MyKooh DESTRUCT OurKooh" : " MyKooh OurKooh"; 35 | 36 | my $script208 = <<'EOF'; 37 | sub MyKooh::DESTROY { print "${^GLOBAL_PHASE} MyKooh " } my $k=bless {}, MyKooh; 38 | sub OurKooh::DESTROY { print "${^GLOBAL_PHASE} OurKooh" }our $k=bless {}, OurKooh; 39 | EOF 40 | 41 | ctest(3,$exp,'C,-O2','ccode197i',$script208,$todo.'missing our DESTROY #208'); 42 | ctest(4,$exp,'C,-O3','ccode197i',$script208,$todo280.'missing our -O3 DESTROY #208, #280'); 43 | 44 | # if the bless happens inside BEGIN: wontfix 45 | ctestok(5,'C,-O3','ccode197i',<<'EOF','TODO destroy upgraded lexvar #254'); 46 | my $flag = 0; 47 | sub X::DESTROY { $flag = 1 } 48 | { 49 | my $x; # x only exists in that scope 50 | BEGIN { $x = 42 } # pre-initialized as IV 51 | $x = bless {}, "X"; # run-time upgrade and bless to call DESTROY 52 | # undef($x); # value should be freed when exiting scope 53 | } 54 | print "ok\n" if $flag; 55 | EOF 56 | 57 | -------------------------------------------------------------------------------- /t/issue93.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=93 3 | # recover state of IO objects. Or not 4 | # Another testcase is t/testm.sh Test::NoWarnings 5 | use strict; 6 | BEGIN { 7 | unshift @INC, 't'; 8 | require TestBC; 9 | } 10 | use Test::More tests => 9; 11 | use Config; 12 | my $i=1; 13 | 14 | my $todo = <<'EOS'; 15 | # === compiled === 16 | my ($pid, $out, $in); 17 | BEGIN { 18 | local(*FPID); 19 | $pid = open(FPID, 'echo <&STDOUT'); #easy 21 | open(my $tmp, '>', 'pcc.tmp'); #hard to gather filename 22 | print $tmp "test\n"; 23 | close $tmp; #ok closed, easy 24 | open($in, '<', 'pcc.tmp'); #hard to gather filename 25 | } 26 | # === run-time === 27 | print $out 'o'; 28 | kill 0, $pid; # BAD! warn? die? how? 29 | read $in, my $x, 4; 30 | print 'k' if 'test' eq $x; 31 | unlink 'pcc.tmp'; 32 | EOS 33 | 34 | my ($cmt, $name); 35 | 36 | TODO: { 37 | local $TODO = "recover IO state generally"; 38 | $cmt = 'various hard IO BEGIN problems'; 39 | $name = 'ccode93ib'; 40 | plctestok($i++, $name, $todo, "BC cmt"); 41 | ctestok($i++, "C", $name, $todo, "C $cmt"); 42 | ctestok($i++, "CC", $name, $todo, "CC $cmt"); 43 | } 44 | 45 | my $ok = <<'EOF'; 46 | my $out;open($out,'>&STDOUT');print $out qq(ok\n); 47 | EOF 48 | 49 | $cmt = '&STDOUT at run-time'; 50 | $name = 'ccode93ig'; 51 | plctestok($i++, $name, $ok, "BC cmt"); 52 | ctestok($i++, "C", $name, $ok, "C $cmt"); 53 | ctestok($i++, "CC", $name, $ok, "CC $cmt"); 54 | 55 | my $work = <<'EOF'; 56 | my $out;BEGIN{open($out,'>&STDOUT');}print $out qq(ok\n); 57 | EOF 58 | 59 | TODO: { 60 | local $TODO = "recover STDIO state"; 61 | $cmt = '&STDOUT restore'; 62 | $name = 'ccode93iw'; 63 | plctestok($i++, $name, $work, ($] < 5.014?"TODO needs 5.14 ":"")."BC cmt"); 64 | ctestok($i++, "C", $name, $work, "C $cmt"); 65 | ctestok($i++, "CC", $name, $work, "CC $cmt"); 66 | } 67 | 68 | END {unlink "pcc.tmp" if -f "pcc.tmp";} 69 | -------------------------------------------------------------------------------- /t/cc_last.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # B::CC limitations with last/next/continue. See README. 3 | # See also issue36.t 4 | use strict; 5 | BEGIN { 6 | if ($ENV{PERL_CORE}) { 7 | @INC = ('t', '../../lib'); 8 | } else { 9 | unshift @INC, 't'; 10 | } 11 | require TestBC; 12 | } 13 | use Test::More tests => 3; 14 | my $base = "ccode_last"; 15 | 16 | # XXX Bogus. This is not the real 'last' failure as described in the README 17 | my $script1 = <<'EOF'; 18 | # last outside loop 19 | label: { 20 | print "ok\n"; 21 | my $i = 1; 22 | { 23 | last label if $i; 24 | } 25 | print " not ok\n"; 26 | } 27 | EOF 28 | 29 | use B::CC; 30 | # 5.12 still fails test 1 31 | ctestok(1, "CC", $base, $script1, 32 | ($B::CC::VERSION < 1.08 or $] =~ m/5\.01[12]/ 33 | ? "TODO last outside loop fixed with B-CC-1.08" 34 | : "last outside loop")); 35 | 36 | # computed labels are invalid 37 | my $script2 = <<'EOF'; 38 | # Label not found at compile-time for last 39 | lab1: { 40 | print "ok\n"; 41 | my $label = "lab1"; 42 | last $label; 43 | print " not ok\n"; 44 | } 45 | EOF 46 | 47 | #TODO: { 48 | #local $TODO = "Same result and errcode as uncompiled. Label not found for last"; 49 | ctest(2, '$ok$', "CC", $base, $script2, "Label not found at compile-time for last"); 50 | #} 51 | 52 | # Fixed by Heinz Knutzen for issue 36 53 | my $script3 = <<'EOF'; 54 | # last for non-loop block 55 | { 56 | print "ok"; 57 | last; 58 | print " not ok\n"; 59 | } 60 | EOF 61 | ctestok(3, "CC", $base, $script3, 62 | $B::CC::VERSION < 1.08 63 | ? "TODO last for non-loop block fixed with B-CC-1.08" 64 | : "last for non-loop block"); 65 | 66 | if ($^O eq 'MSWin32' and $Config{cc} eq 'cl') { 67 | ok(1, "skip MSVC"); 68 | exit; 69 | } 70 | 71 | #my $script4 = <<'EOF'; 72 | ## issue 55 segfault for non local loop exit 73 | #LOOP: 74 | #{ 75 | # my $sub = sub { last LOOP; }; 76 | # $sub->(); 77 | #} 78 | #print "ok"; 79 | #EOF 80 | ## TODO 81 | #ctestok(4, "CC", $base, $script4, 82 | # $B::CC::VERSION < 1.11 83 | # ? "TODO B::CC issue 55 non-local exit with last => segv" 84 | # : "non local loop exit"); 85 | -------------------------------------------------------------------------------- /t/issue305.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=305 3 | # wrong compile-time Encode::XS &ascii_encoding 4 | # fix in perl_init2_aaaa: 5 | # #include 6 | # void *handle = dlopen(sv_list[5032].sv_u.svu_pv, RTLD_NOW|RTLD_NOLOAD); // 7 | # void *ascii_encoding = dlsym(handle, "ascii_encoding"); 8 | # SvIV_set(&sv_list[1], PTR2IV(ascii_encoding)); PVMG->iv 9 | 10 | use strict; 11 | BEGIN { 12 | unshift @INC, 't'; 13 | require TestBC; 14 | } 15 | use Test::More; 16 | if ($] < 5.007) { 17 | plan skip_all => "No Encode with perl-$]"; 18 | exit; 19 | } elsif ($] > 5.025003) { 20 | plan skip_all => "No Encode support yet with v5.26"; 21 | exit; 22 | } else { 23 | require Encode; 24 | plan tests => 3; 25 | } 26 | use Config; 27 | my $ITHREADS = $Config{useithreads}; 28 | 29 | # fixed with 1.49_07 even for older Encode versions 30 | my $todo = $Encode::VERSION lt '2.58' 31 | ? "Old Encode-$Encode::VERSION < 2.58 " 32 | : "New Encode-$Encode::VERSION >= 2.58 "; 33 | #if ($ITHREADS and ($] > 5.015 or $] < 5.01)) { 34 | # $todo = "TODO $] thr ".$todo if $] < 5.020; 35 | #} 36 | #$todo = 'TODO 5.22 ' if $] > 5.021; # fixed with 1.52_13 37 | $todo = $] > 5.025003 ? 'TODO 5.26 ' : ''; 38 | 39 | my $cmt = '#305 compile-time Encode::XS encodings'; 40 | my $script = 'use constant ASCII => eval { require Encode; Encode::find_encoding("ASCII"); } || 0; 41 | print ASCII->encode("www.google.com")'; 42 | my $exp = "www.google.com"; 43 | ctest(1, $exp, 'C,-O3', 'ccode305i', $script, $todo.'C '.$cmt); 44 | 45 | $script = 'INIT{ sub ASCII { eval { require Encode; Encode::find_encoding("ASCII"); } || 0; }} 46 | print ASCII->encode("www.google.com")'; 47 | ctest(2, $exp, 'C,-O3', 'ccode305i', $script, 'C run-time init'); 48 | 49 | # fixed with 1.49_07, and for 5.22 with 1.52_13 50 | #$todo = $] > 5.021 ? 'TODO 5.22 ' : ''; 51 | $todo = $] > 5.025003 ? 'TODO 5.26 ' : ''; 52 | ctest(3, $exp, 'C,-O3', 'ccode305i', <<'EOF', $todo.'C #365 compile-time Encode subtypes'); 53 | use constant JP => eval { require Encode; Encode::find_encoding("euc-jp"); } || 0; 54 | print JP->encode("www.google.com") 55 | EOF 56 | -------------------------------------------------------------------------------- /ByteLoader/ByteLoader.pm: -------------------------------------------------------------------------------- 1 | package ByteLoader; 2 | 3 | use XSLoader (); 4 | our $VERSION = '0.12'; 5 | # XSLoader problem: 6 | # ByteLoader version 0.0601 required--this is only version 0.06_01 at ./bytecode2.plc line 2. 7 | # on use ByteLoader $ByteLoader::VERSION; 8 | # Fixed with use ByteLoader '$ByteLoader::VERSION'; 9 | # Next problem on perl-5.8.3: invalid floating constant suffix _03" 10 | 11 | if ($] < 5.009004) { 12 | # Need to check if ByteLoader is not already linked statically. 13 | # Before 5.6 byterun was in CORE, so we have no name clash. 14 | require Config; Config->import(); 15 | if ($Config{static_ext} =~ /\bByteLoader\b/) { 16 | # We overrode the static module with our site_perl version. Which version? 17 | # We can only check the perl version and guess from that. From Module::CoreList 18 | $VERSION = '0.03' if $] >= 5.006; 19 | $VERSION = '0.04' if $] >= 5.006001; 20 | $VERSION = '0.05' if $] >= 5.008001; 21 | $VERSION = '0.06' if $] >= 5.009003; 22 | $VERSION = '0.06' if $] >= 5.008008 and $] < 5.009; 23 | } else { 24 | XSLoader::load 'ByteLoader'; # fake the old backwards compatible version 25 | } 26 | } else { 27 | XSLoader::load 'ByteLoader', $VERSION; 28 | } 29 | 30 | 1; 31 | __END__ 32 | 33 | =head1 NAME 34 | 35 | ByteLoader - load byte compiled perl code 36 | 37 | =head1 SYNOPSIS 38 | 39 | use ByteLoader; 40 | 41 | 42 | perl -MByteLoader bytecode_file.plc 43 | 44 | perl -MO=Bytecode,-H,-ofile.plc file.pl 45 | ./file.plc 46 | 47 | =head1 DESCRIPTION 48 | 49 | This module is used to load byte compiled perl code as produced by 50 | C. It uses the source filter mechanism to read 51 | the byte code and insert it into the compiled code at the appropriate point. 52 | 53 | =head1 AUTHOR 54 | 55 | Tom Hughes based on the ideas of Tim Bunce and others. 56 | Many changes by Enache Adrian 2003 a.d. 57 | and Reini Urban 2008-2013. 58 | 59 | =head1 SEE ALSO 60 | 61 | perl(1). 62 | 63 | =cut 64 | 65 | # Local Variables: 66 | # mode: cperl 67 | # cperl-indent-level: 4 68 | # fill-column: 100 69 | # End: 70 | # vim: expandtab shiftwidth=4: 71 | -------------------------------------------------------------------------------- /t/c_argv.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | use strict; 3 | use Config; 4 | BEGIN { 5 | unshift @INC, 't'; 6 | require TestBC; 7 | } 8 | use Test::More; 9 | 10 | # but works locally 11 | plan skip_all => "mingw on appveyor" 12 | if $^O eq 'MSWin32' and $Config{cc} eq 'gcc' and $ENV{APPVEYOR}; 13 | plan tests => 4; 14 | 15 | my $runperl = $^X =~ m/\s/ ? qq{"$^X"} : $^X; 16 | my $Mblib = Mblib(); 17 | my $perlcc = perlcc(); 18 | $perlcc .= " --Wc=-O1" if $ENV{PERL_CORE} and $Config{ccflags} =~ /-flto/; 19 | my $exe = $^O eq 'MSWin32' ? 'ccode_argv.exe' : 'ccode_argv'; 20 | my $pl = $^O eq 'MSWin32' ? "t\\c_argv.pl" : "t/c_argv.pl"; 21 | my $plc = $pl . "c"; 22 | my $d = ; 23 | 24 | open F, ">", $pl; 25 | print F $d; 26 | close F; 27 | diag "$runperl $Mblib $perlcc -O3 -o $exe -r $pl ok 1" if $ENV{TEST_VERBOSE}; 28 | is(`$runperl $Mblib $perlcc -O3 -o $exe -r $pl ok 1`, "ok 1\n", #1 29 | "perlcc -r file args"); 30 | unlink($exe); 31 | 32 | open F, ">", $pl; 33 | my $d2 = $d; 34 | $d2 =~ s/ ok 1/ ok 2/; 35 | print F $d2; 36 | close F; 37 | { 38 | my $result = `$runperl $Mblib $perlcc -O -o $exe -r $pl ok 2`; 39 | my $expected = "ok 2\n"; 40 | my $cmt = "perlcc -O -r file args"; 41 | if ($result eq $expected) { 42 | is ($result, $expected, $cmt); #2 43 | } else { 44 | TODO: { 45 | local $TODO = "unreliable CC testcase"; 46 | is($result, $expected, $cmt); 47 | } 48 | } 49 | } 50 | unlink($exe); 51 | 52 | open F, ">", $pl; 53 | my $d3 = $d; 54 | $d3 =~ s/ ok 1/ ok 3/; 55 | print F $d3; 56 | close F; 57 | if ($] < 5.022) { 58 | is(`$runperl $Mblib $perlcc -B -r $pl ok 3`, "ok 3\n", #3 59 | "perlcc -B -r file args"); 60 | } else { 61 | ok(1, "SKIP BC 5.22"); 62 | } 63 | 64 | # issue 30 65 | $d = ' 66 | sub f1 { 67 | my($self) = @_; 68 | $self->f2; 69 | } 70 | sub f2 {} 71 | sub new {} 72 | print "@ARGV\n";'; 73 | 74 | open F, ">", $pl; 75 | print F $d; 76 | close F; 77 | 78 | `$runperl $Mblib $perlcc -o $exe $pl`; 79 | $exe = "./$exe" unless $^O eq 'MSWin32'; 80 | is (`$exe a b c`, "a b c\n", 81 | "issue 30: perlcc -o $exe; $exe args"); #4 82 | 83 | END { 84 | unlink($exe, $pl, $plc); 85 | } 86 | 87 | __DATA__ 88 | print @ARGV?join(" ",@ARGV):"not ok 1 # empty \@ARGV","\n"; 89 | -------------------------------------------------------------------------------- /t/issue29.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=29 3 | use strict; 4 | BEGIN { 5 | if ($] < 5.008) { 6 | print "1..1\nok 1 #skip 5.6 has no IO discipline\n"; exit; 7 | } 8 | unshift @INC, 't'; 9 | require TestBC; 10 | } 11 | use Test::More tests => 2; 12 | use Config; 13 | use B::C::Config; 14 | 15 | my $DEBUGGING = ($Config{ccflags} =~ m/-DDEBUGGING/); 16 | my $ITHREADS = ($Config{useithreads}); 17 | 18 | my $name = "ccode29i"; 19 | my $script = <<'EOF'; 20 | use open qw(:std :utf8); 21 | $_ = <>; 22 | print unpack('U*', $_), " "; 23 | print $_ if /\w/; 24 | EOF 25 | 26 | open F, ">", "$name.pl"; 27 | print F $script; 28 | close F; 29 | 30 | #$ENV{LC_ALL} = 'C.UTF-8'; $ENV{LANGUAGE} = $ENV{LANG} = 'en'; 31 | my $expected = "24610 ö"; 32 | my $Mblib = Mblib; 33 | my $X = $^X =~ m/\s/ ? qq{"$^X" $Mblib} : "$^X $Mblib"; 34 | my $perlcc = "$X -Iblib/arch -Iblib/lib blib/script/perlcc"; 35 | $perlcc = "$X script/perlcc -I../.. -L../.." if $ENV{PERL_CORE}; 36 | system "$perlcc -o $name $name.pl"; 37 | unless (-e $name or -e "$name.exe") { 38 | print "ok 1 #skip perlcc failed. Try -Bdynamic or -Bstatic or fix your ldopts.\n"; 39 | print "ok 2 #skip\n"; 40 | exit; 41 | } 42 | my $runexe = $^O eq 'MSWin32' ? "$name.exe" : "./$name"; 43 | my $result = `echo "ö" | $runexe`; 44 | $result =~ s/\n$//; 45 | TODO: { 46 | local $TODO = "B::C issue 29 utf8 perlio"; 47 | ok($result eq $expected, "C '$result' ne '$expected'"); 48 | } 49 | 50 | if ($] < 5.008) { 51 | system "$X -MO=Bytecode56,-o$name.plc $name.pl"; 52 | } else { 53 | system "$X -MO=-qq,Bytecode,-o$name.plc $name.pl"; 54 | } 55 | unless (-e "$name.plc") { 56 | print "ok 2 #skip perlcc -B failed.\n"; 57 | exit; 58 | } 59 | $runexe = "$X -MByteLoader $name.plc"; 60 | $result = `echo "ö" | $runexe`; 61 | $result =~ s/\n$//; 62 | SKIP: { TODO: { 63 | local $TODO = "B::Bytecode issue 29 utf8 perlio: 5.12-5.16" 64 | if ($] >= 5.011004 and $] < 5.018 and $ITHREADS); 65 | skip "perl5.22 broke ByteLoader", 1 66 | if $] > 5.021006 and !$B::C::Config::have_byteloader; 67 | ok($result eq $expected, "BC '$result' eq '$expected'"); 68 | }} 69 | 70 | END { 71 | unlink($name, "$name.plc", "$name.pl", "$name.exe") 72 | if $result eq $expected; 73 | } 74 | -------------------------------------------------------------------------------- /ramblings/blogs-debugging-article3.pod: -------------------------------------------------------------------------------- 1 | In the first B::C debugging article we stepped into the B::C comnpiler with Od. 2 | In the second B::C debugging article we stepped the c code with gdb. 3 | We saw that the compiler is missing a sub in a seperate package, the most a typical 4 | problem with the compiler. 5 | 6 | We have a cool workaround for this, the -u option. 7 | -udummy forces all symbols in the package dummy to be dumped. 8 | 9 | 'package dummy;sub meth{print "ok"};package main;dummy->meth' as ccode35.pl 10 | 11 | 
12 | $ perl -MO=C,-Do,-v,-udummy,-occode35.c ccode35.pl
13 | 
14 | Starting compile
15 | Walking tree
16 | walkoptree: 0. LISTOP (0x1471a20) leave
17 | walkoptree: 1. OP (0x1471a48) enter
18 | walkoptree: 1. COP (0x14719e0) nextstate
19 | walkoptree: 1. UNOP (0x1471998) entersub
20 | walkoptree: 2. OP (0x14719c0) pushmark
21 | walkoptree: 2. SVOP (0x1472000) const
22 | walkoptree: 2. SVOP (0x1471978) method_named
23 | done main optree, walking symtable for extras
24 | Prescan for unused subs
25 | Saving unused subs
26 | walkoptree: 0. UNOP (0x164a6c0) leavesub
27 | walkoptree: 1. LISTOP (0x164a698) lineseq
28 | walkoptree: 2. COP (0x1472a00) nextstate
29 | walkoptree: 2. LISTOP (0x1472d48) print
30 | walkoptree: 3. OP (0x1523598) pushmark
31 | walkoptree: 3. SVOP (0x147fad8) const
32 | save context:
33 | curpad names:
34 | curpad syms:
35 | %INC and @INC:
36 | amagic_generation = 1
37 | Writing output
38 | Total number of OPs processed: 13
39 | NULLOP count: 0
40 | Loaded Cwd
41 | Loaded B
42 | Loaded IO
43 | Loaded Fcntl
44 | Loaded B::C
45 | ccode35.pl syntax OK
46 |
47 | 48 | Here it is! 49 | 0. UNOP (0x164a6c0) leavesub 50 | 1. LISTOP (0x164a698) lineseq 51 | 2. COP (0x1472a00) nextstate 52 | 2. LISTOP (0x1472d48) print 53 | 3. OP (0x1523598) pushmark 54 | 3. SVOP (0x147fad8) const 55 | 56 | is indeed our missing &dummy::meth 57 | 58 | $ perl -MO=Concise,dummy::meth ccode35.pl 59 | dummy::meth: 60 | 5 <1> leavesub[1 ref] K/REFC,1 ->(end) 61 | - <@> lineseq KP ->5 62 | 1 <;> nextstate(dummy 1 ccode35.pl:1) v ->2 63 | 4 <@> print sK ->5 64 | 2 <0> pushmark s ->3 65 | 3 <$> const(PV "ok") s ->4 66 | 67 | Any sub argument to B::Concise dumps the optree for this sub, not just main. 68 | 69 | -------------------------------------------------------------------------------- /t/issue71.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=71 3 | # Encode::decode fails in multiple ways. 1 with B::REGEXP refs unattached to PMOPs 4 | use Test::More tests => 3; 5 | use strict; 6 | BEGIN { 7 | unshift @INC, 't'; 8 | require TestBC; 9 | } 10 | use Config (); 11 | my $DEBUGGING = ($Config::Config{ccflags} =~ m/-DDEBUGGING/); 12 | my $ITHREADS = $Config::Config{useithreads}; 13 | 14 | # Simplification of Encode::Alias to test SvANY(REGEXP)=SvANY(CALLREGCOMP) 15 | # e.g. Encode::Alias define_alias( qr/^(.*)$/ => '"\L$1"' ) creates REGEXP refs without PMOP's. 16 | my $script = <<'EOF'; 17 | package my; 18 | our @a; 19 | sub f { 20 | my($alias,$name)=@_; 21 | unshift(@a, $alias => $name); 22 | my $find = "ok"; 23 | my $val = $a[1]; 24 | if ( ref($alias) eq 'Regexp' && $find =~ $alias ) { 25 | eval $val; 26 | } 27 | $find 28 | } 29 | package main; 30 | *f=*my::f; 31 | print "ok" if f(qr/^(.*)$/ => '"\L$1"'); 32 | EOF 33 | 34 | use B::C; 35 | ctestok(1, "C", "ccode71i", $script, 36 | ($B::C::VERSION lt '1.35' ? "TODO " : ""). "SvANY(REGEXP)=SvANY(CALLREGCOMP)" 37 | ); 38 | 39 | $script = <<'EOF'; 40 | use Encode; 41 | my $x = 'abc'; 42 | print "ok" if 'abc' eq Encode::decode('UTF-8', $x); 43 | EOF 44 | 45 | # These 2 tests failed until 1.35 because of stale QR Regexp (see test 1), 46 | # issue71 (const destruction) and issue76 (invalid cop_warnings). 47 | # rx: (?^i:^(?:US-?)ascii$)" 48 | # 5.8 failed until 1.45_07-3a25dfd at SvTEMP_off(lexwarn0) for lexwarn0=0 instead of Nullsv 49 | use B::C; 50 | my $todo = $] > 5.025003 ? 'TODO 5.26 ' : ''; 51 | ctestok(2, "C", "ccode71i", $script, 52 | ($B::C::VERSION lt '1.35' or ($] > 5.010 and $] < 5.011)) 53 | ? "TODO C reg_temp_copy from invalid r->offs" 54 | : $todo."C alias reg_temp_copy failed: Unknown encoding 'UTF-8'"); 55 | 56 | SKIP: { 57 | #skip "hangs", 1 if !$DEBUGGING; 58 | #skip "asserts", 1 if $DEBUGGING and $] < 5.011; 59 | #use B::CC; 60 | ctestok(3, "CC", "ccode71i", $script, 61 | (($B::C::VERSION lt '1.42_57') 62 | or ($] > 5.010 and $] < 5.011) 63 | or ($ITHREADS and $] > 5.013) 64 | or ($] >= 5.024) 65 | ) 66 | ? "TODO CC Encode::decode croak: Assertion failed: (SvTYPE(TARG) == SVt_PVHV), function Perl_pp_padhv" 67 | : "CC"); 68 | } 69 | -------------------------------------------------------------------------------- /log.modules-5.020003: -------------------------------------------------------------------------------- 1 | # B::C::VERSION = 1.56 30f59e9e 2019-05-04 | fix -DD sv[0] 2 | # perlversion = 5.020003 3 | # path = /usr/local/bin/perl5.20.3 4 | # platform = linux 64bit threaded 5 | pass Exporter 6 | pass Text::Tabs 7 | pass Text::Wrap 8 | pass Test::Harness 9 | pass Pod::Escapes 10 | pass Pod::Simple 11 | pass IO 12 | pass Scalar::Util 13 | pass Getopt::Long 14 | pass Pod::Parser 15 | pass ExtUtils::MakeMaker 16 | pass Test::Simple 17 | pass ExtUtils::Manifest 18 | pass Pod::Text 19 | pass constant 20 | pass Test 21 | pass Data::Dumper 22 | pass File::Spec 23 | pass File::Temp 24 | pass ExtUtils::Install 25 | pass Text::ParseWords 26 | pass ExtUtils::CBuilder 27 | pass ExtUtils::ParseXS 28 | pass File::Path 29 | pass XSLoader 30 | pass MIME::Base64 31 | pass Digest 32 | pass Digest::MD5 33 | pass Sub::Uplevel 34 | pass URI 35 | pass HTML::Tagset 36 | pass HTML::Parser 37 | pass Test::Exception 38 | pass Net::Cmd 39 | pass Compress::Raw::Zlib 40 | pass Compress::Raw::Bzip2 41 | pass IO::Compress::Base 42 | pass LWP 43 | pass Storable 44 | pass base 45 | pass List::MoreUtils 46 | pass Params::Util 47 | pass Task::Weaken 48 | pass Class::Accessor 49 | pass Test::Tester 50 | pass Sub::Install 51 | pass Attribute::Handlers 52 | pass Data::OptList 53 | pass Sub::Exporter 54 | pass Test::NoWarnings 55 | pass version 56 | pass Params::Validate 57 | pass Sub::Name 58 | pass Filter::Util::Call 59 | pass Algorithm::C3 60 | pass Class::C3 61 | pass Scope::Guard 62 | pass MRO::Compat 63 | pass Time::HiRes 64 | pass Class::Data::Inheritable 65 | pass Try::Tiny 66 | pass Devel::GlobalDestruction 67 | skip Class::MOP 68 | skip Moose 69 | pass Test::Deep 70 | pass Carp::Clan 71 | pass Module::Pluggable 72 | pass if(1) => "Sys::Hostname" 73 | pass Text::Balanced 74 | pass DBI 75 | pass Time::Local 76 | pass IO::Scalar 77 | pass Sub::Identify 78 | pass Class::ISA 79 | pass FCGI 80 | pass Tree::DAG_Node 81 | fail Path::Class 82 | pass Test::Warn 83 | pass Encode 84 | pass Variable::Magic 85 | pass CGI 86 | pass B::Hooks::EndOfScope 87 | pass Test::Pod 88 | pass Digest::SHA1 89 | pass namespace::clean 90 | pass Class::Inspector 91 | pass Clone 92 | pass XML::NamespaceSupport 93 | pass XML::SAX 94 | pass YAML 95 | skip MooseX::Types 96 | pass Class::Singleton 97 | fail DateTime::TimeZone 98 | fail DateTime::Locale 99 | skip DateTime 100 | pass IO::String 101 | pass AppConfig 102 | pass UNIVERSAL::require 103 | skip Template::Stash 104 | # c 105 | # pass 91 / 95 (95.8%) 106 | # fail 4 / 95 (4.2%) 107 | # todo 0 / 4 (0.0%) 108 | # skip 5 / 100 (5.0% not installed) 109 | -------------------------------------------------------------------------------- /log.modules-5.014004: -------------------------------------------------------------------------------- 1 | # B::C::VERSION = 1.56 30f59e9e 2019-05-04 | fix -DD sv[0] 2 | # perlversion = 5.014004 3 | # path = /usr/local/bin/perl5.14.4 4 | # platform = linux 64bit threaded 5 | pass Exporter 6 | pass Text::Tabs 7 | pass Text::Wrap 8 | pass Test::Harness 9 | pass Pod::Escapes 10 | pass Pod::Simple 11 | pass IO 12 | pass Scalar::Util 13 | pass Getopt::Long 14 | pass Pod::Parser 15 | pass ExtUtils::MakeMaker 16 | pass Test::Simple 17 | pass ExtUtils::Manifest 18 | pass Pod::Text 19 | pass constant 20 | pass Test 21 | pass Data::Dumper 22 | pass File::Spec 23 | pass File::Temp 24 | pass ExtUtils::Install 25 | pass Text::ParseWords 26 | pass ExtUtils::CBuilder 27 | pass ExtUtils::ParseXS 28 | pass Module::Build 29 | pass File::Path 30 | pass XSLoader 31 | pass MIME::Base64 32 | pass Digest 33 | pass Digest::MD5 34 | pass Sub::Uplevel 35 | pass URI 36 | pass HTML::Tagset 37 | pass HTML::Parser 38 | pass Test::Exception 39 | pass Net::Cmd 40 | pass Compress::Raw::Zlib 41 | pass Compress::Raw::Bzip2 42 | pass IO::Compress::Base 43 | pass LWP 44 | pass Storable 45 | pass base 46 | pass List::MoreUtils 47 | pass Params::Util 48 | pass Task::Weaken 49 | pass Class::Accessor 50 | pass Test::Tester 51 | pass Sub::Install 52 | pass Attribute::Handlers 53 | pass Data::OptList 54 | pass Sub::Exporter 55 | pass Test::NoWarnings 56 | pass version 57 | pass Params::Validate 58 | pass Sub::Name 59 | pass Filter::Util::Call 60 | pass Algorithm::C3 61 | pass Class::C3 62 | pass Scope::Guard 63 | pass MRO::Compat 64 | pass Time::HiRes 65 | pass Class::Data::Inheritable 66 | pass Try::Tiny 67 | pass Devel::GlobalDestruction 68 | pass Class::MOP 69 | fail Moose 70 | pass Test::Deep 71 | pass Carp::Clan 72 | pass Module::Pluggable 73 | pass if(1) => "Sys::Hostname" 74 | pass Text::Balanced 75 | pass DBI 76 | pass Time::Local 77 | pass IO::Scalar 78 | pass Sub::Identify 79 | pass Class::ISA 80 | pass FCGI 81 | pass Tree::DAG_Node 82 | pass Path::Class 83 | pass Test::Warn 84 | pass Encode 85 | pass Variable::Magic 86 | pass CGI 87 | pass B::Hooks::EndOfScope 88 | pass Test::Pod 89 | pass Digest::SHA1 90 | pass namespace::clean 91 | pass Class::Inspector 92 | pass Clone 93 | pass XML::NamespaceSupport 94 | pass XML::SAX 95 | pass YAML 96 | fail MooseX::Types 97 | pass Class::Singleton 98 | pass DateTime::TimeZone 99 | pass DateTime::Locale 100 | skip DateTime 101 | pass IO::String 102 | pass AppConfig 103 | pass UNIVERSAL::require 104 | pass Template::Stash 105 | # c 106 | # pass 97 / 99 (98.0%) 107 | # fail 2 / 99 (2.0%) 108 | # todo 0 / 2 (0.0%) 109 | # skip 1 / 100 (1.0% not installed) 110 | -------------------------------------------------------------------------------- /log.modules-5.018004: -------------------------------------------------------------------------------- 1 | # B::C::VERSION = 1.56 30f59e9e 2019-05-04 | fix -DD sv[0] 2 | # perlversion = 5.018004 3 | # path = /usr/local/bin/perl5.18.4 4 | # platform = linux 64bit threaded 5 | pass Exporter 6 | pass Text::Tabs 7 | pass Text::Wrap 8 | pass Test::Harness 9 | pass Pod::Escapes 10 | pass Pod::Simple 11 | pass IO 12 | pass Scalar::Util 13 | pass Getopt::Long 14 | pass Pod::Parser 15 | pass ExtUtils::MakeMaker 16 | pass Test::Simple 17 | pass ExtUtils::Manifest 18 | pass Pod::Text 19 | pass constant 20 | pass Test 21 | pass Data::Dumper 22 | pass File::Spec 23 | pass File::Temp 24 | pass ExtUtils::Install 25 | pass Text::ParseWords 26 | pass ExtUtils::CBuilder 27 | pass ExtUtils::ParseXS 28 | pass Module::Build 29 | pass File::Path 30 | pass XSLoader 31 | pass MIME::Base64 32 | pass Digest 33 | pass Digest::MD5 34 | pass Sub::Uplevel 35 | pass URI 36 | pass HTML::Tagset 37 | pass HTML::Parser 38 | pass Test::Exception 39 | pass Net::Cmd 40 | pass Compress::Raw::Zlib 41 | pass Compress::Raw::Bzip2 42 | pass IO::Compress::Base 43 | pass LWP 44 | pass Storable 45 | pass base 46 | pass List::MoreUtils 47 | pass Params::Util 48 | pass Task::Weaken 49 | pass Class::Accessor 50 | pass Test::Tester 51 | pass Sub::Install 52 | pass Attribute::Handlers 53 | pass Data::OptList 54 | pass Sub::Exporter 55 | pass Test::NoWarnings 56 | pass version 57 | pass Params::Validate 58 | pass Sub::Name 59 | pass Filter::Util::Call 60 | pass Algorithm::C3 61 | pass Class::C3 62 | pass Scope::Guard 63 | pass MRO::Compat 64 | pass Time::HiRes 65 | pass Class::Data::Inheritable 66 | pass Try::Tiny 67 | pass Devel::GlobalDestruction 68 | skip Class::MOP 69 | skip Moose 70 | pass Test::Deep 71 | pass Carp::Clan 72 | pass Module::Pluggable 73 | pass if(1) => "Sys::Hostname" 74 | pass Text::Balanced 75 | pass DBI 76 | pass Time::Local 77 | pass IO::Scalar 78 | pass Sub::Identify 79 | pass Class::ISA 80 | pass FCGI 81 | pass Tree::DAG_Node 82 | fail Path::Class 83 | pass Test::Warn 84 | pass Encode 85 | pass Variable::Magic 86 | pass CGI 87 | pass B::Hooks::EndOfScope 88 | pass Test::Pod 89 | pass Digest::SHA1 90 | pass namespace::clean 91 | pass Class::Inspector 92 | pass Clone 93 | pass XML::NamespaceSupport 94 | pass XML::SAX 95 | pass YAML 96 | skip MooseX::Types 97 | pass Class::Singleton 98 | pass DateTime::TimeZone 99 | pass DateTime::Locale 100 | pass DateTime 101 | pass IO::String 102 | pass AppConfig 103 | pass UNIVERSAL::require 104 | pass Template::Stash 105 | # c 106 | # pass 96 / 97 (99.0%) 107 | # fail 1 / 97 (1.0%) 108 | # todo 0 / 1 (0.0%) 109 | # skip 3 / 100 (3.0% not installed) 110 | -------------------------------------------------------------------------------- /log.modules-5.010001-nt: -------------------------------------------------------------------------------- 1 | # B::C::VERSION = 1.56 30f59e9e 2019-05-04 | fix -DD sv[0] 2 | # perlversion = 5.010001-nt 3 | # path = /usr/local/bin/perl5.10.1-nt 4 | # platform = linux 64bit non-threaded 5 | pass Exporter 6 | pass Text::Tabs 7 | pass Text::Wrap 8 | pass Test::Harness 9 | pass Pod::Escapes 10 | pass Pod::Simple 11 | pass IO 12 | pass Scalar::Util 13 | pass Getopt::Long 14 | pass Pod::Parser 15 | pass ExtUtils::MakeMaker 16 | pass Test::Simple 17 | pass ExtUtils::Manifest 18 | pass Pod::Text 19 | pass constant 20 | pass Test 21 | pass Data::Dumper 22 | pass File::Spec 23 | pass File::Temp 24 | pass ExtUtils::Install 25 | pass Text::ParseWords 26 | pass ExtUtils::CBuilder 27 | pass ExtUtils::ParseXS 28 | pass Module::Build 29 | pass File::Path 30 | pass XSLoader 31 | pass MIME::Base64 32 | pass Digest 33 | pass Digest::MD5 34 | pass Sub::Uplevel 35 | pass URI 36 | pass HTML::Tagset 37 | pass HTML::Parser 38 | pass Test::Exception 39 | pass Net::Cmd 40 | pass Compress::Raw::Zlib 41 | pass Compress::Raw::Bzip2 42 | pass IO::Compress::Base 43 | pass LWP 44 | pass Storable 45 | pass base 46 | pass List::MoreUtils 47 | pass Params::Util 48 | pass Task::Weaken 49 | pass Class::Accessor 50 | pass Test::Tester 51 | pass Sub::Install 52 | pass Attribute::Handlers 53 | pass Data::OptList 54 | pass Sub::Exporter 55 | pass Test::NoWarnings 56 | pass version 57 | pass Params::Validate 58 | pass Sub::Name 59 | pass Filter::Util::Call 60 | pass Algorithm::C3 61 | pass Class::C3 62 | pass Scope::Guard 63 | pass MRO::Compat 64 | pass Time::HiRes 65 | pass Class::Data::Inheritable 66 | pass Try::Tiny 67 | pass Devel::GlobalDestruction 68 | pass Class::MOP 69 | pass Moose 70 | pass Test::Deep 71 | pass Carp::Clan 72 | pass Module::Pluggable 73 | pass if(1) => "Sys::Hostname" 74 | pass Text::Balanced 75 | pass DBI 76 | pass Time::Local 77 | pass IO::Scalar 78 | pass Sub::Identify 79 | pass Class::ISA 80 | pass FCGI 81 | pass Tree::DAG_Node 82 | pass Path::Class 83 | pass Test::Warn 84 | pass Encode 85 | pass Variable::Magic 86 | pass CGI 87 | pass B::Hooks::EndOfScope 88 | pass Test::Pod 89 | pass Digest::SHA1 90 | pass namespace::clean 91 | pass Class::Inspector 92 | pass Clone 93 | pass XML::NamespaceSupport 94 | pass XML::SAX 95 | pass YAML 96 | pass MooseX::Types 97 | pass Class::Singleton 98 | pass DateTime::TimeZone 99 | pass DateTime::Locale 100 | pass DateTime 101 | pass IO::String 102 | pass AppConfig 103 | pass UNIVERSAL::require 104 | pass Template::Stash 105 | # c 106 | # pass 100 / 100 (100.0%) 107 | # fail 0 / 100 (0.0%) 108 | # todo 0 / 0 () 109 | # skip 0 / 100 (0.0% not installed) 110 | -------------------------------------------------------------------------------- /log.modules-5.012005-nt: -------------------------------------------------------------------------------- 1 | # B::C::VERSION = 1.56 30f59e9e 2019-05-04 | fix -DD sv[0] 2 | # perlversion = 5.012005-nt 3 | # path = /usr/local/bin/perl5.12.5-nt 4 | # platform = linux 64bit non-threaded 5 | pass Exporter 6 | pass Text::Tabs 7 | pass Text::Wrap 8 | pass Test::Harness 9 | pass Pod::Escapes 10 | pass Pod::Simple 11 | pass IO 12 | pass Scalar::Util 13 | pass Getopt::Long 14 | pass Pod::Parser 15 | pass ExtUtils::MakeMaker 16 | pass Test::Simple 17 | pass ExtUtils::Manifest 18 | pass Pod::Text 19 | pass constant 20 | pass Test 21 | pass Data::Dumper 22 | pass File::Spec 23 | pass File::Temp 24 | pass ExtUtils::Install 25 | pass Text::ParseWords 26 | pass ExtUtils::CBuilder 27 | pass ExtUtils::ParseXS 28 | pass Module::Build 29 | pass File::Path 30 | pass XSLoader 31 | pass MIME::Base64 32 | pass Digest 33 | pass Digest::MD5 34 | pass Sub::Uplevel 35 | pass URI 36 | pass HTML::Tagset 37 | pass HTML::Parser 38 | pass Test::Exception 39 | pass Net::Cmd 40 | pass Compress::Raw::Zlib 41 | pass Compress::Raw::Bzip2 42 | pass IO::Compress::Base 43 | pass LWP 44 | pass Storable 45 | pass base 46 | pass List::MoreUtils 47 | pass Params::Util 48 | pass Task::Weaken 49 | pass Class::Accessor 50 | pass Test::Tester 51 | pass Sub::Install 52 | pass Attribute::Handlers 53 | pass Data::OptList 54 | pass Sub::Exporter 55 | pass Test::NoWarnings 56 | pass version 57 | pass Params::Validate 58 | pass Sub::Name 59 | pass Filter::Util::Call 60 | pass Algorithm::C3 61 | pass Class::C3 62 | pass Scope::Guard 63 | pass MRO::Compat 64 | pass Time::HiRes 65 | pass Class::Data::Inheritable 66 | pass Try::Tiny 67 | pass Devel::GlobalDestruction 68 | pass Class::MOP 69 | pass Moose 70 | pass Test::Deep 71 | pass Carp::Clan 72 | pass Module::Pluggable 73 | pass if(1) => "Sys::Hostname" 74 | pass Text::Balanced 75 | pass DBI 76 | pass Time::Local 77 | pass IO::Scalar 78 | pass Sub::Identify 79 | pass Class::ISA 80 | pass FCGI 81 | pass Tree::DAG_Node 82 | pass Path::Class 83 | pass Test::Warn 84 | pass Encode 85 | pass Variable::Magic 86 | pass CGI 87 | pass B::Hooks::EndOfScope 88 | pass Test::Pod 89 | pass Digest::SHA1 90 | pass namespace::clean 91 | pass Class::Inspector 92 | pass Clone 93 | pass XML::NamespaceSupport 94 | pass XML::SAX 95 | pass YAML 96 | pass MooseX::Types 97 | pass Class::Singleton 98 | pass DateTime::TimeZone 99 | pass DateTime::Locale 100 | pass DateTime 101 | pass IO::String 102 | pass AppConfig 103 | pass UNIVERSAL::require 104 | pass Template::Stash 105 | # c 106 | # pass 100 / 100 (100.0%) 107 | # fail 0 / 100 (0.0%) 108 | # todo 0 / 0 () 109 | # skip 0 / 100 (0.0% not installed) 110 | -------------------------------------------------------------------------------- /log.modules-5.014004-nt: -------------------------------------------------------------------------------- 1 | # B::C::VERSION = 1.56 30f59e9e 2019-05-04 | fix -DD sv[0] 2 | # perlversion = 5.014004-nt 3 | # path = /usr/local/bin/perl5.14.4-nt 4 | # platform = linux 64bit non-threaded 5 | pass Exporter 6 | pass Text::Tabs 7 | pass Text::Wrap 8 | pass Test::Harness 9 | pass Pod::Escapes 10 | pass Pod::Simple 11 | pass IO 12 | pass Scalar::Util 13 | pass Getopt::Long 14 | pass Pod::Parser 15 | pass ExtUtils::MakeMaker 16 | pass Test::Simple 17 | pass ExtUtils::Manifest 18 | pass Pod::Text 19 | pass constant 20 | pass Test 21 | pass Data::Dumper 22 | pass File::Spec 23 | pass File::Temp 24 | pass ExtUtils::Install 25 | pass Text::ParseWords 26 | pass ExtUtils::CBuilder 27 | pass ExtUtils::ParseXS 28 | pass Module::Build 29 | pass File::Path 30 | pass XSLoader 31 | pass MIME::Base64 32 | pass Digest 33 | pass Digest::MD5 34 | pass Sub::Uplevel 35 | pass URI 36 | pass HTML::Tagset 37 | pass HTML::Parser 38 | pass Test::Exception 39 | pass Net::Cmd 40 | pass Compress::Raw::Zlib 41 | pass Compress::Raw::Bzip2 42 | pass IO::Compress::Base 43 | pass LWP 44 | pass Storable 45 | pass base 46 | pass List::MoreUtils 47 | pass Params::Util 48 | pass Task::Weaken 49 | pass Class::Accessor 50 | pass Test::Tester 51 | pass Sub::Install 52 | pass Attribute::Handlers 53 | pass Data::OptList 54 | pass Sub::Exporter 55 | pass Test::NoWarnings 56 | pass version 57 | pass Params::Validate 58 | pass Sub::Name 59 | pass Filter::Util::Call 60 | pass Algorithm::C3 61 | pass Class::C3 62 | pass Scope::Guard 63 | pass MRO::Compat 64 | pass Time::HiRes 65 | pass Class::Data::Inheritable 66 | pass Try::Tiny 67 | pass Devel::GlobalDestruction 68 | pass Class::MOP 69 | pass Moose 70 | pass Test::Deep 71 | pass Carp::Clan 72 | pass Module::Pluggable 73 | pass if(1) => "Sys::Hostname" 74 | pass Text::Balanced 75 | pass DBI 76 | pass Time::Local 77 | pass IO::Scalar 78 | pass Sub::Identify 79 | pass Class::ISA 80 | pass FCGI 81 | pass Tree::DAG_Node 82 | pass Path::Class 83 | pass Test::Warn 84 | pass Encode 85 | pass Variable::Magic 86 | pass CGI 87 | pass B::Hooks::EndOfScope 88 | pass Test::Pod 89 | pass Digest::SHA1 90 | pass namespace::clean 91 | pass Class::Inspector 92 | pass Clone 93 | pass XML::NamespaceSupport 94 | pass XML::SAX 95 | pass YAML 96 | pass MooseX::Types 97 | pass Class::Singleton 98 | pass DateTime::TimeZone 99 | pass DateTime::Locale 100 | pass DateTime 101 | pass IO::String 102 | pass AppConfig 103 | pass UNIVERSAL::require 104 | pass Template::Stash 105 | # c 106 | # pass 100 / 100 (100.0%) 107 | # fail 0 / 100 (0.0%) 108 | # todo 0 / 0 () 109 | # skip 0 / 100 (0.0% not installed) 110 | -------------------------------------------------------------------------------- /log.modules-5.020003-nt: -------------------------------------------------------------------------------- 1 | # B::C::VERSION = 1.56 30f59e9e 2019-05-04 | fix -DD sv[0] 2 | # perlversion = 5.020003-nt 3 | # path = /usr/local/bin/perl5.20.3-nt 4 | # platform = linux 64bit non-threaded 5 | pass Exporter 6 | pass Text::Tabs 7 | pass Text::Wrap 8 | pass Test::Harness 9 | pass Pod::Escapes 10 | pass Pod::Simple 11 | pass IO 12 | pass Scalar::Util 13 | pass Getopt::Long 14 | pass Pod::Parser 15 | pass ExtUtils::MakeMaker 16 | pass Test::Simple 17 | pass ExtUtils::Manifest 18 | pass Pod::Text 19 | pass constant 20 | pass Test 21 | pass Data::Dumper 22 | pass File::Spec 23 | pass File::Temp 24 | pass ExtUtils::Install 25 | pass Text::ParseWords 26 | pass ExtUtils::CBuilder 27 | pass ExtUtils::ParseXS 28 | pass Module::Build 29 | pass File::Path 30 | pass XSLoader 31 | pass MIME::Base64 32 | pass Digest 33 | pass Digest::MD5 34 | pass Sub::Uplevel 35 | pass URI 36 | pass HTML::Tagset 37 | pass HTML::Parser 38 | pass Test::Exception 39 | pass Net::Cmd 40 | pass Compress::Raw::Zlib 41 | pass Compress::Raw::Bzip2 42 | pass IO::Compress::Base 43 | pass LWP 44 | pass Storable 45 | pass base 46 | pass List::MoreUtils 47 | pass Params::Util 48 | pass Task::Weaken 49 | pass Class::Accessor 50 | pass Test::Tester 51 | pass Sub::Install 52 | pass Attribute::Handlers 53 | pass Data::OptList 54 | pass Sub::Exporter 55 | pass Test::NoWarnings 56 | pass version 57 | pass Params::Validate 58 | pass Sub::Name 59 | pass Filter::Util::Call 60 | pass Algorithm::C3 61 | pass Class::C3 62 | pass Scope::Guard 63 | pass MRO::Compat 64 | pass Time::HiRes 65 | pass Class::Data::Inheritable 66 | pass Try::Tiny 67 | pass Devel::GlobalDestruction 68 | skip Class::MOP 69 | skip Moose 70 | pass Test::Deep 71 | pass Carp::Clan 72 | pass Module::Pluggable 73 | pass if(1) => "Sys::Hostname" 74 | pass Text::Balanced 75 | pass DBI 76 | pass Time::Local 77 | pass IO::Scalar 78 | pass Sub::Identify 79 | pass Class::ISA 80 | pass FCGI 81 | pass Tree::DAG_Node 82 | fail Path::Class 83 | pass Test::Warn 84 | pass Encode 85 | pass Variable::Magic 86 | pass CGI 87 | pass B::Hooks::EndOfScope 88 | pass Test::Pod 89 | pass Digest::SHA1 90 | pass namespace::clean 91 | pass Class::Inspector 92 | pass Clone 93 | pass XML::NamespaceSupport 94 | pass XML::SAX 95 | pass YAML 96 | skip MooseX::Types 97 | pass Class::Singleton 98 | fail DateTime::TimeZone 99 | fail DateTime::Locale 100 | skip DateTime 101 | pass IO::String 102 | pass AppConfig 103 | pass UNIVERSAL::require 104 | pass Template::Stash 105 | # c 106 | # pass 93 / 96 (96.9%) 107 | # fail 3 / 96 (3.1%) 108 | # todo 0 / 3 (0.0%) 109 | # skip 4 / 100 (4.0% not installed) 110 | -------------------------------------------------------------------------------- /log.modules-5.022004-nt: -------------------------------------------------------------------------------- 1 | # B::C::VERSION = 1.56 ae61cb22 2019-05-06 | WIP Release 1.56 2 | # perlversion = 5.022004-nt 3 | # path = /usr/local/bin/perl5.22.4-nt 4 | # platform = linux 64bit non-threaded 5 | pass Exporter 6 | pass Text::Tabs 7 | pass Text::Wrap 8 | pass Test::Harness 9 | pass Pod::Escapes 10 | pass Pod::Simple 11 | pass IO 12 | pass Scalar::Util 13 | pass Getopt::Long 14 | pass Pod::Parser 15 | pass ExtUtils::MakeMaker 16 | fail Test::Simple 17 | pass ExtUtils::Manifest 18 | pass Pod::Text 19 | pass constant 20 | pass Test 21 | pass Data::Dumper 22 | pass File::Spec 23 | pass File::Temp 24 | pass ExtUtils::Install 25 | pass Text::ParseWords 26 | pass ExtUtils::CBuilder 27 | pass ExtUtils::ParseXS 28 | pass Module::Build 29 | pass File::Path 30 | pass XSLoader 31 | pass MIME::Base64 32 | pass Digest 33 | pass Digest::MD5 34 | pass Sub::Uplevel 35 | pass URI 36 | pass HTML::Tagset 37 | pass HTML::Parser 38 | fail Test::Exception 39 | pass Net::Cmd 40 | pass Compress::Raw::Zlib 41 | pass Compress::Raw::Bzip2 42 | pass IO::Compress::Base 43 | pass LWP 44 | pass Storable 45 | pass base 46 | pass List::MoreUtils 47 | pass Params::Util 48 | pass Task::Weaken 49 | pass Class::Accessor 50 | fail Test::Tester 51 | pass Sub::Install 52 | pass Attribute::Handlers 53 | pass Data::OptList 54 | pass Sub::Exporter 55 | fail Test::NoWarnings 56 | pass version 57 | pass Params::Validate 58 | pass Sub::Name 59 | pass Filter::Util::Call 60 | pass Algorithm::C3 61 | pass Class::C3 62 | pass Scope::Guard 63 | pass MRO::Compat 64 | pass Time::HiRes 65 | pass Class::Data::Inheritable 66 | pass Try::Tiny 67 | pass Devel::GlobalDestruction 68 | pass Class::MOP 69 | pass Moose 70 | fail Test::Deep 71 | pass Carp::Clan 72 | pass Module::Pluggable 73 | pass if(1) => "Sys::Hostname" 74 | pass Text::Balanced 75 | pass DBI 76 | pass Time::Local 77 | pass IO::Scalar 78 | pass Sub::Identify 79 | pass Class::ISA 80 | pass FCGI 81 | pass Tree::DAG_Node 82 | fail Path::Class 83 | fail Test::Warn 84 | pass Encode 85 | pass Variable::Magic 86 | pass CGI 87 | pass B::Hooks::EndOfScope 88 | fail Test::Pod 89 | pass Digest::SHA1 90 | pass namespace::clean 91 | pass Class::Inspector 92 | pass Clone 93 | pass XML::NamespaceSupport 94 | pass XML::SAX 95 | pass YAML 96 | pass MooseX::Types 97 | pass Class::Singleton 98 | pass DateTime::TimeZone 99 | pass DateTime::Locale 100 | pass DateTime 101 | pass IO::String 102 | pass AppConfig 103 | pass UNIVERSAL::require 104 | pass Template::Stash 105 | # c 106 | # pass 92 / 100 (92.0%) 107 | # fail 8 / 100 (8.0%) 108 | # todo 0 / 8 (0.0%) 109 | # skip 0 / 100 (0.0% not installed) 110 | -------------------------------------------------------------------------------- /t/issue24.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=24 3 | use strict; 4 | use Test::More tests => 3; 5 | use Config; 6 | use B::C::Config; 7 | 8 | my $DEBUGGING = ($Config{ccflags} =~ m/-DDEBUGGING/); 9 | my $ITHREADS = ($Config{useithreads}); 10 | my $name = "ccode24i"; 11 | my $skipped; 12 | 13 | my $script = <<'EOF'; 14 | my %H; dbmopen(%H,'ccode24i.db',0600); print q(ok); 15 | EOF 16 | 17 | open F, ">", "$name.pl"; 18 | print F $script; 19 | close F; 20 | 21 | my $result; 22 | my $Mblib = $] < 5.007 ? "" : "-Iblib/arch -Iblib/lib"; # 5.6 Bytecode not yet released 23 | my $O = $] >= 5.013005 ? "-Wb=-fno-fold,-fno-warnings" : ""; # reduce bloat 24 | # $O = "-Wb,-fno-walkall" if $] < 5.009; 25 | my $runperl = $^X =~ m/\s/ ? qq{"$^X"} : $^X; 26 | my $expected = `$runperl $name.pl`; 27 | 28 | $result = `$runperl $Mblib blib/script/perlcc -r -B $name.pl`; 29 | SKIP: { 30 | TODO: { #1 31 | local $TODO = "Bytecode issue 24 dbm (still original compiler)" 32 | if $] < 5.008001 or $result =~ /No dbm on this machine/; 33 | skip "perl5.22 broke ByteLoader", 1 34 | if $] > 5.021006 and !$B::C::Config::have_byteloader; 35 | is($result, $expected, "Bytecode dbm fixed with r882, 1.30"); 36 | }} 37 | unlink("$name.db*"); 38 | 39 | $Mblib = "-Iblib/arch -Iblib/lib" if $] < 5.007; 40 | TODO: { #2 41 | # also fails now with my perl5.8.9-nt, missing on File::Spec::Unix::rel2abs 42 | local $TODO = "B::C issue 24 dbm 5.10.0 or 5.6" 43 | if $] < 5.007 or $] eq '5.010000'; 44 | $TODO = "no 5.26 support yet" if $] > 5.025003; 45 | 46 | $result = `$runperl $Mblib blib/script/perlcc -r $O $name.pl`; 47 | 48 | if ($result =~ /No dbm on this machine/m) { 49 | ok(1, 'skip - No dbm on this machine'); 50 | $skipped++; 51 | } else { 52 | is($result, $expected, "C dbm fixed with r879, 1.30"); 53 | } 54 | } 55 | 56 | SKIP: { 57 | # broken in 5.23.9. 5.23.8 not tested, 5.23.7 ok. 58 | skip "$] panic: corrupt saved stack index", 1 if $] > 5.023007 and !$Config{usecperl}; 59 | 60 | $result = `$runperl $Mblib blib/script/perlcc -r -O $O $name.pl`; 61 | 62 | TODO: { #3 63 | use B::C (); 64 | local $TODO = "B::CC issue 24 dbm >5.10" if ($] >= 5.010 and $B::C::VERSION lt '1.42_61'); 65 | local $TODO = "B::CC issue 24 dbm >5.18" if ($] >= 5.018 and $B::C::VERSION ge '1.45_05' 66 | and $B::C::VERSION lt '1.45_08'); 67 | 68 | if ($skipped) { 69 | ok(1, 'skip - No dbm on this machine'); 70 | } else { 71 | is($result, $expected, "CC dbm fixed with r881, XSLoader with 1.32"); 72 | } 73 | } 74 | } 75 | 76 | END { 77 | unlink("$name*", "a", "a.out"); 78 | } 79 | -------------------------------------------------------------------------------- /log.modules-5.028002c-nt: -------------------------------------------------------------------------------- 1 | # B::C::VERSION = 1.56 30f59e9e 2019-05-04 | fix -DD sv[0] 2 | # perlversion = 5.028002c-nt 3 | # path = /usr/local/bin/cperl5.28.2-nt 4 | # platform = linux 64bit non-threaded 5 | pass Exporter 6 | pass Text::Tabs 7 | pass Text::Wrap 8 | pass Test::Harness 9 | pass Pod::Escapes 10 | pass Pod::Simple 11 | pass IO 12 | pass Scalar::Util 13 | pass Getopt::Long 14 | pass Pod::Parser 15 | pass ExtUtils::MakeMaker 16 | pass Test::Simple 17 | pass ExtUtils::Manifest 18 | pass Pod::Text 19 | pass constant 20 | pass Test 21 | pass Data::Dumper 22 | pass File::Spec 23 | pass File::Temp 24 | pass ExtUtils::Install 25 | pass Text::ParseWords 26 | pass ExtUtils::CBuilder 27 | pass ExtUtils::ParseXS 28 | pass Module::Build 29 | pass File::Path 30 | pass XSLoader 31 | pass MIME::Base64 32 | pass Digest 33 | pass Digest::MD5 34 | pass Sub::Uplevel 35 | pass URI 36 | pass HTML::Tagset 37 | pass HTML::Parser 38 | pass Test::Exception 39 | pass Net::Cmd 40 | pass Compress::Raw::Zlib 41 | pass Compress::Raw::Bzip2 42 | pass IO::Compress::Base 43 | pass LWP 44 | pass Storable 45 | pass base 46 | pass List::MoreUtils 47 | pass Params::Util 48 | pass Task::Weaken 49 | pass Class::Accessor 50 | pass Test::Tester 51 | pass Sub::Install 52 | pass Attribute::Handlers #TODO >= 5.23.5 SEGV 53 | pass Data::OptList 54 | pass Sub::Exporter 55 | pass Test::NoWarnings 56 | pass version 57 | pass Params::Validate 58 | pass Sub::Name 59 | pass Filter::Util::Call 60 | pass Algorithm::C3 61 | pass Class::C3 62 | pass Scope::Guard 63 | pass MRO::Compat 64 | pass Time::HiRes 65 | pass Class::Data::Inheritable 66 | pass Try::Tiny 67 | pass Devel::GlobalDestruction 68 | skip Class::MOP 69 | skip Moose 70 | pass Test::Deep 71 | pass Carp::Clan 72 | pass Module::Pluggable 73 | pass if(1) => "Sys::Hostname" 74 | pass Text::Balanced 75 | pass DBI 76 | pass Time::Local 77 | pass IO::Scalar 78 | pass Sub::Identify 79 | pass Class::ISA 80 | pass FCGI 81 | pass Tree::DAG_Node 82 | fail Path::Class 83 | pass Test::Warn 84 | pass Encode 85 | skip Variable::Magic 86 | pass CGI 87 | pass B::Hooks::EndOfScope 88 | pass Test::Pod 89 | pass Digest::SHA1 90 | pass namespace::clean 91 | pass Class::Inspector 92 | pass Clone 93 | pass XML::NamespaceSupport 94 | pass XML::SAX 95 | pass YAML 96 | skip MooseX::Types 97 | pass Class::Singleton 98 | fail DateTime::TimeZone 99 | fail DateTime::Locale 100 | skip DateTime 101 | pass IO::String 102 | pass AppConfig 103 | pass UNIVERSAL::require 104 | pass Template::Stash 105 | # c 106 | # pass 92 / 95 (96.8%) 107 | # fail 3 / 95 (3.2%) 108 | # todo 1 / 3 (33.3%) 109 | # skip 5 / 100 (5.0% not installed) 110 | -------------------------------------------------------------------------------- /log.modules-5.018004-nt: -------------------------------------------------------------------------------- 1 | # B::C::VERSION = 1.56 30f59e9e 2019-05-04 | fix -DD sv[0] 2 | # perlversion = 5.018004-nt 3 | # path = /usr/local/bin/perl5.18.4-nt 4 | # platform = linux 64bit non-threaded 5 | pass Exporter 6 | pass Text::Tabs 7 | pass Text::Wrap 8 | pass Test::Harness 9 | pass Pod::Escapes 10 | pass Pod::Simple 11 | pass IO 12 | pass Scalar::Util 13 | pass Getopt::Long 14 | pass Pod::Parser 15 | pass ExtUtils::MakeMaker 16 | pass Test::Simple 17 | pass ExtUtils::Manifest 18 | pass Pod::Text 19 | pass constant 20 | pass Test 21 | pass Data::Dumper 22 | pass File::Spec 23 | pass File::Temp 24 | pass ExtUtils::Install 25 | pass Text::ParseWords 26 | pass ExtUtils::CBuilder 27 | pass ExtUtils::ParseXS 28 | pass Module::Build 29 | pass File::Path 30 | pass XSLoader 31 | pass MIME::Base64 32 | pass Digest 33 | pass Digest::MD5 34 | pass Sub::Uplevel 35 | pass URI 36 | pass HTML::Tagset 37 | pass HTML::Parser 38 | pass Test::Exception 39 | pass Net::Cmd 40 | pass Compress::Raw::Zlib 41 | pass Compress::Raw::Bzip2 42 | pass IO::Compress::Base 43 | pass LWP 44 | pass Storable 45 | pass base 46 | pass List::MoreUtils 47 | pass Params::Util 48 | pass Task::Weaken 49 | pass Class::Accessor 50 | pass Test::Tester 51 | pass Sub::Install 52 | pass Attribute::Handlers 53 | pass Data::OptList 54 | pass Sub::Exporter 55 | pass Test::NoWarnings 56 | pass version 57 | pass Params::Validate 58 | pass Sub::Name 59 | pass Filter::Util::Call 60 | pass Algorithm::C3 61 | pass Class::C3 62 | pass Scope::Guard 63 | pass MRO::Compat 64 | pass Time::HiRes 65 | pass Class::Data::Inheritable 66 | pass Try::Tiny 67 | pass Devel::GlobalDestruction 68 | pass Class::MOP 69 | pass Moose #TODO 5.18 without threads 70 | pass Test::Deep 71 | pass Carp::Clan 72 | pass Module::Pluggable 73 | pass if(1) => "Sys::Hostname" 74 | pass Text::Balanced 75 | pass DBI 76 | pass Time::Local 77 | pass IO::Scalar 78 | pass Sub::Identify 79 | pass Class::ISA 80 | pass FCGI 81 | pass Tree::DAG_Node 82 | fail Path::Class 83 | pass Test::Warn 84 | pass Encode 85 | pass Variable::Magic 86 | pass CGI 87 | pass B::Hooks::EndOfScope 88 | pass Test::Pod 89 | pass Digest::SHA1 90 | pass namespace::clean 91 | pass Class::Inspector 92 | pass Clone 93 | pass XML::NamespaceSupport 94 | pass XML::SAX 95 | pass YAML 96 | pass MooseX::Types 97 | pass Class::Singleton 98 | pass DateTime::TimeZone 99 | pass DateTime::Locale 100 | pass DateTime 101 | pass IO::String 102 | pass AppConfig 103 | pass UNIVERSAL::require 104 | pass Template::Stash 105 | # c 106 | # pass 99 / 100 (99.0%) 107 | # fail 1 / 100 (1.0%) 108 | # todo 1 / 1 (100.0%) 109 | # skip 0 / 100 (0.0% not installed) 110 | -------------------------------------------------------------------------------- /t/issue90.t: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | # http://code.google.com/p/perl-compiler/issues/detail?id=90 3 | # Magic Tie::Named::Capture <=> *main::+ main::*- and Errno vs ! 4 | # op/leaky-magic.t: defer loading of Tie::Named::Capture and Errno to run-time 5 | use strict; 6 | BEGIN { 7 | unshift @INC, 't'; 8 | require TestBC; 9 | } 10 | use Test::More tests => 15; 11 | use B::C (); 12 | use Config; 13 | 14 | my $i=0; 15 | sub test3 { 16 | my $name = shift; 17 | my $script = shift; 18 | my $cmt = join('',@_); 19 | my ($todobc,$todoc,$todocc) = ("","",""); 20 | $todobc = 'TODO ' if $name eq 'ccode90i_c'; 21 | # passes BC threaded 5.10-16 22 | $todobc = '' if $name eq 'ccode90i_c' 23 | and $] >= 5.010 and $Config{'useithreads'}; 24 | if ($name eq 'ccode90i_c' and ($B::C::VERSION lt '1.42_61')) { 25 | $todocc = 'TODO '; #3 CC %+ includes Tie::Hash::NamedCapture 26 | } elsif ($name eq 'ccode90i_ca' and $] >= 5.010) { 27 | $todocc = ''; #6 CC @+ fixed with 1.44, broken with 1.56 28 | if ($B::C::VERSION gt '1.55_11') { 29 | $todoc = $todocc = 'TODO '; 30 | } 31 | } elsif ($name eq 'ccode90i_es' and $] >= 5.026) { 32 | $todocc = 'TODO '; #9 CC %! 33 | #} elsif ($name eq 'ccode90i_er' and $] >= 5.010 and $Config{'useithreads'}) { 34 | # $todocc = 'TODO '; #12 CC Errno loaded automagically. fixed with 1.48 35 | } 36 | $todocc = 'TODO 5.24 ' if $] > 5.023007 and $i < 2 and $^V !~ /c$/; 37 | $todoc = 'TODO 5.26 ' if $] > 5.025003 and $i < 2 and $^V !~ /c$/; 38 | 39 | plctestok($i*3+1, $name, $script, $todobc."BC ".$cmt); 40 | ctestok($i*3+2, "C,-O3", $name, $script, $todoc."C $cmt"); 41 | ctestok($i*3+3, "CC", $name, $script, $todocc."CC $cmt"); 42 | $i++; 43 | } 44 | 45 | SKIP: { 46 | skip "Tie::Named::Capture requires Perl v5.10", 3 if $] < 5.010; 47 | 48 | test3('ccode90i_c', <<'EOF', '%+ includes Tie::Hash::NamedCapture'); 49 | my $s = 'test string'; 50 | $s =~ s/(?test) (?string)/\2 \1/g; 51 | print q(o) if $s eq 'string test'; 52 | 'test string' =~ /(?\w+) (?\w+)/; 53 | print q(k) if $+{first} eq 'test'; 54 | EOF 55 | } 56 | 57 | test3('ccode90i_ca', <<'EOF', '@+'); 58 | "abc" =~ /(.)./; print "ok" if "21" eq join"",@+; 59 | EOF 60 | 61 | test3('ccode90i_es', <<'EOF', '%! magic'); 62 | my %errs = %!; # t/op/magic.t Errno compiled in 63 | print q(ok) if defined ${"!"}{ENOENT}; 64 | EOF 65 | 66 | # %{"!"} detected at compile-time 67 | test3('ccode90i_er', <<'EOF', 'Errno loaded automagically'); 68 | my %errs = %{"!"}; # t/op/magic.t Errno to be loaded at run-time 69 | print q(ok) if defined ${"!"}{ENOENT}; 70 | EOF 71 | 72 | test3('ccode90i_ep', <<'EOF', '%! pure IV'); 73 | print FH "foo"; print "ok" if $! == 9; 74 | EOF 75 | -------------------------------------------------------------------------------- /log.modules-5.016003-nt: -------------------------------------------------------------------------------- 1 | # B::C::VERSION = 1.56 2f18f75c 2019-02-13 | Release 1.56 2 | # perlversion = 5.016003-nt 3 | # path = /usr/local/bin/perl5.16.3-nt 4 | # platform = linux 64bit non-threaded 5 | pass Exporter 6 | pass Text::Tabs 7 | pass Text::Wrap 8 | pass Test::Harness 9 | pass Pod::Escapes 10 | pass Pod::Simple 11 | pass IO 12 | pass Scalar::Util 13 | pass Getopt::Long 14 | pass Pod::Parser 15 | pass ExtUtils::MakeMaker 16 | pass Test::Simple 17 | pass ExtUtils::Manifest 18 | pass Pod::Text 19 | pass constant 20 | pass Test 21 | pass Data::Dumper 22 | pass File::Spec 23 | pass File::Temp 24 | pass ExtUtils::Install 25 | pass Text::ParseWords 26 | pass ExtUtils::CBuilder 27 | pass ExtUtils::ParseXS 28 | pass Module::Build #TODO 5.16 without threads (invalid free) 29 | pass File::Path 30 | pass XSLoader 31 | pass MIME::Base64 32 | pass Digest 33 | pass Digest::MD5 34 | pass Sub::Uplevel 35 | pass URI 36 | pass HTML::Tagset 37 | skip HTML::Parser 38 | pass Test::Exception 39 | pass Net::Cmd 40 | pass Compress::Raw::Zlib 41 | pass Compress::Raw::Bzip2 42 | pass IO::Compress::Base 43 | pass LWP 44 | pass Storable 45 | pass base 46 | skip List::MoreUtils 47 | skip Params::Util 48 | pass Task::Weaken 49 | pass Class::Accessor 50 | pass Test::Tester 51 | pass Sub::Install 52 | pass Attribute::Handlers 53 | skip Data::OptList 54 | skip Sub::Exporter 55 | pass Test::NoWarnings 56 | pass version 57 | skip Params::Validate 58 | skip Sub::Name 59 | pass Filter::Util::Call 60 | pass Algorithm::C3 61 | pass Class::C3 62 | pass Scope::Guard 63 | pass MRO::Compat 64 | pass Time::HiRes 65 | pass Class::Data::Inheritable 66 | pass Try::Tiny 67 | pass Devel::GlobalDestruction 68 | skip Class::MOP 69 | skip Moose 70 | pass Test::Deep 71 | pass Carp::Clan 72 | pass Module::Pluggable 73 | pass if(1) => "Sys::Hostname" 74 | pass Text::Balanced 75 | skip DBI 76 | pass Time::Local 77 | pass IO::Scalar 78 | skip Sub::Identify 79 | pass Class::ISA 80 | skip FCGI 81 | pass Tree::DAG_Node 82 | pass Path::Class 83 | pass Test::Warn 84 | pass Encode 85 | skip Variable::Magic 86 | pass CGI 87 | pass B::Hooks::EndOfScope 88 | pass Test::Pod 89 | skip Digest::SHA1 90 | pass namespace::clean 91 | pass Class::Inspector 92 | skip Clone 93 | pass XML::NamespaceSupport 94 | pass XML::SAX 95 | pass YAML 96 | skip MooseX::Types 97 | pass Class::Singleton 98 | skip DateTime::TimeZone 99 | skip DateTime::Locale 100 | skip DateTime 101 | pass IO::String 102 | pass AppConfig 103 | pass UNIVERSAL::require 104 | skip Template::Stash 105 | # c 106 | # pass 80 / 80 (100.0%) 107 | # fail 0 / 80 (0.0%) 108 | # todo 1 / 0 () 109 | # skip 20 / 100 (20.0% not installed) 110 | -------------------------------------------------------------------------------- /log.modules-5.008009: -------------------------------------------------------------------------------- 1 | # B::C::VERSION = 1.52_26 6db7b9b 2015-12-02 | 5.8 fixes: RX_WRAPPED 2 | # perlversion = 5.008009 3 | # path = /usr/local/bin/perl5.8.9 4 | # platform = linux 64bit threaded 5 | pass Exporter 6 | pass Text::Tabs 7 | pass Text::Wrap 8 | pass Test::Harness 9 | pass Pod::Escapes 10 | pass Pod::Simple 11 | pass IO 12 | pass Scalar::Util 13 | pass Getopt::Long 14 | pass Pod::Parser 15 | pass ExtUtils::MakeMaker 16 | pass Test::Simple 17 | pass ExtUtils::Manifest 18 | pass Pod::Text 19 | pass constant 20 | pass Test 21 | pass Data::Dumper 22 | pass File::Spec 23 | pass File::Temp 24 | pass ExtUtils::Install 25 | pass Text::ParseWords 26 | pass ExtUtils::CBuilder 27 | pass ExtUtils::ParseXS 28 | pass Module::Build 29 | pass File::Path 30 | pass XSLoader 31 | pass MIME::Base64 32 | pass Digest 33 | pass Digest::MD5 34 | pass Sub::Uplevel 35 | pass URI 36 | pass HTML::Tagset 37 | pass HTML::Parser 38 | pass Test::Exception 39 | pass Net::Cmd 40 | pass Compress::Raw::Zlib 41 | pass Compress::Raw::Bzip2 42 | pass IO::Compress::Base 43 | pass LWP 44 | pass Storable 45 | pass base 46 | pass List::MoreUtils 47 | pass Params::Util 48 | pass Task::Weaken 49 | pass Class::Accessor 50 | pass Test::Tester 51 | pass Sub::Install 52 | pass Attribute::Handlers 53 | pass Data::OptList 54 | pass Sub::Exporter 55 | pass Test::NoWarnings 56 | pass version 57 | pass Params::Validate 58 | pass Sub::Name 59 | pass Filter::Util::Call 60 | pass Algorithm::C3 61 | pass Class::C3 62 | pass Scope::Guard 63 | pass MRO::Compat 64 | pass Time::HiRes 65 | pass Class::Data::Inheritable 66 | pass Try::Tiny 67 | pass Devel::GlobalDestruction 68 | pass Class::MOP 69 | pass Moose 70 | pass Test::Deep 71 | pass Carp::Clan 72 | pass Module::Pluggable 73 | pass if(1) => "Sys::Hostname" 74 | pass Text::Balanced 75 | pass DBI 76 | pass Time::Local 77 | pass IO::Scalar 78 | pass Sub::Identify 79 | pass Class::ISA 80 | pass FCGI 81 | pass Tree::DAG_Node 82 | pass Path::Class 83 | pass Test::Warn 84 | pass Encode 85 | pass Variable::Magic 86 | pass CGI 87 | pass B::Hooks::EndOfScope 88 | pass Test::Pod 89 | pass Digest::SHA1 90 | pass namespace::clean 91 | pass Class::Inspector 92 | pass Clone 93 | pass XML::NamespaceSupport 94 | pass XML::SAX 95 | pass YAML 96 | pass MooseX::Types 97 | pass Class::Singleton 98 | pass DateTime::TimeZone 99 | pass DateTime::Locale 100 | pass DateTime 101 | pass IO::String 102 | pass AppConfig 103 | pass UNIVERSAL::require 104 | pass Template::Stash 105 | # 100 / 100 modules tested with B-C-1.52_26 - perl-5.008009 106 | # pass 100 / 100 (100.0%) 107 | # fail 0 / 100 (0.0%) 108 | # todo 0 / 0 () 109 | # skip 0 / 100 (0.0% not installed) 110 | -------------------------------------------------------------------------------- /log.modules-5.024004c-nt: -------------------------------------------------------------------------------- 1 | # B::C::VERSION = 1.56 30f59e9e 2019-05-04 | fix -DD sv[0] 2 | # perlversion = 5.024004c-nt 3 | # path = /usr/local/bin/cperl5.24.4-nt 4 | # platform = linux 64bit non-threaded 5 | pass Exporter 6 | pass Text::Tabs 7 | pass Text::Wrap 8 | pass Test::Harness 9 | pass Pod::Escapes 10 | pass Pod::Simple 11 | pass IO 12 | pass Scalar::Util 13 | pass Getopt::Long 14 | pass Pod::Parser 15 | pass ExtUtils::MakeMaker 16 | pass Test::Simple 17 | pass ExtUtils::Manifest 18 | pass Pod::Text 19 | pass constant 20 | pass Test 21 | pass Data::Dumper 22 | pass File::Spec 23 | pass File::Temp 24 | pass ExtUtils::Install 25 | pass Text::ParseWords 26 | pass ExtUtils::CBuilder 27 | pass ExtUtils::ParseXS 28 | pass Module::Build 29 | pass File::Path 30 | pass XSLoader 31 | pass MIME::Base64 32 | pass Digest 33 | pass Digest::MD5 34 | pass Sub::Uplevel 35 | pass URI 36 | pass HTML::Tagset 37 | pass HTML::Parser 38 | pass Test::Exception 39 | pass Net::Cmd 40 | pass Compress::Raw::Zlib 41 | pass Compress::Raw::Bzip2 42 | pass IO::Compress::Base 43 | pass LWP 44 | pass Storable 45 | pass base 46 | pass List::MoreUtils 47 | pass Params::Util 48 | pass Task::Weaken 49 | pass Class::Accessor 50 | pass Test::Tester 51 | pass Sub::Install 52 | pass Attribute::Handlers #TODO >= 5.23.5 SEGV 53 | pass Data::OptList 54 | pass Sub::Exporter 55 | pass Test::NoWarnings 56 | pass version 57 | pass Params::Validate 58 | pass Sub::Name 59 | pass Filter::Util::Call 60 | pass Algorithm::C3 61 | pass Class::C3 62 | pass Scope::Guard 63 | pass MRO::Compat 64 | pass Time::HiRes 65 | pass Class::Data::Inheritable 66 | pass Try::Tiny 67 | pass Devel::GlobalDestruction 68 | pass Class::MOP 69 | pass Moose 70 | pass Test::Deep 71 | pass Carp::Clan 72 | pass Module::Pluggable 73 | pass if(1) => "Sys::Hostname" 74 | pass Text::Balanced 75 | pass DBI 76 | pass Time::Local 77 | pass IO::Scalar 78 | pass Sub::Identify 79 | pass Class::ISA 80 | pass FCGI 81 | pass Tree::DAG_Node 82 | fail Path::Class 83 | pass Test::Warn 84 | pass Encode 85 | pass Variable::Magic 86 | pass CGI 87 | pass B::Hooks::EndOfScope 88 | pass Test::Pod 89 | pass Digest::SHA1 90 | pass namespace::clean 91 | pass Class::Inspector 92 | pass Clone 93 | pass XML::NamespaceSupport 94 | pass XML::SAX 95 | pass YAML 96 | pass MooseX::Types #TODO >= 5.23.5 SEGV 97 | pass Class::Singleton 98 | fail DateTime::TimeZone 99 | fail DateTime::Locale 100 | fail DateTime 101 | pass IO::String 102 | pass AppConfig 103 | pass UNIVERSAL::require 104 | pass Template::Stash 105 | # c 106 | # pass 96 / 100 (96.0%) 107 | # fail 4 / 100 (4.0%) 108 | # todo 2 / 4 (50.0%) 109 | # skip 0 / 100 (0.0% not installed) 110 | -------------------------------------------------------------------------------- /log.modules-5.008005-nt: -------------------------------------------------------------------------------- 1 | # B::C::VERSION = 1.52_26 6db7b9b 2015-12-02 | 5.8 fixes: RX_WRAPPED 2 | # perlversion = 5.008005-nt 3 | # path = /usr/local/bin/perl5.8.5-nt 4 | # platform = linux 64bit non-threaded 5 | pass Exporter 6 | pass Text::Tabs 7 | pass Text::Wrap 8 | pass Test::Harness 9 | pass Pod::Escapes 10 | pass Pod::Simple 11 | pass IO 12 | pass Scalar::Util 13 | pass Getopt::Long 14 | pass Pod::Parser 15 | pass ExtUtils::MakeMaker 16 | pass Test::Simple 17 | pass ExtUtils::Manifest 18 | pass Pod::Text 19 | pass constant 20 | pass Test 21 | pass Data::Dumper 22 | pass File::Spec 23 | pass File::Temp 24 | pass ExtUtils::Install 25 | pass Text::ParseWords 26 | pass ExtUtils::CBuilder 27 | pass ExtUtils::ParseXS 28 | pass Module::Build 29 | pass File::Path 30 | pass XSLoader 31 | pass MIME::Base64 32 | pass Digest 33 | pass Digest::MD5 34 | pass Sub::Uplevel 35 | pass URI 36 | pass HTML::Tagset 37 | pass HTML::Parser 38 | pass Test::Exception 39 | pass Net::Cmd 40 | pass Compress::Raw::Zlib 41 | pass Compress::Raw::Bzip2 42 | pass IO::Compress::Base 43 | pass LWP 44 | pass Storable 45 | pass base 46 | pass List::MoreUtils 47 | pass Params::Util 48 | pass Task::Weaken 49 | pass Class::Accessor 50 | pass Test::Tester 51 | pass Sub::Install 52 | pass Attribute::Handlers 53 | pass Data::OptList 54 | pass Sub::Exporter 55 | pass Test::NoWarnings 56 | pass version 57 | pass Params::Validate 58 | pass Sub::Name 59 | pass Filter::Util::Call 60 | pass Algorithm::C3 61 | pass Class::C3 62 | pass Scope::Guard 63 | pass MRO::Compat 64 | pass Time::HiRes 65 | pass Class::Data::Inheritable 66 | pass Try::Tiny 67 | pass Devel::GlobalDestruction 68 | pass Class::MOP 69 | pass Moose 70 | pass Test::Deep 71 | pass Carp::Clan 72 | pass Module::Pluggable 73 | pass if(1) => "Sys::Hostname" 74 | pass Text::Balanced 75 | pass DBI 76 | pass Time::Local 77 | pass IO::Scalar 78 | pass Sub::Identify 79 | pass Class::ISA 80 | pass FCGI 81 | pass Tree::DAG_Node 82 | pass Path::Class 83 | pass Test::Warn 84 | pass Encode 85 | pass Variable::Magic 86 | pass CGI 87 | pass B::Hooks::EndOfScope 88 | pass Test::Pod 89 | pass Digest::SHA1 90 | pass namespace::clean 91 | pass Class::Inspector 92 | pass Clone 93 | pass XML::NamespaceSupport 94 | pass XML::SAX 95 | pass YAML 96 | pass MooseX::Types 97 | pass Class::Singleton 98 | pass DateTime::TimeZone 99 | pass DateTime::Locale 100 | pass DateTime 101 | pass IO::String 102 | pass AppConfig 103 | pass UNIVERSAL::require 104 | pass Template::Stash 105 | # 100 / 100 modules tested with B-C-1.52_26 - perl-5.008005-nt 106 | # pass 100 / 100 (100.0%) 107 | # fail 0 / 100 (0.0%) 108 | # todo 0 / 0 () 109 | # skip 0 / 100 (0.0% not installed) 110 | -------------------------------------------------------------------------------- /log.modules-5.008009-nt: -------------------------------------------------------------------------------- 1 | # B::C::VERSION = 1.52_26 6db7b9b 2015-12-02 | 5.8 fixes: RX_WRAPPED 2 | # perlversion = 5.008009-nt 3 | # path = /usr/local/bin/perl5.8.9-nt 4 | # platform = linux 64bit non-threaded 5 | pass Exporter 6 | pass Text::Tabs 7 | pass Text::Wrap 8 | pass Test::Harness 9 | pass Pod::Escapes 10 | pass Pod::Simple 11 | pass IO 12 | pass Scalar::Util 13 | pass Getopt::Long 14 | pass Pod::Parser 15 | pass ExtUtils::MakeMaker 16 | pass Test::Simple 17 | pass ExtUtils::Manifest 18 | pass Pod::Text 19 | pass constant 20 | pass Test 21 | pass Data::Dumper 22 | pass File::Spec 23 | pass File::Temp 24 | pass ExtUtils::Install 25 | pass Text::ParseWords 26 | pass ExtUtils::CBuilder 27 | pass ExtUtils::ParseXS 28 | pass Module::Build 29 | pass File::Path 30 | pass XSLoader 31 | pass MIME::Base64 32 | pass Digest 33 | pass Digest::MD5 34 | pass Sub::Uplevel 35 | pass URI 36 | pass HTML::Tagset 37 | pass HTML::Parser 38 | pass Test::Exception 39 | pass Net::Cmd 40 | pass Compress::Raw::Zlib 41 | pass Compress::Raw::Bzip2 42 | pass IO::Compress::Base 43 | pass LWP 44 | pass Storable 45 | pass base 46 | pass List::MoreUtils 47 | pass Params::Util 48 | pass Task::Weaken 49 | pass Class::Accessor 50 | pass Test::Tester 51 | pass Sub::Install 52 | pass Attribute::Handlers 53 | pass Data::OptList 54 | pass Sub::Exporter 55 | pass Test::NoWarnings 56 | pass version 57 | pass Params::Validate 58 | pass Sub::Name 59 | pass Filter::Util::Call 60 | pass Algorithm::C3 61 | pass Class::C3 62 | pass Scope::Guard 63 | pass MRO::Compat 64 | pass Time::HiRes 65 | pass Class::Data::Inheritable 66 | pass Try::Tiny 67 | pass Devel::GlobalDestruction 68 | pass Class::MOP 69 | pass Moose 70 | pass Test::Deep 71 | pass Carp::Clan 72 | pass Module::Pluggable 73 | pass if(1) => "Sys::Hostname" 74 | pass Text::Balanced 75 | pass DBI 76 | pass Time::Local 77 | pass IO::Scalar 78 | pass Sub::Identify 79 | pass Class::ISA 80 | pass FCGI 81 | pass Tree::DAG_Node 82 | pass Path::Class 83 | pass Test::Warn 84 | pass Encode 85 | pass Variable::Magic 86 | pass CGI 87 | pass B::Hooks::EndOfScope 88 | pass Test::Pod 89 | pass Digest::SHA1 90 | pass namespace::clean 91 | pass Class::Inspector 92 | pass Clone 93 | pass XML::NamespaceSupport 94 | pass XML::SAX 95 | pass YAML 96 | pass MooseX::Types 97 | pass Class::Singleton 98 | pass DateTime::TimeZone 99 | pass DateTime::Locale 100 | pass DateTime 101 | pass IO::String 102 | pass AppConfig 103 | pass UNIVERSAL::require 104 | pass Template::Stash 105 | # 100 / 100 modules tested with B-C-1.52_26 - perl-5.008009-nt 106 | # pass 100 / 100 (100.0%) 107 | # fail 0 / 100 (0.0%) 108 | # todo 0 / 0 () 109 | # skip 0 / 100 (0.0% not installed) 110 | -------------------------------------------------------------------------------- /log.modules-5.012005: -------------------------------------------------------------------------------- 1 | # B::C::VERSION = 1.52_25 8d47bfc 2015-12-01 | Update log.modules-5.022000, fixed all FAILs M 2 | # perlversion = 5.012005 3 | # path = /usr/local/bin/perl5.12.5 4 | # platform = linux 64bit threaded 5 | pass Exporter 6 | pass Text::Tabs 7 | pass Text::Wrap 8 | pass Test::Harness 9 | pass Pod::Escapes 10 | pass Pod::Simple 11 | pass IO 12 | pass Scalar::Util 13 | pass Getopt::Long 14 | pass Pod::Parser 15 | pass ExtUtils::MakeMaker 16 | pass Test::Simple 17 | pass ExtUtils::Manifest 18 | pass Pod::Text 19 | pass constant 20 | pass Test 21 | pass Data::Dumper 22 | pass File::Spec 23 | pass File::Temp 24 | pass ExtUtils::Install 25 | pass Text::ParseWords 26 | pass ExtUtils::CBuilder 27 | pass ExtUtils::ParseXS 28 | pass Module::Build 29 | pass File::Path 30 | pass XSLoader 31 | pass MIME::Base64 32 | pass Digest 33 | pass Digest::MD5 34 | pass Sub::Uplevel 35 | pass URI 36 | pass HTML::Tagset 37 | pass HTML::Parser 38 | pass Test::Exception 39 | pass Net::Cmd 40 | pass Compress::Raw::Zlib 41 | pass Compress::Raw::Bzip2 42 | pass IO::Compress::Base 43 | pass LWP 44 | pass Storable 45 | pass base 46 | pass List::MoreUtils 47 | pass Params::Util 48 | pass Task::Weaken 49 | pass Class::Accessor 50 | pass Test::Tester 51 | pass Sub::Install 52 | pass Attribute::Handlers 53 | pass Data::OptList 54 | pass Sub::Exporter 55 | pass Test::NoWarnings 56 | pass version 57 | pass Params::Validate 58 | pass Sub::Name 59 | pass Filter::Util::Call 60 | pass Algorithm::C3 61 | pass Class::C3 62 | pass Scope::Guard 63 | pass MRO::Compat 64 | pass Time::HiRes 65 | pass Class::Data::Inheritable 66 | pass Try::Tiny 67 | pass Devel::GlobalDestruction 68 | pass Class::MOP 69 | pass Moose 70 | pass Test::Deep 71 | pass Carp::Clan 72 | pass Module::Pluggable 73 | pass if(1) => "Sys::Hostname" 74 | pass Text::Balanced 75 | pass DBI 76 | pass Time::Local 77 | pass IO::Scalar 78 | pass Sub::Identify 79 | pass Class::ISA 80 | pass FCGI 81 | pass Tree::DAG_Node 82 | pass Path::Class 83 | pass Test::Warn 84 | pass Encode 85 | pass Variable::Magic 86 | pass CGI 87 | pass B::Hooks::EndOfScope 88 | pass Test::Pod 89 | pass Digest::SHA1 90 | pass namespace::clean 91 | pass Class::Inspector 92 | pass Clone 93 | pass XML::NamespaceSupport 94 | pass XML::SAX 95 | pass YAML 96 | pass MooseX::Types 97 | pass Class::Singleton 98 | pass DateTime::TimeZone 99 | pass DateTime::Locale 100 | pass DateTime 101 | pass IO::String 102 | pass AppConfig 103 | pass UNIVERSAL::require 104 | pass Template::Stash 105 | # 100 / 100 modules tested with B-C-1.52_25 - perl-5.012005 106 | # pass 100 / 100 (100.0%) 107 | # fail 0 / 100 (0.0%) 108 | # todo 0 / 0 () 109 | # skip 0 / 100 (0.0% not installed) 110 | --------------------------------------------------------------------------------