2007-05-27 Janne Blomqvist <jb@gcc.gnu.org>

	* runtime/string.c (compare0): Use gfc_charlen_type instead of int.
	(fstrlen): Likewise.
	(find_option): Likewise.
	(fstrcpy): Use gfc_charlen_type instead of int, return length.
	(cf_strcpy): Likewise.
	* libgfortran.h: Change string prototypes to use gfc_charlen_type.
	* io/open.c (new_unit): Use snprintf if available.
	* io/list_read.c (nml_touch_nodes): Use memcpy instead of strcpy/strcat.
	(nml_read_obj): Likewise.
	* io/transfer.c (st_set_nml_var): Likewise.
	* io/write.c (output_float): Use snprintf if available.
	(nml_write_obj) Use memcpy instead of strcpy/strcat.
	



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@125100 138bc75d-0d04-0410-961f-82ee72b054a4

7 files changed, 97 insertions, 41 deletions

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 1df8b3c937e..246eee50289 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,20 @@
+2007-05-27  Janne Blomqvist  <jb@gcc.gnu.org>
+
+	* runtime/string.c (compare0): Use gfc_charlen_type instead of
+	int.
+	(fstrlen): Likewise.
+	(find_option): Likewise.
+	(fstrcpy): Use gfc_charlen_type instead of int, return length.
+	(cf_strcpy): Likewise.
+	* libgfortran.h: Change string prototypes to use gfc_charlen_type.
+	* io/open.c (new_unit): Use snprintf if available.
+	* io/list_read.c (nml_touch_nodes): Use memcpy instead of
+	strcpy/strcat.
+	(nml_read_obj): Likewise.
+	* io/transfer.c (st_set_nml_var): Likewise.
+	* io/write.c (output_float): Use snprintf if available.
+	(nml_write_obj) Use memcpy instead of strcpy/strcat.
+
 2007-05-26  Janne Blomqvist  <jb@gcc.gnu.org>
 
 	* io/unix.c (unix_stream): Rearrange struct members, remove
diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c
index 9e2e0f91484..b06b1cab929 100644
--- a/libgfortran/io/list_read.c
+++ b/libgfortran/io/list_read.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
+/* Copyright (C) 2002, 2003, 2004, 2005, 2007 Free Software Foundation, Inc.
    Contributed by Andy Vaught
    Namelist input contributed by Paul Thomas
 
@@ -1859,8 +1859,8 @@ nml_touch_nodes (namelist_info * nl)
   index_type len = strlen (nl->var_name) + 1;
   int dim;
   char * ext_name = (char*)get_mem (len + 1);
-  strcpy (ext_name, nl->var_name);
-  strcat (ext_name, "%");
+  memcpy (ext_name, nl->var_name, len-1);
+  memcpy (ext_name + len - 1, "%", 2);
   for (nl = nl->next; nl; nl = nl->next)
     {
       if (strncmp (nl->var_name, ext_name, len) == 0)
@@ -2133,8 +2133,8 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info * nl, index_type offset,
 	  case GFC_DTYPE_DERIVED:
 	    obj_name_len = strlen (nl->var_name) + 1;
 	    obj_name = get_mem (obj_name_len+1);
-	    strcpy (obj_name, nl->var_name);
-	    strcat (obj_name, "%");
+	    memcpy (obj_name, nl->var_name, obj_name_len-1);
+	    memcpy (obj_name + obj_name_len - 1, "%", 2);
 
 	    /* If reading a derived type, disable the expanded read warning
 	       since a single object can have multiple reads.  */
diff --git a/libgfortran/io/open.c b/libgfortran/io/open.c
index 55c376939e8..68be74b978f 100644
--- a/libgfortran/io/open.c
+++ b/libgfortran/io/open.c
@@ -345,7 +345,12 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags)
 	break;
 
       opp->file = tmpname;
+#ifdef HAVE_SNPRINTF
+      opp->file_len = snprintf(opp->file, sizeof (tmpname), "fort.%d", 
+			       (int) opp->common.unit);
+#else
       opp->file_len = sprintf(opp->file, "fort.%d", (int) opp->common.unit);
