From: Gurusamy Sarathy <gsar@cpan.org>
Date: Sun, 7 May 2000 01:24:19 +0000 (+0000)
Subject: workaround for CRT bug in chdir() (from Charles Lane, via
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=101e51674871122572db1eb9982dc8d132eb2ae9;p=p5sagit%2Fp5-mst-13.2.git

workaround for CRT bug in chdir() (from Charles Lane, via
Peter Prymmer)

p4raw-id: //depot/perl@6078
---

diff --git a/iperlsys.h b/iperlsys.h
index f36dcd5..59da474 100644
--- a/iperlsys.h
+++ b/iperlsys.h
@@ -551,7 +551,7 @@ struct IPerlDirInfo
 
 #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
diff --git a/vms/vms.c b/vms/vms.c
index c18ca49..c50d828 100644
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -911,6 +911,30 @@ my_mkdir(char *dir, Mode_t mode)
 }  /* 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)
diff --git a/vms/vmsish.h b/vms/vmsish.h
index e53c604..c21f8f3 100644
--- a/vms/vmsish.h
+++ b/vms/vmsish.h
@@ -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 @@ struct utimbuf {
 /* 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 @@ char *	my_gconvert (double, int, int, char *);
 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);