perl 5.0 alpha 6

[editor's note: cleaned up from the September '94 InfoMagic CD, just
like the last commit]

7 files changed, 139 insertions, 21 deletions

diff --git a/t/foo b/t/foo
index ace796d88b..57d87eb167 100755
--- a/t/foo
+++ b/t/foo
@@ -1,4 +1,2 @@
-#!./perl -Dst
+#!./perl
 
-$ref = [[],2,[3,4,5,]];
-print ${$$ref[2]}[2] == 5 ? "ok 16\n" : "not ok 16\n";
diff --git a/t/foo.out b/t/foo.out
new file mode 100644
index 0000000000..422ebf8155
--- /dev/null
+++ b/t/foo.out
@@ -0,0 +1,36 @@
+{
+5   TYPE = block exit  ===> DONE
+    FLAGS = (UNKNOWN,KIDS,PARENS)
+    {
+1       TYPE = block entry  ===> 2
+    }
+    {
+2       TYPE = next statement  ===> 3
+        FLAGS = (SCALAR)
+        LINE = 1
+    }
+    {
+4       TYPE = subroutine entry  ===> 5
+        FLAGS = (UNKNOWN,KIDS)
+        {
+            TYPE = null operation  ===> (4)
+            WAS = subroutine reference
+            FLAGS = (SCALAR,KIDS)
+            {
+3               TYPE = glob value  ===> 4
+                FLAGS = (SCALAR)
+                GV = main::foo
+            }
+        }
+    }
+}
+
+SUB ODBM_File::init = (xsub 0x7efb8 0)
+
+SUB SDBM_File::init = (xsub 0x80318 0)
+
+SUB NDBM_File::init = (xsub 0x7ddf8 0)
+
+EXECUTING...
+
+- syntax OK
diff --git a/t/lib/big.t b/t/lib/bigint.t
index 23cd00beb5..034c5c6457 100755
--- a/t/lib/big.t
+++ b/t/lib/bigint.t
@@ -1,5 +1,7 @@
 #!./perl
-require "../lib/bigint.pl";
+
+BEGIN { @INC = '../lib' }
+require "bigint.pl";
 
 $test = 0;
 $| = 1;
diff --git a/t/lib/english.t b/t/lib/english.t
new file mode 100755
index 0000000000..bbc0c0c6b7
--- /dev/null
+++ b/t/lib/english.t
@@ -0,0 +1,41 @@
+#!./perl
+
+print "1..16\n";
+
+BEGIN { @INC = '../lib' }
+require English; import English;
+
+print $PID == $$ ? "ok 1\n" : "not ok 1\n";
+
+$_ = 1;
+print $MAGIC == $_ ? "ok 2\n" : "not ok 2\n";
+
+sub foo {
+    print $ARG[0] == $_[0] ? "ok 3\n" : "not ok 3\n";
+}
+&foo(1);
+
+$MAGIC = "ok 4\nok 5\nok 6\n";
+/ok 5\n/;
+print $PREMATCH, $MATCH, $POSTMATCH;
+
+$OFS = " ";
+$ORS = "\n";
+print 'ok',7;
+undef $OUTPUT_FIELD_SEPARATOR;
+
+$LIST_SEPARATOR = "\n";
+@foo = ("ok 8", "ok 9");
+print "@foo";
+undef $OUTPUT_RECORD_SEPARATOR;
+
+eval 'no such function';
+print "ok 10\n" if $EVAL_ERROR =~ /method/;
+
+print $UID == $< ? "ok 11\n" : "not ok 11\n";
+print $GID == $( ? "ok 12\n" : "not ok 12\n";
+print $EUID == $> ? "ok 13\n" : "not ok 13\n";
+print $EGID == $) ? "ok 14\n" : "not ok 14\n";
+
+print $PROGRAM_NAME == $0 ? "ok 15\n" : "not ok 15\n";
+print $BASETIME == $^T ? "ok 16\n" : "not ok 16\n";
diff --git a/t/op/dbm.t b/t/lib/sdbm.t
index a011169865..79d95f315f 100755
--- a/t/op/dbm.t
+++ b/t/lib/sdbm.t
@@ -2,26 +2,19 @@
 
 # $RCSfile: dbm.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:43 $
 
