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); |
a243a48e |
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 |
15 | require './test.pl'; # for run_perl() |
16 | } |
17 | use strict; |
18 | |
19 | my $test = 'bytecode.pl'; |
ba566e15 |
20 | END { 1 while unlink $test, "${test}c" } |
46983aad |
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; |
ba566e15 |
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 |
37 | progfile => $test); |
38 | unless ($?) { |
ba566e15 |
39 | 1 while unlink($test); # nuke the .pl |
40 | $got = run_perl(progfile => "${test}c"); # run the .plc |
46983aad |
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 | ############################################################ |
46983aad |
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 |