[inseparable changes from patch from perl5.003_20 to perl5.003_21]

 BUILD PROCESS

Subject: Make MachTen hints file warn about db-recno failures
Date: Wed, 8 Jan 1997 12:07:18 +0100
From: Dominic Dunlop <domo@slipper.ip.lu>
Files: hints/machten.sh
Msg-ID: <v03010d00aef92fba6aca@[194.51.248.78]>

    (applied based on p5p patch as commit a4c70ab8da3ec1d87c83e5c617f4550814ec1724)

Subject: 5.003_20, FreeBSD 3.0 and minor patch
Date: Wed, 8 Jan 1997 14:37:47 +0100
From: Ollivier Robert <roberto@eurocontrol.fr>
Files: Configure
Msg-ID: <Mutt.19970108143747.roberto@caerdonn.eurocontrol.fr>

    (applied based on p5p patch as commit 50e0d465254be88fb90ac23584812a529741b4b1)

 CORE LANGUAGE CHANGES

Subject: Fix overloading via inherited autoloaded functions
Date: Mon, 13 Jan 1997 05:22:47 -0500 (EST)
From: Ilya Zakharevich <ilya@math.ohio-state.edu>
Files: gv.c lib/overload.pm pod/perldiag.pod t/pragma/overload.t
Msg-ID: <199701131022.FAA22830@monk.mps.ohio-state.edu>

    (applied based on p5p patch as commit a9bc755754f0db5e848e65dfd2e63a96af50ffd4)

Subject: Method call fixes: Don't cache in alias, don't skip undef
From: Chip Salzenberg <chip@atlantic.net>
Files: global.sym gv.c gv.h hv.c op.c pod/perlguts.pod pod/perltoc.pod pp.c pp_ctl.c pp_hot.c proto.h scope.c sv.c t/op/method.t

Subject: Formats can be closures
From: Chip Salzenberg <chip@atlantic.net>
Files: cv.h op.c perly.c perly.c.diff perly.y pp_sys.c sv.h

Subject: Quote 'foo' in C<$x{-foo}>
From: Chip Salzenberg <chip@atlantic.net>
Files: toke.c

Subject: Forbid C< x->{y} > and C< x->[0] > under C<strict refs>
From: Chip Salzenberg <chip@atlantic.net>
Files: op.c pod/perldiag.pod t/pragma/strict-refs

Subject: Allow <=> to return undef when operands are not ordered
From: Chip Salzenberg <chip@perl.com>
Files: MANIFEST pp.c t/op/cmp.t

 CORE PORTABILITY

Subject: Re: Perl 5.003_20: OS/2 patches
Date: Fri, 10 Jan 1997 06:02:16 -0500 (EST)
From: Ilya Zakharevich <ilya@math.ohio-state.edu>
Files: hints/os2.sh os2/Changes os2/os2.c os2/os2ish.h pp_sys.c
Msg-ID: <199701101102.GAA19051@monk.mps.ohio-state.edu>

    (applied based on p5p patch as commit 9a3e71f668bd84b1cf53dd3ea10f588d59ecfebb)

Subject: VMS patches for _20
Date: Tue, 14 Jan 1997 17:34:43 -0500 (EST)
From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU>
Files: configpm dosish.h os2/os2ish.h plan9/plan9ish.h proto.h t/pragma/strict.t t/pragma/subs.t t/pragma/warning.t toke.c unixish.h vms/Makefile vms/config.vms vms/descrip.mms vms/genconfig.pl vms/perly_c.vms vms/test.com vms/vmsish.h x2p/a2p.h x2p/str.c

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

Subject: Irix 6.3 & 6.4 and perl5.003_20
Date: Mon, 13 Jan 1997 17:42:50 -0500 (EST)
From: John Stoffel <jfs@fluent.com>
Files: MANIFEST hints/irix_6_3.sh hints/irix_6_4.sh
Msg-ID: <199701132242.RAA14601@jfs.Fluent.COM>

    (applied based on p5p patch as commit 8a1e91d771b51ae31eed1ac5944c63934213fb07)

