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