1N/A#!./perl
1N/A
1N/ABEGIN {
1N/A chdir 't' if -d 't';
1N/A @INC = '../lib';
1N/A}
1N/A
1N/A$| = 1;
1N/Aumask 0;
1N/A$xref = \ "";
1N/A$runme = ($^O eq 'VMS' ? 'MCR ' : '') . $^X;
1N/A@a = (1..5);
1N/A%h = (1..6);
1N/A$aref = \@a;
1N/A$href = \%h;
1N/Aopen OP, qq{$runme -le "print 'aaa Ok ok' for 1..100"|};
1N/A$chopit = 'aaaaaa';
1N/A@chopar = (113 .. 119);
1N/A$posstr = '123456';
1N/A$cstr = 'aBcD.eF';
1N/Apos $posstr = 3;
1N/A$nn = $n = 2;
1N/Asub subb {"in s"}
1N/A
1N/A@INPUT = <DATA>;
1N/A@simple_input = grep /^\s*\w+\s*\$\w+\s*[#\n]/, @INPUT;
1N/Aprint "1..", (10 + @INPUT + @simple_input), "\n";
1N/A$ord = 0;
1N/A
1N/Asub wrn {"@_"}
1N/A
1N/A# Check correct optimization of ucfirst etc
1N/A$ord++;
1N/Amy $a = "AB";
1N/Amy $b = "\u\L$a";
1N/Aprint "not " unless $b eq 'Ab';
1N/Aprint "ok $ord\n";
1N/A
1N/A# Check correct destruction of objects:
1N/Amy $dc = 0;
1N/Asub A::DESTROY {$dc += 1}
1N/A$a=8;
1N/Amy $b;
1N/A{ my $c = 6; $b = bless \$c, "A"}
1N/A
1N/A$ord++;
1N/Aprint "not " unless $dc == 0;
1N/Aprint "ok $ord\n";
1N/A
1N/A$b = $a+5;
1N/A
1N/A$ord++;
1N/Aprint "not " unless $dc == 1;
1N/Aprint "ok $ord\n";
1N/A
1N/A$ord++;
1N/Amy $xxx = 'b';
1N/A$xxx = 'c' . ($xxx || 'e');
1N/Aprint "not " unless $xxx eq 'cb';
1N/Aprint "ok $ord\n";
1N/A
1N/A{ # Check calling STORE
1N/A my $sc = 0;
1N/A sub B::TIESCALAR {bless [11], 'B'}
1N/A sub B::FETCH { -(shift->[0]) }
1N/A sub B::STORE { $sc++; my $o = shift; $o->[0] = 17 + shift }
1N/A
1N/A my $m;
1N/A tie $m, 'B';
1N/A $m = 100;
1N/A
1N/A $ord++;
1N/A print "not " unless $sc == 1;
1N/A print "ok $ord\n";
1N/A
1N/A my $t = 11;
1N/A $m = $t + 89;
1N/A
1N/A $ord++;
1N/A print "not " unless $sc == 2;
1N/A print "ok $ord\n";
1N/A
1N/A $ord++;
1N/A print "# $m\nnot " unless $m == -117;
1N/A print "ok $ord\n";
1N/A
1N/A $m += $t;
1N/A
1N/A $ord++;
1N/A print "not " unless $sc == 3;
1N/A print "ok $ord\n";
1N/A
1N/A $ord++;
1N/A print "# $m\nnot " unless $m == 89;
1N/A print "ok $ord\n";
1N/A
1N/A}
1N/A
1N/A# Chains of assignments
1N/A
1N/Amy ($l1, $l2, $l3, $l4);
1N/Amy $zzzz = 12;
1N/A$zzz1 = $l1 = $l2 = $zzz2 = $l3 = $l4 = 1 + $zzzz;
1N/A
1N/A$ord++;
1N/Aprint "# $zzz1 = $l1 = $l2 = $zzz2 = $l3 = $l4 = 13\nnot "
1N/A unless $zzz1 == 13 and $zzz2 == 13 and $l1 == 13
1N/A and $l2 == 13 and $l3 == 13 and $l4 == 13;
1N/Aprint "ok $ord\n";
1N/A
1N/Afor (@INPUT) {
1N/A $ord++;
1N/A ($op, undef, $comment) = /^([^\#]+)(\#\s+(.*))?/;
1N/A $comment = $op unless defined $comment;
1N/A chomp;
1N/A $op = "$op==$op" unless $op =~ /==/;
1N/A ($op, $expectop) = $op =~ /(.*)==(.*)/;
1N/A
1N/A $skip = ($op =~ /^'\?\?\?'/ or $comment =~ /skip\(.*\Q$^O\E.*\)/i)
1N/A ? "skip" : "# '$_'\nnot";
1N/A $integer = ($comment =~ /^i_/) ? "use integer" : '' ;
1N/A (print "#skipping $comment:\nok $ord\n"), next if $skip eq 'skip';
1N/A
1N/A eval <<EOE;
1N/A local \$SIG{__WARN__} = \\&wrn;
1N/A my \$a = 'fake';
1N/A $integer;
1N/A \$a = $op;
1N/A \$b = $expectop;
1N/A if (\$a ne \$b) {
1N/A print "# \$comment: got `\$a', expected `\$b'\n";
1N/A print "\$skip " if \$a ne \$b or \$skip eq 'skip';
1N/A }
1N/A print "ok \$ord\\n";
1N/AEOE
1N/A if ($@) {
1N/A if ($@ =~ /is unimplemented/) {
1N/A print "# skipping $comment: unimplemented:\nok $ord\n";
1N/A } else {
1N/A warn $@;
1N/A print "# '$_'\nnot ok $ord\n";
1N/A }
1N/A }
1N/A}
1N/A
1N/Afor (@simple_input) {
1N/A $ord++;
1N/A ($op, undef, $comment) = /^([^\#]+)(\#\s+(.*))?/;
1N/A $comment = $op unless defined $comment;
1N/A chomp;
1N/A ($operator, $variable) = /^\s*(\w+)\s*\$(\w+)/ or warn "misprocessed '$_'\n";
1N/A eval <<EOE;
1N/A local \$SIG{__WARN__} = \\&wrn;
1N/A my \$$variable = "Ac# Ca\\nxxx";
1N/A \$$variable = $operator \$$variable;
1N/A \$toself = \$$variable;
1N/A \$direct = $operator "Ac# Ca\\nxxx";
1N/A print "# \\\$$variable = $operator \\\$$variable\\nnot "
1N/A unless \$toself eq \$direct;
1N/A print "ok \$ord\\n";
1N/AEOE
1N/A if ($@) {
1N/A if ($@ =~ /is unimplemented/) {
1N/A print "# skipping $comment: unimplemented:\nok $ord\n";
1N/A } elsif ($@ =~ /Can't (modify|take log of 0)/) {
1N/A print "# skipping $comment: syntax not good for selfassign:\nok $ord\n";
1N/A } else {
1N/A warn $@;
1N/A print "# '$_'\nnot ok $ord\n";
1N/A }
1N/A }
1N/A}
1N/A__END__
1N/Aref $xref # ref
1N/Aref $cstr # ref nonref
1N/A`$runme -e "print qq[1\\n]"` # backtick skip(MSWin32)
1N/A`$undefed` # backtick undef skip(MSWin32)
1N/A<*> # glob
1N/A<OP> # readline
1N/A'faked' # rcatline
1N/A(@z = (1 .. 3)) # aassign
1N/Achop $chopit # chop
1N/A(chop (@x=@chopar)) # schop
1N/Achomp $chopit # chomp
1N/A(chop (@x=@chopar)) # schomp
1N/Apos $posstr # pos
1N/Apos $chopit # pos returns undef
1N/A$nn++==2 # postinc
1N/A$nn++==3 # i_postinc
1N/A$nn--==4 # postdec
1N/A$nn--==3 # i_postdec
1N/A$n ** $n # pow
1N/A$n * $n # multiply
1N/A$n * $n # i_multiply
1N/A$n / $n # divide
1N/A$n / $n # i_divide
1N/A$n % $n # modulo
1N/A$n % $n # i_modulo
1N/A$n x $n # repeat
1N/A$n + $n # add
1N/A$n + $n # i_add
1N/A$n - $n # subtract
1N/A$n - $n # i_subtract
1N/A$n . $n # concat
1N/A$n . $a=='2fake' # concat with self
1N/A"3$a"=='3fake' # concat with self in stringify
1N/A"$n" # stringify
1N/A$n << $n # left_shift
1N/A$n >> $n # right_shift
1N/A$n <=> $n # ncmp
1N/A$n <=> $n # i_ncmp
1N/A$n cmp $n # scmp
1N/A$n & $n # bit_and
1N/A$n ^ $n # bit_xor
1N/A$n | $n # bit_or
1N/A-$n # negate
1N/A-$n # i_negate
1N/A~$n # complement
1N/Aatan2 $n,$n # atan2
1N/Asin $n # sin
1N/Acos $n # cos
1N/A'???' # rand
1N/Aexp $n # exp
1N/Alog $n # log
1N/Asqrt $n # sqrt
1N/Aint $n # int
1N/Ahex $n # hex
1N/Aoct $n # oct
1N/Aabs $n # abs
1N/Alength $posstr # length
1N/Asubstr $posstr, 2, 2 # substr
1N/Avec("abc",2,8) # vec
1N/Aindex $posstr, 2 # index
1N/Arindex $posstr, 2 # rindex
1N/Asprintf "%i%i", $n, $n # sprintf
1N/Aord $n # ord
1N/Achr $n # chr
1N/Acrypt $n, $n # crypt
1N/Aucfirst ($cstr . "a") # ucfirst padtmp
1N/Aucfirst $cstr # ucfirst
1N/Alcfirst $cstr # lcfirst
1N/Auc $cstr # uc
1N/Alc $cstr # lc
1N/Aquotemeta $cstr # quotemeta
1N/A@$aref # rv2av
1N/A@$undefed # rv2av undef
1N/A(each %h) % 2 == 1 # each
1N/Avalues %h # values
1N/Akeys %h # keys
1N/A%$href # rv2hv
1N/Apack "C2", $n,$n # pack
1N/Asplit /a/, "abad" # split
1N/Ajoin "a"; @a # join
1N/Apush @a,3==6 # push
1N/Aunshift @aaa # unshift
1N/Areverse @a # reverse
1N/Areverse $cstr # reverse - scal
1N/Agrep $_, 1,0,2,0,3 # grepwhile
1N/Amap "x$_", 1,0,2,0,3 # mapwhile
1N/Asubb() # entersub
1N/Acaller # caller
1N/Awarn "ignore this\n" # warn
1N/A'faked' # die
1N/Aopen BLAH, "<non-existent" # open
1N/Afileno STDERR # fileno
1N/Aumask 0 # umask
1N/Aselect STDOUT # sselect
1N/Aselect "","","",0 # select
1N/Agetc OP # getc
1N/A'???' # read
1N/A'???' # sysread
1N/A'???' # syswrite
1N/A'???' # send
1N/A'???' # recv
1N/A'???' # tell
1N/A'???' # fcntl
1N/A'???' # ioctl
1N/A'???' # flock
1N/A'???' # accept
1N/A'???' # shutdown
1N/A'???' # ftsize
1N/A'???' # ftmtime
1N/A'???' # ftatime
1N/A'???' # ftctime
1N/Achdir 'non-existent' # chdir
1N/A'???' # chown
1N/A'???' # chroot
1N/Aunlink 'non-existent' # unlink
1N/Achmod 'non-existent' # chmod
1N/Autime 'non-existent' # utime
1N/Arename 'non-existent', 'non-existent1' # rename
1N/Alink 'non-existent', 'non-existent1' # link
1N/A'???' # symlink
1N/Areadlink 'non-existent', 'non-existent1' # readlink
1N/A'???' # mkdir
1N/A'???' # rmdir
1N/A'???' # telldir
1N/A'???' # fork
1N/A'???' # wait
1N/A'???' # waitpid
1N/Asystem "$runme -e 0" # system skip(VMS)
1N/A'???' # exec
1N/A'???' # kill
1N/Agetppid # getppid
1N/Agetpgrp # getpgrp
1N/A'???' # setpgrp
1N/Agetpriority $$, $$ # getpriority
1N/A'???' # setpriority
1N/Atime # time
1N/Alocaltime $^T # localtime
1N/Agmtime $^T # gmtime
1N/A'???' # sleep: can randomly fail
1N/A'???' # alarm
1N/A'???' # shmget
1N/A'???' # shmctl
1N/A'???' # shmread
1N/A'???' # shmwrite
1N/A'???' # msgget
1N/A'???' # msgctl
1N/A'???' # msgsnd
1N/A'???' # msgrcv
1N/A'???' # semget
1N/A'???' # semctl
1N/A'???' # semop
1N/A'???' # getlogin
1N/A'???' # syscall