Commit | Line | Data |
46983aad |
1 | #!./perl |
2 | |
3 | BEGIN { |
ba566e15 |
4 | if ($^O eq 'VMS') { |
5 | print "1..0 # skip - Bytecode/ByteLoader doesn't work on VMS\n"; |
6 | exit 0; |
7 | } |
46983aad |
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'; |
ba566e15 |
15 | END { 1 while unlink $test, "${test}c" } |
46983aad |
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; |
ba566e15 |
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" |
46983aad |
32 | progfile => $test); |
33 | unless ($?) { |
ba566e15 |
34 | 1 while unlink($test); # nuke the .pl |
35 | $got = run_perl(progfile => "${test}c"); # run the .plc |
46983aad |
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 | ############################################################ |
46983aad |
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 |