string.c (compare0): Use gfc_charlen_type instead of int.

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.

From-SVN: r125100

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 1df8b3c937e83f4484e19119d78afca401d9a379..246eee50289f4b14a77dccc95a3aed06f5bcd83d 100644 (file)
--- 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 9e2e0f91484ce34aba60dc807f61165487e01b92..b06b1cab9297f48ebb24f20590b18533143eceed 100644 (file)
--- 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 55c376939e89200254c8589c229da28079cc509a..68be74b978f576d2a55b5ced60c559c521a25bb8 100644 (file)
--- 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 128b4c1be5933d805d0a73489b992a5d4a4510ff..24bcc5e1a3eea5ada7fe18e5408788d0a63c10e1 100644 (file)
--- 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 ecee33032c941f2cc0c32578af114ea8b9a82534..e0c507f4750570a59b8a3bf81255ced09ba85b50 100644 (file)
--- 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 c98d01d60439c4862a58e3c30af012e260ec7d3a..d42302a3002f1015dbfdc33d5acca0092b6477af 100644 (file)
--- 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 a0c44980feb60b645125b15d0cf77880439e1cd5..c0f70ef8ad2776614a83392950d0a8f37d29b377 100644 (file)
--- 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++)