Subject: Patch: MachTen hints, Configure
Date: Tue, 14 Jan 1997 13:43:13 +0100
From: Dominic Dunlop <domo@slipper.ip.lu>
Files: Configure hints/machten.sh

    private-msgid: <v03010d00af0123a93670@[194.51.248.75]>

Subject: Rename aux.sh to aux_3.sh for MS-LOSS
From: Chip Salzenberg <chip@atlantic.net>
Files: MANIFEST hints/aux_3.sh

 DOCUMENTATION

Subject: Full documentation generation patch
Date: Wed, 15 Jan 97 11:16:28 +0100
From: Raphael Manfredi <Raphael_Manfredi@grenoble.hp.com>
Files: MANIFEST pod/roffitall pod/rofftoc
Msg-ID: <15309.853323388@lyon.grenoble.hp.com>

    (applied based on p5p patch as commit a3270a1d7469cab9221ab0050a0e6695bd0047d8)

Subject: Document use of pos() and /\G/
Date: Mon, 13 Jan 1997 15:13:12 -0500
From: Gurusamy Sarathy <gsar@engin.umich.edu>
Files: pod/perlfunc.pod pod/perlnews.pod pod/perlop.pod pod/perlre.pod pod/perltoc.pod pod/perltrap.pod
Msg-ID: <199701132013.PAA26606@aatma.engin.umich.edu>

    (applied based on p5p patch as commit b2a07c1c241ec86f010fc0ea3bfa54c8ec28be90)

Subject: Document new closure warnings
From: Chip Salzenberg <chip@atlantic.net>
Files: op.c pod/perldiag.pod

Subject: Misc. doc patches missing in _20
Date: Tue, 07 Jan 1997 22:55:33 -0500
From: Roderick Schertler <roderick@gate.net>
Files: pod/perlsub.pod pod/perltoc.pod pod/perlvar.pod
Msg-ID: <102.852695733@eeyore.ibcinc.com>

    (applied based on p5p patch as commit b88f04ff2985d0899964b90ae56789d88f6b353e)

 LIBRARY AND EXTENSIONS

Subject: Localize info about filesystems being case-forgiving
From: Chip Salzenberg <chip@atlantic.net>
Files: lib/File/Basename.pm pod/checkpods.PL pod/pod2html.PL pod/pod2latex.PL pod/pod2man.PL pod/pod2text.PL utils/c2ph.PL utils/h2ph.PL utils/h2xs.PL utils/perlbug.PL utils/perldoc.PL utils/pl2pm.PL utils/splain.PL x2p/find2perl.PL x2p/s2p.PL

Subject: Eliminate warning from C<use overload>
From: Chip Salzenberg <chip@atlantic.net>
Files: lib/overload.pm

 OTHER CORE CHANGES

Subject: Fix C< eval { my $x; eval '$x' } >
From: Chip Salzenberg <chip@atlantic.net>
Files: op.c t/op/misc.t

Subject: Don't warn if eval '' uses outer func's lexicals
From: Chip Salzenberg <chip@atlantic.net>
Files: op.c

Subject: Avoid memory wastage in wait(); make pidstatus global
From: Chip Salzenberg <chip@atlantic.net>
Files: global.sym interp.sym perl.c perl.h pp_sys.c

Subject: Forbid ++ and -- on readonly values
Date: Fri, 10 Jan 1997 19:47:16 -0800 (PST)
From: "John Q. Linux" <jql@accessone.com>
Files: pp.c pp_hot.c
Msg-ID: <Pine.LNX.3.95.970110193330.11249D-100000@jql.accessone.com>

    (applied based on p5p patch as commit 74c80e585086695d5428ab316ca82fd6931aeabd)

Subject: Keep array from dying during foreach(@array)
From: Chip Salzenberg <chip@atlantic.net>
Files: cop.h pp_ctl.c

