5 unshift @INC, '../lib';
7 $ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3;
11 $runme = ($^O eq 'VMS' ? 'MCR ' : '') . $^X;
16 open OP, qq{$runme -le "print 'aaa Ok ok' for 1..100"|};
18 @chopar = (113 .. 119);
26 @simple_input = grep /^\s*\w+\s*\$\w+\s*[#\n]/, @INPUT;
27 print "1..", (9 + @INPUT + @simple_input), "\n";
32 # Check correct optimization of ucfirst etc
36 print "not " unless $b eq 'Ab';
39 # Check correct destruction of objects:
41 sub A::DESTROY {$dc += 1}
44 { my $c = 6; $b = bless \$c, "A"}
47 print "not " unless $dc == 0;
53 print "not " unless $dc == 1;
58 $xxx = 'c' . ($xxx || 'e');
59 print "not " unless $xxx eq 'cb';
62 { # Check calling STORE
64 sub B::TIESCALAR {bless [11], 'B'}
65 sub B::FETCH { -(shift->[0]) }
66 sub B::STORE { $sc++; my $o = shift; $o->[0] = 17 + shift }
73 print "not " unless $sc == 1;
80 print "not " unless $sc == 2;
84 print "# $m\nnot " unless $m == -117;
90 print "not " unless $sc == 3;
94 print "# $m\nnot " unless $m == 89;
101 ($op, undef, $comment) = /^([^\#]+)(\#\s+(.*))?/;
102 $comment = $op unless defined $comment;
103 $op = "$op==$op" unless $op =~ /==/;
104 ($op, $expectop) = $op =~ /(.*)==(.*)/;
106 $skip = ($op =~ /^'\?\?\?'/ or $comment =~ /skip\(.*\Q$^O\E.*\)/i)
108 $integer = ($comment =~ /^i_/) ? "use integer" : '' ;
109 (print "#skipping $comment:\nok $ord\n"), next if $skip eq 'skip';
112 local \$SIG{__WARN__} = \\&wrn;
118 print "# \$comment: got `\$a', expected `\$b'\n";
119 print "\$skip " if \$a ne \$b or \$skip eq 'skip';
124 if ($@ =~ /is unimplemented/) {
125 print "# skipping $comment: unimplemented:\nok $ord\n";
128 print "not ok $ord\n";
133 for (@simple_input) {
135 ($op, undef, $comment) = /^([^\#]+)(\#\s+(.*))?/;
136 $comment = $op unless defined $comment;
137 ($operator, $variable) = /^\s*(\w+)\s*\$(\w+)/ or warn "misprocessed '$_'\n";
139 local \$SIG{__WARN__} = \\&wrn;
140 my \$$variable = "Ac# Ca\\nxxx";
141 \$$variable = $operator \$$variable;
142 \$toself = \$$variable;
143 \$direct = $operator "Ac# Ca\\nxxx";
144 print "# \\\$$variable = $operator \\\$$variable\\nnot "
145 unless \$toself eq \$direct;
149 if ($@ =~ /is unimplemented/) {
150 print "# skipping $comment: unimplemented:\nok $ord\n";
151 } elsif ($@ =~ /Can't (modify|take log of 0)/) {
152 print "# skipping $comment: syntax not good for selfassign:\nok $ord\n";
155 print "not ok $ord\n";
161 ref $cstr # ref nonref
162 `$runme -e "print qq[1\n]"` # backtick skip(MSWin32)
163 `$undefed` # backtick undef skip(MSWin32)
167 (@z = (1 .. 3)) # aassign
169 (chop (@x=@chopar)) # schop
170 chomp $chopit # chomp
171 (chop (@x=@chopar)) # schomp
173 pos $chopit # pos returns undef
191 $n . $a=='2fake' # concat with self
192 "3$a"=='3fake' # concat with self in stringify
194 $n << $n # left_shift
195 $n >> $n # right_shift
216 length $posstr # length
217 substr $posstr, 2, 2 # substr
219 index $posstr, 2 # index
220 rindex $posstr, 2 # rindex
221 sprintf "%i%i", $n, $n # sprintf
225 ucfirst ($cstr . "a") # ucfirst padtmp
226 ucfirst $cstr # ucfirst
227 lcfirst $cstr # lcfirst
230 quotemeta $cstr # quotemeta
232 @$undefed # rv2av undef
237 pack "C2", $n,$n # pack
238 split /a/, "abad" # split
241 unshift @aaa # unshift
243 reverse $cstr # reverse - scal
244 grep $_, 1,0,2,0,3 # grepwhile
245 map "x$_", 1,0,2,0,3 # mapwhile
248 warn "ignore this\n" # warn
250 open BLAH, "<non-existent" # open
251 fileno STDERR # fileno
253 select STDOUT # sselect
254 select "","","",0 # select
271 chdir 'non-existent' # chdir
274 unlink 'non-existent' # unlink
275 chmod 'non-existent' # chmod
276 utime 'non-existent' # utime
277 rename 'non-existent', 'non-existent1' # rename
278 link 'non-existent', 'non-existent1' # link
280 readlink 'non-existent', 'non-existent1' # readlink
287 system "$runme -e 0" # system skip(VMS)
293 getpriority $$, $$ # getpriority
296 localtime $^T # localtime