-if (!-r '/usr/include/dbm.h' && !-r '/usr/include/ndbm.h'
-    && !-r '/usr/include/rpcsvc/dbm.h') {
-    print "1..0\n";
-    exit;
-}
+BEGIN { @INC = '../lib' }
+require SDBM_File;
 
 print "1..12\n";
 
-init SDBM_File;
-
-unlink <Op.dbmx.*>;
-unlink Op.dbmx;		# in case we're running gdbm
+unlink <Op.dbmx*>;
 
 umask(0);
 print (tie(%h,SDBM_File,'Op.dbmx', 0x202, 0640) ? "ok 1\n" : "not ok 1\n");
 
 $Dfile = "Op.dbmx.pag";
 if (! -e $Dfile) {
-	$Dfile = "Op.dbmx";
-	print "# Probably a gdbm database\n";
+	($Dfile) = <Op.dbmx*>;
 }
 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
    $blksize,$blocks) = stat($Dfile);
diff --git a/t/op/goto.t b/t/op/goto.t
index 0b89921b94..21a35c1de3 100755
--- a/t/op/goto.t
+++ b/t/op/goto.t
@@ -2,7 +2,9 @@
 
 # $RCSfile: goto.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:56 $
 
-print "1..5\n";
+# "This IS structured code.  It's just randomly structured."
+
+print "1..9\n";
 
 while ($?) {
     $foo = 1;
@@ -43,11 +45,43 @@ bar:
 &foo;
 
 sub bar {
-    $x = 'exitcode';
-    eval "goto $x";	# Do not take this as exemplary code!!!
+    $x = 'bypass';
+    eval "goto $x";
 }
 
 &bar;
 exit;
-exitcode:
+
+FINALE:
+print "ok 9\n";
+exit;
+
+bypass:
 print "ok 5\n";
+
+# Test autoloading mechanism.
+
+sub two {
+    ($pack, $file, $line) = caller;	# Should indicate original call stats.
+    print "@_ $pack $file $line" eq "1 2 3 main $FILE $LINE"
+	? "ok 7\n"
+	: "not ok 7\n";
+}
+
+sub one {
+    eval <<'END';
+    sub one { print "ok 6\n"; goto &two; print "not ok 6\n"; }
+END
+    goto &one;
+}
+
+$FILE = __FILE__;
+$LINE = __LINE__ + 1;
+&one(1,2,3);
+
+$wherever = NOWHERE;
+eval { goto $wherever };
+print $@ =~ /Can't find label NOWHERE/ ? "ok 8\n" : "not ok 8\n";
+
+$wherever = FINALE;
+goto $wherever;
diff --git a/t/op/ref.t b/t/op/ref.t
index ead65b52ef..60bb75ce33 100755
--- a/t/op/ref.t
+++ b/t/op/ref.t
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..37\n";
+print "1..40\n";
 
 # Test glob operations.
 
@@ -145,9 +145,10 @@ $string = "not ok 34\n";
 $object = "foo";
 $string = "ok 34\n";
 $main'anonhash2 = "foo";
-$string = "not ok 34\n";
+$string = "";
 
 DESTROY {
+    return unless $string;
     print $string;
 
     # Test that the object has already been "cursed".
@@ -178,3 +179,16 @@ sub BASEOBJ'doit {
     die "Not an OBJ" unless ref $ref eq OBJ;
     $ref->{shift};
 }
+
+package FINALE;
+
+{
+    $ref3 = bless ["ok 40\n"];		# package destruction
+    my $ref2 = bless ["ok 39\n"];	# lexical destruction
+    local $ref1 = bless ["ok 38\n"];	# dynamic destruction
+    1;					# flush any temp values on stack
+}
+
+DESTROY {
+    print $_[0][0];
+}