build

Message-ID: <20021213215404.GA2597@math.berkeley.edu>

p4raw-id: //depot/perl@18316

diff --git a/os2/os2.c b/os2/os2.c
index fc05f4e..49b1736 100644 (file)
--- a/os2/os2.c
+++ b/os2/os2.c
@@ -2637,18 +2637,30 @@ my_tmpfile ()
 
 #undef rmdir
 
+/* EMX flavors do not tolerate trailing slashes.  t/op/mkdir.t has many
+   trailing slashes, so we need to support this as well. */
+
 int
 my_rmdir (__const__ char *s)
 {
-    char buf[MAXPATHLEN];
+    char b[MAXPATHLEN];
+    char *buf = b;
     STRLEN l = strlen(s);
+    int rc;
 
-    if (s[l-1] == '/' || s[l-1] == '\\') {     /* EMX rmdir fails... */
+    if (s[l-1] == '/' || s[l-1] == '\\') {     /* EMX mkdir fails... */
+       if (l >= sizeof b)
+           New(1305, buf, l + 1, char);
        strcpy(buf,s);
-       buf[l - 1] = 0;
+       while (l > 1 && (s[l-1] == '/' || s[l-1] == '\\'))
+           l--;
+       buf[l] = 0;
        s = buf;
     }
-    return rmdir(s);
+    rc = rmdir(s);
+    if (b != buf)
+       Safefree(buf);
+    return rc;
 }
 
 #undef mkdir
@@ -2656,15 +2668,24 @@ my_rmdir (__const__ char *s)
 int
 my_mkdir (__const__ char *s, long perm)
 {
-    char buf[MAXPATHLEN];
+    char b[MAXPATHLEN];
+    char *buf = b;
     STRLEN l = strlen(s);
+    int rc;
 
     if (s[l-1] == '/' || s[l-1] == '\\') {     /* EMX mkdir fails... */
+       if (l >= sizeof b)
+           New(1305, buf, l + 1, char);
        strcpy(buf,s);
-       buf[l - 1] = 0;
+       while (l > 1 && (s[l-1] == '/' || s[l-1] == '\\'))
+           l--;
+       buf[l] = 0;
        s = buf;
     }
-    return mkdir(s, perm);
+    rc = mkdir(s, perm);
+    if (b != buf)
+       Safefree(buf);
+    return rc;
 }
 
 #undef flock

diff --git a/t/run/runenv.t b/t/run/runenv.t
index f3a5a06..9acad00 100644 (file)
--- a/t/run/runenv.t
+++ b/t/run/runenv.t
@@ -39,6 +39,10 @@ sub runperl {
 
   $stdout = '' unless defined $stdout;
   $stderr = '' unless defined $stderr;
+  local %ENV = %ENV;
+  delete $ENV{PERLLIB};
+  delete $ENV{PERL5LIB};
+  delete $ENV{PERL5OPT};
   my $pid = fork;
   return (0, "Couldn't fork: $!") unless defined $pid;   # failure
   if ($pid) {                   # parent
@@ -149,22 +153,22 @@ try({PERL5OPT => '-t'},
     '1',
     '');
 
-try({PERLLIB => "foobar:42"},
+try({PERLLIB => "foobar$Config{path_sep}42"},
     ['-e', 'print grep { $_ eq "foobar" } @INC'],
     'foobar',
     '');
 
-try({PERLLIB => "foobar:42"},
+try({PERLLIB => "foobar$Config{path_sep}42"},
     ['-e', 'print grep { $_ eq "42" } @INC'],
     '42',
     '');
 
-try({PERL5LIB => "foobar:42"},
+try({PERL5LIB => "foobar$Config{path_sep}42"},
     ['-e', 'print grep { $_ eq "foobar" } @INC'],
     'foobar',
     '');
 
-try({PERL5LIB => "foobar:42"},
+try({PERL5LIB => "foobar$Config{path_sep}42"},
     ['-e', 'print grep { $_ eq "42" } @INC'],
     '42',
     '');