Commit | Line | Data |
---|---|---|
a0d0e21e LW |
1 | #!./perl |
2 | ||
3 | chdir 't' if -d 't'; | |
4 | @INC = "../lib"; | |
5 | $ENV{PERL5LIB} = "../lib"; | |
6 | ||
7 | $|=1; | |
8 | ||
9 | undef $/; | |
10 | @prgs = split "\n########\n", <DATA>; | |
11 | print "1..", scalar @prgs, "\n"; | |
12 | ||
13 | $tmpfile = "misctmp000"; | |
14 | 1 while -f ++$tmpfile; | |
15 | END { unlink $tmpfile if $tmpfile; } | |
16 | ||
17 | for (@prgs){ | |
18 | my $switch; | |
19 | if (s/^\s*-\w+//){ | |
20 | $switch = $&; | |
21 | } | |
22 | my($prog,$expected) = split(/\nEXPECT\n/, $_); | |
23 | open TEST, "| sh -c './perl $switch' >$tmpfile 2>&1"; | |
24 | print TEST $prog, "\n"; | |
25 | close TEST; | |
26 | $status = $?; | |
27 | $results = `cat $tmpfile`; | |
28 | $results =~ s/\n+$//; | |
29 | $expected =~ s/\n+$//; | |
30 | if ( $results ne $expected){ | |
31 | print STDERR "PROG: $switch\n$prog\n"; | |
32 | print STDERR "EXPECTED:\n$expected\n"; | |
33 | print STDERR "GOT:\n$results\n"; | |
34 | print "not "; | |
35 | } | |
36 | print "ok ", ++$i, "\n"; | |
37 | } | |
38 | ||
39 | __END__ | |
40 | $foo=undef; $foo->go; | |
41 | EXPECT | |
42 | Can't call method "go" without a package or object reference at - line 1. | |
43 | ######## | |
44 | BEGIN | |
45 | { | |
46 | "foo"; | |
47 | } | |
48 | ######## | |
a0d0e21e LW |
49 | $array[128]=1 |
50 | ######## | |
51 | $x=0x0eabcd; print $x->ref; | |
52 | EXPECT | |
53 | Can't call method "ref" without a package or object reference at - line 1. | |
54 | ######## | |
55 | chop ($str .= <STDIN>); | |
56 | ######## | |
57 | close ($banana); | |
58 | ######## | |
59 | $x=2;$y=3;$x<$y ? $x : $y += 23;print $x; | |
60 | EXPECT | |
61 | 25 | |
62 | ######## | |
63 | eval {sub bar {print "In bar";}} | |
64 | ######## | |
65 | system "./perl -ne 'print if eof' /dev/null" | |
66 | ######## | |
67 | chop($file = <>); | |
68 | ######## | |
69 | package N; | |
70 | sub new {my ($obj,$n)=@_; bless \$n} | |
71 | $aa=new N 1; | |
72 | $aa=12345; | |
73 | print $aa; | |
74 | EXPECT | |
75 | 12345 | |
76 | ######## | |
77 | %@x=0; | |
78 | EXPECT | |
79 | Can't coerce HASH to string in repeat at - line 1. | |
80 | ######## | |
81 | $_="foo"; | |
82 | printf(STDOUT "%s\n", $_); | |
83 | EXPECT | |
84 | foo | |
85 | ######## | |
86 | push(@a, 1, 2, 3,) | |
87 | ######## | |
88 | quotemeta "" | |
89 | ######## | |
90 | for ("ABCDE") { | |
91 | ⊂ | |
92 | s/./&sub($&)/eg; | |
93 | print;} | |
94 | sub sub {local($_) = @_; | |
95 | $_ x 4;} | |
96 | EXPECT | |
97 | Modification of a read-only value attempted at - line 3. | |
98 | ######## | |
99 | package FOO;sub new {bless {FOO => BAR}}; | |
100 | package main; | |
101 | use strict vars; | |
102 | my $self = new FOO; | |
103 | print $$self{FOO}; | |
104 | EXPECT | |
105 | BAR | |
106 | ######## | |
107 | $_="foo"; | |
108 | s/.{1}//s; | |
109 | print; | |
110 | EXPECT | |
111 | oo | |
112 | ######## | |
113 | print scalar ("foo","bar") | |
114 | EXPECT | |
115 | bar | |
116 | ######## | |
117 | sub by_number { $a <=> $b; };# inline function for sort below | |
118 | $as_ary{0}="a0"; | |
119 | @ordered_array=sort by_number keys(%as_ary); | |
120 | ######## | |
121 | sub NewShell | |
122 | { | |
123 | local($Host) = @_; | |
124 | my($m2) = $#Shells++; | |
125 | $Shells[$m2]{HOST} = $Host; | |
126 | return $m2; | |
127 | } | |
128 | ||
129 | sub ShowShell | |
130 | { | |
131 | local($i) = @_; | |
132 | } | |
133 | ||
134 | &ShowShell(&NewShell(beach,Work,"+0+0")); | |
135 | &ShowShell(&NewShell(beach,Work,"+0+0")); | |
136 | &ShowShell(&NewShell(beach,Work,"+0+0")); | |
137 | ######## | |
138 | { | |
139 | package FAKEARRAY; | |
140 | ||
141 | sub TIEARRAY | |
142 | { print "TIEARRAY @_\n"; | |
143 | die "bomb out\n" unless $count ++ ; | |
144 | bless ['foo'] | |
145 | } | |
146 | sub FETCH { print "fetch @_\n"; $_[0]->[$_[1]] } | |
147 | sub STORE { print "store @_\n"; $_[0]->[$_[1]] = $_[2] } | |
148 | sub DESTROY { print "DESTROY \n"; undef @{$_[0]}; } | |
149 | } | |
150 | ||
151 | eval 'tie @h, FAKEARRAY, fred' ; | |
152 | tie @h, FAKEARRAY, fred ; | |
153 | EXPECT | |
154 | TIEARRAY FAKEARRAY fred | |
155 | TIEARRAY FAKEARRAY fred | |
156 | DESTROY | |
157 | ######## | |
158 | BEGIN { die "phooey\n" } | |
159 | EXPECT | |
160 | phooey | |
161 | BEGIN failed--compilation aborted at - line 1. | |
162 | ######## | |
163 | BEGIN { 1/$zero } | |
164 | EXPECT | |
165 | Illegal division by zero at - line 1. | |
166 | BEGIN failed--compilation aborted at - line 1. | |
167 | ######## | |
168 | BEGIN { undef = 0 } | |
169 | EXPECT | |
170 | Modification of a read-only value attempted at - line 1. | |
171 | BEGIN failed--compilation aborted at - line 1. | |
a7adf1f0 | 172 | ######## |
173 | { | |
174 | package foo; | |
175 | sub PRINT { | |
176 | shift; | |
177 | print join(' ', reverse @_)."\n"; | |
178 | } | |
179 | sub TIEHANDLE { | |
180 | bless {}, shift; | |
181 | } | |
58f51617 SV |
182 | sub READLINE { |
183 | "Out of inspiration"; | |
184 | } | |
a7adf1f0 | 185 | sub DESTROY { |
186 | print "and destroyed as well\n"; | |
187 | } | |
188 | } | |
189 | { | |
190 | local(*FOO); | |
191 | tie(*FOO,'foo'); | |
192 | print FOO "sentence.", "reversed", "a", "is", "This"; | |
58f51617 | 193 | print "-- ", <FOO>, " --\n"; |
a7adf1f0 | 194 | } |
195 | EXPECT | |
196 | This is a reversed sentence. | |
58f51617 | 197 | -- Out of inspiration -- |
a7adf1f0 | 198 | and destroyed as well |