This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
's buildtoc now.
[perl5.git] / ext / B / t / bytecode.t
CommitLineData
46983aad
AE
1#!./perl
2
3BEGIN {
ba566e15
JH
4 if ($^O eq 'VMS') {
5 print "1..0 # skip - Bytecode/ByteLoader doesn't work on VMS\n";
6 exit 0;
7 }
46983aad
AE
8 chdir 't' if -d 't';
9 @INC = qw(../lib);
a243a48e
JH
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 }
46983aad
AE
15 require './test.pl'; # for run_perl()
16}
17use strict;
18
19my $test = 'bytecode.pl';
ba566e15 20END { 1 while unlink $test, "${test}c" }
46983aad
AE
21
22undef $/;
23my @tests = split /\n###+\n/, <DATA>;
24
25print "1..".($#tests+1)."\n";
26
27my $cnt = 1;
28
29for (@tests) {
30 my $got;
31 my ($script, $expect) = split />>>+\n/;
32 $expect =~ s/\n$//;
33 open T, ">$test"; print T $script; close T;
ba566e15
JH
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"
46983aad
AE
37 progfile => $test);
38 unless ($?) {
ba566e15
JH
39 1 while unlink($test); # nuke the .pl
40 $got = run_perl(progfile => "${test}c"); # run the .plc
46983aad
AE
41 unless ($?) {
42 if ($got =~ /^$expect$/) {
43 print "ok $cnt\n";
44 next;
45 } else {
46 print <<"EOT"; next;
47not ok $cnt
48--------- SCRIPT
49$script
50--------- GOT
51$got
52--------- EXPECT
53$expect
54----------------
55
56EOT
57 }
58 }
59 }
60 print <<"EOT";
61--------- SCRIPT
62$script
63--------- $?
64$got
65EOT
66} continue {
67 $cnt++;
68}
69
70__DATA__
71
72print 'hi'
73>>>>
74hi
75############################################################
76for (1,2,3) { print if /\d/ }
77>>>>
78123
79############################################################
80$_ = "xyxyx"; %j=(1,2); s/x/$j{print('z')}/ge; print $_
81>>>>
82zzz2y2y2
83############################################################
84$_ = "xyxyx"; %j=(1,2); s/x/$j{print('z')}/g; print $_
85>>>>
86z2y2y2
87############################################################
88split /a/,"bananarama"; print @_
89>>>>
90bnnrm
91############################################################
92{ package P; sub x { print 'ya' } x }
93>>>>
94ya
95############################################################
96@z = split /:/,"b:r:n:f:g"; print @z
97>>>>
98brnfg
99############################################################
100sub AUTOLOAD { print 1 } &{"a"}()
101>>>>
1021
103############################################################
104my $l = 3; $x = sub { print $l }; &$x
105>>>>
1063
107############################################################
108my $i = 1;
109my $foo = sub {$i = shift if @_};
110&$foo(3);
111############################################################
46983aad
AE
112$x="Cannot use"; print index $x, "Can"
113>>>>
1140
115############################################################
116my $i=6; eval "print \$i\n"
117>>>>
1186
119############################################################
120BEGIN { %h=(1=>2,3=>4) } print $h{3}
121>>>>
1224
123############################################################
124open our $T,"a"
125############################################################
126print <DATA>
127__DATA__
128a
129b
130>>>>
131a
132b
133############################################################
134BEGIN { tie @a, __PACKAGE__; sub TIEARRAY { bless{} } sub FETCH { 1 } }
135print $a[1]
136>>>>
1371
138############################################################
139my $i=3; print 1 .. $i
140>>>>
141123
142############################################################
143my $h = { a=>3, b=>1 }; print sort {$h->{$a} <=> $h->{$b}} keys %$h
144>>>>
145ba
146############################################################
147print sort { my $p; $b <=> $a } 1,4,3
148>>>>
149431