--- patchlevel.h-orig	Wed May 17 08:55:19 2000

+++ patchlevel.h	Wed May 17 09:02:26 2000

@@ -73,2 +73,3 @@

+	,"VMSMISC001 - misc VMS fixes, combined patch"

 	,NULL

 };

 

--- iperlsys.h-orig	Wed May 17 08:55:11 2000

+++ iperlsys.h	Wed May 17 08:51:48 2000

@@ -551,7 +551,7 @@

 

 #define PerlDir_mkdir(name, mode)	Mkdir((name), (mode))

 #ifdef VMS

-#  define PerlDir_chdir(n)		chdir(((n) && *(n)) ? (n) : "SYS$LOGIN")

+#  define PerlDir_chdir(n)		Chdir(((n) && *(n)) ? (n) : "SYS$LOGIN")

 #else 

 #  define PerlDir_chdir(name)		chdir((name))

 #endif

--- perlio.c-orig	Wed May 17 08:55:26 2000

+++ perlio.c	Wed May 17 08:53:36 2000

@@ -43,7 +43,11 @@

 PerlIO *

 PerlIO_tmpfile(void)

 {

+#ifndef VMS

  return tmpfile();

+#else

+ return Perl_my_tmpfile();

+#endif

 }

 

 #else /* PERLIO_IS_STDIO */

--- perlsdio.h-orig	Wed May 17 08:55:34 2000

+++ perlsdio.h	Wed May 17 08:53:36 2000

@@ -75,7 +75,11 @@

 #endif

 

 #define PerlIO_rewind(f)		rewind(f)

+#ifndef VMS

 #define PerlIO_tmpfile()		tmpfile()

+#else

+#define PerlIO_tmpfile()		Perl_my_tmpfile()

+#endif

 

 #define PerlIO_importFILE(f,fl)		(f)            

 #define PerlIO_exportFILE(f,fl)		(f)            

--- ext/Devel/DProf/DProf.xs-orig	Wed May 17 08:56:23 2000

+++ ext/Devel/DProf/DProf.xs	Wed May 17 08:52:35 2000

@@ -28,6 +28,7 @@

 #  define HZ ((I32)CLK_TCK)

 #  define DPROF_HZ HZ

 #  include <starlet.h>  /* prototype for sys$gettim() */

+#  include <lib$routines.h> /* prototype for lib$ediv() */

 #  define Times(ptr) (dprof_times(aTHX_ ptr))

 #else

 #  ifndef HZ

--- lib/ExtUtils/MM_VMS.pm-orig	Wed May 17 08:56:48 2000

+++ lib/ExtUtils/MM_VMS.pm	Wed May 17 09:00:24 2000

