[PATCH perl@7065] another VMS my_fwrite() fix for Storable

I've finally nailed the bug that was causing Storable failures on VMS, and 
once again it's our little friend my_fwrite().  This routine had never been 
put through the wringer with binary data before Storable came along, and it 
was depending on having null-terminated strings without taking steps to 
ensure that it got them.  The enclosed patch makes it take those steps.  
Without this, binary store operations tended to write too much data since they 
just kept going until they bumped into a null byte.  Ouch.

Since writing to a file is a rather primitive operation, it seemed safest to 
avoid any Perl API features such as New(), croak(), etc.  croak(), for 
example, definitely calls this, so it would just end up recursing until it 
blew the stack.

All Storable tests now pass with -des configure in the following environments:
	
	Compaq C V6.2-007 on OpenVMS Alpha V7.2-1
	DEC C V5.2-003 on OpenVMS Alpha V7.1


--- vms/vms.c;-0        Fri Sep  8 14:46:49 2000
+++ vms/vms.c   Sat Sep 16 01:59:09 2000
@@ -4695,24 +4695,37 @@
 /* 
  * A simple fwrite replacement which outputs itmsz*nitm chars without
  * introducing record boundaries every itmsz chars.
+ * We are using fputs, which depends on a terminating null.  We may
+ * well be writing binary data, so we need to accommodate not only
+ * data with nulls sprinkled in the middle but also data with no null 
+ * byte at the end.
  */
 /*{{{ int my_fwrite(void *src, size_t itmsz, size_t nitm, FILE *dest)*/
 int
 my_fwrite(void *src, size_t itmsz, size_t nitm, FILE *dest)
 {
-  register char *cp, *end;
+  register char *cp, *end, *cpd, *data;
+  int retval;
+  int bufsize = itmsz*nitm+1;
 
-  end = (char *)src + itmsz * nitm;
+  _ckvmssts_noperl(lib$get_vm( &bufsize, &data ));
+  memcpy( data, src, itmsz*nitm );
+  data[itmsz*nitm] = '\0';
 
-  while ((char *)src <= end) {
-    for (cp = src; cp <= end; cp++) if (!*cp) break;
-    if (fputs(src,dest) == EOF) return EOF;
+  end = data + itmsz * nitm;
+  retval = (int) nitm; /* on success return # items written */
+
+  cpd = data;
+  while (cpd <= end) {
+    for (cp = cpd; cp <= end; cp++) if (!*cp) break;
+    if (fputs(cpd,dest) == EOF) { retval = EOF; break; }
     if (cp < end)
-      if (fputc('\0',dest) == EOF) return EOF;
-    src = cp + 1;
+      if (fputc('\0',dest) == EOF) { retval = EOF; break; }
+    cpd = cp + 1;
   }
 
-  return nitm;
+  if (data) _ckvmssts_noperl(lib$free_vm( &bufsize, &data ));
+  return retval;
 
 }  /* end of my_fwrite() */
 /*}}}*/
[END OF PATCH] 
_______________________________________________
Craig A. Berry                                   
mailto:craig.berry@psinetcs.com

• [PATCH perl@7065] another VMS my_fwrite() fix for Storable by Craig A. Berry