This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Test patches for OS/2
authorIlya Zakharevich <ilya@math.ohio-state.edu>
Fri, 17 Jan 1997 04:48:18 +0000 (23:48 -0500)
committerChip Salzenberg <chip@atlantic.net>
Sat, 25 Jan 1997 03:58:00 +0000 (15:58 +1200)
a) Teaches tests in os2/OS2/*/* new format of $Config{extensions};
 os2/OS2/ExtAttr/t/os2_ea.t os2/OS2/PrfDB/t/os2_prfdb.t
 os2/OS2/REXX/t/rx_cmprt.t os2/OS2/REXX/t/rx_dllld.t
 os2/OS2/REXX/t/rx_objcall.t os2/OS2/REXX/t/rx_sql.test
 os2/OS2/REXX/t/rx_tiesql.test os2/OS2/REXX/t/rx_tievar.t
 os2/OS2/REXX/t/rx_tieydb.t os2/OS2/REXX/t/rx_varset.t
 os2/OS2/REXX/t/rx_vrexx.t

b) Closes all the files before unlinking - for DOSISH systems;
 t/cmd/while.t t/comp/multiline.t t/io/argv.t t/lib/anydbm.t
 t/lib/gdbm.t t/lib/ndbm.t t/lib/odbm.t t/lib/sdbm.t

c) t/README mentions running `harness' to get better granularity;
 t/README

d) New test op/lex_assign.t added - will check optimization of lexicals
when applied - 153 cases (some just ignored since hard to implement).
 MANIFEST t/op/lex_assign.t

e) When a script is started via shell, $Config{exe_ext} may be appended.
 t/op/magic.t

f) path/echo may print a warning if run without args
 t/comp/colon.t

g) Error explanations more verbose
  t/op/cmp.t t/op/magic.t

p5p-msgid: <199701170448.XAA28948@monk.mps.ohio-state.edu>

25 files changed:
MANIFEST
os2/OS2/ExtAttr/t/os2_ea.t
os2/OS2/PrfDB/t/os2_prfdb.t
os2/OS2/REXX/t/rx_cmprt.t
os2/OS2/REXX/t/rx_dllld.t
os2/OS2/REXX/t/rx_objcall.t
os2/OS2/REXX/t/rx_sql.test
os2/OS2/REXX/t/rx_tiesql.test
os2/OS2/REXX/t/rx_tievar.t
os2/OS2/REXX/t/rx_tieydb.t
os2/OS2/REXX/t/rx_varset.t
os2/OS2/REXX/t/rx_vrexx.t
t/README
t/cmd/while.t
t/comp/colon.t
t/comp/multiline.t
t/io/argv.t
t/lib/anydbm.t
t/lib/gdbm.t
t/lib/ndbm.t
t/lib/odbm.t
t/lib/sdbm.t
t/op/cmp.t
t/op/lex_assign.t [new file with mode: 0644]
t/op/magic.t

index 6b202da..6a45129 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -657,6 +657,7 @@ t/op/inc.t          See if inc/dec of integers near 32 bit limit work
 t/op/index.t           See if index works
 t/op/int.t             See if int works
 t/op/join.t            See if join works
+t/op/lex_assign.t      See if assignment to lexicals work
 t/op/list.t            See if array lists work
 t/op/local.t           See if local works
 t/op/magic.t           See if magic variables work
index dc6f996..a1da398 100644 (file)
@@ -2,7 +2,7 @@ BEGIN {
     chdir 't' if -d 't/lib';
     @INC = '../lib' if -d 'lib';
     require Config; import Config;
-    if (-d 'lib' and $Config{'extensions'} !~ /\bOS2::REXX\b/) {
+    if (-d 'lib' and $Config{'extensions'} !~ /\bOS2(::|\/)REXX\b/) {
        print "1..0\n";
        exit 0;
     }
@@ -76,4 +76,4 @@ print "ok 12\n";
 }
 
 print "ok 21\n";
-
+unlink 't.out';
index 4c0883d..a8c9752 100644 (file)
@@ -2,7 +2,7 @@ BEGIN {
     chdir 't' if -d 't/lib';
     @INC = '../lib' if -d 'lib';
     require Config; import Config;
-    if (-d 'lib' and $Config{'extensions'} !~ /\bOS2::PrfDB\b/) {
+    if (-d 'lib' and $Config{'extensions'} !~ /\bOS2(::|\/)PrfDB\b/) {
        print "1..0\n";
        exit 0;
     }
@@ -183,3 +183,6 @@ tie %hash2, 'OS2::PrfDB', $inifile;
 print "ok 47\n";
 
 print ($hash2{nnn}->{mmm} eq "67" ? "ok 48\n" : "not ok 48\n# `$val'\n");
+
+untie %hash2;
+unlink $inifile;
index a73e43e..f2113e3 100644 (file)
@@ -2,7 +2,7 @@ BEGIN {
     chdir 't' if -d 't/lib';
     @INC = '../lib' if -d 'lib';
     require Config; import Config;
-    if (-d 'lib' and $Config{'extensions'} !~ /\bOS2::REXX\b/) {
+    if (-d 'lib' and $Config{'extensions'} !~ /\bOS2(::|\/)REXX\b/) {
        print "1..0\n";
        exit 0;
     }
index 317743f..9d81bf3 100644 (file)
@@ -2,7 +2,7 @@ BEGIN {
     chdir 't' if -d 't/lib';
     @INC = '../lib' if -d 'lib';
     require Config; import Config;
-    if (-d 'lib' and $Config{'extensions'} !~ /\bOS2::REXX\b/) {
+    if (-d 'lib' and $Config{'extensions'} !~ /\bOS2(::|\/)REXX\b/) {
        print "1..0\n";
        exit 0;
     }
index b4f04c3..cb3c52a 100644 (file)
@@ -2,7 +2,7 @@ BEGIN {
     chdir 't' if -d 't/lib';
     @INC = '../lib' if -d 'lib';
     require Config; import Config;
-    if (-d 'lib' and $Config{'extensions'} !~ /\bOS2::REXX\b/) {
+    if (-d 'lib' and $Config{'extensions'} !~ /\bOS2(::|\/)REXX\b/) {
        print "1..0\n";
        exit 0;
     }
index 4f98425..602c76d 100644 (file)
@@ -2,7 +2,7 @@ BEGIN {
     chdir 't' if -d 't/lib';
     @INC = '../lib';
     require Config; import Config;
-    if ($Config{'extensions'} !~ /\bOS2::REXX\b/) {
+    if ($Config{'extensions'} !~ /\bOS2(::|\/)REXX\b/) {
        print "1..0\n";
        exit 0;
     }
index 2947516..c85a1e9 100644 (file)
@@ -2,7 +2,7 @@ BEGIN {
     chdir 't' if -d 't/lib';
     @INC = '../lib';
     require Config; import Config;
-    if ($Config{'extensions'} !~ /\bOS2::REXX\b/) {
+    if ($Config{'extensions'} !~ /\bOS2(::|\/)REXX\b/) {
        print "1..0\n";
        exit 0;
     }
index 6132e23..77f90c2 100644 (file)
@@ -2,7 +2,7 @@ BEGIN {
     chdir 't' if -d 't/lib';
     @INC = '../lib' if -d 'lib';
     require Config; import Config;
-    if (-d 'lib' and $Config{'extensions'} !~ /\bOS2::REXX\b/) {
+    if (-d 'lib' and $Config{'extensions'} !~ /\bOS2(::|\/)REXX\b/) {
        print "1..0\n";
        exit 0;
     }
index 8251051..30a2daf 100644 (file)
@@ -2,7 +2,7 @@ BEGIN {
     chdir 't' if -d 't/lib';
     @INC = '../lib' if -d 'lib';
     require Config; import Config;
-    if (-d 'lib' and $Config{'extensions'} !~ /\bOS2::REXX\b/) {
+    if (-d 'lib' and $Config{'extensions'} !~ /\bOS2(::|\/)REXX\b/) {
        print "1..0\n";
        exit 0;
     }
index 9d4f3b2..166cf53 100644 (file)
@@ -2,7 +2,7 @@ BEGIN {
     chdir 't' if -d 't/lib';
     @INC = '../lib' if -d 'lib';
     require Config; import Config;
-    if (-d 'lib' and $Config{'extensions'} !~ /\bOS2::REXX\b/) {
+    if (-d 'lib' and $Config{'extensions'} !~ /\bOS2(::|\/)REXX\b/) {
        print "1..0\n";
        exit 0;
     }
index a40749f..04ca663 100644 (file)
@@ -2,7 +2,7 @@ BEGIN {
     chdir 't' if -d 't/lib';
     @INC = '../lib' if -d 'lib';
     require Config; import Config;
-    if (-d 'lib' and $Config{'extensions'} !~ /\bOS2::REXX\b/) {
+    if (-d 'lib' and $Config{'extensions'} !~ /\bOS2(::|\/)REXX\b/) {
        print "1..0\n";
        exit 0;
     }
index 00bf561..6fb569b 100644 (file)
--- a/t/README
+++ b/t/README
@@ -8,4 +8,9 @@ If you put out extra lines with a '#' character on the front, you don't
 have to worry about removing the extra print statements later since TEST
 ignores lines beginning with '#'.
 
+If you know that "basic" features work and expect that some test are going
+to fail, it is adviced to run tests via Test::Harness thusly:
+       ./perl -I../lib harness
+This would pinpoint failed tests with better granularity.
+
 If you come up with new tests, send them to larry@wall.org.
index 4c8c10e..c6e464d 100755 (executable)
@@ -90,6 +90,7 @@ loop: while (<fh>) {
 if (!eof || $bad) {print "not ok 8\n";} else {print "ok 8\n";}
 if (!$badcont) {print "ok 9\n";} else {print "not ok 9\n";}
 
+close(fh) || die "Can't close Cmd_while.tmp.";
 unlink 'Cmd_while.tmp' || `/bin/rm Cmd_While.tmp`;
 
 #$x = 0;
index 2a37367..d2c64fe 100755 (executable)
@@ -110,7 +110,7 @@ ok 18, (not eval "qw:1" and
        not eval "qw:echo:ohce: >= 0");
 
 ok 19, (not eval "qx:1" and
-       eval "qx:echo: eq qx|echo|" and
+       eval "qx:echo 1: eq qx|echo 1|" and     # echo without args may warn
        not eval "qx:echo:ohce: >= 0");
 
 ok 20, (not eval "s:1" and
index 634b06a..0e022e9 100755 (executable)
@@ -35,6 +35,8 @@ if ($count == 3) {print "ok 3\n";} else {print "not ok 3\n";}
 $_ = `cat Comp.try`;
 
 if (/.*\n.*\n.*\n$/) {print "ok 4\n";} else {print "not ok 4\n";}
+
+close(try) || (die "Can't close temp file.");
 unlink 'Comp.try' || `/bin/rm -f Comp.try`;
 
 if ($_ eq $y) {print "ok 5\n";} else {print "not ok 5\n";}
index 40ed23b..bf592f9 100755 (executable)
@@ -34,3 +34,4 @@ else
     {print "not ok 5\n";}
 
 `/bin/rm -f Io.argv.tmp` if -x '/bin/rm';
+unlink 'Io.argv.tmp';
index 80b39df..52ab22b 100755 (executable)
@@ -111,4 +111,5 @@ print join(':',200..400) eq join(':',@foo) ? "ok 10\n" : "not ok 10\n";
 print ($h{'foo'} eq '' ? "ok 11\n" : "not ok 11\n");
 print ($h{''} eq 'bar' ? "ok 12\n" : "not ok 12\n");
 
+untie %h;
 unlink 'Op.dbmx.dir', $Dfile;
index c888c00..62bb936 100755 (executable)
@@ -114,4 +114,5 @@ print join(':',200..400) eq join(':',@foo) ? "ok 10\n" : "not ok 10\n";
 print ($h{'foo'} eq '' ? "ok 11\n" : "not ok 11\n");
 print ($h{''} eq 'bar' ? "ok 12\n" : "not ok 12\n");
 
+untie %h;
 unlink 'Op.dbmx.dir', $Dfile;
index 15aa93a..8e2ba81 100755 (executable)
@@ -117,4 +117,5 @@ print join(':',200..400) eq join(':',@foo) ? "ok 10\n" : "not ok 10\n";
 print ($h{'foo'} eq '' ? "ok 11\n" : "not ok 11\n");
 print ($h{''} eq 'bar' ? "ok 12\n" : "not ok 12\n");
 
+untie %h;
 unlink 'Op.dbmx.dir', $Dfile;
index 0b1fa50..0c530d2 100755 (executable)
@@ -117,4 +117,5 @@ print join(':',200..400) eq join(':',@foo) ? "ok 10\n" : "not ok 10\n";
 print ($h{'foo'} eq '' ? "ok 11\n" : "not ok 11\n");
 print ($h{''} eq 'bar' ? "ok 12\n" : "not ok 12\n");
 
+untie %h;
 unlink 'Op.dbmx.dir', $Dfile;
index 1bb3fde..65419f9 100755 (executable)
@@ -116,4 +116,5 @@ print join(':',200..400) eq join(':',@foo) ? "ok 10\n" : "not ok 10\n";
 print ($h{'foo'} eq '' ? "ok 11\n" : "not ok 11\n");
 print ($h{''} eq 'bar' ? "ok 12\n" : "not ok 12\n");
 
+untie %h;
 unlink 'Op.dbmx.dir', $Dfile;
index aba7c2e..4a7e68d 100755 (executable)
@@ -18,7 +18,7 @@ for my $i (0..$#FOO) {
            print "ok $ok\n";
        }
        else {
-           print "not ok $ok ($FOO[$i] <=> $FOO[$j])\n";
+           print "not ok $ok ($FOO[$i] <=> $FOO[$j]) gives: '$cmp'\n";
        }
        $ok++;
        $cmp = $FOO[$i] cmp $FOO[$j];
@@ -29,7 +29,7 @@ for my $i (0..$#FOO) {
            print "ok $ok\n";
        }
        else {
-           print "not ok $ok ($FOO[$i] cmp $FOO[$j])\n";
+           print "not ok $ok ($FOO[$i] cmp $FOO[$j]) gives '$cmp'\n";
        }
     }
 }
diff --git a/t/op/lex_assign.t b/t/op/lex_assign.t
new file mode 100644 (file)
index 0000000..d35f39c
--- /dev/null
@@ -0,0 +1,214 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+umask 0;
+$xref = \ "";
+@a = (1..5);
+%h = (1..6);
+$aref = \@a;
+$href = \%h;
+open OP, qq{$^X -le 'print "aaa Ok ok" while \$i++ < 100'|};
+$chopit = 'aaaaaa';
+@chopar = (113 .. 119);
+$posstr = '123456';
+$cstr = 'aBcD.eF';
+pos $posstr = 3;
+$nn = $n = 2;
+sub subb {"in s"}
+
+@INPUT = <DATA>;
+print "1..", (scalar @INPUT), "\n";
+$ord = 0;
+
+sub wrn {"@_"}
+
+for (@INPUT) {
+  $ord++;
+  ($op, undef, $comment) = /^([^\#]+)(\#\s+(.*))?/;
+  $comment = $op unless defined $comment;
+  $op = "$op==$op" unless $op =~ /==/;
+  ($op, $expectop) = $op =~ /(.*)==(.*)/;
+  
+  $skip = ($op =~ /^'\?\?\?'/) ? "skip" : "not";
+  $integer = ($comment =~ /^i_/) ? "use integer" : '' ;
+  (print "#skipping $comment:\nok $ord\n"), next if $skip eq 'skip';
+  
+  eval <<EOE;
+  local \$SIG{__WARN__} = \\&wrn;
+  my \$a = 'fake';
+  $integer;
+  \$a = $op;
+  \$b = $expectop;
+  if (\$a ne \$b) {
+    print "# \$comment: got `\$a', expected `\$b'\n";
+    print "\$skip " if \$a ne \$b or \$skip eq 'skip';
+  }
+  print "ok \$ord\\n";
+EOE
+  if ($@) {
+    if ($@ =~ /is unimplemented/) {
+      print "# skipping $comment: unimplemented:\nok $ord\n";
+    } else {
+      warn $@;
+      print "not ok $ord\n";
+    }
+  }
+}
+__END__
+ref $xref                      # ref
+ref $cstr                      # ref nonref
+`ls`                           # backtick
+`$undefed`                     # backtick undef
+<*>                            # glob
+<OP>                           # readline
+'faked'                                # rcatline
+(@z = (1 .. 3))                        # aassign
+chop $chopit                   # chop
+(chop (@x=@chopar))            # schop
+chomp $chopit                  # chomp
+(chop (@x=@chopar))            # schomp
+pos $posstr                    # pos
+pos $chopit                    # pos returns undef
+$nn++==2                       # postinc
+$nn++==3                       # i_postinc
+$nn--==4                       # postdec
+$nn--==3                       # i_postdec
+$n ** $n                       # pow
+$n * $n                                # multiply
+$n * $n                                # i_multiply
+$n / $n                                # divide
+$n / $n                                # i_divide
+$n % $n                                # modulo
+$n % $n                                # i_modulo
+$n x $n                                # repeat
+$n + $n                                # add
+$n + $n                                # i_add
+$n - $n                                # subtract
+$n - $n                                # i_subtract
+$n . $n                                # concat
+$n . $a=='2fake'               # concat with self
+"3$a"=='3fake'                 # concat with self in stringify
+"$n"                           # stringify
+$n << $n                       # left_shift
+$n >> $n                       # right_shift
+$n <=> $n                      # ncmp
+$n <=> $n                      # i_ncmp
+$n cmp $n                      # scmp
+$n & $n                                # bit_and
+$n ^ $n                                # bit_xor
+$n | $n                                # bit_or
+-$n                            # negate
+-$n                            # i_negate
+~$n                            # complement
+atan2 $n,$n                    # atan2
+sin $n                         # sin
+cos $n                         # cos
+'???'                          # rand
+exp $n                         # exp
+log $n                         # log
+sqrt $n                                # sqrt
+int $n                         # int
+hex $n                         # hex
+oct $n                         # oct
+abs $n                         # abs
+length $posstr                 # length
+substr $posstr, 2, 2           # substr
+vec("abc",2,8)                 # vec
+index $posstr, 2               # index
+rindex $posstr, 2              # rindex
+sprintf "%i%i", $n, $n         # sprintf
+ord $n                         # ord
+chr $n                         # chr
+crypt $n, $n                   # crypt
+ucfirst ($cstr . "a")          # ucfirst padtmp
+ucfirst $cstr                  # ucfirst
+lcfirst $cstr                  # lcfirst
+uc $cstr                       # uc
+lc $cstr                       # lc
+quotemeta $cstr                        # quotemeta
+@$aref                         # rv2av
+@$undefed                      # rv2av undef
+each %h==1                     # each
+values %h                      # values
+keys %h                                # keys
+%$href                         # rv2hv
+pack "C2", $n,$n               # pack
+split /a/, "abad"              # split
+join "a"; @a                   # join
+push @a,3==6                   # push
+unshift @aaa                   # unshift
+reverse        @a                      # reverse
+reverse        $cstr                   # reverse - scal
+grep $_, 1,0,2,0,3             # grepwhile
+map "x$_", 1,0,2,0,3           # mapwhile
+subb()                         # entersub
+caller                         # caller
+warn "ignore this\n"           # warn
+'faked'                                # die
+open BLAH, "<non-existent"     # open
+fileno STDERR                  # fileno
+umask 0                                # umask
+select STDOUT                  # sselect
+select "","","",0              # select
+getc OP                                # getc
+'???'                          # read
+'???'                          # sysread
+'???'                          # syswrite
+'???'                          # send
+'???'                          # recv
+'???'                          # tell
+'???'                          # fcntl
+'???'                          # ioctl
+'???'                          # flock
+'???'                          # accept
+'???'                          # shutdown
+'???'                          # ftsize
+'???'                          # ftmtime
+'???'                          # ftatime
+'???'                          # ftctime
+chdir 'non-existent'           # chdir
+'???'                          # chown
+'???'                          # chroot
+unlink 'non-existent'          # unlink
+chmod 'non-existent'           # chmod
+utime 'non-existent'           # utime
+rename 'non-existent', 'non-existent1' # rename
+link 'non-existent', 'non-existent1' # link
+symlink 'non-existent', 'non-existent1' # symlink
+readlink 'non-existent', 'non-existent1' # readlink
+'???'                          # mkdir
+'???'                          # rmdir
+'???'                          # telldir
+'???'                          # fork
+'???'                          # wait
+'???'                          # waitpid
+system 'sh -c true'            # system
+'???'                          # exec
+kill 0, $$                     # kill
+getppid                                # getppid
+getpgrp                                # getpgrp
+'???'                          # setpgrp
+getpriority $$, $$             # getpriority
+'???'                          # setpriority
+time                           # time
+localtime                      # localtime
+gmtime                         # gmtime
+sleep 1                                # sleep
+'???'                          # alarm
+'???'                          # shmget
+'???'                          # shmctl
+'???'                          # shmread
+'???'                          # shmwrite
+'???'                          # msgget
+'???'                          # msgctl
+'???'                          # msgsnd
+'???'                          # msgrcv
+'???'                          # semget
+'???'                          # semctl
+'???'                          # semop
+'???'                          # getlogin
+'???'                          # syscall
index a050510..f12f67b 100755 (executable)
@@ -7,7 +7,7 @@ BEGIN {
     $| = 1;
     chdir 't' if -d 't';
     @INC = '../lib';
-    $SIG{__WARN__} = sub { die @_ };
+    $SIG{__WARN__} = sub { die "dying on warning: ", @_ };
 }
 
 sub ok {
@@ -107,9 +107,11 @@ ok 21, close(SCRIPT), $!;
 ok 22, chmod(0755, $script), $!;
 $s = "\$^X is ./perl, \$0 is $script\n";
 $_ = `$script`;
-ok 23, $_ eq $s, ":$_:";
+ok 23, $_ eq $s, ":$_:!=:$s:"                               if $^O ne 'os2';
+# Started by ksh, which sets adds suffixes '.exe' and '.' to perl and script :
+ok 23, $_ eq "\$^X is ./perl.exe, \$0 is $script.\n", ":$_:" if $^O eq 'os2';
 $_ = `./perl $script`;
-ok 24, $_ eq $s, ":$_:";
+ok 24, $_ eq $s, ":$_:!=:$s:";
 ok 25, unlink($script), $!;
 
 # $], $^O, $^T