ext/B/t/bytecode.t

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