@@ -231,7 +231,9 @@

 sub find_perl {

     my($self, $ver, $names, $dirs, $trace) = @_;

     my($name,$dir,$vmsfile,@sdirs,@snames,@cand);

+    my($rslt);

     my($inabs) = 0;

+    local *TCF;

     # Check in relative directories first, so we pick up the current

     # version of Perl if we're running MakeMaker as part of the main build.

     @sdirs = sort { my($absa) = $self->file_name_is_absolute($a);

@@ -277,15 +279,28 @@

     foreach $name (@cand) {

 	print "Checking $name\n" if ($trace >= 2);

 	# If it looks like a potential command, try it without the MCR

-	if ($name =~ /^[\w\-\$]+$/ &&

-            `$name -e "require $ver; print ""VER_OK\\n"""` =~ /VER_OK/) {

+        if ($name =~ /^[\w\-\$]+$/) {

+            open(TCF,">temp_mmvms.com") || die('unable to open temp file');

+            print TCF "\$ set message/nofacil/nosever/noident/notext\n";

+            print TCF "\$ $name -e \"require $ver; print \"\"VER_OK\\n\"\"\"\n";

+            close TCF;

+            $rslt = `\@temp_mmvms.com` ;

+            unlink('temp_mmvms.com');

+            if ($rslt =~ /VER_OK/) {

 	    print "Using PERL=$name\n" if $trace;

 	    return $name;

 	}

+        }

 	next unless $vmsfile = $self->maybe_command($name);

 	$vmsfile =~ s/;[\d\-]*$//;  # Clip off version number; we can use a newer version as well

 	print "Executing $vmsfile\n" if ($trace >= 2);

-        if (`MCR $vmsfile -e "require $ver; print ""VER_OK\\n"""` =~ /VER_OK/) {

+        open(TCF,">temp_mmvms.com") || die('unable to open temp file');

+        print TCF "\$ set message/nofacil/nosever/noident/notext\n";

+        print TCF "\$ mcr $vmsfile -e \"require $ver; print \"\"VER_OK\\n\"\"\" \n";

+        close TCF;

+        $rslt = `\@temp_mmvms.com`;

+        unlink('temp_mmvms.com');

+        if ($rslt =~ /VER_OK/) {

 	    print "Using PERL=MCR $vmsfile\n" if $trace;

 	    return "MCR $vmsfile";

 	}

@@ -865,7 +880,11 @@

     if( exists $self->{XSOPT} ){

 	unshift( @tmargs, $self->{XSOPT} );

     }

-

+    if ($Config{'ldflags'} && 

+        $Config{'ldflags'} =~ m!/Debug!i &&

+        (!exists($self->{XSOPT}) || $self->{XSOPT} !~ /linenumbers/)) {

+        unshift(@tmargs,'-nolinenumbers');

+    }

     my $xsubpp_version = $self->xsubpp_version($self->catfile($xsdir,'xsubpp'));

 

     # What are the correct thresholds for version 1 && 2 Paul?

@@ -1018,7 +1037,7 @@

 

     # Sanitize these for use in $(DISTVNAME) filespec

     $attribs{VERSION} =~ s/[^\w\$]/_/g;

-    $attribs{NAME} =~ s/[^\w\$]/_/g;

+    $attribs{NAME} =~ s/[^\w\$]/-/g;

 

     return ExtUtils::MM_Unix::dist($self,%attribs);

 }

@@ -1194,8 +1213,8 @@

 	                   s/.*[:>\/\]]//;       # Trim off dir spec

 			   $upcase ? uc($_) : $_;

 	                 } split ' ', $self->eliminate_macros($self->{OBJECT});

-	my($tmp,@lines,$elt) = '';

-	my $tmp = shift @omods;

+        my($tmp, @lines,$elt) = '';

+	$tmp = shift @omods;

 	foreach $elt (@omods) {

 	    $tmp .= ",$elt";

 		if (length($tmp) > 80) { push @lines, $tmp;  $tmp = ''; }

@@ -1652,6 +1671,9 @@

 zipdist : $(DISTVNAME).zip

 	$(NOECHO) $(NOOP)

 

+tardist : $(DISTVNAME).tar$(SUFFIX)

+	$(NOECHO) $(NOOP)

+

 $(DISTVNAME).zip : distdir

 	$(PREOP)

 	$(ZIP) "$(ZIPFLAGS)" $(MMS$TARGET) [.$(DISTVNAME)...]*.*;

@@ -1661,7 +1683,7 @@

 $(DISTVNAME).tar$(SUFFIX) : distdir

 	$(PREOP)

 	$(TO_UNIX)

-	$(TAR) "$(TARFLAGS)" $(DISTVNAME).tar [.$(DISTVNAME)]

+        $(TAR) "$(TARFLAGS)" $(DISTVNAME).tar [.$(DISTVNAME)...]

 	$(RM_RF) $(DISTVNAME)

 	$(COMPRESS) $(DISTVNAME).tar

 	$(POSTOP)

@@ -1922,6 +1944,7 @@

 	$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" Makefile.PL ],join(' ',map(qq["$_"],@ARGV)),q[

 	$(NOECHO) $(SAY) "$(MAKEFILE) has been rebuilt."

 	$(NOECHO) $(SAY) "Please run $(MMS) to build the extension."

+	$(NOECHO) spawn/nolog/nonotify exit 44

 ];

 

     join('',@m);

--- lib/File/Basename.pm-orig	Wed May 17 08:57:01 2000

+++ lib/File/Basename.pm	Wed May 17 08:53:00 2000

@@ -189,9 +189,13 @@

   }

   elsif ($fstype !~ /^VMS/i) {  # default to Unix

     ($dirpath,$basename) = ($fullname =~ m#^(.*/)?(.*)#s);

-    if ($^O eq 'VMS' and $fullname =~ m:/[^/]+/000000/?:) {

+    if ($^O eq 'VMS' and $fullname =~ m:^(/[^/]+/000000(/|$))(.*):) {

       # dev:[000000] is top of VMS tree, similar to Unix '/'

-      ($basename,$dirpath) = ('',$fullname);

+      # so strip it off and treat the rest as "normal"

+      my $devspec  = $1;

+      my $remainder = $3;

+      ($dirpath,$basename) = ($remainder =~ m#^(.*/)?(.*)#s);

+      $dirpath = $devspec.$dirpath;

     }

     $dirpath = './' unless $dirpath;

   }

--- t/lib/glob-basic.t-orig	Wed May 17 08:57:34 2000

+++ t/lib/glob-basic.t	Wed May 17 08:49:11 2000

@@ -39,7 +39,7 @@

 

 # look up the user's home directory

 # should return a list with one item, and not set ERROR

-if ($^O ne 'MSWin32' || $^O ne 'VMS') {

+if ($^O ne 'MSWin32' && $^O ne 'VMS') {

   eval {

     ($name, $home) = (getpwuid($>))[0,7];

     1;

@@ -99,7 +99,7 @@

 

 @a = File::Glob::glob(

     '{TES*,doesntexist*,a,b}',

-    GLOB_BRACE | GLOB_NOMAGIC

+    GLOB_BRACE | GLOB_NOMAGIC | ($^O eq 'VMS' ? GLOB_NOCASE : 0)

 );

 unless (@a == 3

         and $a[0] eq ($^O eq 'VMS'? 'test.' : 'TEST')

--- t/pod/testp2pt.pl-orig	Wed May 17 08:57:43 2000

+++ t/pod/testp2pt.pl	Wed May 17 08:53:01 2000

@@ -42,7 +42,7 @@

 sub catfile(@) { File::Spec->catfile(@_); }

 

 my $INSTDIR = abs_path(dirname $0);

-$INSTDIR = VMS::Filespec::unixpath($INSTDIR) if $^O eq 'VMS';

+$INSTDIR = lc(VMS::Filespec::unixpath($INSTDIR)) if $^O eq 'VMS';

 $INSTDIR =~ s#/$## if $^O eq 'VMS';

 $INSTDIR = (dirname $INSTDIR) if (basename($INSTDIR) eq 'pod');

 $INSTDIR = (dirname $INSTDIR) if (basename($INSTDIR) eq 't');

--- vms/subconfigure.com-orig	Wed May 17 09:00:25 2000

+++ vms/subconfigure.com	Wed May 17 09:00:26 2000

@@ -219,7 +219,6 @@

 $ perl_cc=Mcc

 $ perl_d_sockpair="undef"

 $ perl_i_neterrno="define"

-$ perl_ldflags="/NoTrace/NoMap"

 $ perl_d_lchown="undef"

 $ perl_d_mknod="undef"

 $ perl_d_union_semun="undef"

@@ -3665,9 +3664,11 @@

 $ then

 $     perl_optimize="/Debug/NoOpt"

 $     perl_dbgprefix = "DBG"

+$     perl_ldflags="/Debug/Trace/NoMap"

 $ else

 $     perl_optimize= ""

 $     perl_dbgprefix = ""

+$     perl_ldflags="/NoTrace/NoMap"

 $ endif

 $!

 $! Okay, we've got everything configured. Now go write out a config.sh.

--- vms/vms.c-orig	Wed May 17 08:58:32 2000

+++ vms/vms.c	Wed May 17 08:53:39 2000

@@ -897,6 +897,9 @@

   STRLEN dirlen = strlen(dir);

   dTHX;

 

+  /* zero length string sometimes gives ACCVIO */

+  if (dirlen == 0) return -1;

+

   /* CRTL mkdir() doesn't tolerate trailing /, since that implies

    * null file name/type.  However, it's commonplace under Unix,

    * so we'll allow it for a gain in portability.

@@ -911,6 +914,30 @@

 }  /* end of my_mkdir */

 /*}}}*/

 

+/*{{{int my_chdir(char *)*/

+int

+my_chdir(char *dir)

+{

+  STRLEN dirlen = strlen(dir);

+  dTHX;

+

+  /* zero length string sometimes gives ACCVIO */

+  if (dirlen == 0) return -1;

+

+  /* some versions of CRTL chdir() doesn't tolerate trailing /, since 

+   * that implies

+   * null file name/type.  However, it's commonplace under Unix,

+   * so we'll allow it for a gain in portability.

+   */

+  if (dir[dirlen-1] == '/') {

+    char *newdir = savepvn(dir,dirlen-1);

+    int ret = chdir(newdir);

+    Safefree(newdir);

+    return ret;

+  }

+  else return chdir(dir);

+}  /* end of my_chdir */

+/*}}}*/

 

 static void

 create_mbx(unsigned short int *chan, struct dsc$descriptor_s *namdsc)

@@ -1460,7 +1487,7 @@

       set_errno(EINVAL); set_vaxc_errno(SS$_BADPARAM); return NULL;

     }

     dirlen = strlen(dir);

-    while (dir[dirlen-1] == '/') --dirlen;

+    while (dirlen && dir[dirlen-1] == '/') --dirlen;

     if (!dirlen) { /* We had Unixish '/' -- substitute top of current tree */

       strcpy(trndir,"/sys$disk/000000");

       dir = trndir;

@@ -1486,7 +1513,7 @@

      *    ... do_fileify_dirspec("myroot",buf,1) ...

      * does something useful.

      */

-    if (!strcmp(dir+dirlen-2,".]")) {

+    if (dirlen >= 2 && !strcmp(dir+dirlen-2,".]")) {

       dir[--dirlen] = '\0';

       dir[dirlen-1] = ']';

     }

@@ -1516,7 +1543,7 @@

                  (dir[2] == '\0' || (dir[2] == '/' && dir[3] == '\0')))

           return do_fileify_dirspec("[-]",buf,ts);

       }

-      if (dir[dirlen-1] == '/') {    /* path ends with '/'; just add .dir;1 */

+      if (dirlen && dir[dirlen-1] == '/') {    /* path ends with '/'; just add .dir;1 */

         dirlen -= 1;                 /* to last element */

         lastdir = strrchr(dir,'/');

       }

@@ -1543,7 +1570,7 @@

         } while ((cp1 = strstr(cp1,"/.")) != NULL);

         lastdir = strrchr(dir,'/');

       }

-      else if (!strcmp(&dir[dirlen-7],"/000000")) {

+      else if (dirlen >= 7 && !strcmp(&dir[dirlen-7],"/000000")) {

         /* Ditto for specs that end in an MFD -- let the VMS code

          * figure out whether it's a real device or a rooted logical. */

         dir[dirlen] = '/'; dir[dirlen+1] = '\0';

@@ -4648,7 +4675,7 @@

   retsts = sys$check_access(&objtyp,&namdsc,&usrdsc,armlst);

   if (retsts == SS$_NOPRIV      || retsts == SS$_NOSUCHOBJECT ||

       retsts == SS$_INVFILFOROP || retsts == RMS$_FNF || retsts == RMS$_SYN ||

-      retsts == RMS$_DIR        || retsts == RMS$_DEV) {

+      retsts == RMS$_DIR        || retsts == RMS$_DEV || retsts == RMS$_DNF) {

     set_vaxc_errno(retsts);

     if (retsts == SS$_NOPRIV) set_errno(EACCES);

     else if (retsts == SS$_INVFILFOROP) set_errno(EINVAL);

@@ -5199,4 +5226,36 @@

   return;

 }

   

+/* 

+    once AGAIN, we're working around the deficiencies of the CRTL...

+

+    the normal CRTL tmpfile is fine, *except* when our default is set

+    to a disk where we don't have any quota...

+

+    this routine makes a temp file in SYS$SCRATCH as a fallback

+    we open in write/update mode, with "delete on close" 

+*/

+

+

+FILE *

+Perl_my_tmpfile(void)

+{

+    FILE *f;

+    char *p,*q; 

+

+    f = tmpfile();

+    if (f) return f;

+

+

+    p = malloc(100+L_tmpnam);

+    strcpy(p,"sys$scratch:ptmp_");

+    q = p + strlen(p);

+    tmpnam(q);

+    strcat(p,".");

+    f = fopen(p,"w+","fop=dlt");

+    free(p);

+    return f;

+}

+

+

 /*  End of vms.c */

--- vms/vmsish.h-orig	Wed May 17 08:58:13 2000

+++ vms/vmsish.h	Wed May 17 08:53:40 2000

@@ -109,6 +109,7 @@

 #define do_rmdir		Perl_do_rmdir

 #define kill_file		Perl_kill_file

 #define my_mkdir		Perl_my_mkdir

+#define my_chdir		Perl_my_chdir

 #define my_utime		Perl_my_utime

 #define rmsexpand	Perl_rmsexpand

 #define rmsexpand_ts	Perl_rmsexpand_ts

@@ -447,8 +448,9 @@

 /* Ditto for sys$hash_passwrod() . . . */

 #define crypt  my_crypt

 

-/* Tweak arg to mkdir first, so we can tolerate trailing /. */

+/* Tweak arg to mkdir & chdir first, so we can tolerate trailing /. */

 #define Mkdir(dir,mode) my_mkdir((dir),(mode))

+#define Chdir(dir) my_chdir((dir))

 

 /* Use our own stat() clones, which handle Unix-style directory names */

 #define Stat(name,bufptr) flex_stat(name,bufptr)

@@ -638,6 +640,7 @@

 int	do_rmdir (char *);

 int	kill_file (char *);

 int	my_mkdir (char *, Mode_t);

+int	my_chdir (char *);

 int	my_utime (char *, struct utimbuf *);

 char *	rmsexpand (char *, char *, char *, unsigned);

 char *	rmsexpand_ts (char *, char *, char *, unsigned);

@@ -688,6 +691,7 @@

 void	my_endpwent ();

 char *	my_getlogin ();

 int	rmscopy (char *, char *, int);

+FILE * Perl_my_tmpfile(void);

 typedef char __VMS_SEPYTOTORP__;

 /* prototype section end marker; `typedef' passes through cpp */



--- vms/test.com-orig	Fri May 19 11:18:28 2000

+++ vms/test.com	Wed May 24 06:41:21 2000

@@ -93,7 +93,8 @@

 $!  And do it

 $   Show Process/Accounting

 $   testdir = "Directory/NoHead/NoTrail/Column=1"

-$   Define/User 'dbg'Perlshr Sys$Disk:[-]'dbg'PerlShr'exe'

+$   old_perlshr = f$trnlnm("''dbg'Perlshr")

+$   Define 'dbg'Perlshr Sys$Disk:[-]'dbg'PerlShr'exe'

 $   MCR Sys$Disk:[]Perl. "-I[-.lib]" - "''p3'" "''p4'" "''p5'" "''p6'"

 $   Deck/Dollar=$$END-OF-TEST$$

 # $RCSfile: TEST,v $$Revision: 4.1 $$Date: 92/08/07 18:27:00 $

@@ -244,4 +245,6 @@

 $   If F$Search("Echo.Exe").nes."" Then Delete/Log/NoConfirm Echo.Exe;*

 $   Set Default &olddef

 $   Set Message 'oldmsg'

+$   deassign 'dbg'Perlshr

+$   if old_perlshr .nes. "" then Define 'dbg'Perlshr 'old_perlshr'

 $   Exit

 

--- lib/file/path.pm-orig	Wed May 24 16:26:13 2000

+++ lib/file/path.pm	Thu May 25 09:25:34 2000

@@ -119,15 +119,18 @@

     my(@created,$path);

     foreach $path (@$paths) {

 	$path .= '/' if $^O eq 'os2' and $path =~ /^\w:\z/s; # feature of CRT 

-	next if -d $path;

 	# Logic wants Unix paths, so go with the flow.

-	$path = VMS::Filespec::unixify($path) if $Is_VMS;

-	my $parent = File::Basename::dirname($path);

-	# Allow for creation of new logical filesystems under VMS

-	if (not $Is_VMS or $parent !~ m:/[^/]+/000000/?:) {

-	    unless (-d $parent or $path eq $parent) {

-		push(@created,mkpath($parent, $verbose, $mode));

+	if ($Is_VMS) {

+	    next if $path eq '/';

+	    $path = VMS::Filespec::unixify($path);

+	    if ($path =~ m:^(/[^/]+)/?\z:) {

+	        $path = $1.'/000000';

 	    }

+	}

+	next if -d $path;

+	my $parent = File::Basename::dirname($path);

+	unless (-d $parent or $path eq $parent) {

+	    push(@created,mkpath($parent, $verbose, $mode));

 	}

 	print "mkdir $path\n" if $verbose;

 	unless (mkdir($path,$mode)) {

--- t/op/lex_assign.t-orig	Thu May 25 13:27:25 2000

+++ t/op/lex_assign.t	Thu May 25 13:27:18 2000

@@ -171,7 +171,7 @@

 __END__

 ref $xref			# ref

 ref $cstr			# ref nonref

-`$runme -e "print qq[1\n]"`				# backtick skip(MSWin32)

+`$runme -e "print qq[1\\n]"`				# backtick skip(MSWin32)

 `$undefed`			# backtick undef skip(MSWin32)

 <*>				# glob

 <OP>				# readline

