ext/B/t/bytecode.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = qw(../lib);
   6     require './test.pl'; # for run_perl()
   7 }
   8 use strict;
   9
  10 my $test = 'bytecode.pl';
  11 END { 1 while unlink $test }
  12
  13 undef $/;
  14 my @tests = split /\n###+\n/, <DATA>;
  15
  16 print "1..".($#tests+1)."\n";
  17
  18 my $cnt = 1;
  19
  20 for (@tests) {
  21     my $got;
  22     my ($script, $expect) = split />>>+\n/;
  23     $expect =~ s/\n$//;
  24     open T, ">$test"; print T $script; close T;
  25     $got = run_perl(switches => [ "-MO=Bytecode,-H,-o$test" ],
  26                     stderr   => 1,
  27                     progfile => $test);
  28     unless ($?) {
  29         $got = run_perl(progfile => $test);
  30         unless ($?) {
  31             if ($got =~ /^$expect$/) {
  32                 print "ok $cnt\n";
  33                 next;
  34             } else {
  35                 print <<"EOT"; next;
  36 not ok $cnt
  37 --------- SCRIPT
  38 $script
  39 --------- GOT
  40 $got
  41 --------- EXPECT
  42 $expect
  43 ----------------
  44
  45 EOT
  46             }
  47         }
  48     }
  49     print <<"EOT";
  50 --------- SCRIPT
  51 $script
  52 --------- $?
  53 $got
  54 EOT
  55 } continue {
  56     $cnt++;
  57 }
  58
  59 __DATA__
  60
  61 print 'hi'
  62 >>>>
  63 hi
  64 ############################################################
  65 for (1,2,3) { print if /\d/ }
  66 >>>>
  67 123
  68 ############################################################
  69 $_ = "xyxyx"; %j=(1,2); s/x/$j{print('z')}/ge; print $_
  70 >>>>
  71 zzz2y2y2
  72 ############################################################
  73 $_ = "xyxyx"; %j=(1,2); s/x/$j{print('z')}/g; print $_
  74 >>>>
  75 z2y2y2
  76 ############################################################
  77 split /a/,"bananarama"; print @_
  78 >>>>
  79 bnnrm
  80 ############################################################
  81 { package P; sub x { print 'ya' } x }
  82 >>>>
  83 ya
  84 ############################################################
  85 @z = split /:/,"b:r:n:f:g"; print @z
  86 >>>>
  87 brnfg
  88 ############################################################
  89 sub AUTOLOAD { print 1 } &{"a"}()
  90 >>>>
  91 1
  92 ############################################################
  93 my $l = 3; $x = sub { print $l }; &$x
  94 >>>>
  95 3
  96 ############################################################
  97 my $i = 1;
  98 my $foo = sub {$i = shift if @_};
  99 &$foo(3);
 100 ############################################################
 101 $_="\xff\xff"; use utf8; utf8::encode $_; print $_
 102 >>>>
 103 \xc3\xbf\xc3\xbf
 104 ############################################################
 105 $x="Cannot use"; print index $x, "Can"
 106 >>>>
 107 0
 108 ############################################################
 109 my $i=6; eval "print \$i\n"
 110 >>>>
 111 6
 112 ############################################################
 113 BEGIN { %h=(1=>2,3=>4) } print $h{3}
 114 >>>>
 115 4
 116 ############################################################
 117 open our $T,"a"
 118 ############################################################
 119 print <DATA>
 120 __DATA__
 121 a
 122 b
 123 >>>>
 124 a
 125 b
 126 ############################################################
 127 BEGIN { tie @a, __PACKAGE__; sub TIEARRAY { bless{} } sub FETCH { 1 } }
 128 print $a[1]
 129 >>>>
 130 1
 131 ############################################################
 132 my $i=3; print 1 .. $i
 133 >>>>
 134 123
 135 ############################################################
 136 my $h = { a=>3, b=>1 }; print sort {$h->{$a} <=> $h->{$b}} keys %$h
 137 >>>>
 138 ba
 139 ############################################################
 140 print sort { my $p; $b <=> $a } 1,4,3
 141 >>>>
 142 431