symlink() wrapper for VMS that prevents the creation of symlinks

with zero-length names.  The standards disallow that and the test
suite gets indigestion.

p4raw-id: //depot/perl@32037

diff --git a/vms/vms.c b/vms/vms.c
index 40e80a2..01fb235 100644 (file)
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -12721,7 +12721,22 @@ vms_realpath_fromperl(pTHX_ CV *cv)
     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);

diff --git a/vms/vmsish.h b/vms/vmsish.h
index a0a52a3..178934e 100644 (file)
--- a/vms/vmsish.h
+++ b/vms/vmsish.h
@@ -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 @@ struct interp_intern {
 #  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_aspawn (pTHX_ void *, void **, void **);
 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);