[inseparable changes from patch from perl5.003_24 to perl5.003_25]perl-5.003_25

 CORE LANGUAGE CHANGES

Subject: Make $] read-only
From: Chip Salzenberg <chip@perl.com>
Files: gv.c

Subject: New variable C<$^S> is a native version of C<$?>
From: Chip Salzenberg <chip@perl.com>
Files: doio.c global.sym gv.c interp.sym lib/English.pm mg.c perl.c perl.h pod/perldelta.pod pod/perlfunc.pod pod/perlvar.pod pp_ctl.c pp_sys.c proto.h util.c

Subject: Make $^T work with undump, and don't taint it
From: Chip Salzenberg <chip@perl.com>
Files: perl.c

 CORE PORTABILITY

Subject: VMS patches for _24
Date: Fri, 31 Jan 1997 02:34:37 -0500 (EST)
From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU>
Files: ext/DynaLoader/DynaLoader.pm ext/DynaLoader/dl_vms.xs lib/AutoSplit.pm lib/ExtUtils/MM_VMS.pm lib/ExtUtils/MakeMaker.pm perl.h pp_hot.c t/lib/filehand.t t/op/closure.t vms/Makefile vms/config.vms vms/descrip.mms vms/ext/filespec.t vms/vms.c vms/vmsish.h

    private-msgid: <01IEUIFP5038004GQP@hmivax.humgen.upenn.edu>

 DOCUMENTATION

Subject: Document how extension pms go in $archlib
From: Chip Salzenberg <chip@perl.com>
Files: pod/perldelta.pod

Subject: perlfunc.pod tweaks
Date: Thu, 30 Jan 1997 16:20:55 -0500
From: Roderick Schertler <roderick@gate.net>
Files: pod/perlfunc.pod

    private-msgid: <20526.854659255@eeyore.ibcinc.com>

Subject: Error lines must not have trailing periods
From: Chip Salzenberg <chip@perl.com>
Files: pod/perldiag.pod

 LIBRARY AND EXTENSIONS

Subject: Make IO::Handle::gets() an alias of getline
Date: Thu, 30 Jan 1997 12:03:15 +0100
From: Gisle Aas <aas@bergen.sn.no>
Files: ext/IO/lib/IO/Handle.pm lib/IO/Handle.pm

    private-msgid: <199701301103.MAA11291@bergen.sn.no>

 OTHER CORE CHANGES

Subject: Require '-T' in argv[], not just on #! line
From: Chip Salzenberg <chip@perl.com>
Files: perl.c pod/perldiag.pod

Subject: Fix C<return @_> and associated stack bugs
From: Chip Salzenberg <chip@perl.com>
Files: cop.h pp_ctl.c pp_hot.c t/op/misc.t

Subject: Fix never-closing handle after C<select>
From: Chip Salzenberg <chip@perl.com>
Files: pp_sys.c

Subject: Fix /\G/g with patterns that match empty string
From: Ilya Zakharevich <ilya@math.ohio-state.edu>
Files: pp_hot.c

Subject: Don't create AV, HV, IO when assigning glob
From: Chip Salzenberg <chip@perl.com>
Files: mg.c

 TESTS

Subject: More Amiga test patches
Date: Wed, 29 Jan 1997 16:07:33 +0100
From: "Norbert Pueschel" <pueschel@imsdd.meb.uni-bonn.de>
Files: README.amiga t/lib/safe2.t t/op/closure.t

    private-msgid: <77724725@Armageddon.meb.uni-bonn.de>

4 files changed, 73 insertions, 33 deletions

diff --git a/t/lib/filehand.t b/t/lib/filehand.t
index 14a17704b9..20b2ee0bb0 100755
--- a/t/lib/filehand.t
+++ b/t/lib/filehand.t
@@ -22,7 +22,9 @@ print "1..11\n";
 
 print $mystdout "ok ",fileno($mystdout),"\n";
 
-$fh = new FileHandle "TEST", O_RDONLY and print "ok 2\n";
+$fh = (new FileHandle "./TEST", O_RDONLY
+       or new FileHandle "TEST", O_RDONLY)
+  and print "ok 2\n";
 
 
 $buffer = <$fh>;
diff --git a/t/lib/safe2.t b/t/lib/safe2.t
index 586eace6a8..feaab16956 100755
--- a/t/lib/safe2.t
+++ b/t/lib/safe2.t
@@ -120,7 +120,8 @@ print $@ =~ /foo bar/ ? "ok 29\n" : "not ok 29\n";
 my $t = 30;
 $cpt->rdo('/non/existant/file.name');
 print +(($! =~ /No such file/ || $! =~ /file specification syntax error/) ||
-      $! =~ /A file or directory in the path name does not exist/ ?
+      $! =~ /A file or directory in the path name does not exist/ ||
+      $! =~ /Device not configured/ ?
       "ok $t\n" : "not ok $t # $!\n"); $t++;
 print 1 ? "ok $t\n" : "not ok $t\n#$@/$!\n"; $t++;
   
diff --git a/t/op/closure.t b/t/op/closure.t
index 752f30c9c6..ab1e426d81 100755
--- a/t/op/closure.t
+++ b/t/op/closure.t
@@ -5,6 +5,13 @@
 #   Greatly extended by Tom Phoenix <rootbeer@teleport.com> on 28 Jan 1997.
 #
 
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use Config;
+
 print "1..167\n";
 
 my $test = 1;
