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