[patch@35055] vms.c unixpath refactor

[email protected] ("John E. Malmberg")
Newsgroups perl.perl5.porters,perl.vmsperl
Message-ID <[email protected]>
This patch makes a version of unixpath available for calling without an 
implicit context, which is needed for threaded perl as several routines 
currently calling it do not have a or should not need a thread context.

This is the third part of a multi-part conversion to remove access 
violations when internal perl warnings and error routines or memory 
allocation routines are called with a null pointer or the implicit context.

By removing the implicit context from these routines, it will cause a 
compile time error on threaded perl should they be modified to call a 
routine rhat requires that context.

-John
[email protected]
Personal Opinion Only
vms_c_unixpath.gdiff (text/plain, 2.8 KB)
--- /ref4_root/perl/vms/vms.c	Sun Dec  7 09:54:27 2008
+++ vms/vms.c	Sun Dec  7 13:10:49 2008
@@ -8613,46 +8613,60 @@
   { return do_tovmspath(path,buf,1,utf8_fl); }
 
 
+/* Internal tounixpath - Can not use PERL_IMPLICIT_CONTEXT */
+static char *int_tounixpath(const char *path,
+                            char *buf, int * utf8_fl) {
+
+char *pathified, *ret_spec;
+
+    /* No perl context here - no Newx/Safefree */
+    
+    /* First make sure it is a path */
+    pathified = PerlMem_malloc(VMS_MAXRSS);
+    if (int_pathify_dirspec(path, pathified) == NULL) {
+        PerlMem_free(pathified);
+        return NULL;
+    }
+
+    /* Convert this to unix format */
+    ret_spec = int_tounixspec(pathified, buf, utf8_fl);
+
+    PerlMem_free(pathified);
+    return ret_spec;
+}
+
+
 /*{{{ char *tounixpath[_ts](char *path, char *buf, int * utf8_fl)*/
-static char *mp_do_tounixpath(pTHX_ const char *path, char *buf, int ts, int * utf8_fl) {
+static char *mp_do_tounixpath(pTHX_ const char *path, char *buf,
+                              int ts, int * utf8_fl) {
   static char __tounixpath_retbuf[VMS_MAXRSS];
-  int unixlen;
-  char *pathified, *unixified, *cp;
+  char *pathified, *ret_spec, *ret_buf;
 
-  if (path == NULL) return NULL;
-  pathified = PerlMem_malloc(VMS_MAXRSS);
-  if (pathified == NULL) _ckvmssts(SS$_INSFMEM);
-  if (do_pathify_dirspec(path,pathified,0,NULL) == NULL) {
-    PerlMem_free(pathified);
-    return NULL;
-  }
+  /* If an input buffer is not specified, For thread specific, dynamically */
+  /* allocate the return, otherwise use the internal static buffer. */
 
-  unixified = NULL;
-  if (buf == NULL) {
-      Newx(unixified, VMS_MAXRSS, char);
-  }
-  if (do_tounixspec(pathified,buf ? buf : unixified,0,NULL) == NULL) {
-    PerlMem_free(pathified);
-    if (unixified) Safefree(unixified);
-    return NULL;
-  }
-  PerlMem_free(pathified);
-  if (buf) {
-    return buf;
+  pathified = NULL;
+  ret_buf = buf;
+  if (ret_buf == NULL) {
+      if (ts) {
+          Newx(pathified, VMS_MAXRSS, char);
+          if (pathified == NULL)
+              _ckvmssts(SS$_INSFMEM);
+          ret_buf = pathified;
+      } else {
+          ret_buf = __tounixpath_retbuf;
+      }
   }
-  else if (ts) {
-    unixlen = strlen(unixified);
-    Newx(cp,unixlen+1,char);
-    memcpy(cp,unixified,unixlen);
-    cp[unixlen] = '\0';
-    Safefree(unixified);
-    return cp;
-  }
-  else {
-    strcpy(__tounixpath_retbuf,unixified);
-    Safefree(unixified);
-    return __tounixpath_retbuf;
+
+  ret_spec = int_tounixpath(path, ret_buf, utf8_fl);
+
+  if (ret_spec == NULL) {
+      /* Cleanup on isle 5, if this is thread specific we need to deallocate */
+      if (pathified)
+          Safefree(pathified);
   }
+
+  return ret_spec;
 
 }  /* end of do_tounixpath() */
 /*}}}*/
lmpx.com only provides a reader for public news (NNTP) servers. It is not affiliated with the servers or forums shown here and is not responsible for the content of articles, which is written by their respective authors.