From: John E. Malmberg Date: Wed, 10 Aug 2005 23:26:03 +0000 (-0400) Subject: [patch] blead@25282 - VMS specific fixes. [2nd try] X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=16ed468695c21630f18883bfbedc3d5170ddc8b2;p=p5sagit%2Fp5-mst-13.2.git [patch] blead@25282 - VMS specific fixes. [2nd try] From: "John E. Malmberg" Message-ID: <42FAC54B.2050207@qsl.net> p4raw-id: //depot/perl@25284 --- diff --git a/lib/Test/Harness/Straps.pm b/lib/Test/Harness/Straps.pm index 74ddaa5..59f8e60 100644 --- a/lib/Test/Harness/Straps.pm +++ b/lib/Test/Harness/Straps.pm @@ -356,7 +356,6 @@ sub _command { my $self = shift; return $ENV{HARNESS_PERL} if defined $ENV{HARNESS_PERL}; - return "MCR $^X" if $self->{_is_vms}; return Win32::GetShortPathName($^X) if $self->{_is_win32}; return $^X; } diff --git a/lib/vmsish.t b/lib/vmsish.t index 71ca3b5..f40e434 100644 --- a/lib/vmsish.t +++ b/lib/vmsish.t @@ -5,7 +5,10 @@ BEGIN { @INC = '../lib'; } -my $Invoke_Perl = qq(MCR $^X "-I[-.lib]"); +my $perl = $^X; +$perl = VMS::Filespec::vmsify($perl) if $^O eq 'VMS'; + +my $Invoke_Perl = qq(MCR $perl "-I[-.lib]"); require "./test.pl"; plan(tests => 25); diff --git a/t/lib/warnings/doio b/t/lib/warnings/doio index a451846..a7165ad 100644 --- a/t/lib/warnings/doio +++ b/t/lib/warnings/doio @@ -60,10 +60,10 @@ __END__ # doio.c [Perl_do_open9] use warnings 'io' ; -open(F, '|'.($^O eq 'VMS' ? 'mcr ':'')."$^X -e 1|"); +open(F, '|'."$^X -e 1|"); close(F); no warnings 'io' ; -open(G, '|'.($^O eq 'VMS' ? 'mcr ':'')."$^X -e 1|"); +open(G, '|'."$^X -e 1|"); close(G); EXPECT Can't open bidirectional pipe at - line 3. diff --git a/t/op/anonsub.t b/t/op/anonsub.t index ddfcd47..970440b 100755 --- a/t/op/anonsub.t +++ b/t/op/anonsub.t @@ -32,7 +32,7 @@ for (@prgs){ print TEST "$prog\n"; close TEST or die "Could not close: $!"; my $results = $Is_VMS ? - `MCR $^X "-I[-.lib]" $switch $tmpfile 2>&1` : + `$^X "-I[-.lib]" $switch $tmpfile 2>&1` : $Is_MSWin32 ? `.\\perl -I../lib $switch $tmpfile 2>&1` : $Is_MacOS ? diff --git a/t/op/chdir.t b/t/op/chdir.t index 3a00df2..cb24da8 100644 --- a/t/op/chdir.t +++ b/t/op/chdir.t @@ -138,6 +138,10 @@ END { # Restore the environment for VMS (and doesn't hurt for anyone else) @ENV{@magic_envs} = @Saved_Env{@magic_envs}; + + # On VMS this must be deleted or process table is wrong on exit + # when this script is run interactively. + delete $ENV{'SYS$LOGIN'} if $IsVMS; } diff --git a/t/op/closure.t b/t/op/closure.t index 574656b..78087a0 100755 --- a/t/op/closure.t +++ b/t/op/closure.t @@ -466,7 +466,7 @@ END my $errfile = "terr$$"; $errfile++ while -e $errfile; my @tmpfiles = ($cmdfile, $errfile); open CMD, ">$cmdfile"; print CMD $code; close CMD; - my $cmd = (($^O eq 'VMS') ? "MCR $^X" + my $cmd = (($^O eq 'VMS') ? "$^X" : ($^O eq 'MSWin32') ? '.\perl' : ($^O eq 'MacOS') ? $^X : ($^O eq 'NetWare') ? 'perl' diff --git a/t/op/lex_assign.t b/t/op/lex_assign.t index 59d422e..c6c424d 100755 --- a/t/op/lex_assign.t +++ b/t/op/lex_assign.t @@ -8,7 +8,7 @@ BEGIN { $| = 1; umask 0; $xref = \ ""; -$runme = ($^O eq 'VMS' ? 'MCR ' : '') . $^X; +$runme = $^X; @a = (1..5); %h = (1..6); $aref = \@a; diff --git a/t/op/runlevel.t b/t/op/runlevel.t index 531b862..36c63ef 100755 --- a/t/op/runlevel.t +++ b/t/op/runlevel.t @@ -34,7 +34,7 @@ for (@prgs){ print TEST "$prog\n"; close TEST or die "Could not close: $!"; my $results = $Is_VMS ? - `MCR $^X "-I[-.lib]" $switch $tmpfile 2>&1` : + `$^X "-I[-.lib]" $switch $tmpfile 2>&1` : $Is_MSWin32 ? `.\\perl -I../lib $switch $tmpfile 2>&1` : $Is_NetWare ? diff --git a/t/op/stat.t b/t/op/stat.t index 924c5f4..6eb5c9a 100755 --- a/t/op/stat.t +++ b/t/op/stat.t @@ -49,6 +49,8 @@ close FOO; open(FOO, ">$tmpfile") || DIE("Can't open temp test file: $!"); my($nlink, $mtime, $ctime) = (stat(FOO))[$NLINK, $MTIME, $CTIME]; + +#VMS Fix-me: nlink should work on VMS if applicable link support configured. SKIP: { skip "No link count", 1 if $Is_VMS; @@ -212,6 +214,16 @@ SKIP: { skip "Skipping: unexpected ls output in MP-RAS", 6 if $Is_MPRAS; + # VMS problem: If GNV or other UNIX like tool is installed, then + # sometimes Perl will find /bin/ls, and will try to run it. + # But since Perl on VMS does not know to run it under Bash, it will + # try to run the DCL verb LS. And if the VMS product Language + # Sensitive Editor is installed, or some other LS verb, that will + # be run instead. So do not do this until we can teach Perl + # when to use BASH on VMS. + skip "ls command not available to Perl in OpenVMS right now.", 6 + if $Is_VMS; + my $LS = $Config{d_readlink} ? "ls -lL" : "ls -l"; my $CMD = "$LS /dev 2>/dev/null"; my $DEV = qx($CMD); diff --git a/t/pod/find.t b/t/pod/find.t index 7f8476d..2058601 100644 --- a/t/pod/find.t +++ b/t/pod/find.t @@ -88,6 +88,7 @@ print "### found $result\n"; require Config; if ($^O eq 'VMS') { # privlib is perl_root:[lib] OK but not under mms + $result = VMS::Filespec::vmsify($result); #if you want VMS you need to force it. $compare = "lib.File]Find.pm"; $result =~ s/perl_root:\[\-?\.?//i; $result =~ s/\[\-?\.?//i; # needed under `mms test` diff --git a/t/x2p/s2p.t b/t/x2p/s2p.t index 39c6cd8..85df364 100755 --- a/t/x2p/s2p.t +++ b/t/x2p/s2p.t @@ -791,6 +791,8 @@ my $s2p = File::Spec->catfile( File::Spec->updir(), 'x2p', 's2p' ); my $psed = File::Spec->catfile( File::Spec->curdir(), 'psed' ); if ($^O eq 'VMS') { # default in the .com extenson if it's not already there + $s2p = VMS::Filespec::vmsify($s2p); + $psed = VMS::Filespec::vmsify($psed); $s2p = VMS::Filespec::rmsexpand($s2p, '.com'); $psed = VMS::Filespec::rmsexpand($psed, '.com'); } diff --git a/utils/c2ph.PL b/utils/c2ph.PL index 799e39f..11ab606 100644 --- a/utils/c2ph.PL +++ b/utils/c2ph.PL @@ -1435,9 +1435,9 @@ sub repeat_template { close OUT or die "Can't close $file: $!"; chmod 0755, $file or die "Can't reset permissions for $file: $!\n"; unlink 'pstruct'; -print "Linking c2ph to pstruct.\n"; +print "Linking $file to pstruct.\n"; if (defined $Config{d_link}) { - link 'c2ph', 'pstruct'; + link $file, 'pstruct'; } else { unshift @INC, '../lib'; require File::Copy; diff --git a/vms/ext/Stdio/test.pl b/vms/ext/Stdio/test.pl index 2b2f7be..77505d8 100755 --- a/vms/ext/Stdio/test.pl +++ b/vms/ext/Stdio/test.pl @@ -5,6 +5,10 @@ import VMS::Stdio qw(&flush &getname &rewind &sync &tmpnam); print "1..18\n"; print +(defined(&getname) ? '' : 'not '), "ok 1\n"; +#VMS can pretend that it is UNIX. +my $perl = $^X; +$perl = VMS::Filespec::vmsify($perl) if $^O eq 'VMS'; + $name = "test$$"; $name++ while -e "$name.tmp"; $fh = VMS::Stdio::vmsopen("+>$name",'ctx=rec','shr=put','fop=dlt','dna=.tmp'); @@ -28,6 +32,11 @@ chop($line = <$fh>); print +($line eq localtime($time) ? '' : 'not '), "ok 9\n"; ($gotname) = (getname($fh) =~/\](.*);/); + +#we may be in UNIX emulation mode. +if (!defined($gotname)) { + ($gotname) = (VMS::Filespec::vmsify(getname($fh)) =~/\](.*)/); +} print +("\U$gotname" eq "\U$name.tmp" ? '' : 'not '), "ok 10\n"; $sfh = VMS::Stdio::vmssysopen($name, O_RDONLY, 0, @@ -43,7 +52,7 @@ print +(stat("$name.tmp") ? 'not ' : ''),"ok 13\n"; print +(&VMS::Stdio::tmpnam ? '' : 'not '),"ok 14\n"; -#if (open(P, qq[| MCR $^X -e "1 while ();print 'Foo';1 while (); print 'Bar'" >$name.tmp])) { +#if (open(P, qq[| $^X -e "1 while ();print 'Foo';1 while (); print 'Bar'" >$name.tmp])) { # print P "Baz\nQuux\n"; # print +(VMS::Stdio::writeof(P) ? '' : 'not '),"ok 15\n"; # print P "Baz\nQuux\n"; @@ -59,7 +68,7 @@ print "ok 15\nok 16\nok 17\n"; #} $sfh = VMS::Stdio::vmsopen(">$name.tmp"); -$setuperl = "\$ MCR $^X\nBEGIN { \@INC = qw(@INC) };\nuse VMS::Stdio qw(&setdef);"; +$setuperl = "\$ MCR $perl\nBEGIN { \@INC = qw(@INC) };\nuse VMS::Stdio qw(&setdef);"; print $sfh qq[\$ here = F\$Environment("Default")\n]; print $sfh "$setuperl\nsetdef();\n\$ Show Default\n\$ Set Default 'here'\n"; print $sfh "$setuperl\nsetdef('..');\n\$ Show Default\n";