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
This commit is contained in:
Janne Blomqvist
parent
c132497f1b
commit
88fdfd5a86
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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. */
|
||||
|
|
|
|||
|
|
@ -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:
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 */
|
||||
|
|
|
|||
|
|
@ -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++)
|
||||
|
|
|
|||
Loading…
Reference in New Issue