+#endif
       break;
 
     default:
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index 128b4c1be59..24bcc5e1a3e 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -2852,13 +2852,15 @@ st_set_nml_var (st_parameter_dt *dtp, void * var_addr, char * var_name,
 {
   namelist_info *t1 = NULL;
   namelist_info *nml;
+  size_t var_name_len = strlen (var_name);
 
   nml = (namelist_info*) get_mem (sizeof (namelist_info));
 
   nml->mem_pos = var_addr;
 
-  nml->var_name = (char*) get_mem (strlen (var_name) + 1);
-  strcpy (nml->var_name, var_name);
+  nml->var_name = (char*) get_mem (var_name_len + 1);
+  memcpy (nml->var_name, var_name, var_name_len);
+  nml->var_name[var_name_len] = '\0';
 
   nml->len = (int) len;
   nml->string_length = (index_type) string_length;
diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c
index ecee33032c9..e0c507f4750 100644
--- a/libgfortran/io/write.c
+++ b/libgfortran/io/write.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
    Contributed by Andy Vaught
    Namelist output contributed by Paul Thomas
 
@@ -545,8 +545,13 @@ output_float (st_parameter_dt *dtp, const fnode *f, GFC_REAL_LARGEST value)
    *   equal to the precision. The exponent always contains at least two
    *   digits; if the value is zero, the exponent is 00.
    */
+#ifdef HAVE_SNPRINTF
+  snprintf (buffer, sizeof (buffer), "%+-#" STR(MIN_FIELD_WIDTH) ".*"
+	   GFC_REAL_LARGEST_FORMAT "e", ndigits - 1, value);
+#else
   sprintf (buffer, "%+-#" STR(MIN_FIELD_WIDTH) ".*"
 	   GFC_REAL_LARGEST_FORMAT "e", ndigits - 1, value);
+#endif
 
   /* Check the resulting string has punctuation in the correct places.  */
   if (d != 0 && (buffer[2] != '.' || buffer[ndigits + 2] != 'e'))
@@ -1610,6 +1615,9 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset,
   char rep_buff[NML_DIGITS];
   namelist_info * cmp;
   namelist_info * retval = obj->next;
+  size_t base_name_len;
+  size_t base_var_name_len;
+  size_t tot_len;
 
   /* Write namelist variable names in upper case. If a derived type,
      nothing is output.  If a component, base and base_name are set.  */
@@ -1755,32 +1763,43 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset,
 
 	      /* First ext_name => get length of all possible components  */
 
-	      ext_name = (char*)get_mem ( (base_name ? strlen (base_name) : 0)
-					+ (base ? strlen (base->var_name) : 0)
+	      base_name_len = base_name ? strlen (base_name) : 0;
+	      base_var_name_len = base ? strlen (base->var_name) : 0;
+	      ext_name = (char*)get_mem ( base_name_len
+					+ base_var_name_len
 					+ strlen (obj->var_name)
 					+ obj->var_rank * NML_DIGITS
 					+ 1);
 
-	      strcpy(ext_name, base_name ? base_name : "");
-	      clen = base ? strlen (base->var_name) : 0;
-	      strcat (ext_name, obj->var_name + clen);
-
+	      memcpy (ext_name, base_name, base_name_len);
+	      clen = strlen (obj->var_name + base_var_name_len);
+	      memcpy (ext_name + base_name_len, 
+		      obj->var_name + base_var_name_len, clen);
+	      
 	      /* Append the qualifier.  */
 
+	      tot_len = base_name_len + clen;
 	      for (dim_i = 0; dim_i < obj->var_rank; dim_i++)
 		{
-		  strcat (ext_name, dim_i ? "" : "(");
-		  clen = strlen (ext_name);
-		  st_sprintf (ext_name + clen, "%d", (int) obj->ls[dim_i].idx);
-		  strcat (ext_name, (dim_i == obj->var_rank - 1) ? ")" : ",");
+		  if (!dim_i)
+		    {
+		      ext_name[tot_len] = '(';
+		      tot_len++;
+		    }
+		  st_sprintf (ext_name + tot_len, "%d", (int) obj->ls[dim_i].idx);
+		  tot_len += strlen (ext_name + tot_len);
+		  ext_name[tot_len] = (dim_i == obj->var_rank - 1) ? ')' : ',';
+		  tot_len++;
 		}
 
+	      ext_name[tot_len] = '\0';
+
 	      /* Now obj_name.  */
 
 	      obj_name_len = strlen (obj->var_name) + 1;
 	      obj_name = get_mem (obj_name_len+1);
-	      strcpy (obj_name, obj->var_name);
-	      strcat (obj_name, "%");
+	      memcpy (obj_name, obj->var_name, obj_name_len-1);
+	      memcpy (obj_name + obj_name_len-1, "%", 2);
 
 	      /* Now loop over the components. Update the component pointer
 		 with the return value from nml_write_obj => this loop jumps
diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h
index c98d01d6043..d42302a3002 100644
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -1,5 +1,5 @@
 /* Common declarations for all of libgfortran.
-   Copyright (C) 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
+   Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
    Contributed by Paul Brook <paul@nowt.org>, and
    Andy Vaught <andy@xena.eas.asu.edu>
 
@@ -650,17 +650,17 @@ internal_proto(get_unformatted_convert);
 
 /* string.c */
 
-extern int find_option (st_parameter_common *, const char *, int,
+extern int find_option (st_parameter_common *, const char *, gfc_charlen_type,
 			const st_option *, const char *);
 internal_proto(find_option);
 
-extern int fstrlen (const char *, int);
+extern gfc_charlen_type fstrlen (const char *, gfc_charlen_type);
 internal_proto(fstrlen);
 
-extern void fstrcpy (char *, int, const char *, int);
+extern gfc_charlen_type fstrcpy (char *, gfc_charlen_type, const char *, gfc_charlen_type);
 internal_proto(fstrcpy);
 
-extern void cf_strcpy (char *, int, const char *);
+extern gfc_charlen_type cf_strcpy (char *, gfc_charlen_type, const char *);
 internal_proto(cf_strcpy);
 
 /* io/intrinsics.c */
diff --git a/libgfortran/runtime/string.c b/libgfortran/runtime/string.c
index a0c44980feb..c0f70ef8ad2 100644
--- a/libgfortran/runtime/string.c
+++ b/libgfortran/runtime/string.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2002, 2003, 2005 Free Software Foundation, Inc.
+/* Copyright (C) 2002, 2003, 2005, 2007 Free Software Foundation, Inc.
    Contributed by Paul Brook
 
 This file is part of the GNU Fortran 95 runtime library (libgfortran).
@@ -37,64 +37,77 @@ Boston, MA 02110-1301, USA.  */
    zero if not equal, nonzero if equal.  */
 
 static int
-compare0 (const char *s1, int s1_len, const char *s2)
+compare0 (const char *s1, gfc_charlen_type s1_len, const char *s2)
 {
-  int len;
+  size_t len;
 
   /* Strip trailing blanks from the Fortran string.  */
   len = fstrlen (s1, s1_len);
-  if (len != (int) strlen(s2)) return 0; /* don't match */
+  if (len != strlen(s2)) return 0; /* don't match */
   return strncasecmp (s1, s2, len) == 0;
 }
 
 
 /* Given a fortran string, return its length exclusive of the trailing
    spaces.  */
-int
-fstrlen (const char *string, int len)
+
+gfc_charlen_type
+fstrlen (const char *string, gfc_charlen_type len)
 {
-  for (len--; len >= 0; len--)
-    if (string[len] != ' ')
+  for (; len > 0; len--)
+    if (string[len-1] != ' ')
       break;
 
-  return len + 1;
+  return len;
 }
 
 
-void
-fstrcpy (char *dest, int destlen, const char *src, int srclen)
+/* Copy a Fortran string (not null-terminated, hence length arguments
+   for both source and destination strings. Returns the non-padded
+   length of the destination.  */
+
+gfc_charlen_type
+fstrcpy (char *dest, gfc_charlen_type destlen, 
+	 const char *src, gfc_charlen_type srclen)
 {
   if (srclen >= destlen)
     {
       /* This will truncate if too long.  */
       memcpy (dest, src, destlen);
+      return destlen;
     }
   else
     {
       memcpy (dest, src, srclen);
       /* Pad with spaces.  */
       memset (&dest[srclen], ' ', destlen - srclen);
+      return srclen;
     }
 }
 
 
-void
-cf_strcpy (char *dest, int dest_len, const char *src)
+/* Copy a null-terminated C string to a non-null-terminated Fortran
+   string. Returns the non-padded length of the destination string.  */
+
+gfc_charlen_type
+cf_strcpy (char *dest, gfc_charlen_type dest_len, const char *src)
 {
-  int src_len;
+  size_t src_len;
 
   src_len = strlen (src);
 
-  if (src_len >= dest_len)
+  if (src_len >= (size_t) dest_len)
     {
       /* This will truncate if too long.  */
       memcpy (dest, src, dest_len);
+      return dest_len;
     }
   else
     {
       memcpy (dest, src, src_len);
       /* Pad with spaces.  */
       memset (&dest[src_len], ' ', dest_len - src_len);
+      return src_len;
     }
 }
 
@@ -104,7 +117,7 @@ cf_strcpy (char *dest, int dest_len, const char *src)
    if no default is provided.  */
 
 int
-find_option (st_parameter_common *cmp, const char *s1, int s1_len,
+find_option (st_parameter_common *cmp, const char *s1, gfc_charlen_type s1_len,
 	     const st_option * opts, const char *error_message)
 {
   for (; opts->name; opts++)