In perl.git, the branch blead has been updated

<http://perl5.git.perl.org/perl.git/commitdiff/2e82b6ce46e012458b738a5c24d9ed52f5a54d3d?hp=8da0169c5cf5e6fd8ad2fceb04286b6a44ca381d>

- Log -----------------------------------------------------------------
commit 2e82b6ce46e012458b738a5c24d9ed52f5a54d3d
Author: Craig A. Berry <[email protected]>
Date:   Fri Dec 20 18:11:15 2013 -0600

    Fix unescaped first character in tovmsspec.
    
    Passing a path to int_tovmsspec that contained an "extended"
    character as the first character when converting a Unix filespec
    to VMS format skipped escaping that character, but only when the
    path spec had no directory component.  The character that didn't
    get escaped could then be passed to a native service that choked
    or incorrectly processed it.  For example ' foo.txt' remained,
    after translation, ' foo.txt', but parsing that as a native spec
    would squeeze out the leading space.
    
    So we now make sure we don't eat the first character of the
    filename component while processing the directory component and
    also handle escaping the very first character.  In the example
    of ' foo.txt', it now gets correctly translated to '^_foo.txt'.
-----------------------------------------------------------------------

Summary of changes:
 ext/VMS-Filespec/t/filespec.t | 4 +++-
 vms/vms.c                     | 8 ++------
 2 files changed, 5 insertions(+), 7 deletions(-)

diff --git a/ext/VMS-Filespec/t/filespec.t b/ext/VMS-Filespec/t/filespec.t
index f84efb3..09ee7f9 100644
--- a/ext/VMS-Filespec/t/filespec.t
+++ b/ext/VMS-Filespec/t/filespec.t
@@ -31,8 +31,9 @@ if ($^O eq 'VMS') {
 
 
 foreach $test (@tests) {
-  ($arg,$func,$expect2,$expect5) = split(/\s+/,$test);
+  ($arg,$func,$expect2,$expect5) = split(/(?<!\\)\s+/,$test);
 
+  $arg =~ s/\\//g; # to get whitespace into the argument escape with \
   $expect2 = undef if $expect2 eq 'undef';
   $expect2 = undef if $expect2 eq '^';
   $expect5 = undef if $expect5 eq 'undef';
@@ -125,6 +126,7 @@ __some_/__where_/...   vmsify  [.__some_.__where_...] ^
 ./$(macro)     vmsify  []$(macro) ^
 ./$(m+ vmsify  []$^(m^+        ^
 foo-bar-0^.01/ vmsify [.foo-bar-0_01] [.foo-bar-0^.01]
+\ foo.tmp      vmsify ^_foo.tmp ^
 # Fileifying directory specs
 __down_:[__the_.__garden_.__path_]     fileify 
__down_:[__the_.__garden_]__path_.dir;1 ^
 [.__down_.__the_.__garden_.__path_]    fileify 
[.__down_.__the_.__garden_]__path_.dir;1 ^
diff --git a/vms/vms.c b/vms/vms.c
index d1cb948..cbc47d2 100644
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -8537,9 +8537,6 @@ static char *int_tovmsspec
     }
     else *(cp1++) = '.';
   }
-  else {
-    *(cp1++) = *cp2;
-  }
   for (; cp2 < dirend; cp2++) {
     if (*cp2 == '/') {
       if (*(cp2-1) == '/') continue;
@@ -8597,8 +8594,7 @@ static char *int_tovmsspec
   }
   if (cp1 > rslt && *(cp1-1) == '.') cp1--; /* Unix spec ending in '/' ==> 
trailing '.' */
   if (hasdir) *(cp1++) = ']';
-  if (*cp2) cp2++;  /* check in case we ended with trailing '..' */
-  /* fixme for ODS5 */
+  if (*cp2 && *cp2 == '/') cp2++;  /* check in case we ended with trailing '/' 
*/
   no_type_seen = 0;
   if (cp2 > lastdot)
     no_type_seen = 1;
@@ -8611,7 +8607,7 @@ static char *int_tovmsspec
          *(cp1++) = '?';
        cp2++;
     case ' ':
-       if (cp2 > path && *(cp2-1) != '^') /* not previously escaped */
+       if (cp2 >= path && (cp2 == path || *(cp2-1) != '^')) /* not previously 
escaped */
            *(cp1)++ = '^';
        *(cp1)++ = '_';
        cp2++;

--
Perl5 Master Repository

Reply via email to