This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to Digest::MD5 2.27.
[perl5.git] / 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