Commit 88fdfd5a by Janne Blomqvist

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
parent c132497f
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> 2007-05-26 Janne Blomqvist <jb@gcc.gnu.org>
* io/unix.c (unix_stream): Rearrange struct members, remove * io/unix.c (unix_stream): Rearrange struct members, remove
......
/* 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 Contributed by Andy Vaught
Namelist input contributed by Paul Thomas Namelist input contributed by Paul Thomas
...@@ -1859,8 +1859,8 @@ nml_touch_nodes (namelist_info * nl) ...@@ -1859,8 +1859,8 @@ nml_touch_nodes (namelist_info * nl)
index_type len = strlen (nl->var_name) + 1; index_type len = strlen (nl->var_name) + 1;
int dim; int dim;
char * ext_name = (char*)get_mem (len + 1); char * ext_name = (char*)get_mem (len + 1);
strcpy (ext_name, nl->var_name); memcpy (ext_name, nl->var_name, len-1);
strcat (ext_name, "%"); memcpy (ext_name + len - 1, "%", 2);
for (nl = nl->next; nl; nl = nl->next) for (nl = nl->next; nl; nl = nl->next)
{ {
if (strncmp (nl->var_name, ext_name, len) == 0) 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, ...@@ -2133,8 +2133,8 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info * nl, index_type offset,
case GFC_DTYPE_DERIVED: case GFC_DTYPE_DERIVED:
obj_name_len = strlen (nl->var_name) + 1; obj_name_len = strlen (nl->var_name) + 1;
obj_name = get_mem (obj_name_len+1); obj_name = get_mem (obj_name_len+1);
strcpy (obj_name, nl->var_name); memcpy (obj_name, nl->var_name, obj_name_len-1);
strcat (obj_name, "%"); memcpy (obj_name + obj_name_len - 1, "%", 2);
/* If reading a derived type, disable the expanded read warning /* If reading a derived type, disable the expanded read warning
since a single object can have multiple reads. */ since a single object can have multiple reads. */
......
...@@ -345,7 +345,12 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags) ...@@ -345,7 +345,12 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags)
break; break;
opp->file = tmpname; 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); opp->file_len = sprintf(opp->file, "fort.%d", (int) opp->common.unit);
#endif
break; break;
default: default:
......
...@@ -2852,13 +2852,15 @@ st_set_nml_var (st_parameter_dt *dtp, void * var_addr, char * var_name, ...@@ -2852,13 +2852,15 @@ st_set_nml_var (st_parameter_dt *dtp, void * var_addr, char * var_name,
{ {
namelist_info *t1 = NULL; namelist_info *t1 = NULL;
namelist_info *nml; namelist_info *nml;
size_t var_name_len = strlen (var_name);
nml = (namelist_info*) get_mem (sizeof (namelist_info)); nml = (namelist_info*) get_mem (sizeof (namelist_info));
nml->mem_pos = var_addr; nml->mem_pos = var_addr;
nml->var_name = (char*) get_mem (strlen (var_name) + 1); nml->var_name = (char*) get_mem (var_name_len + 1);
strcpy (nml->var_name, var_name); memcpy (nml->var_name, var_name, var_name_len);
nml->var_name[var_name_len] = '\0';
nml->len = (int) len; nml->len = (int) len;
nml->string_length = (index_type) string_length; nml->string_length = (index_type) string_length;
......
/* 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 Contributed by Andy Vaught
Namelist output contributed by Paul Thomas Namelist output contributed by Paul Thomas
...@@ -545,8 +545,13 @@ output_float (st_parameter_dt *dtp, const fnode *f, GFC_REAL_LARGEST value) ...@@ -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 * equal to the precision. The exponent always contains at least two
* digits; if the value is zero, the exponent is 00. * 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) ".*" sprintf (buffer, "%+-#" STR(MIN_FIELD_WIDTH) ".*"
GFC_REAL_LARGEST_FORMAT "e", ndigits - 1, value); GFC_REAL_LARGEST_FORMAT "e", ndigits - 1, value);
#endif
/* Check the resulting string has punctuation in the correct places. */ /* Check the resulting string has punctuation in the correct places. */
if (d != 0 && (buffer[2] != '.' || buffer[ndigits + 2] != 'e')) 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, ...@@ -1610,6 +1615,9 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset,
char rep_buff[NML_DIGITS]; char rep_buff[NML_DIGITS];
namelist_info * cmp; namelist_info * cmp;
namelist_info * retval = obj->next; 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, /* Write namelist variable names in upper case. If a derived type,
nothing is output. If a component, base and base_name are set. */ 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, ...@@ -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 */ /* First ext_name => get length of all possible components */
ext_name = (char*)get_mem ( (base_name ? strlen (base_name) : 0) base_name_len = base_name ? strlen (base_name) : 0;
+ (base ? strlen (base->var_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) + strlen (obj->var_name)
+ obj->var_rank * NML_DIGITS + obj->var_rank * NML_DIGITS
+ 1); + 1);
strcpy(ext_name, base_name ? base_name : ""); memcpy (ext_name, base_name, base_name_len);
clen = base ? strlen (base->var_name) : 0; clen = strlen (obj->var_name + base_var_name_len);
strcat (ext_name, obj->var_name + clen); memcpy (ext_name + base_name_len,
obj->var_name + base_var_name_len, clen);
/* Append the qualifier. */ /* Append the qualifier. */
tot_len = base_name_len + clen;
for (dim_i = 0; dim_i < obj->var_rank; dim_i++) for (dim_i = 0; dim_i < obj->var_rank; dim_i++)
{ {
strcat (ext_name, dim_i ? "" : "("); if (!dim_i)
clen = strlen (ext_name); {
st_sprintf (ext_name + clen, "%d", (int) obj->ls[dim_i].idx); ext_name[tot_len] = '(';
strcat (ext_name, (dim_i == obj->var_rank - 1) ? ")" : ","); 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. */ /* Now obj_name. */
obj_name_len = strlen (obj->var_name) + 1; obj_name_len = strlen (obj->var_name) + 1;
obj_name = get_mem (obj_name_len+1); obj_name = get_mem (obj_name_len+1);
strcpy (obj_name, obj->var_name); memcpy (obj_name, obj->var_name, obj_name_len-1);
strcat (obj_name, "%"); memcpy (obj_name + obj_name_len-1, "%", 2);
/* Now loop over the components. Update the component pointer /* Now loop over the components. Update the component pointer
with the return value from nml_write_obj => this loop jumps with the return value from nml_write_obj => this loop jumps
......
/* Common declarations for all of libgfortran. /* 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 Contributed by Paul Brook <paul@nowt.org>, and
Andy Vaught <andy@xena.eas.asu.edu> Andy Vaught <andy@xena.eas.asu.edu>
...@@ -650,17 +650,17 @@ internal_proto(get_unformatted_convert); ...@@ -650,17 +650,17 @@ internal_proto(get_unformatted_convert);
/* string.c */ /* 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 *); const st_option *, const char *);
internal_proto(find_option); internal_proto(find_option);
extern int fstrlen (const char *, int); extern gfc_charlen_type fstrlen (const char *, gfc_charlen_type);
internal_proto(fstrlen); 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); 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); internal_proto(cf_strcpy);
/* io/intrinsics.c */ /* io/intrinsics.c */
......
/* Copyright (C) 2002, 2003, 2005 Free Software Foundation, Inc. /* Copyright (C) 2002, 2003, 2005, 2007 Free Software Foundation, Inc.
Contributed by Paul Brook Contributed by Paul Brook
This file is part of the GNU Fortran 95 runtime library (libgfortran). This file is part of the GNU Fortran 95 runtime library (libgfortran).
...@@ -37,64 +37,77 @@ Boston, MA 02110-1301, USA. */ ...@@ -37,64 +37,77 @@ Boston, MA 02110-1301, USA. */
zero if not equal, nonzero if equal. */ zero if not equal, nonzero if equal. */
static int 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. */ /* Strip trailing blanks from the Fortran string. */
len = fstrlen (s1, s1_len); 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; return strncasecmp (s1, s2, len) == 0;
} }
/* Given a fortran string, return its length exclusive of the trailing /* Given a fortran string, return its length exclusive of the trailing
spaces. */ spaces. */
int
fstrlen (const char *string, int len) gfc_charlen_type
fstrlen (const char *string, gfc_charlen_type len)
{ {
for (len--; len >= 0; len--) for (; len > 0; len--)
if (string[len] != ' ') if (string[len-1] != ' ')
break; break;
return len + 1; return len;
} }
void /* Copy a Fortran string (not null-terminated, hence length arguments
fstrcpy (char *dest, int destlen, const char *src, int srclen) 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) if (srclen >= destlen)
{ {
/* This will truncate if too long. */ /* This will truncate if too long. */
memcpy (dest, src, destlen); memcpy (dest, src, destlen);
return destlen;
} }
else else
{ {
memcpy (dest, src, srclen); memcpy (dest, src, srclen);
/* Pad with spaces. */ /* Pad with spaces. */
memset (&dest[srclen], ' ', destlen - srclen); memset (&dest[srclen], ' ', destlen - srclen);
return srclen;
} }
} }
void /* Copy a null-terminated C string to a non-null-terminated Fortran
cf_strcpy (char *dest, int dest_len, const char *src) 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); src_len = strlen (src);
if (src_len >= dest_len) if (src_len >= (size_t) dest_len)
{ {
/* This will truncate if too long. */ /* This will truncate if too long. */
memcpy (dest, src, dest_len); memcpy (dest, src, dest_len);
return dest_len;
} }
else else
{ {
memcpy (dest, src, src_len); memcpy (dest, src, src_len);
/* Pad with spaces. */ /* Pad with spaces. */
memset (&dest[src_len], ' ', dest_len - src_len); 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) ...@@ -104,7 +117,7 @@ cf_strcpy (char *dest, int dest_len, const char *src)
if no default is provided. */ if no default is provided. */
int 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) const st_option * opts, const char *error_message)
{ {
for (; opts->name; opts++) for (; opts->name; opts++)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment