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