Subject: Fix C< $a="simple"; split /($a)/o >
From: Chip Salzenberg <chip@atlantic.net>
Files: pp.c t/op/misc.t

Subject: Fix for anon-lists with tied entries coredump
Date: Fri, 10 Jan 1997 02:45:11 -0500
From: Gurusamy Sarathy <gsar@engin.umich.edu>
Files: pp.c
Msg-ID: <199701100745.CAA13057@aatma.engin.umich.edu>

    (applied based on p5p patch as commit d976ac8220f8890bb7663152c4870f60e8e018c8)

Subject: Don't set SVf_PADBUSY on immortal SVs
From: Chip Salzenberg <chip@atlantic.net>
Files: op.c

Subject: Patch for Object subroutines
Date: Tue, 7 Jan 1997 20:56:02 -0500 (EST)
From: Ilya Zakharevich <ilya@math.ohio-state.edu>
Files: cop.h
Msg-ID: <199701080156.UAA15366@monk.mps.ohio-state.edu>

    (applied based on p5p patch as commit 174150afa5efdafc0e94a18211d3c9aa06b15cd9)

Subject: Use an SVt_PVLV to hold stacked OP pointers when debugging
From: Chip Salzenberg <chip@atlantic.net>
Files: pp.c pp_hot.c

Subject: Undo change that freed large pad vars
From: Chip Salzenberg <chip@atlantic.net>
Files: scope.c

 TESTS

Subject: UNIVERSAL tests
From: Roderick Schertler <roderick@gate.net>
Files: MANIFEST t/op/universal.t

Subject: Test deletion of array during foreach
From: Jarkko Hietaniemi <jhi@alpha.hut.fi>
Files: t/op/misc.t

 UTILITIES

Subject: Don't search for pod if path is already valid
Date: Wed, 08 Jan 1997 15:25:19 -0800
From: Wayne Scott <wscott@ichips.intel.com>
Files: utils/perldoc.PL
Msg-ID: <199701082325.PAA04521@pdxlx008.intel.com>

    (applied based on p5p patch as commit 88f0eda82bb679b4e6445ccb17e18d0781c6a5da)

Subject: Yet another perldoc option
Date: Thu, 3 Oct 1996 00:00:35 +0200
From: Gisle Aas <aas@aas.no>
Files: utils/perldoc.PL
Msg-ID: <199610022200.AAA15334@furubotn.sn.no>

    (applied based on p5p patch as commit a2333f3625faa17fb193cfa25c3d598cb59f105f)

Subject: Re: perldoc, temp files, async pagers
Date: 07 Jan 1997 22:54:14 -0500
From: Roderick Schertler <roderick@gate.net>
Files: utils/perldoc.PL
Msg-ID: <pzwwtoom8p.fsf@eeyore.ibcinc.com>

    (applied based on p5p patch as commit 7c36043de26da560a0f7eb04f36d232762c0092c)

11 files changed, 179 insertions, 23 deletions

diff --git a/t/comp/proto.t b/t/comp/proto.t
index 0d3de96a51..197ea78272 100755
--- a/t/comp/proto.t
+++ b/t/comp/proto.t
@@ -7,6 +7,12 @@
 #
 # It is impossible to test every prototype that can be specified, but
 # we should test as many as we can.
+#
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
 
 use strict;
 
diff --git a/t/io/fs.t b/t/io/fs.t
index 87a3d2f6fb..dc29fda4d9 100755
--- a/t/io/fs.t
+++ b/t/io/fs.t
@@ -73,12 +73,14 @@ if ($ino == 0) {print "ok 20\n";} else {print "not ok 20\n";}
 unlink 'c';
 
 chdir $wd || die "Can't cd back to $wd";
