1*0Sstevel@tonic-gate#!./perl 2*0Sstevel@tonic-gate 3*0Sstevel@tonic-gateBEGIN { 4*0Sstevel@tonic-gate chdir 't' if -d 't'; 5*0Sstevel@tonic-gate @INC = '../lib'; 6*0Sstevel@tonic-gate} 7*0Sstevel@tonic-gate 8*0Sstevel@tonic-gate$| = 1; 9*0Sstevel@tonic-gateumask 0; 10*0Sstevel@tonic-gate$xref = \ ""; 11*0Sstevel@tonic-gate$runme = ($^O eq 'VMS' ? 'MCR ' : '') . $^X; 12*0Sstevel@tonic-gate@a = (1..5); 13*0Sstevel@tonic-gate%h = (1..6); 14*0Sstevel@tonic-gate$aref = \@a; 15*0Sstevel@tonic-gate$href = \%h; 16*0Sstevel@tonic-gateopen OP, qq{$runme -le "print 'aaa Ok ok' for 1..100"|}; 17*0Sstevel@tonic-gate$chopit = 'aaaaaa'; 18*0Sstevel@tonic-gate@chopar = (113 .. 119); 19*0Sstevel@tonic-gate$posstr = '123456'; 20*0Sstevel@tonic-gate$cstr = 'aBcD.eF'; 21*0Sstevel@tonic-gatepos $posstr = 3; 22*0Sstevel@tonic-gate$nn = $n = 2; 23*0Sstevel@tonic-gatesub subb {"in s"} 24*0Sstevel@tonic-gate 25*0Sstevel@tonic-gate@INPUT = <DATA>; 26*0Sstevel@tonic-gate@simple_input = grep /^\s*\w+\s*\$\w+\s*[#\n]/, @INPUT; 27*0Sstevel@tonic-gateprint "1..", (10 + @INPUT + @simple_input), "\n"; 28*0Sstevel@tonic-gate$ord = 0; 29*0Sstevel@tonic-gate 30*0Sstevel@tonic-gatesub wrn {"@_"} 31*0Sstevel@tonic-gate 32*0Sstevel@tonic-gate# Check correct optimization of ucfirst etc 33*0Sstevel@tonic-gate$ord++; 34*0Sstevel@tonic-gatemy $a = "AB"; 35*0Sstevel@tonic-gatemy $b = "\u\L$a"; 36*0Sstevel@tonic-gateprint "not " unless $b eq 'Ab'; 37*0Sstevel@tonic-gateprint "ok $ord\n"; 38*0Sstevel@tonic-gate 39*0Sstevel@tonic-gate# Check correct destruction of objects: 40*0Sstevel@tonic-gatemy $dc = 0; 41*0Sstevel@tonic-gatesub A::DESTROY {$dc += 1} 42*0Sstevel@tonic-gate$a=8; 43*0Sstevel@tonic-gatemy $b; 44*0Sstevel@tonic-gate{ my $c = 6; $b = bless \$c, "A"} 45*0Sstevel@tonic-gate 46*0Sstevel@tonic-gate$ord++; 47*0Sstevel@tonic-gateprint "not " unless $dc == 0; 48*0Sstevel@tonic-gateprint "ok $ord\n"; 49*0Sstevel@tonic-gate 50*0Sstevel@tonic-gate$b = $a+5; 51*0Sstevel@tonic-gate 52*0Sstevel@tonic-gate$ord++; 53*0Sstevel@tonic-gateprint "not " unless $dc == 1; 54*0Sstevel@tonic-gateprint "ok $ord\n"; 55*0Sstevel@tonic-gate 56*0Sstevel@tonic-gate$ord++; 57*0Sstevel@tonic-gatemy $xxx = 'b'; 58*0Sstevel@tonic-gate$xxx = 'c' . ($xxx || 'e'); 59*0Sstevel@tonic-gateprint "not " unless $xxx eq 'cb'; 60*0Sstevel@tonic-gateprint "ok $ord\n"; 61*0Sstevel@tonic-gate 62*0Sstevel@tonic-gate{ # Check calling STORE 63*0Sstevel@tonic-gate my $sc = 0; 64*0Sstevel@tonic-gate sub B::TIESCALAR {bless [11], 'B'} 65*0Sstevel@tonic-gate sub B::FETCH { -(shift->[0]) } 66*0Sstevel@tonic-gate sub B::STORE { $sc++; my $o = shift; $o->[0] = 17 + shift } 67*0Sstevel@tonic-gate 68*0Sstevel@tonic-gate my $m; 69*0Sstevel@tonic-gate tie $m, 'B'; 70*0Sstevel@tonic-gate $m = 100; 71*0Sstevel@tonic-gate 72*0Sstevel@tonic-gate $ord++; 73*0Sstevel@tonic-gate print "not " unless $sc == 1; 74*0Sstevel@tonic-gate print "ok $ord\n"; 75*0Sstevel@tonic-gate 76*0Sstevel@tonic-gate my $t = 11; 77*0Sstevel@tonic-gate $m = $t + 89; 78*0Sstevel@tonic-gate 79*0Sstevel@tonic-gate $ord++; 80*0Sstevel@tonic-gate print "not " unless $sc == 2; 81*0Sstevel@tonic-gate print "ok $ord\n"; 82*0Sstevel@tonic-gate 83*0Sstevel@tonic-gate $ord++; 84*0Sstevel@tonic-gate print "# $m\nnot " unless $m == -117; 85*0Sstevel@tonic-gate print "ok $ord\n"; 86*0Sstevel@tonic-gate 87*0Sstevel@tonic-gate $m += $t; 88*0Sstevel@tonic-gate 89*0Sstevel@tonic-gate $ord++; 90*0Sstevel@tonic-gate print "not " unless $sc == 3; 91*0Sstevel@tonic-gate print "ok $ord\n"; 92*0Sstevel@tonic-gate 93*0Sstevel@tonic-gate $ord++; 94*0Sstevel@tonic-gate print "# $m\nnot " unless $m == 89; 95*0Sstevel@tonic-gate print "ok $ord\n"; 96*0Sstevel@tonic-gate 97*0Sstevel@tonic-gate} 98*0Sstevel@tonic-gate 99*0Sstevel@tonic-gate# Chains of assignments 100*0Sstevel@tonic-gate 101*0Sstevel@tonic-gatemy ($l1, $l2, $l3, $l4); 102*0Sstevel@tonic-gatemy $zzzz = 12; 103*0Sstevel@tonic-gate$zzz1 = $l1 = $l2 = $zzz2 = $l3 = $l4 = 1 + $zzzz; 104*0Sstevel@tonic-gate 105*0Sstevel@tonic-gate$ord++; 106*0Sstevel@tonic-gateprint "# $zzz1 = $l1 = $l2 = $zzz2 = $l3 = $l4 = 13\nnot " 107*0Sstevel@tonic-gate unless $zzz1 == 13 and $zzz2 == 13 and $l1 == 13 108*0Sstevel@tonic-gate and $l2 == 13 and $l3 == 13 and $l4 == 13; 109*0Sstevel@tonic-gateprint "ok $ord\n"; 110*0Sstevel@tonic-gate 111*0Sstevel@tonic-gatefor (@INPUT) { 112*0Sstevel@tonic-gate $ord++; 113*0Sstevel@tonic-gate ($op, undef, $comment) = /^([^\#]+)(\#\s+(.*))?/; 114*0Sstevel@tonic-gate $comment = $op unless defined $comment; 115*0Sstevel@tonic-gate chomp; 116*0Sstevel@tonic-gate $op = "$op==$op" unless $op =~ /==/; 117*0Sstevel@tonic-gate ($op, $expectop) = $op =~ /(.*)==(.*)/; 118*0Sstevel@tonic-gate 119*0Sstevel@tonic-gate $skip = ($op =~ /^'\?\?\?'/ or $comment =~ /skip\(.*\Q$^O\E.*\)/i) 120*0Sstevel@tonic-gate ? "skip" : "# '$_'\nnot"; 121*0Sstevel@tonic-gate $integer = ($comment =~ /^i_/) ? "use integer" : '' ; 122*0Sstevel@tonic-gate (print "#skipping $comment:\nok $ord\n"), next if $skip eq 'skip'; 123*0Sstevel@tonic-gate 124*0Sstevel@tonic-gate eval <<EOE; 125*0Sstevel@tonic-gate local \$SIG{__WARN__} = \\&wrn; 126*0Sstevel@tonic-gate my \$a = 'fake'; 127*0Sstevel@tonic-gate $integer; 128*0Sstevel@tonic-gate \$a = $op; 129*0Sstevel@tonic-gate \$b = $expectop; 130*0Sstevel@tonic-gate if (\$a ne \$b) { 131*0Sstevel@tonic-gate print "# \$comment: got `\$a', expected `\$b'\n"; 132*0Sstevel@tonic-gate print "\$skip " if \$a ne \$b or \$skip eq 'skip'; 133*0Sstevel@tonic-gate } 134*0Sstevel@tonic-gate print "ok \$ord\\n"; 135*0Sstevel@tonic-gateEOE 136*0Sstevel@tonic-gate if ($@) { 137*0Sstevel@tonic-gate if ($@ =~ /is unimplemented/) { 138*0Sstevel@tonic-gate print "# skipping $comment: unimplemented:\nok $ord\n"; 139*0Sstevel@tonic-gate } else { 140*0Sstevel@tonic-gate warn $@; 141*0Sstevel@tonic-gate print "# '$_'\nnot ok $ord\n"; 142*0Sstevel@tonic-gate } 143*0Sstevel@tonic-gate } 144*0Sstevel@tonic-gate} 145*0Sstevel@tonic-gate 146*0Sstevel@tonic-gatefor (@simple_input) { 147*0Sstevel@tonic-gate $ord++; 148*0Sstevel@tonic-gate ($op, undef, $comment) = /^([^\#]+)(\#\s+(.*))?/; 149*0Sstevel@tonic-gate $comment = $op unless defined $comment; 150*0Sstevel@tonic-gate chomp; 151*0Sstevel@tonic-gate ($operator, $variable) = /^\s*(\w+)\s*\$(\w+)/ or warn "misprocessed '$_'\n"; 152*0Sstevel@tonic-gate eval <<EOE; 153*0Sstevel@tonic-gate local \$SIG{__WARN__} = \\&wrn; 154*0Sstevel@tonic-gate my \$$variable = "Ac# Ca\\nxxx"; 155*0Sstevel@tonic-gate \$$variable = $operator \$$variable; 156*0Sstevel@tonic-gate \$toself = \$$variable; 157*0Sstevel@tonic-gate \$direct = $operator "Ac# Ca\\nxxx"; 158*0Sstevel@tonic-gate print "# \\\$$variable = $operator \\\$$variable\\nnot " 159*0Sstevel@tonic-gate unless \$toself eq \$direct; 160*0Sstevel@tonic-gate print "ok \$ord\\n"; 161*0Sstevel@tonic-gateEOE 162*0Sstevel@tonic-gate if ($@) { 163*0Sstevel@tonic-gate if ($@ =~ /is unimplemented/) { 164*0Sstevel@tonic-gate print "# skipping $comment: unimplemented:\nok $ord\n"; 165*0Sstevel@tonic-gate } elsif ($@ =~ /Can't (modify|take log of 0)/) { 166*0Sstevel@tonic-gate print "# skipping $comment: syntax not good for selfassign:\nok $ord\n"; 167*0Sstevel@tonic-gate } else { 168*0Sstevel@tonic-gate warn $@; 169*0Sstevel@tonic-gate print "# '$_'\nnot ok $ord\n"; 170*0Sstevel@tonic-gate } 171*0Sstevel@tonic-gate } 172*0Sstevel@tonic-gate} 173*0Sstevel@tonic-gate__END__ 174*0Sstevel@tonic-gateref $xref # ref 175*0Sstevel@tonic-gateref $cstr # ref nonref 176*0Sstevel@tonic-gate`$runme -e "print qq[1\\n]"` # backtick skip(MSWin32) 177*0Sstevel@tonic-gate`$undefed` # backtick undef skip(MSWin32) 178*0Sstevel@tonic-gate<*> # glob 179*0Sstevel@tonic-gate<OP> # readline 180*0Sstevel@tonic-gate'faked' # rcatline 181*0Sstevel@tonic-gate(@z = (1 .. 3)) # aassign 182*0Sstevel@tonic-gatechop $chopit # chop 183*0Sstevel@tonic-gate(chop (@x=@chopar)) # schop 184*0Sstevel@tonic-gatechomp $chopit # chomp 185*0Sstevel@tonic-gate(chop (@x=@chopar)) # schomp 186*0Sstevel@tonic-gatepos $posstr # pos 187*0Sstevel@tonic-gatepos $chopit # pos returns undef 188*0Sstevel@tonic-gate$nn++==2 # postinc 189*0Sstevel@tonic-gate$nn++==3 # i_postinc 190*0Sstevel@tonic-gate$nn--==4 # postdec 191*0Sstevel@tonic-gate$nn--==3 # i_postdec 192*0Sstevel@tonic-gate$n ** $n # pow 193*0Sstevel@tonic-gate$n * $n # multiply 194*0Sstevel@tonic-gate$n * $n # i_multiply 195*0Sstevel@tonic-gate$n / $n # divide 196*0Sstevel@tonic-gate$n / $n # i_divide 197*0Sstevel@tonic-gate$n % $n # modulo 198*0Sstevel@tonic-gate$n % $n # i_modulo 199*0Sstevel@tonic-gate$n x $n # repeat 200*0Sstevel@tonic-gate$n + $n # add 201*0Sstevel@tonic-gate$n + $n # i_add 202*0Sstevel@tonic-gate$n - $n # subtract 203*0Sstevel@tonic-gate$n - $n # i_subtract 204*0Sstevel@tonic-gate$n . $n # concat 205*0Sstevel@tonic-gate$n . $a=='2fake' # concat with self 206*0Sstevel@tonic-gate"3$a"=='3fake' # concat with self in stringify 207*0Sstevel@tonic-gate"$n" # stringify 208*0Sstevel@tonic-gate$n << $n # left_shift 209*0Sstevel@tonic-gate$n >> $n # right_shift 210*0Sstevel@tonic-gate$n <=> $n # ncmp 211*0Sstevel@tonic-gate$n <=> $n # i_ncmp 212*0Sstevel@tonic-gate$n cmp $n # scmp 213*0Sstevel@tonic-gate$n & $n # bit_and 214*0Sstevel@tonic-gate$n ^ $n # bit_xor 215*0Sstevel@tonic-gate$n | $n # bit_or 216*0Sstevel@tonic-gate-$n # negate 217*0Sstevel@tonic-gate-$n # i_negate 218*0Sstevel@tonic-gate~$n # complement 219*0Sstevel@tonic-gateatan2 $n,$n # atan2 220*0Sstevel@tonic-gatesin $n # sin 221*0Sstevel@tonic-gatecos $n # cos 222*0Sstevel@tonic-gate'???' # rand 223*0Sstevel@tonic-gateexp $n # exp 224*0Sstevel@tonic-gatelog $n # log 225*0Sstevel@tonic-gatesqrt $n # sqrt 226*0Sstevel@tonic-gateint $n # int 227*0Sstevel@tonic-gatehex $n # hex 228*0Sstevel@tonic-gateoct $n # oct 229*0Sstevel@tonic-gateabs $n # abs 230*0Sstevel@tonic-gatelength $posstr # length 231*0Sstevel@tonic-gatesubstr $posstr, 2, 2 # substr 232*0Sstevel@tonic-gatevec("abc",2,8) # vec 233*0Sstevel@tonic-gateindex $posstr, 2 # index 234*0Sstevel@tonic-gaterindex $posstr, 2 # rindex 235*0Sstevel@tonic-gatesprintf "%i%i", $n, $n # sprintf 236*0Sstevel@tonic-gateord $n # ord 237*0Sstevel@tonic-gatechr $n # chr 238*0Sstevel@tonic-gatecrypt $n, $n # crypt 239*0Sstevel@tonic-gateucfirst ($cstr . "a") # ucfirst padtmp 240*0Sstevel@tonic-gateucfirst $cstr # ucfirst 241*0Sstevel@tonic-gatelcfirst $cstr # lcfirst 242*0Sstevel@tonic-gateuc $cstr # uc 243*0Sstevel@tonic-gatelc $cstr # lc 244*0Sstevel@tonic-gatequotemeta $cstr # quotemeta 245*0Sstevel@tonic-gate@$aref # rv2av 246*0Sstevel@tonic-gate@$undefed # rv2av undef 247*0Sstevel@tonic-gate(each %h) % 2 == 1 # each 248*0Sstevel@tonic-gatevalues %h # values 249*0Sstevel@tonic-gatekeys %h # keys 250*0Sstevel@tonic-gate%$href # rv2hv 251*0Sstevel@tonic-gatepack "C2", $n,$n # pack 252*0Sstevel@tonic-gatesplit /a/, "abad" # split 253*0Sstevel@tonic-gatejoin "a"; @a # join 254*0Sstevel@tonic-gatepush @a,3==6 # push 255*0Sstevel@tonic-gateunshift @aaa # unshift 256*0Sstevel@tonic-gatereverse @a # reverse 257*0Sstevel@tonic-gatereverse $cstr # reverse - scal 258*0Sstevel@tonic-gategrep $_, 1,0,2,0,3 # grepwhile 259*0Sstevel@tonic-gatemap "x$_", 1,0,2,0,3 # mapwhile 260*0Sstevel@tonic-gatesubb() # entersub 261*0Sstevel@tonic-gatecaller # caller 262*0Sstevel@tonic-gatewarn "ignore this\n" # warn 263*0Sstevel@tonic-gate'faked' # die 264*0Sstevel@tonic-gateopen BLAH, "<non-existent" # open 265*0Sstevel@tonic-gatefileno STDERR # fileno 266*0Sstevel@tonic-gateumask 0 # umask 267*0Sstevel@tonic-gateselect STDOUT # sselect 268*0Sstevel@tonic-gateselect "","","",0 # select 269*0Sstevel@tonic-gategetc OP # getc 270*0Sstevel@tonic-gate'???' # read 271*0Sstevel@tonic-gate'???' # sysread 272*0Sstevel@tonic-gate'???' # syswrite 273*0Sstevel@tonic-gate'???' # send 274*0Sstevel@tonic-gate'???' # recv 275*0Sstevel@tonic-gate'???' # tell 276*0Sstevel@tonic-gate'???' # fcntl 277*0Sstevel@tonic-gate'???' # ioctl 278*0Sstevel@tonic-gate'???' # flock 279*0Sstevel@tonic-gate'???' # accept 280*0Sstevel@tonic-gate'???' # shutdown 281*0Sstevel@tonic-gate'???' # ftsize 282*0Sstevel@tonic-gate'???' # ftmtime 283*0Sstevel@tonic-gate'???' # ftatime 284*0Sstevel@tonic-gate'???' # ftctime 285*0Sstevel@tonic-gatechdir 'non-existent' # chdir 286*0Sstevel@tonic-gate'???' # chown 287*0Sstevel@tonic-gate'???' # chroot 288*0Sstevel@tonic-gateunlink 'non-existent' # unlink 289*0Sstevel@tonic-gatechmod 'non-existent' # chmod 290*0Sstevel@tonic-gateutime 'non-existent' # utime 291*0Sstevel@tonic-gaterename 'non-existent', 'non-existent1' # rename 292*0Sstevel@tonic-gatelink 'non-existent', 'non-existent1' # link 293*0Sstevel@tonic-gate'???' # symlink 294*0Sstevel@tonic-gatereadlink 'non-existent', 'non-existent1' # readlink 295*0Sstevel@tonic-gate'???' # mkdir 296*0Sstevel@tonic-gate'???' # rmdir 297*0Sstevel@tonic-gate'???' # telldir 298*0Sstevel@tonic-gate'???' # fork 299*0Sstevel@tonic-gate'???' # wait 300*0Sstevel@tonic-gate'???' # waitpid 301*0Sstevel@tonic-gatesystem "$runme -e 0" # system skip(VMS) 302*0Sstevel@tonic-gate'???' # exec 303*0Sstevel@tonic-gate'???' # kill 304*0Sstevel@tonic-gategetppid # getppid 305*0Sstevel@tonic-gategetpgrp # getpgrp 306*0Sstevel@tonic-gate'???' # setpgrp 307*0Sstevel@tonic-gategetpriority $$, $$ # getpriority 308*0Sstevel@tonic-gate'???' # setpriority 309*0Sstevel@tonic-gatetime # time 310*0Sstevel@tonic-gatelocaltime $^T # localtime 311*0Sstevel@tonic-gategmtime $^T # gmtime 312*0Sstevel@tonic-gate'???' # sleep: can randomly fail 313*0Sstevel@tonic-gate'???' # alarm 314*0Sstevel@tonic-gate'???' # shmget 315*0Sstevel@tonic-gate'???' # shmctl 316*0Sstevel@tonic-gate'???' # shmread 317*0Sstevel@tonic-gate'???' # shmwrite 318*0Sstevel@tonic-gate'???' # msgget 319*0Sstevel@tonic-gate'???' # msgctl 320*0Sstevel@tonic-gate'???' # msgsnd 321*0Sstevel@tonic-gate'???' # msgrcv 322*0Sstevel@tonic-gate'???' # semget 323*0Sstevel@tonic-gate'???' # semctl 324*0Sstevel@tonic-gate'???' # semop 325*0Sstevel@tonic-gate'???' # getlogin 326*0Sstevel@tonic-gate'???' # syscall 327