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
... / ...
CommitLineData
1#!./perl
2
3BEGIN {
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}
12use strict;
13
14my $test = 'bytecode.pl';
15END { 1 while unlink $test, "${test}c" }
16
17undef $/;
18my @tests = split /\n###+\n/, <DATA>;
19
20print "1..".($#tests+1)."\n";
21
22my $cnt = 1;
23
24for (@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;
42not ok $cnt
43--------- SCRIPT
44$script
45--------- GOT
46$got
47--------- EXPECT
48$expect
49----------------
50
51EOT
52 }
53 }
54 }
55 print <<"EOT";
56--------- SCRIPT
57$script
58--------- $?
59$got
60EOT
61} continue {
62 $cnt++;
63}
64
65__DATA__
66
67print 'hi'
68>>>>
69hi
70############################################################
71for (1,2,3) { print if /\d/ }
72>>>>
73123
74############################################################
75$_ = "xyxyx"; %j=(1,2); s/x/$j{print('z')}/ge; print $_
76>>>>
77zzz2y2y2
78############################################################
79$_ = "xyxyx"; %j=(1,2); s/x/$j{print('z')}/g; print $_
80>>>>
81z2y2y2
82############################################################
83split /a/,"bananarama"; print @_
84>>>>
85bnnrm
86############################################################
87{ package P; sub x { print 'ya' } x }
88>>>>
89ya
90############################################################
91@z = split /:/,"b:r:n:f:g"; print @z
92>>>>
93brnfg
94############################################################
95sub AUTOLOAD { print 1 } &{"a"}()
96>>>>
971
98############################################################
99my $l = 3; $x = sub { print $l }; &$x
100>>>>
1013
102############################################################
103my $i = 1;
104my $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>>>>
1130
114############################################################
115my $i=6; eval "print \$i\n"
116>>>>
1176
118############################################################
119BEGIN { %h=(1=>2,3=>4) } print $h{3}
120>>>>
1214
122############################################################
123open our $T,"a"
124############################################################
125print <DATA>
126__DATA__
127a
128b
129>>>>
130a
131b
132############################################################
133BEGIN { tie @a, __PACKAGE__; sub TIEARRAY { bless{} } sub FETCH { 1 } }
134print $a[1]
135>>>>
1361
137############################################################
138my $i=3; print 1 .. $i
139>>>>
140123
141############################################################
142my $h = { a=>3, b=>1 }; print sort {$h->{$a} <=> $h->{$b}} keys %$h
143>>>>
144ba
145############################################################
146print sort { my $p; $b <=> $a } 1,4,3
147>>>>
148431