+rmdir 'tmp';
 
 unlink 'c';
 if (`ls -l perl 2>/dev/null` =~ /^l.*->/) {  # we have symbolic links
     if (symlink("TEST","c")) {print "ok 21\n";} else {print "not ok 21\n";}
     $foo = `grep perl c`;
     if ($foo) {print "ok 22\n";} else {print "not ok 22\n";}
+    unlink 'c';
 }
 else {
     print "ok 21\nok 22\n";
diff --git a/t/op/cmp.t b/t/op/cmp.t
index e69de29bb2..aba7c2e9dc 100755
--- a/t/op/cmp.t
+++ b/t/op/cmp.t
@@ -0,0 +1,35 @@
+#!./perl
+
+@FOO = ('s', 'N/A', 'a', 'NaN', -1, undef, 0, 1);
+
+$expect = ($#FOO+2) * ($#FOO+1);
+print "1..$expect\n";
+
+my $ok = 0;
+for my $i (0..$#FOO) {
+    for my $j ($i..$#FOO) {
+	$ok++;
+	my $cmp = $FOO[$i] <=> $FOO[$j];
+	if (!defined($cmp) ||
+	    $cmp == -1 && $FOO[$i] < $FOO[$j] ||
+	    $cmp == 0  && $FOO[$i] == $FOO[$j] ||
+	    $cmp == 1  && $FOO[$i] > $FOO[$j])
+	{
+	    print "ok $ok\n";
+	}
+	else {
+	    print "not ok $ok ($FOO[$i] <=> $FOO[$j])\n";
+	}
+	$ok++;
+	$cmp = $FOO[$i] cmp $FOO[$j];
+	if ($cmp == -1 && $FOO[$i] lt $FOO[$j] ||
+	    $cmp == 0  && $FOO[$i] eq $FOO[$j] ||
+	    $cmp == 1  && $FOO[$i] gt $FOO[$j])
+	{
+	    print "ok $ok\n";
+	}
+	else {
+	    print "not ok $ok ($FOO[$i] cmp $FOO[$j])\n";
+	}
+    }
+}
diff --git a/t/op/method.t b/t/op/method.t
index 7c19ecdfdc..bdbc8a9673 100755
--- a/t/op/method.t
+++ b/t/op/method.t
@@ -4,7 +4,7 @@
 # test method calls and autoloading.
 #
 
-print "1..18\n";
+print "1..20\n";
 
 @A::ISA = 'B';
 @B::ISA = 'C';
@@ -24,11 +24,15 @@ test( A->d, "C::d");		# Update hash table;
 *B::d = \&D::d;			# Import now.
 test (A->d, "D::d");		# Update hash table;
 
-eval 'sub B::d {"B::d1"}';	# Import now.
-test (A->d, "B::d1");		# Update hash table;
+{
+    local *B::d;
+    eval 'sub B::d {"B::d1"}';	# Import now.
+    test (A->d, "B::d1");	# Update hash table;
+    undef &B::d;
+    test ((eval { A->d }, ($@ =~ /Undefined subroutine/)), 1);
+}
 
-undef &B::d;			# Should work without any help too
-test (A->d, "C::d");
+test (A->d, "D::d");		# Back to previous state
 
 eval 'sub B::d {"B::d2"}';	# Import now.
 test (A->d, "B::d2");		# Update hash table;
@@ -54,6 +58,10 @@ test (A->d, "B::d4");		# Update hash table;
 delete $B::{d};			# Should work without any help too
 test (A->d, "C::d");
 
+*A::x = *A::d;			# See if cache incorrectly follows synonyms
+A->d;
+test (eval { A->x } || "nope", "nope");
+
 eval <<'EOF';
 sub C::e;
 sub Y::f;
@@ -91,9 +99,9 @@ test(Y->f(), "B: In Y::f, 3");	# Which sticks
 
 *B::AUTOLOAD = sub {
   my $c = ++$counter;
-  my $method = $main::__ANON__; 
-  *$main::__ANON__ = sub { "new B: In $method, $c" };
-  goto &$main::__ANON__;
+  my $method = $AUTOLOAD; 
+  *$AUTOLOAD = sub { "new B: In $method, $c" };
+  goto &$AUTOLOAD;
 };
 
 test(A->eee(), "new B: In A::eee, 4");	# We get a correct $autoload
diff --git a/t/op/misc.t b/t/op/misc.t
index 6d591c0556..4f47f0f7af 100755
--- a/t/op/misc.t
+++ b/t/op/misc.t
@@ -39,6 +39,10 @@ for (@prgs){
 __END__
 ()=()
 ########
+$a = ":="; split /($a)/o, "a:=b:=c"; print "@_"
+EXPECT
+a := b := c
+########
 $cusp = ~0 ^ (~0 >> 1);
 $, = " ";
 print +($cusp - 1) % 8, $cusp % 8, -$cusp % 8, ($cusp + 1) % 8, "!\n";
@@ -255,3 +259,13 @@ print p::func()->groovy(), "\n"
 EXPECT
 really groovy
 ########
+($k, $s)  = qw(x 0);
+@{$h{$k}} = qw(1 2 4);
+for (@{$h{$k}}) { $s += $_; delete $h{$k} if ($_ == 2) }
+print "bogus\n" unless $s == 7;
+########
+my $a = 'outer';
+eval q[ my $a = 'inner'; eval q[ print "$a " ] ];
+eval { my $x = 'peace'; eval q[ print "$x\n" ] }
+EXPECT
+inner peace
diff --git a/t/op/universal.t b/t/op/universal.t
index e69de29bb2..3e075cff43 100755
--- a/t/op/universal.t
+++ b/t/op/universal.t
@@ -0,0 +1,38 @@
+#!./perl
+#
+# check UNIVERSAL
+#
+
+print "1..4\n";
+
+# explicit bless
+
+$a = {};
+bless $a, "Bob";
+if ($a->class eq "Bob") {print "ok 1\n";} else {print "not ok 1\n";}
+
+# bless through a package
+
+package Fred;
+
+$b = {};
+bless $b;
+if ($b->class eq "Fred") {print "ok 2\n";} else {print "not ok 2\n";}
+
+package main;
+
+# same as test 1 and 2, but with other object syntax
+
+# explicit bless
+
+$a = {};
+bless $a, "Bob";
+if (class $a eq "Bob") {print "ok 3\n";} else {print "not ok 3\n";}
+
+# bless through a package
+
+package Fred;
+
+$b = {};
+bless $b;
+if (class $b eq "Fred") {print "ok 4\n";} else {print "not ok 4\n";}
diff --git a/t/pragma/overload.t b/t/pragma/overload.t
index 9c897c31dc..42d045741d 100755
--- a/t/pragma/overload.t
+++ b/t/pragma/overload.t
@@ -291,7 +291,7 @@ test($@ =~ /no method found/);	# 96
   sub { *{"Oscalar::$AUTOLOAD"} = sub {"_!_" . shift() . "_!_"} ;
 	goto &{"Oscalar::$AUTOLOAD"}};
 
-eval "package Oscalar; use overload '~' => 'comple'";
+eval "package Oscalar; sub comple; use overload '~' => 'comple'";
 
 $na = eval { ~$a };		# Hash was not updated
 test($@ =~ /no method found/);	# 97
@@ -299,6 +299,7 @@ test($@ =~ /no method found/);	# 97
 bless \$x, Oscalar;
 
 $na = eval { ~$a };		# Hash updated
+warn "`$na', $@" if $@;
 test !$@;			# 98
 test($na eq '_!_xx_!_');	# 99
 
@@ -315,7 +316,7 @@ print $@;
 test !$@;			# 101
 test($na eq '_!_xx_!_');	# 102
 
-eval "package Oscalar; use overload '>>' => 'rshft'";
+eval "package Oscalar; sub rshft; use overload '>>' => 'rshft'";
 
 $na = eval { $aI >> 1 };	# Hash was not updated
 test($@ =~ /no method found/);	# 103
@@ -330,6 +331,7 @@ print $@;
 test !$@;			# 104
 test($na eq '_!_xx_!_');	# 105
 
+# warn overload::Method($a, '0+'), "\n";
 test (overload::Method($a, '0+') eq \&Oscalar::numify); # 106
 test (overload::Method($aI,'0+') eq \&Oscalar::numify); # 107
 test (overload::Overloaded($aI)); # 108
@@ -341,5 +343,21 @@ test (! defined overload::Method($a, '<')); # 111
 test (overload::StrVal($aI) =~ /^OscalarI=SCALAR\(0x[\da-fA-F]+\)$/); # 112
 test (overload::StrVal(\$aI) eq "@{[\$aI]}"); # 113
 
+# Check overloading by methods (specified deep in the ISA tree).
+{
+  package OscalarII;
+  @ISA = 'OscalarI';
+  sub Oscalar::lshft {"_<<_" . shift() . "_<<_"}
+  eval "package OscalarI; use overload '<<' => 'lshft', '|' => 'lshft'";
+}
+
+$aaII = "087";
+$aII = \$aaII;
+bless $aII, 'OscalarII';
+bless \$fake, 'OscalarI';		# update the hash
+test(($aI | 3) eq '_<<_xx_<<_');	# 114
+# warn $aII << 3;
+test(($aII << 3) eq '_<<_087_<<_');	# 115
+
 # Last test is:
-sub last {113}
+sub last {115}
diff --git a/t/pragma/strict-refs b/t/pragma/strict-refs
index 6d36ff88c9..7bf1556e10 100644
--- a/t/pragma/strict-refs
+++ b/t/pragma/strict-refs
@@ -11,6 +11,8 @@ $c = @{"def"} ;
 $c = %{"def"} ;
 $c = *{"def"} ;
 $c = \&{"def"} ;
+$c = def->[0];
+$c = def->{xyz};
 EXPECT
 
 ########
@@ -72,6 +74,20 @@ EXPECT
 Can't use an undefined value as a symbol reference at - line 5.
 ########
 
+# strict refs - error
+use strict 'refs' ;
+my $a = fred->[0] ;
+EXPECT
+Can't use bareword ("fred") as an ARRAY ref while "strict refs" in use at - line 4.
+########
+
+# strict refs - error
+use strict 'refs' ;
+my $a = fred->{barney} ;
+EXPECT
+Can't use bareword ("fred") as a HASH ref while "strict refs" in use at - line 4.
+########
+
 # strict refs - no error
 use strict ;
 no strict 'refs' ;
diff --git a/t/pragma/strict.t b/t/pragma/strict.t
index bf90266def..0ff849e2be 100755
--- a/t/pragma/strict.t
+++ b/t/pragma/strict.t
@@ -8,10 +8,11 @@ BEGIN {
 
 $| = 1;
 
+my $Is_VMS = $^O eq 'VMS';
 my $tmpfile = "tmp0000";
 my $i = 0 ;
 1 while -f ++$tmpfile;
-END { unlink $tmpfile if $tmpfile; }
+END { if ($tmpfile) { 1 while unlink $tmpfile; } }
 
 my @prgs = () ;
 
@@ -58,12 +59,17 @@ for (@prgs){
 	shift @files ;
 	$prog = shift @files ;
     }
-    open TEST, "| sh -c './perl $switch' >$tmpfile 2>&1";
-    print TEST $prog, "\n";
+    open TEST, ">$tmpfile";
+    print TEST $prog,"\n";
     close TEST;
+    my $results = $Is_VMS ?
+                  `MCR $^X $switch $tmpfile` :
+                  `sh -c './perl $switch $tmpfile' 2>&1`;
     my $status = $?;
-    my $results = `cat $tmpfile`;
     $results =~ s/\n+$//;
+    # allow expected output to be written as if $prog is on STDIN
+    $results =~ s/tmp\d+/-/g;
+    $results =~ s/\n%[A-Z]+-[SIWEF]-.*$// if $Is_VMS;  # clip off DCL status msg
     $expected =~ s/\n+$//;
     my $prefix = ($results =~ s/^PREFIX\n//) ;
     if ( $results =~ s/^SKIPPED\n//) {
diff --git a/t/pragma/subs.t b/t/pragma/subs.t
index cf936d2b9f..33180066e0 100755
--- a/t/pragma/subs.t
+++ b/t/pragma/subs.t
@@ -11,10 +11,11 @@ undef $/;
 my @prgs = split "\n########\n", <DATA>;
 print "1..", scalar @prgs, "\n";
 
+my $Is_VMS = $^O eq 'VMS';
 my $tmpfile = "tmp0000";
 my $i = 0 ;
 1 while -f ++$tmpfile;
-END { unlink $tmpfile if $tmpfile; }
+END {  if ($tmpfile) { 1 while unlink $tmpfile} }
 
 for (@prgs){
     my $switch = "";
@@ -40,12 +41,17 @@ for (@prgs){
 	shift @files ;
 	$prog = shift @files ;
     }
-    open TEST, "| sh -c './perl $switch' >$tmpfile 2>&1";
-    print TEST $prog, "\n";
+    open TEST, ">$tmpfile";
+    print TEST $prog,"\n";
     close TEST;
+    my $results = $Is_VMS ?
+                  `MCR $^X $switch $tmpfile` :
+                  `sh -c './perl $switch $tmpfile' 2>&1`;
     my $status = $?;
-    my $results = `cat $tmpfile`;
     $results =~ s/\n+$//;
+    # allow expected output to be written as if $prog is on STDIN
+    $results =~ s/tmp\d+/-/g;
+    $results =~ s/\n%[A-Z]+-[SIWEF]-.*$// if $Is_VMS;  # clip off DCL status msg
     $expected =~ s/\n+$//;
     my $prefix = ($results =~ s/^PREFIX\n//) ;
     if ( $results =~ s/^SKIPPED\n//) {
diff --git a/t/pragma/warning.t b/t/pragma/warning.t
index c197f35980..3cb5c73569 100755
--- a/t/pragma/warning.t
+++ b/t/pragma/warning.t
@@ -8,10 +8,11 @@ BEGIN {
 
 $| = 1;
 
+my $Is_VMS = $^O eq 'VMS';
 my $tmpfile = "tmp0000";
 my $i = 0 ;
 1 while -f ++$tmpfile;
-END { unlink $tmpfile if $tmpfile; }
+END {  if ($tmpfile) { 1 while unlink $tmpfile} }
 
 my @prgs = () ;
 
@@ -39,6 +40,7 @@ for (@prgs){
     my @temps = () ;
     if (s/^\s*-\w+//){
         $switch = $&;
+        $switch =~ s/(-\S*[A-Z]\S*)/"-$1"/ if $Is_VMS; # protect uc switches
     }
     my($prog,$expected) = split(/\nEXPECT\n/, $_);
     if ( $prog =~ /--FILE--/) {
@@ -58,12 +60,17 @@ for (@prgs){
 	shift @files ;
 	$prog = shift @files ;
     }
-    open TEST, "| sh -c './perl $switch' >$tmpfile 2>&1";
-    print TEST $prog, "\n";
+    open TEST, ">$tmpfile";
+    print TEST $prog,"\n";
     close TEST;
+    my $results = $Is_VMS ?
+                  `MCR $^X $switch $tmpfile` :
+                  `sh -c './perl $switch $tmpfile' 2>&1`;
     my $status = $?;
-    my $results = `cat $tmpfile`;
     $results =~ s/\n+$//;
+    # allow expected output to be written as if $prog is on STDIN
+    $results =~ s/tmp\d+/-/g;
+    $results =~ s/\n%[A-Z]+-[SIWEF]-.*$// if $Is_VMS;  # clip off DCL status msg
     $expected =~ s/\n+$//;
     my $prefix = ($results =~ s/^PREFIX\n//) ;
     if ( $results =~ s/^SKIPPED\n//) {