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