Change 32037 by [EMAIL PROTECTED] on 2007/10/05 22:37:23

        symlink() wrapper for VMS that prevents the creation of symlinks
        with zero-length names.  The standards disallow that and the test
        suite gets indigestion.

Affected files ...

... //depot/perl/vms/vms.c#209 edit
... //depot/perl/vms/vmsish.h#88 edit

Differences ...

==== //depot/perl/vms/vms.c#209 (text) ====
Index: perl/vms/vms.c
--- perl/vms/vms.c#208~31850~   2007-09-12 01:03:00.000000000 -0700
+++ perl/vms/vms.c      2007-10-05 15:37:23.000000000 -0700
@@ -12721,7 +12721,22 @@
     Safefree(rslt_spec);
   XSRETURN(1);
 }
-#endif
+
+/*
+ * A thin wrapper around decc$symlink to make sure we follow the 
+ * standard and do not create a symlink with a zero-length name.
+ */
+/*{{{ int my_symlink(const char *path1, const char *path2)*/
+int my_symlink(const char *path1, const char *path2) {
+  if (!path2 || !*path2) {
+    SETERRNO(ENOENT, SS$_NOSUCHFILE);
+    return -1;
+  }
+  return symlink(path1, path2);
+}
+/*}}}*/
+
+#endif /* HAS_SYMLINK */
 
 #if __CRTL_VER >= 70301000 && !defined(__VAX)
 int do_vms_case_tolerant(void);

==== //depot/perl/vms/vmsish.h#88 (text) ====
Index: perl/vms/vmsish.h
--- perl/vms/vmsish.h#87~31970~ 2007-09-25 11:00:32.000000000 -0700
+++ perl/vms/vmsish.h   2007-10-05 15:37:23.000000000 -0700
@@ -274,6 +274,9 @@
 #define my_getpwent()          Perl_my_getpwent(aTHX)
 #define my_endpwent()          Perl_my_endpwent(aTHX)
 #define my_getlogin            Perl_my_getlogin
+#ifdef HAS_SYMLINK
+#  define my_symlink           Perl_my_symlink
+#endif
 #define init_os_extras         Perl_init_os_extras
 #define vms_realpath(a, b, c)  Perl_vms_realpath(aTHX_ a,b,c)
 #define vms_case_tolerant(a)   Perl_vms_case_tolerant(a)
@@ -507,6 +510,9 @@
 #  define fwrite my_fwrite     /* for PerlSIO_fwrite */
 #  define fdopen my_fdopen
 #  define fclose my_fclose
+#ifdef HAS_SYMLINK
+#  define symlink my_symlink
+#endif
 #endif
 
 
@@ -958,7 +964,10 @@
 unsigned long int      Perl_do_spawn (pTHX_ const char *);
 FILE *  my_fdopen (int, const char *);
 int     my_fclose (FILE *);
-int    my_fwrite (const void *, size_t, size_t, FILE *);
+int     my_fwrite (const void *, size_t, size_t, FILE *);
+#ifdef HAS_SYMLINK
+int     my_symlink(const char *path1, const char *path2);
+#endif
 int    Perl_my_flush (pTHX_ FILE *);
 struct passwd *        Perl_my_getpwnam (pTHX_ const char *name);
 struct passwd *        Perl_my_getpwuid (pTHX_ Uid_t uid);
End of Patch.

Reply via email to