@@ -123,16 +130,11 @@ test {
   &{$foo[4]}() == 0
   };
 
+exit 0 unless $Config{'d_fork'};
+
 # Additional tests by Tom Phoenix <rootbeer@teleport.com>.
 
 {
-    BEGIN {
-      if (-d 't') {
-	unshift @INC, "lib"
-      } else {
-	unshift @INC, '../lib'
-      }
-    }
     use strict;
 
     use vars qw!$test!;
@@ -377,38 +379,64 @@ END
 	    $test++;
 	  }
 
-	  # Fork off a new perl to run the tests.
-	  # (This is so we can catch spurious warnings.)
-	  $| = 1; print ""; $| = 0; # flush output before forking
-	  pipe READ, WRITE or die "Can't make pipe: $!";
-	  pipe READ2, WRITE2 or die "Can't make second pipe: $!";
-	  die "Can't fork: $!" unless defined($pid = open PERL, "|-");
-	  unless ($pid) {
-	    # Child process here. We're going to send errors back
-	    # through the extra pipe.
-	    close READ;
-	    close READ2;
-	    open STDOUT, ">&WRITE"  or die "Can't redirect STDOUT: $!";
-	    open STDERR, ">&WRITE2" or die "Can't redirect STDERR: $!";
-	    exec './perl', '-w', '-'
+	  if ($Config{d_fork} and $^O ne 'VMS') {
+	    # Fork off a new perl to run the tests.
+	    # (This is so we can catch spurious warnings.)
+	    $| = 1; print ""; $| = 0; # flush output before forking
+	    pipe READ, WRITE or die "Can't make pipe: $!";
+	    pipe READ2, WRITE2 or die "Can't make second pipe: $!";
+	    die "Can't fork: $!" unless defined($pid = open PERL, "|-");
+	    unless ($pid) {
+	      # Child process here. We're going to send errors back
+	      # through the extra pipe.
+	      close READ;
+	      close READ2;
+	      open STDOUT, ">&WRITE"  or die "Can't redirect STDOUT: $!";
+	      open STDERR, ">&WRITE2" or die "Can't redirect STDERR: $!";
+	      exec './perl', '-w', '-'
 		or die "Can't exec ./perl: $!";
+	    } else {
+	      # Parent process here.
+	      close WRITE;
+	      close WRITE2;
+	      print PERL $code;
+	      close PERL;
+	      { local $/;
+	        $output = join '', <READ>;
+	        $errors = join '', <READ2>; }
+	      close READ;
+	      close READ2;
+	    }
+	  } else {
+	    # No fork().  Do it the hard way.
+	    my $cmdfile = "tcmd$$";  $cmdfile++ while -e $cmdfile;
+	    my $outfile = "tout$$";  $outfile++ while -e $outfile;
+	    my $errfile = "terr$$";  $errfile++ while -e $errfile;
+	    open CMD, ">$cmdfile"; print CMD $code; close CMD;
+	    my $cmd = ($^O eq 'VMS') ? "MCR $^X" : "./perl";
+	    $cmd .= " -w $cmdfile >$outfile 2>$errfile";
+	    system $cmd;
+	    $? = 0 if $^O eq 'VMS' and $? & 1;  # Keep Unix-minded code below happy
+	    if ($?) {
+	      printf "not ok: exited with error code %04X\n", $?;
+	      $debugging or do { 1 while unlink $cmdfile, $outfile, $errfile };
+	      exit;
+	    }
+	    { local $/;
+	      open IN, $outfile; $output = <IN>; close IN;
+	      open IN, $errfile; $errors = <IN>; close IN; }
+	    1 while unlink $cmdfile, $outfile, $errfile;
 	  }
-	  # Parent process here.
-	  close WRITE;
-	  close WRITE2;
-	  print PERL $code;
-	  close PERL;
-	  $output = join '', <READ>;
-	  $errors = join '', <READ2>;
-	  print $output, $errors;
+	  print $output;
+	  print STDERR $errors;
 	  if ($debugging && ($errors || $? || ($output =~ /not ok/))) {
 	    my $lnum = 0;
 	    for $line (split '\n', $code) {
 	      printf "%3d:  %s\n", ++$lnum, $line;
 	    }
 	  }
-	  printf "not ok: exited with error code %04lX\n",$? if $?;
-	  print "-" x 30, $/ if $debugging;
+	  printf "not ok: exited with error code %04X\n", $? if $?;
+	  print "-" x 30, "\n" if $debugging;
 
 	}	# End of foreach $within
       }	# End of foreach $where_declared
diff --git a/t/op/misc.t b/t/op/misc.t
index 25eb6619ed..5e628ad67a 100755
--- a/t/op/misc.t
+++ b/t/op/misc.t
@@ -293,3 +293,12 @@ print "eat flaming death\n" unless ($s == 7);
 sub foo { local $_ = shift; split; @_ }
 @x = foo(' x  y  z ');
 print "you die joe!\n" unless "@x" eq 'x y z';
+########
+sub foo { local(@_) = ('p', 'q', 'r'); }
+sub bar { unshift @_, 'D'; @_ }
+sub baz { push @_, 'E'; return @_ }
+for (1..3) { print foo('a', 'b', 'c'), bar('d'), baz('e'), "\n" }
+EXPECT
+pqrDdeE
+pqrDdeE
+pqrDdeE