Index: runtime/string.c =================================================================== --- runtime/string.c (revision 124871) +++ runtime/string.c (working copy) @@ -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, con 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++) Index: libgfortran.h =================================================================== --- libgfortran.h (revision 124871) +++ libgfortran.h (working copy) @@ -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 , and Andy Vaught @@ -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 */ Index: io/open.c =================================================================== --- io/open.c (revision 124871) +++ io/open.c (working copy) @@ -345,7 +345,12 @@ new_unit (st_parameter_open *opp, gfc_un 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: Index: io/list_read.c =================================================================== --- io/list_read.c (revision 124871) +++ io/list_read.c (working copy) @@ -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, name 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. */ Index: io/transfer.c =================================================================== --- io/transfer.c (revision 124871) +++ io/transfer.c (working copy) @@ -2859,13 +2859,15 @@ st_set_nml_var (st_parameter_dt *dtp, vo { 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; Index: io/write.c =================================================================== --- io/write.c (revision 124871) +++ io/write.c (working copy) @@ -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, cons * 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, nam 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, nam /* 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