diff options
44 files changed, 194 insertions, 499 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 1c7b681282d..191bfc816a7 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,85 +1,3 @@ -2017-01-13 Janne Blomqvist <jb@gcc.gnu.org> - - PR fortran/78534 - PR fortran/66310 - * class.c (gfc_find_derived_vtab): Use gfc_size_kind instead of - hardcoded kind. - (find_intrinsic_vtab): Likewise. - * expr.c (gfc_get_character_expr): Length parameter of type - gfc_charlen_t. - (gfc_get_int_expr): Value argument of type HOST_WIDE_INT. - (gfc_extract_hwi): New function. - (simplify_const_ref): Make string_len of type gfc_charlen_t. - (gfc_simplify_expr): Use HOST_WIDE_INT for substring refs. - * gfortran.h (gfc_mpz_get_hwi): New prototype. - (gfc_mpz_set_hwi): Likewise. - (gfc_charlen_t): New typedef. - (gfc_expr): Use gfc_charlen_t for character lengths. - (gfc_size_kind): New extern variable. - (gfc_extract_hwi): New prototype. - (gfc_get_character_expr): Use gfc_charlen_t for character length. - (gfc_get_int_expr): Use HOST_WIDE_INT type for value argument. - * iresolve.c (gfc_resolve_repeat): Pass string length directly without - temporary, use gfc_charlen_int_kind. - * match.c (select_intrinsic_set_tmp): Use HOST_WIDE_INT for charlen. - * misc.c (gfc_mpz_get_hwi): New function. - (gfc_mpz_set_hwi): New function. - * module.c (atom_int): Change type from int to HOST_WIDE_INT. - (parse_integer): Don't complain about large integers. - (write_atom): Use HOST_WIDE_INT for integers. - (mio_integer): Handle integer type mismatch. - (mio_hwi): New function. - (mio_intrinsic_op): Use HOST_WIDE_INT. - (mio_array_ref): Likewise. - (mio_expr): Likewise. - * resolve.c (resolve_select_type): Use HOST_WIDE_INT for charlen, - use snprintf. - (resolve_substring_charlen): Use gfc_charlen_int_kind. - (resolve_charlen): Use mpz_sgn to determine sign. - * simplify.c (gfc_simplify_repeat): Use HOST_WIDE_INT/gfc_charlen_t - instead of long. - * target-memory.c (size_character): Length argument of type - gfc_charlen_t. - (gfc_encode_character): Likewise. - (gfc_interpret_character): Use gfc_charlen_t. - * target-memory.h (gfc_encode_character): Modify prototype. - * trans-array.c (get_array_ctor_var_strlen): Use - gfc_conv_mpz_to_tree_type. - * trans-const.c (gfc_conv_mpz_to_tree_type): New function. - * trans-const.h (gfc_conv_mpz_to_tree_type): New prototype. - * trans-expr.c (gfc_class_len_or_zero_get): Build const of type - gfc_charlen_type_node. - (gfc_conv_intrinsic_to_class): Use gfc_charlen_int_kind instead of - 4, fold_convert to correct type. - (gfc_conv_class_to_class): Build const of type size_type_node for - size. - (gfc_copy_class_to_class): Likewise. - (gfc_conv_string_length): Use same type in expression. - (gfc_conv_substring): Likewise, use HOST_WIDE_INT for charlen. - (gfc_conv_string_tmp): Make sure len is of the right type. - (gfc_conv_concat_op): Use same type in expression. - (gfc_conv_procedure_call): Likewise. - (alloc_scalar_allocatable_for_subcomponent_assignment): - fold_convert to right type. - (gfc_trans_subcomponent_assign): Likewise. - (trans_class_vptr_len_assignment): Build const of correct type. - (gfc_trans_pointer_assignment): Likewise. - (alloc_scalar_allocatable_for_assignment): fold_convert to right - type in expr. - (trans_class_assignment): Build const of correct type. - * trans-intrinsic.c (gfc_conv_associated): Likewise. - (gfc_conv_intrinsic_repeat): Do calculation in sizetype. - * trans-io.c (gfc_build_io_library_fndecls): Use - gfc_charlen_type_node for character lengths. - * trans-stmt.c (gfc_trans_label_assign): Build const of - gfc_charlen_type_node. - (gfc_trans_character_select): Likewise. - (gfc_trans_allocate): Likewise, don't typecast strlen result. - (gfc_trans_deallocate): Don't typecast strlen result. - * trans-types.c (gfc_size_kind): New variable. - (gfc_init_types): Determine gfc_charlen_int_kind and gfc_size_kind - from size_type_node. - 2017-01-13 Andre Vehreschild <vehre@gcc.gnu.org> PR fortran/70697 diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c index 6149adaac98..d507e22ce09 100644 --- a/gcc/fortran/class.c +++ b/gcc/fortran/class.c @@ -35,7 +35,7 @@ along with GCC; see the file COPYING3. If not see * _vptr: A pointer to the vtable entry (see below) of the dynamic type. Only for unlimited polymorphic classes: - * _len: An integer(C_SIZE_T) to store the string length when the unlimited + * _len: An integer(4) to store the string length when the unlimited polymorphic pointer is used to point to a char array. The '_len' component will be zero when no character array is stored in '_data'. @@ -2310,13 +2310,13 @@ gfc_find_derived_vtab (gfc_symbol *derived) if (!gfc_add_component (vtype, "_size", &c)) goto cleanup; c->ts.type = BT_INTEGER; - c->ts.kind = gfc_size_kind; + c->ts.kind = 4; c->attr.access = ACCESS_PRIVATE; /* Remember the derived type in ts.u.derived, so that the correct initializer can be set later on (in gfc_conv_structure). */ c->ts.u.derived = derived; - c->initializer = gfc_get_int_expr (gfc_size_kind, + c->initializer = gfc_get_int_expr (gfc_default_integer_kind, NULL, 0); /* Add component _extends. */ @@ -2676,7 +2676,7 @@ find_intrinsic_vtab (gfc_typespec *ts) if (!gfc_add_component (vtype, "_size", &c)) goto cleanup; c->ts.type = BT_INTEGER; - c->ts.kind = gfc_size_kind; + c->ts.kind = 4; c->attr.access = ACCESS_PRIVATE; /* Build a minimal expression to make use of @@ -2687,11 +2687,11 @@ find_intrinsic_vtab (gfc_typespec *ts) e = gfc_get_expr (); e->ts = *ts; e->expr_type = EXPR_VARIABLE; - c->initializer = gfc_get_int_expr (gfc_size_kind, + c->initializer = gfc_get_int_expr (gfc_default_integer_kind, NULL, ts->type == BT_CHARACTER ? ts->kind - : gfc_element_size (e)); + : (int)gfc_element_size (e)); gfc_free_expr (e); /* Add component _extends. */ diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c index 65b47de8dd0..36fc4cc0969 100644 --- a/gcc/fortran/dump-parse-tree.c +++ b/gcc/fortran/dump-parse-tree.c @@ -348,10 +348,12 @@ show_constructor (gfc_constructor_base base) static void -show_char_const (const gfc_char_t *c, gfc_charlen_t length) +show_char_const (const gfc_char_t *c, int length) { + int i; + fputc ('\'', dumpfile); - for (size_t i = 0; i < (size_t) length; i++) + for (i = 0; i < length; i++) { if (c[i] == '\'') fputs ("''", dumpfile); @@ -463,8 +465,7 @@ show_expr (gfc_expr *p) break; case BT_HOLLERITH: - fprintf (dumpfile, HOST_WIDE_INT_PRINT_DEC "H", - p->representation.length); + fprintf (dumpfile, "%dH", p->representation.length); c = p->representation.string; for (i = 0; i < p->representation.length; i++, c++) { diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index a313328ca4c..7b95d206c53 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -27,7 +27,6 @@ along with GCC; see the file COPYING3. If not see #include "match.h" #include "target-memory.h" /* for gfc_convert_boz */ #include "constructor.h" -#include "tree.h" /* The following set of functions provide access to gfc_expr* of @@ -185,7 +184,7 @@ gfc_get_constant_expr (bt type, int kind, locus *where) blanked and null-terminated. */ gfc_expr * -gfc_get_character_expr (int kind, locus *where, const char *src, gfc_charlen_t len) +gfc_get_character_expr (int kind, locus *where, const char *src, int len) { gfc_expr *e; gfc_char_t *dest; @@ -211,14 +210,13 @@ gfc_get_character_expr (int kind, locus *where, const char *src, gfc_charlen_t l /* Get a new expression node that is an integer constant. */ gfc_expr * -gfc_get_int_expr (int kind, locus *where, HOST_WIDE_INT value) +gfc_get_int_expr (int kind, locus *where, int value) { gfc_expr *p; p = gfc_get_constant_expr (BT_INTEGER, kind, where ? where : &gfc_current_locus); - const wide_int w = wi::shwi (value, kind * BITS_PER_UNIT); - wi::to_mpz (w, p->value.integer, SIGNED); + mpz_set_si (p->value.integer, value); return p; } @@ -638,32 +636,6 @@ gfc_extract_int (gfc_expr *expr, int *result) } -/* Same as gfc_extract_int, but use a HWI. */ - -const char * -gfc_extract_hwi (gfc_expr *expr, HOST_WIDE_INT *result) -{ - if (expr->expr_type != EXPR_CONSTANT) - return _("Constant expression required at %C"); - - if (expr->ts.type != BT_INTEGER) - return _("Integer expression required at %C"); - - /* Use long_long_integer_type_node to determine when to saturate. */ - const wide_int val = wi::from_mpz (long_long_integer_type_node, - expr->value.integer, false); - - if (!wi::fits_shwi_p (val)) - { - return _("Integer value too large in expression at %C"); - } - - *result = val.to_shwi (); - - return NULL; -} - - /* Recursively copy a list of reference structures. */ gfc_ref * @@ -1683,7 +1655,7 @@ simplify_const_ref (gfc_expr *p) a substring out of it, update the type-spec's character length according to the first element (as all should have the same length). */ - gfc_charlen_t string_len; + int string_len; if ((c = gfc_constructor_first (p->value.constructor))) { const gfc_expr* first = c->expr; @@ -1852,18 +1824,18 @@ gfc_simplify_expr (gfc_expr *p, int type) if (gfc_is_constant_expr (p)) { gfc_char_t *s; - HOST_WIDE_INT start, end; + int start, end; start = 0; if (p->ref && p->ref->u.ss.start) { - gfc_extract_hwi (p->ref->u.ss.start, &start); + gfc_extract_int (p->ref->u.ss.start, &start); start--; /* Convert from one-based to zero-based. */ } end = p->value.character.length; if (p->ref && p->ref->u.ss.end) - gfc_extract_hwi (p->ref->u.ss.end, &end); + gfc_extract_int (p->ref->u.ss.end, &end); if (end < start) end = start; diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 137914aa5d6..f01a290e28f 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -2064,14 +2064,6 @@ gfc_intrinsic_sym; typedef splay_tree gfc_constructor_base; - -/* This should be an unsigned variable of type size_t. But to handle - compiling to a 64-bit target from a 32-bit host, we need to use a - HOST_WIDE_INT. Also, occasionally the string length field is used - as a flag with values -1 and -2, see e.g. gfc_add_assign_aux_vars. - So it needs to be signed. */ -typedef HOST_WIDE_INT gfc_charlen_t; - typedef struct gfc_expr { expr_t expr_type; @@ -2117,7 +2109,7 @@ typedef struct gfc_expr the value. */ struct { - gfc_charlen_t length; + int length; char *string; } representation; @@ -2173,7 +2165,7 @@ typedef struct gfc_expr struct { - gfc_charlen_t length; + int length; gfc_char_t *string; } character; @@ -2767,9 +2759,6 @@ void gfc_done_2 (void); int get_c_kind (const char *, CInteropKind_t *); -HOST_WIDE_INT gfc_mpz_get_hwi (mpz_t); -void gfc_mpz_set_hwi (mpz_t, const HOST_WIDE_INT); - /* options.c */ unsigned int gfc_option_lang_mask (void); void gfc_init_options_struct (struct gcc_options *); @@ -2861,7 +2850,6 @@ extern int gfc_atomic_int_kind; extern int gfc_atomic_logical_kind; extern int gfc_intio_kind; extern int gfc_charlen_int_kind; -extern int gfc_size_kind; extern int gfc_numeric_storage_size; extern int gfc_character_storage_size; @@ -3093,7 +3081,6 @@ void gfc_resolve_oacc_blocks (gfc_code *, gfc_namespace *); void gfc_free_actual_arglist (gfc_actual_arglist *); gfc_actual_arglist *gfc_copy_actual_arglist (gfc_actual_arglist *); const char *gfc_extract_int (gfc_expr *, int *); -const char *gfc_extract_hwi (gfc_expr *, HOST_WIDE_INT *); bool is_subref_array (gfc_expr *); bool gfc_is_simply_contiguous (gfc_expr *, bool, bool); bool gfc_check_init_expr (gfc_expr *); @@ -3111,8 +3098,8 @@ gfc_expr *gfc_get_null_expr (locus *); gfc_expr *gfc_get_operator_expr (locus *, gfc_intrinsic_op,gfc_expr *, gfc_expr *); gfc_expr *gfc_get_structure_constructor_expr (bt, int, locus *); gfc_expr *gfc_get_constant_expr (bt, int, locus *); -gfc_expr *gfc_get_character_expr (int, locus *, const char *, gfc_charlen_t len); -gfc_expr *gfc_get_int_expr (int, locus *, HOST_WIDE_INT); +gfc_expr *gfc_get_character_expr (int, locus *, const char *, int len); +gfc_expr *gfc_get_int_expr (int, locus *, int); gfc_expr *gfc_get_logical_expr (int, locus *, bool); gfc_expr *gfc_get_iokind_expr (locus *, io_kind); diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi index 1a36dd7b80d..9a263171e47 100644 --- a/gcc/fortran/gfortran.texi +++ b/gcc/fortran/gfortran.texi @@ -3810,42 +3810,12 @@ front ends of GCC, e.g. to GCC's C99 compiler for @code{_Bool} or GCC's Ada compiler for @code{Boolean}.) For arguments of @code{CHARACTER} type, the character length is passed -as a hidden argument at the end of the argument list. For -deferred-length strings, the value is passed by reference, otherwise -by value. The character length has the C type @code{size_t} (or -@code{INTEGER(kind=C_SIZE_T)} in Fortran). Note that this is -different to older versions of the GNU Fortran compiler, where the -type of the hidden character length argument was a C @code{int}. In -order to retain compatibility with older versions, one can e.g. for -the following Fortran procedure - -@smallexample -subroutine fstrlen (s, a) - character(len=*) :: s - integer :: a - print*, len(s) -end subroutine fstrlen -@end smallexample - -define the corresponding C prototype as follows: - -@smallexample -#if __GNUC__ > 6 -typedef size_t fortran_charlen_t; -#else -typedef int fortran_charlen_t; -#endif - -void fstrlen_ (char*, int*, fortran_charlen_t); -@end smallexample - -In order to avoid such compiler-specific details, for new code it is -instead recommended to use the ISO_C_BINDING feature. - -Note with C binding, @code{CHARACTER(len=1)} result variables are -returned according to the platform ABI and no hidden length argument -is used for dummy arguments; with @code{VALUE}, those variables are -passed by value. +as hidden argument. For deferred-length strings, the value is passed +by reference, otherwise by value. The character length has the type +@code{INTEGER(kind=4)}. Note with C binding, @code{CHARACTER(len=1)} +result variables are returned according to the platform ABI and no +hidden length argument is used for dummy arguments; with @code{VALUE}, +those variables are passed by value. For @code{OPTIONAL} dummy arguments, an absent argument is denoted by a NULL pointer, except for scalar dummy arguments of type diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c index fd2747fb4f8..5c3ad42990b 100644 --- a/gcc/fortran/iresolve.c +++ b/gcc/fortran/iresolve.c @@ -2147,6 +2147,7 @@ void gfc_resolve_repeat (gfc_expr *f, gfc_expr *string, gfc_expr *ncopies) { + int len; gfc_expr *tmp; f->ts.type = BT_CHARACTER; f->ts.kind = string->ts.kind; @@ -2159,8 +2160,8 @@ gfc_resolve_repeat (gfc_expr *f, gfc_expr *string, tmp = NULL; if (string->expr_type == EXPR_CONSTANT) { - tmp = gfc_get_int_expr (gfc_charlen_int_kind, NULL, - string->value.character.length); + len = string->value.character.length; + tmp = gfc_get_int_expr (gfc_default_integer_kind, NULL , len); } else if (string->ts.u.cl && string->ts.u.cl->length) { diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index 992a6d96744..ea9d315d7cf 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -5765,7 +5765,7 @@ select_intrinsic_set_tmp (gfc_typespec *ts) { char name[GFC_MAX_SYMBOL_LEN]; gfc_symtree *tmp; - HOST_WIDE_INT charlen = 0; + int charlen = 0; if (ts->type == BT_CLASS || ts->type == BT_DERIVED) return NULL; @@ -5776,14 +5776,14 @@ select_intrinsic_set_tmp (gfc_typespec *ts) if (ts->type == BT_CHARACTER && ts->u.cl && ts->u.cl->length && ts->u.cl->length->expr_type == EXPR_CONSTANT) - charlen = gfc_mpz_get_hwi (ts->u.cl->length->value.integer); + charlen = mpz_get_si (ts->u.cl->length->value.integer); if (ts->type != BT_CHARACTER) sprintf (name, "__tmp_%s_%d", gfc_basic_typename (ts->type), ts->kind); else - snprintf (name, sizeof (name), "__tmp_%s_" HOST_WIDE_INT_PRINT_DEC "_%d", - gfc_basic_typename (ts->type), charlen, ts->kind); + sprintf (name, "__tmp_%s_%d_%d", gfc_basic_typename (ts->type), + charlen, ts->kind); gfc_get_sym_tree (name, gfc_current_ns, &tmp, false); gfc_add_type (tmp->n.sym, ts, NULL); diff --git a/gcc/fortran/misc.c b/gcc/fortran/misc.c index 7dd0557bb3b..a2c199efb56 100644 --- a/gcc/fortran/misc.c +++ b/gcc/fortran/misc.c @@ -22,7 +22,6 @@ along with GCC; see the file COPYING3. If not see #include "system.h" #include "coretypes.h" #include "gfortran.h" -#include "tree.h" /* Initialize a typespec to unknown. */ @@ -281,24 +280,3 @@ get_c_kind(const char *c_kind_name, CInteropKind_t kinds_table[]) return ISOCBINDING_INVALID; } - - -/* Convert between GMP integers (mpz_t) and HOST_WIDE_INT. */ - -HOST_WIDE_INT -gfc_mpz_get_hwi (mpz_t op) -{ - /* Using long_long_integer_type_node as that is the integer type - node that closest matches HOST_WIDE_INT; both are guaranteed to - be at least 64 bits. */ - const wide_int w = wi::from_mpz (long_long_integer_type_node, op, true); - return w.to_shwi (); -} - - -void -gfc_mpz_set_hwi (mpz_t rop, const HOST_WIDE_INT op) -{ - const wide_int w = wi::shwi (op, HOST_BITS_PER_WIDE_INT); - wi::to_mpz (w, rop, SIGNED); -} diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index ca5301665e1..b3b09672aca 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -1141,7 +1141,7 @@ static atom_type last_atom; #define MAX_ATOM_SIZE 100 -static HOST_WIDE_INT atom_int; +static int atom_int; static char *atom_string, atom_name[MAX_ATOM_SIZE]; @@ -1271,7 +1271,7 @@ parse_string (void) } -/* Parse an integer. Should fit in a HOST_WIDE_INT. */ +/* Parse a small integer. */ static void parse_integer (int c) @@ -1288,6 +1288,8 @@ parse_integer (int c) } atom_int = 10 * atom_int + c - '0'; + if (atom_int > 99999999) + bad_module ("Integer overflow"); } } @@ -1629,12 +1631,11 @@ write_char (char out) static void write_atom (atom_type atom, const void *v) { - char buffer[32]; + char buffer[20]; /* Workaround -Wmaybe-uninitialized false positive during profiledbootstrap by initializing them. */ - int len; - HOST_WIDE_INT i = 0; + int i = 0, len; const char *p; switch (atom) @@ -1653,9 +1654,11 @@ write_atom (atom_type atom, const void *v) break; case ATOM_INTEGER: - i = *((const HOST_WIDE_INT *) v); + i = *((const int *) v); + if (i < 0) + gfc_internal_error ("write_atom(): Writing negative integer"); - snprintf (buffer, sizeof (buffer), HOST_WIDE_INT_PRINT_DEC, i); + sprintf (buffer, "%d", i); p = buffer; break; @@ -1763,10 +1766,7 @@ static void mio_integer (int *ip) { if (iomode == IO_OUTPUT) - { - HOST_WIDE_INT hwi = *ip; - write_atom (ATOM_INTEGER, &hwi); - } + write_atom (ATOM_INTEGER, ip); else { require_atom (ATOM_INTEGER); @@ -1774,18 +1774,6 @@ mio_integer (int *ip) } } -static void -mio_hwi (HOST_WIDE_INT *hwi) -{ - if (iomode == IO_OUTPUT) - write_atom (ATOM_INTEGER, hwi); - else - { - require_atom (ATOM_INTEGER); - *hwi = atom_int; - } -} - /* Read or write a gfc_intrinsic_op value. */ @@ -1795,7 +1783,7 @@ mio_intrinsic_op (gfc_intrinsic_op* op) /* FIXME: Would be nicer to do this via the operators symbolic name. */ if (iomode == IO_OUTPUT) { - HOST_WIDE_INT converted = (HOST_WIDE_INT) *op; + int converted = (int) *op; write_atom (ATOM_INTEGER, &converted); } else @@ -2692,7 +2680,7 @@ mio_array_ref (gfc_array_ref *ar) { for (i = 0; i < ar->dimen; i++) { - HOST_WIDE_INT tmp = (HOST_WIDE_INT)ar->dimen_type[i]; + int tmp = (int)ar->dimen_type[i]; write_atom (ATOM_INTEGER, &tmp); } } @@ -3394,7 +3382,6 @@ fix_mio_expr (gfc_expr *e) static void mio_expr (gfc_expr **ep) { - HOST_WIDE_INT hwi; gfc_expr *e; atom_type t; int flag; @@ -3609,9 +3596,7 @@ mio_expr (gfc_expr **ep) break; case BT_CHARACTER: - hwi = e->value.character.length; - mio_hwi (&hwi); - e->value.character.length = hwi; + mio_integer (&e->value.character.length); e->value.character.string = CONST_CAST (gfc_char_t *, mio_allocated_wide_string (e->value.character.string, diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 71880d8da2a..a5fe2314372 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -4726,7 +4726,7 @@ gfc_resolve_substring_charlen (gfc_expr *e) /* Length = (end - start + 1). */ e->ts.u.cl->length = gfc_subtract (end, start); e->ts.u.cl->length = gfc_add (e->ts.u.cl->length, - gfc_get_int_expr (gfc_charlen_int_kind, + gfc_get_int_expr (gfc_default_integer_kind, NULL, 1)); /* F2008, 6.4.1: Both the starting point and the ending point shall @@ -8469,6 +8469,7 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns) char name[GFC_MAX_SYMBOL_LEN]; gfc_namespace *ns; int error = 0; + int charlen = 0; int rank = 0; gfc_ref* ref = NULL; gfc_expr *selector_expr = NULL; @@ -8716,13 +8717,11 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns) sprintf (name, "__tmp_type_%s", c->ts.u.derived->name); else if (c->ts.type == BT_CHARACTER) { - HOST_WIDE_INT charlen = 0; if (c->ts.u.cl && c->ts.u.cl->length && c->ts.u.cl->length->expr_type == EXPR_CONSTANT) - charlen = gfc_mpz_get_hwi (c->ts.u.cl->length->value.integer); - snprintf (name, sizeof (name), - "__tmp_%s_" HOST_WIDE_INT_PRINT_DEC "_%d", - gfc_basic_typename (c->ts.type), charlen, c->ts.kind); + charlen = mpz_get_si (c->ts.u.cl->length->value.integer); + sprintf (name, "__tmp_%s_%d_%d", gfc_basic_typename (c->ts.type), + charlen, c->ts.kind); } else sprintf (name, "__tmp_%s_%d", gfc_basic_typename (c->ts.type), @@ -11387,7 +11386,7 @@ resolve_index_expr (gfc_expr *e) static bool resolve_charlen (gfc_charlen *cl) { - int k; + int i, k; bool saved_specification_expr; if (cl->resolved) @@ -11423,10 +11422,9 @@ resolve_charlen (gfc_charlen *cl) /* F2008, 4.4.3.2: If the character length parameter value evaluates to a negative value, the length of character entities declared is zero. */ - if (cl->length && cl->length->expr_type == EXPR_CONSTANT - && mpz_sgn (cl->length->value.integer) < 0) + if (cl->length && !gfc_extract_int (cl->length, &i) && i < 0) gfc_replace_expr (cl->length, - gfc_get_int_expr (gfc_charlen_int_kind, NULL, 0)); + gfc_get_int_expr (gfc_default_integer_kind, NULL, 0)); /* Check that the character length is not too large. */ k = gfc_validate_kind (BT_INTEGER, gfc_charlen_int_kind, false); diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index 4ea8163e598..942b4015447 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -5198,7 +5198,7 @@ gfc_expr * gfc_simplify_repeat (gfc_expr *e, gfc_expr *n) { gfc_expr *result; - gfc_charlen_t len; + int i, j, len, ncop, nlen; mpz_t ncopies; bool have_length = false; @@ -5218,7 +5218,7 @@ gfc_simplify_repeat (gfc_expr *e, gfc_expr *n) if (e->ts.u.cl && e->ts.u.cl->length && e->ts.u.cl->length->expr_type == EXPR_CONSTANT) { - len = gfc_mpz_get_hwi (e->ts.u.cl->length->value.integer); + len = mpz_get_si (e->ts.u.cl->length->value.integer); have_length = true; } else if (e->expr_type == EXPR_CONSTANT @@ -5254,8 +5254,7 @@ gfc_simplify_repeat (gfc_expr *e, gfc_expr *n) } else { - mpz_init (mlen); - gfc_mpz_set_hwi (mlen, len); + mpz_init_set_si (mlen, len); mpz_tdiv_q (max, gfc_integer_kinds[i].huge, mlen); mpz_clear (mlen); } @@ -5279,12 +5278,11 @@ gfc_simplify_repeat (gfc_expr *e, gfc_expr *n) if (e->expr_type != EXPR_CONSTANT) return NULL; - HOST_WIDE_INT ncop; if (len || (e->ts.u.cl->length && mpz_sgn (e->ts.u.cl->length->value.integer) != 0)) { - const char *res = gfc_extract_hwi (n, &ncop); + const char *res = gfc_extract_int (n, &ncop); gcc_assert (res == NULL); } else @@ -5294,18 +5292,11 @@ gfc_simplify_repeat (gfc_expr *e, gfc_expr *n) return gfc_get_character_expr (e->ts.kind, &e->where, NULL, 0); len = e->value.character.length; - gfc_charlen_t nlen = ncop * len; - - /* Here's a semi-arbitrary limit. If the string is longer than 32 MB - (8 * 2**20 elements * 4 bytes (wide chars) per element) defer to - runtime instead of consuming (unbounded) memory and CPU at - compile time. */ - if (nlen > 8388608) - return NULL; + nlen = ncop * len; result = gfc_get_character_expr (e->ts.kind, &e->where, NULL, nlen); - for (size_t i = 0; i < (size_t) ncop; i++) - for (size_t j = 0; j < (size_t) len; j++) + for (i = 0; i < ncop; i++) + for (j = 0; j < len; j++) result->value.character.string[j+i*len]= e->value.character.string[j]; result->value.character.string[nlen] = '\0'; /* For debugger */ diff --git a/gcc/fortran/target-memory.c b/gcc/fortran/target-memory.c index 34b61dc2e11..d239cf114e1 100644 --- a/gcc/fortran/target-memory.c +++ b/gcc/fortran/target-memory.c @@ -65,7 +65,7 @@ size_logical (int kind) static size_t -size_character (gfc_charlen_t length, int kind) +size_character (int length, int kind) { int i = gfc_validate_kind (BT_CHARACTER, kind, false); return length * gfc_character_kinds[i].bit_size / 8; @@ -97,9 +97,9 @@ gfc_element_size (gfc_expr *e) && e->ts.u.cl->length->expr_type == EXPR_CONSTANT && e->ts.u.cl->length->ts.type == BT_INTEGER) { - HOST_WIDE_INT length; + int length; - gfc_extract_hwi (e->ts.u.cl->length, &length); + gfc_extract_int (e->ts.u.cl->length, &length); return size_character (length, e->ts.kind); } else @@ -217,15 +217,16 @@ encode_logical (int kind, int logical, unsigned char *buffer, size_t buffer_size int -gfc_encode_character (int kind, gfc_charlen_t length, const gfc_char_t *string, +gfc_encode_character (int kind, int length, const gfc_char_t *string, unsigned char *buffer, size_t buffer_size) { size_t elsize = size_character (1, kind); tree type = gfc_get_char_type (kind); + int i; gcc_assert (buffer_size >= size_character (length, kind)); - for (size_t i = 0; i < (size_t) length; i++) + for (i = 0; i < length; i++) native_encode_expr (build_int_cst (type, string[i]), &buffer[i*elsize], elsize); @@ -437,9 +438,11 @@ int gfc_interpret_character (unsigned char *buffer, size_t buffer_size, gfc_expr *result) { + int i; + if (result->ts.u.cl && result->ts.u.cl->length) result->value.character.length = - gfc_mpz_get_hwi (result->ts.u.cl->length->value.integer); + (int) mpz_get_ui (result->ts.u.cl->length->value.integer); gcc_assert (buffer_size >= size_character (result->value.character.length, result->ts.kind)); @@ -447,7 +450,7 @@ gfc_interpret_character (unsigned char *buffer, size_t buffer_size, gfc_get_wide_string (result->value.character.length + 1); if (result->ts.kind == gfc_default_character_kind) - for (size_t i = 0; i < (size_t) result->value.character.length; i++) + for (i = 0; i < result->value.character.length; i++) result->value.character.string[i] = (gfc_char_t) buffer[i]; else { @@ -456,7 +459,7 @@ gfc_interpret_character (unsigned char *buffer, size_t buffer_size, mpz_init (integer); gcc_assert (bytes <= sizeof (unsigned long)); - for (size_t i = 0; i < (size_t) result->value.character.length; i++) + for (i = 0; i < result->value.character.length; i++) { gfc_conv_tree_to_mpz (integer, native_interpret_expr (gfc_get_char_type (result->ts.kind), diff --git a/gcc/fortran/target-memory.h b/gcc/fortran/target-memory.h index ddcaf602b56..5d4655352cc 100644 --- a/gcc/fortran/target-memory.h +++ b/gcc/fortran/target-memory.h @@ -28,7 +28,7 @@ size_t gfc_element_size (gfc_expr *); size_t gfc_target_expr_size (gfc_expr *); /* Write a constant expression in binary form to a target buffer. */ -int gfc_encode_character (int, gfc_charlen_t, const gfc_char_t *, unsigned char *, +int gfc_encode_character (int, int, const gfc_char_t *, unsigned char *, size_t); unsigned HOST_WIDE_INT gfc_target_encode_expr (gfc_expr *, unsigned char *, size_t); diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 7ab2ef6d6f1..a3aab8e4528 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -1909,7 +1909,8 @@ get_array_ctor_var_strlen (stmtblock_t *block, gfc_expr * expr, tree * len) mpz_init_set_ui (char_len, 1); mpz_add (char_len, char_len, ref->u.ss.end->value.integer); mpz_sub (char_len, char_len, ref->u.ss.start->value.integer); - *len = gfc_conv_mpz_to_tree_type (char_len, gfc_charlen_type_node); + *len = gfc_conv_mpz_to_tree (char_len, gfc_default_integer_kind); + *len = convert (gfc_charlen_type_node, *len); mpz_clear (char_len); return; diff --git a/gcc/fortran/trans-const.c b/gcc/fortran/trans-const.c index cd4a8d7588b..128d47d0fa3 100644 --- a/gcc/fortran/trans-const.c +++ b/gcc/fortran/trans-const.c @@ -206,18 +206,6 @@ gfc_conv_mpz_to_tree (mpz_t i, int kind) return wide_int_to_tree (gfc_get_int_type (kind), val); } - -/* Convert a GMP integer into a tree node of type given by the type - argument. */ - -tree -gfc_conv_mpz_to_tree_type (mpz_t i, const tree type) -{ - const wide_int val = wi::from_mpz (type, i, true); - return wide_int_to_tree (type, val); -} - - /* Converts a backend tree into a GMP integer. */ void diff --git a/gcc/fortran/trans-const.h b/gcc/fortran/trans-const.h index 7863e833929..97308676d16 100644 --- a/gcc/fortran/trans-const.h +++ b/gcc/fortran/trans-const.h @@ -20,7 +20,6 @@ along with GCC; see the file COPYING3. If not see /* Converts between INT_CST and GMP integer representations. */ tree gfc_conv_mpz_to_tree (mpz_t, int); -tree gfc_conv_mpz_to_tree_type (mpz_t, const tree); void gfc_conv_tree_to_mpz (mpz_t, tree); /* Converts between REAL_CST and MPFR floating-point representations. */ diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 97aa6575322..01b7dd27dce 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -250,7 +250,7 @@ gfc_class_len_or_zero_get (tree decl) return len != NULL_TREE ? fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (len), decl, len, NULL_TREE) - : build_zero_cst (gfc_charlen_type_node); + : integer_zero_node; } @@ -884,8 +884,7 @@ gfc_conv_intrinsic_to_class (gfc_se *parmse, gfc_expr *e, { /* Amazingly all data is present to compute the length of a constant string, but the expression is not yet there. */ - e->ts.u.cl->length = gfc_get_constant_expr (BT_INTEGER, - gfc_charlen_int_kind, + e->ts.u.cl->length = gfc_get_constant_expr (BT_INTEGER, 4, &e->where); mpz_set_ui (e->ts.u.cl->length->value.integer, e->value.character.length); @@ -903,7 +902,7 @@ gfc_conv_intrinsic_to_class (gfc_se *parmse, gfc_expr *e, else tmp = integer_zero_node; - gfc_add_modify (&parmse->pre, ctree, fold_convert (TREE_TYPE (ctree), tmp)); + gfc_add_modify (&parmse->pre, ctree, tmp); } else if (class_ts.type == BT_CLASS && class_ts.u.derived->components @@ -1042,7 +1041,7 @@ gfc_conv_class_to_class (gfc_se *parmse, gfc_expr *e, gfc_typespec class_ts, if (DECL_LANG_SPECIFIC (tmp) && GFC_DECL_SAVED_DESCRIPTOR (tmp)) tmp = GFC_DECL_SAVED_DESCRIPTOR (tmp); - slen = build_zero_cst (size_type_node); + slen = integer_zero_node; } else { @@ -1089,7 +1088,7 @@ gfc_conv_class_to_class (gfc_se *parmse, gfc_expr *e, gfc_typespec class_ts, tmp = slen; } else - tmp = build_zero_cst (size_type_node); + tmp = integer_zero_node; gfc_add_modify (&parmse->pre, ctree, fold_convert (TREE_TYPE (ctree), tmp)); @@ -1228,7 +1227,7 @@ gfc_copy_class_to_class (tree from, tree to, tree nelems, bool unlimited) if (from != NULL_TREE && unlimited) from_len = gfc_class_len_or_zero_get (from); else - from_len = build_zero_cst (size_type_node); + from_len = integer_zero_node; } if (GFC_CLASS_TYPE_P (TREE_TYPE (to))) @@ -1340,7 +1339,7 @@ gfc_copy_class_to_class (tree from, tree to, tree nelems, bool unlimited) tmp = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, from_len, - build_zero_cst (TREE_TYPE (from_len))); + integer_zero_node); tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, tmp, extcopy, stdcopy); gfc_add_expr_to_block (&body, tmp); @@ -1368,7 +1367,7 @@ gfc_copy_class_to_class (tree from, tree to, tree nelems, bool unlimited) extcopy = build_call_vec (fcn_type, fcn, args); tmp = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, from_len, - build_zero_cst (TREE_TYPE (from_len))); + integer_zero_node); tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, tmp, extcopy, stdcopy); } @@ -2200,7 +2199,7 @@ gfc_conv_string_length (gfc_charlen * cl, gfc_expr * expr, stmtblock_t * pblock) gfc_conv_expr_type (&se, cl->length, gfc_charlen_type_node); se.expr = fold_build2_loc (input_location, MAX_EXPR, gfc_charlen_type_node, - se.expr, build_zero_cst (TREE_TYPE (se.expr))); + se.expr, build_int_cst (gfc_charlen_type_node, 0)); gfc_add_block_to_block (pblock, &se.pre); if (cl->backend_decl) @@ -2272,7 +2271,7 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind, /* Check lower bound. */ fault = fold_build2_loc (input_location, LT_EXPR, boolean_type_node, start.expr, - build_one_cst (TREE_TYPE (start.expr))); + build_int_cst (gfc_charlen_type_node, 1)); fault = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR, boolean_type_node, nonempty, fault); if (name) @@ -2308,9 +2307,9 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind, if (ref->u.ss.end && gfc_dep_difference (ref->u.ss.end, ref->u.ss.start, &length)) { - HOST_WIDE_INT i_len; + int i_len; - i_len = gfc_mpz_get_hwi (length) + 1; + i_len = mpz_get_si (length) + 1; if (i_len < 0) i_len = 0; @@ -2320,8 +2319,7 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind, else { tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_charlen_type_node, - fold_convert (gfc_charlen_type_node, end.expr), - fold_convert (gfc_charlen_type_node, start.expr)); + end.expr, start.expr); tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_charlen_type_node, build_int_cst (gfc_charlen_type_node, 1), tmp); tmp = fold_build2_loc (input_location, MAX_EXPR, gfc_charlen_type_node, @@ -3121,10 +3119,9 @@ gfc_conv_string_tmp (gfc_se * se, tree type, tree len) { /* Create a temporary variable to hold the result. */ tmp = fold_build2_loc (input_location, MINUS_EXPR, - gfc_charlen_type_node, - fold_convert (gfc_charlen_type_node, len), + gfc_charlen_type_node, len, build_int_cst (gfc_charlen_type_node, 1)); - tmp = build_range_type (gfc_charlen_type_node, gfc_index_zero_node, tmp); + tmp = build_range_type (gfc_array_index_type, gfc_index_zero_node, tmp); if (TREE_CODE (TREE_TYPE (type)) == ARRAY_TYPE) tmp = build_array_type (TREE_TYPE (TREE_TYPE (type)), tmp); @@ -3187,9 +3184,7 @@ gfc_conv_concat_op (gfc_se * se, gfc_expr * expr) { len = fold_build2_loc (input_location, PLUS_EXPR, TREE_TYPE (lse.string_length), - lse.string_length, - fold_convert (TREE_TYPE (lse.string_length), - rse.string_length)); + lse.string_length, rse.string_length); } type = build_pointer_type (type); @@ -5881,7 +5876,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, tmp = fold_convert (gfc_charlen_type_node, parmse.expr); tmp = fold_build2_loc (input_location, MAX_EXPR, gfc_charlen_type_node, tmp, - build_zero_cst (TREE_TYPE (tmp))); + build_int_cst (gfc_charlen_type_node, 0)); cl.backend_decl = tmp; } @@ -7210,8 +7205,7 @@ alloc_scalar_allocatable_for_subcomponent_assignment (stmtblock_t *block, if (cm->ts.type == BT_CHARACTER && cm->ts.deferred) /* Update the lhs character length. */ - gfc_add_modify (block, lhs_cl_size, - fold_convert (TREE_TYPE (lhs_cl_size), size)); + gfc_add_modify (block, lhs_cl_size, size); } @@ -7450,8 +7444,7 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr, 1, size); gfc_add_modify (&block, dest, fold_convert (TREE_TYPE (dest), tmp)); - gfc_add_modify (&block, strlen, - fold_convert (TREE_TYPE (strlen), se.string_length)); + gfc_add_modify (&block, strlen, se.string_length); tmp = gfc_build_memcpy_call (dest, se.expr, size); gfc_add_expr_to_block (&block, tmp); } @@ -8118,7 +8111,7 @@ trans_class_vptr_len_assignment (stmtblock_t *block, gfc_expr * le, from_len = gfc_evaluate_now (se.expr, block); } else - from_len = build_zero_cst (gfc_charlen_type_node); + from_len = integer_zero_node; } gfc_add_modify (pre, to_len, fold_convert (TREE_TYPE (to_len), from_len)); @@ -8293,7 +8286,7 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2) gfc_add_modify (&block, lse.string_length, rse.string_length); else if (lse.string_length != NULL) gfc_add_modify (&block, lse.string_length, - build_zero_cst (TREE_TYPE (lse.string_length))); + build_int_cst (gfc_charlen_type_node, 0)); } gfc_add_modify (&block, lse.expr, @@ -9553,9 +9546,7 @@ alloc_scalar_allocatable_for_assignment (stmtblock_t *block, if (expr1->ts.type == BT_CHARACTER && expr1->ts.deferred) { cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, - lse.string_length, - fold_convert (TREE_TYPE (lse.string_length), - size)); + lse.string_length, size); /* Jump past the realloc if the lengths are the same. */ tmp = build3_v (COND_EXPR, cond, build1_v (GOTO_EXPR, jump_label2), @@ -9572,8 +9563,7 @@ alloc_scalar_allocatable_for_assignment (stmtblock_t *block, /* Update the lhs character length. */ size = string_length; - gfc_add_modify (block, lse.string_length, - fold_convert (TREE_TYPE (lse.string_length), size)); + gfc_add_modify (block, lse.string_length, size); } } @@ -9755,7 +9745,7 @@ trans_class_assignment (stmtblock_t *block, gfc_expr *lhs, gfc_expr *rhs, tmp = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, from_len, - build_zero_cst (TREE_TYPE (from_len))); + integer_zero_node); return fold_build3_loc (input_location, COND_EXPR, void_type_node, tmp, extcopy, stdcopy); diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index ec26a0d4753..14781ac4814 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -7497,12 +7497,10 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr) nonzero_charlen = NULL_TREE; if (arg1->expr->ts.type == BT_CHARACTER) - nonzero_charlen - = fold_build2_loc (input_location, NE_EXPR, - boolean_type_node, - arg1->expr->ts.u.cl->backend_decl, - build_zero_cst - (TREE_TYPE (arg1->expr->ts.u.cl->backend_decl))); + nonzero_charlen = fold_build2_loc (input_location, NE_EXPR, + boolean_type_node, + arg1->expr->ts.u.cl->backend_decl, + integer_zero_node); if (scalar) { /* A pointer to a scalar. */ @@ -7792,11 +7790,11 @@ gfc_conv_intrinsic_repeat (gfc_se * se, gfc_expr * expr) /* We store in charsize the size of a character. */ i = gfc_validate_kind (BT_CHARACTER, expr->ts.kind, false); - size = build_int_cst (sizetype, gfc_character_kinds[i].bit_size / 8); + size = build_int_cst (size_type_node, gfc_character_kinds[i].bit_size / 8); /* Get the arguments. */ gfc_conv_intrinsic_function_args (se, expr, args, 3); - slen = fold_convert (sizetype, gfc_evaluate_now (args[0], &se->pre)); + slen = fold_convert (size_type_node, gfc_evaluate_now (args[0], &se->pre)); src = args[1]; ncopies = gfc_evaluate_now (args[2], &se->pre); ncopies_type = TREE_TYPE (ncopies); @@ -7813,7 +7811,7 @@ gfc_conv_intrinsic_repeat (gfc_se * se, gfc_expr * expr) is valid, and nothing happens. */ n = gfc_create_var (ncopies_type, "ncopies"); cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, slen, - size_zero_node); + build_int_cst (size_type_node, 0)); tmp = fold_build3_loc (input_location, COND_EXPR, ncopies_type, cond, build_int_cst (ncopies_type, 0), ncopies); gfc_add_modify (&se->pre, n, tmp); @@ -7823,17 +7821,17 @@ gfc_conv_intrinsic_repeat (gfc_se * se, gfc_expr * expr) (or equal to) MAX / slen, where MAX is the maximal integer of the gfc_charlen_type_node type. If slen == 0, we need a special case to avoid the division by zero. */ - max = fold_build2_loc (input_location, TRUNC_DIV_EXPR, sizetype, - fold_convert (sizetype, - TYPE_MAX_VALUE (gfc_charlen_type_node)), - slen); - largest = TYPE_PRECISION (sizetype) > TYPE_PRECISION (ncopies_type) - ? sizetype : ncopies_type; + i = gfc_validate_kind (BT_INTEGER, gfc_charlen_int_kind, false); + max = gfc_conv_mpz_to_tree (gfc_integer_kinds[i].huge, gfc_charlen_int_kind); + max = fold_build2_loc (input_location, TRUNC_DIV_EXPR, size_type_node, + fold_convert (size_type_node, max), slen); + largest = TYPE_PRECISION (size_type_node) > TYPE_PRECISION (ncopies_type) + ? size_type_node : ncopies_type; cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, fold_convert (largest, ncopies), fold_convert (largest, max)); tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, slen, - size_zero_node); + build_int_cst (size_type_node, 0)); cond = fold_build3_loc (input_location, COND_EXPR, boolean_type_node, tmp, boolean_false_node, cond); gfc_trans_runtime_check (true, false, cond, &se->pre, &expr->where, @@ -7850,8 +7848,8 @@ gfc_conv_intrinsic_repeat (gfc_se * se, gfc_expr * expr) for (i = 0; i < ncopies; i++) memmove (dest + (i * slen * size), src, slen*size); */ gfc_start_block (&block); - count = gfc_create_var (sizetype, "count"); - gfc_add_modify (&block, count, size_zero_node); + count = gfc_create_var (ncopies_type, "count"); + gfc_add_modify (&block, count, build_int_cst (ncopies_type, 0)); exit_label = gfc_build_label_decl (NULL_TREE); /* Start the loop body. */ @@ -7859,7 +7857,7 @@ gfc_conv_intrinsic_repeat (gfc_se * se, gfc_expr * expr) /* Exit the loop if count >= ncopies. */ cond = fold_build2_loc (input_location, GE_EXPR, boolean_type_node, count, - fold_convert (sizetype, ncopies)); + ncopies); tmp = build1_v (GOTO_EXPR, exit_label); TREE_USED (exit_label) = 1; tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond, tmp, @@ -7867,22 +7865,25 @@ gfc_conv_intrinsic_repeat (gfc_se * se, gfc_expr * expr) gfc_add_expr_to_block (&body, tmp); /* Call memmove (dest + (i*slen*size), src, slen*size). */ - tmp = fold_build2_loc (input_location, MULT_EXPR, sizetype, slen, - count); - tmp = fold_build2_loc (input_location, MULT_EXPR, sizetype, tmp, - size); + tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_charlen_type_node, + fold_convert (gfc_charlen_type_node, slen), + fold_convert (gfc_charlen_type_node, count)); + tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_charlen_type_node, + tmp, fold_convert (gfc_charlen_type_node, size)); tmp = fold_build_pointer_plus_loc (input_location, fold_convert (pvoid_type_node, dest), tmp); tmp = build_call_expr_loc (input_location, builtin_decl_explicit (BUILT_IN_MEMMOVE), 3, tmp, src, fold_build2_loc (input_location, MULT_EXPR, - size_type_node, slen, size)); + size_type_node, slen, + fold_convert (size_type_node, + size))); gfc_add_expr_to_block (&body, tmp); /* Increment count. */ - tmp = fold_build2_loc (input_location, PLUS_EXPR, sizetype, - count, size_one_node); + tmp = fold_build2_loc (input_location, PLUS_EXPR, ncopies_type, + count, build_int_cst (TREE_TYPE (count), 1)); gfc_add_modify (&body, count, tmp); /* Build the loop. */ diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c index 02e2b918291..fbbad46de67 100644 --- a/gcc/fortran/trans-io.c +++ b/gcc/fortran/trans-io.c @@ -339,11 +339,11 @@ gfc_build_io_library_fndecls (void) iocall[IOCALL_X_CHARACTER] = gfc_build_library_function_decl_with_spec ( get_identifier (PREFIX("transfer_character")), ".wW", - void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_charlen_type_node); + void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_int4_type_node); iocall[IOCALL_X_CHARACTER_WRITE] = gfc_build_library_function_decl_with_spec ( get_identifier (PREFIX("transfer_character_write")), ".wR", - void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_charlen_type_node); + void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_int4_type_node); iocall[IOCALL_X_CHARACTER_WIDE] = gfc_build_library_function_decl_with_spec ( get_identifier (PREFIX("transfer_character_wide")), ".wW", diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 6b529748afb..856008779ba 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -112,7 +112,7 @@ gfc_trans_label_assign (gfc_code * code) || code->label1->defined == ST_LABEL_DO_TARGET) { label_tree = gfc_build_addr_expr (pvoid_type_node, label_tree); - len_tree = build_int_cst (gfc_charlen_type_node, -1); + len_tree = integer_minus_one_node; } else { @@ -125,7 +125,7 @@ gfc_trans_label_assign (gfc_code * code) label_tree = gfc_build_addr_expr (pvoid_type_node, label_tree); } - gfc_add_modify (&se.pre, len, fold_convert (TREE_TYPE (len), len_tree)); + gfc_add_modify (&se.pre, len, len_tree); gfc_add_modify (&se.pre, addr, label_tree); return gfc_finish_block (&se.pre); @@ -2750,7 +2750,7 @@ gfc_trans_character_select (gfc_code *code) { for (d = cp; d; d = d->right) { - gfc_charlen_t i; + int i; if (d->low) { gcc_assert (d->low->expr_type == EXPR_CONSTANT @@ -2955,7 +2955,7 @@ gfc_trans_character_select (gfc_code *code) if (d->low == NULL) { CONSTRUCTOR_APPEND_ELT (node, ss_string1[k], null_pointer_node); - CONSTRUCTOR_APPEND_ELT (node, ss_string1_len[k], build_zero_cst (gfc_charlen_type_node)); + CONSTRUCTOR_APPEND_ELT (node, ss_string1_len[k], integer_zero_node); } else { @@ -2968,7 +2968,7 @@ gfc_trans_character_select (gfc_code *code) if (d->high == NULL) { CONSTRUCTOR_APPEND_ELT (node, ss_string2[k], null_pointer_node); - CONSTRUCTOR_APPEND_ELT (node, ss_string2_len[k], build_zero_cst (gfc_charlen_type_node)); + CONSTRUCTOR_APPEND_ELT (node, ss_string2_len[k], integer_zero_node); } else { @@ -5640,7 +5640,7 @@ gfc_trans_allocate (gfc_code * code) { gfc_init_se (&se, NULL); temp_var_needed = false; - expr3_len = build_zero_cst (gfc_charlen_type_node); + expr3_len = integer_zero_node; e3_is = E3_MOLD; } /* Prevent aliasing, i.e., se.expr may be already a @@ -6036,8 +6036,7 @@ gfc_trans_allocate (gfc_code * code) e.g., a string. */ memsz = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, expr3_len, - build_zero_cst - (TREE_TYPE (expr3_len))); + integer_zero_node); memsz = fold_build3_loc (input_location, COND_EXPR, TREE_TYPE (expr3_esize), memsz, tmp, expr3_esize); @@ -6367,7 +6366,7 @@ gfc_trans_allocate (gfc_code * code) gfc_build_addr_expr (pchar_type_node, gfc_build_localized_cstring_const (msg))); - slen = build_int_cst (gfc_charlen_type_node, strlen (msg)); + slen = build_int_cst (gfc_charlen_type_node, ((int) strlen (msg))); dlen = gfc_get_expr_charlen (code->expr2); slen = fold_build2_loc (input_location, MIN_EXPR, TREE_TYPE (slen), dlen, slen); @@ -6649,7 +6648,7 @@ gfc_trans_deallocate (gfc_code *code) gfc_add_modify (&errmsg_block, errmsg_str, gfc_build_addr_expr (pchar_type_node, gfc_build_localized_cstring_const (msg))); - slen = build_int_cst (gfc_charlen_type_node, strlen (msg)); + slen = build_int_cst (gfc_charlen_type_node, ((int) strlen (msg))); dlen = gfc_get_expr_charlen (code->expr2); gfc_trans_string_copy (&errmsg_block, dlen, errmsg, code->expr2->ts.kind, diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index 5da60523877..759b80eecaa 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -118,9 +118,6 @@ int gfc_intio_kind; /* The integer kind used to store character lengths. */ int gfc_charlen_int_kind; -/* Kind of internal integer for storing object sizes. */ -int gfc_size_kind; - /* The size of the numeric storage unit and character storage unit. */ int gfc_numeric_storage_size; int gfc_character_storage_size; @@ -964,13 +961,9 @@ gfc_init_types (void) wi::mask (n, UNSIGNED, TYPE_PRECISION (size_type_node))); - /* Character lengths are of type size_t, except signed. */ - gfc_charlen_int_kind = get_int_kind_from_node (size_type_node); + /* ??? Shouldn't this be based on gfc_index_integer_kind or so? */ + gfc_charlen_int_kind = 4; gfc_charlen_type_node = gfc_get_int_type (gfc_charlen_int_kind); - - /* Fortran kind number of size_type_node (size_t). This is used for - the _size member in vtables. */ - gfc_size_kind = get_int_kind_from_node (size_type_node); } /* Get the type node for the given type and kind. */ diff --git a/gcc/fortran/trans-types.h b/gcc/fortran/trans-types.h index 00a83e37d9a..2974e451304 100644 --- a/gcc/fortran/trans-types.h +++ b/gcc/fortran/trans-types.h @@ -23,7 +23,6 @@ along with GCC; see the file COPYING3. If not see #ifndef GFC_BACKEND_H #define GFC_BACKEND_H - extern GTY(()) tree gfc_array_index_type; extern GTY(()) tree gfc_array_range_type; extern GTY(()) tree gfc_character1_type_node; @@ -36,9 +35,10 @@ extern GTY(()) tree gfc_complex_float128_type_node; /* This is the type used to hold the lengths of character variables. It must be the same as the corresponding definition in gfortran.h. */ +/* TODO: This is still hardcoded as kind=4 in some bits of the compiler + and runtime library. */ extern GTY(()) tree gfc_charlen_type_node; - /* The following flags give us information on the correspondence of real (and complex) kinds with C floating-point types long double and __float128. */ diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 76dfd7e4747..02b877ddf82 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -19,18 +19,6 @@ PR c++/71166 * g++.dg/cpp0x/constexpr-array18.C: New test. -2017-01-13 Janne Blomqvist <jb@gcc.gnu.org> - - PR fortran/78534 - PR fortran/66310 - * gfortran.dg/repeat_4.f90: Use integers of kind C_SIZE_T. - * gfortran.dg/repeat_7.f90: New test for PR 66310. - * gfortran.dg/scan_2.f90: Handle potential cast in assignment. - * gfortran.dg/string_1.f90: Limit to ilp32 targets. - * gfortran.dg/string_1_lp64.f90: New test. - * gfortran.dg/string_3.f90: Limit to ilp32 targets. - * gfortran.dg/string_3_lp64.f90: New test. - 2017-01-13 Jeff Law <law@redhat.com> * gcc.dg/tree-ssa/ssa-dse-25.c: New test. diff --git a/gcc/testsuite/gfortran.dg/repeat_4.f90 b/gcc/testsuite/gfortran.dg/repeat_4.f90 index 99e7aee4670..e5b5acc60ce 100644 --- a/gcc/testsuite/gfortran.dg/repeat_4.f90 +++ b/gcc/testsuite/gfortran.dg/repeat_4.f90 @@ -2,7 +2,6 @@ ! ! { dg-do compile } program test - use iso_c_binding, only: k => c_size_t implicit none character(len=0), parameter :: s0 = "" character(len=1), parameter :: s1 = "a" @@ -22,18 +21,18 @@ program test print *, repeat(t2, -1) ! { dg-error "Argument NCOPIES of REPEAT intrinsic is negative" } ! Check for too large NCOPIES argument and limit cases - print *, repeat(t0, huge(0_k)) - print *, repeat(t1, huge(0_k)) - print *, repeat(t2, huge(0_k)) ! { dg-error "Argument NCOPIES of REPEAT intrinsic is too large " } - print *, repeat(s2, huge(0_k)) ! { dg-error "Argument NCOPIES of REPEAT intrinsic is too large " } + print *, repeat(t0, huge(0)) + print *, repeat(t1, huge(0)) + print *, repeat(t2, huge(0)) ! { dg-error "Argument NCOPIES of REPEAT intrinsic is too large " } + print *, repeat(s2, huge(0)) ! { dg-error "Argument NCOPIES of REPEAT intrinsic is too large " } - print *, repeat(t0, huge(0_k)/2) - print *, repeat(t1, huge(0_k)/2) - print *, repeat(t2, huge(0_k)/2) + print *, repeat(t0, huge(0)/2) + print *, repeat(t1, huge(0)/2) + print *, repeat(t2, huge(0)/2) - print *, repeat(t0, huge(0_k)/2+1) - print *, repeat(t1, huge(0_k)/2+1) - print *, repeat(t2, huge(0_k)/2+1) ! { dg-error "Argument NCOPIES of REPEAT intrinsic is too large " } - print *, repeat(s2, huge(0_k)/2+1) ! { dg-error "Argument NCOPIES of REPEAT intrinsic is too large " } + print *, repeat(t0, huge(0)/2+1) + print *, repeat(t1, huge(0)/2+1) + print *, repeat(t2, huge(0)/2+1) ! { dg-error "Argument NCOPIES of REPEAT intrinsic is too large " } + print *, repeat(s2, huge(0)/2+1) ! { dg-error "Argument NCOPIES of REPEAT intrinsic is too large " } end program test diff --git a/gcc/testsuite/gfortran.dg/repeat_7.f90 b/gcc/testsuite/gfortran.dg/repeat_7.f90 deleted file mode 100644 index 82f8dbf4dea..00000000000 --- a/gcc/testsuite/gfortran.dg/repeat_7.f90 +++ /dev/null @@ -1,8 +0,0 @@ -! { dg-do compile } -! PR 66310 -! Make sure there is a limit to how large arrays we try to handle at -! compile time. -program p - character, parameter :: z = 'z' - print *, repeat(z, huge(1_4)) -end program p diff --git a/gcc/testsuite/gfortran.dg/scan_2.f90 b/gcc/testsuite/gfortran.dg/scan_2.f90 index 5ef02300d9b..c58a3a21a7f 100644 --- a/gcc/testsuite/gfortran.dg/scan_2.f90 +++ b/gcc/testsuite/gfortran.dg/scan_2.f90 @@ -30,5 +30,5 @@ program p1 call s1(.TRUE.) end program p1 -! { dg-final { scan-tree-dump-times "_gfortran_string_scan \\(2," 1 "original" } } -! { dg-final { scan-tree-dump-times "_gfortran_string_verify \\(2," 1 "original" } } +! { dg-final { scan-tree-dump-times "iscan = _gfortran_string_scan \\(2," 1 "original" } } +! { dg-final { scan-tree-dump-times "iverify = _gfortran_string_verify \\(2," 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/string_1.f90 b/gcc/testsuite/gfortran.dg/string_1.f90 index 6a6151e20a4..11dc5b7a340 100644 --- a/gcc/testsuite/gfortran.dg/string_1.f90 +++ b/gcc/testsuite/gfortran.dg/string_1.f90 @@ -1,5 +1,4 @@ ! { dg-do compile } -! { dg-require-effective-target ilp32 } ! program main implicit none diff --git a/gcc/testsuite/gfortran.dg/string_1_lp64.f90 b/gcc/testsuite/gfortran.dg/string_1_lp64.f90 deleted file mode 100644 index a0edbefc53e..00000000000 --- a/gcc/testsuite/gfortran.dg/string_1_lp64.f90 +++ /dev/null @@ -1,15 +0,0 @@ -! { dg-do compile } -! { dg-require-effective-target lp64 } -! { dg-require-effective-target fortran_integer_16 } -program main - implicit none - integer(kind=16), parameter :: l1 = 2_16**64_16 - character (len=2_16**64_16+4_16), parameter :: s = "" ! { dg-error "too large" } - character (len=2_16**64_8+4_16) :: ch ! { dg-error "too large" } - character (len=l1 + 1_16) :: v ! { dg-error "too large" } - character (len=int(huge(0_8),kind=16) + 1_16) :: z ! { dg-error "too large" } - character (len=int(huge(0_8),kind=16) + 0_16) :: w - - print *, len(s) - -end program main diff --git a/gcc/testsuite/gfortran.dg/string_3.f90 b/gcc/testsuite/gfortran.dg/string_3.f90 index 4a88b06da7c..7daf8d31ae6 100644 --- a/gcc/testsuite/gfortran.dg/string_3.f90 +++ b/gcc/testsuite/gfortran.dg/string_3.f90 @@ -1,5 +1,4 @@ ! { dg-do compile } -! { dg-require-effective-target ilp32 } ! subroutine foo(i) implicit none diff --git a/gcc/testsuite/gfortran.dg/string_3_lp64.f90 b/gcc/testsuite/gfortran.dg/string_3_lp64.f90 deleted file mode 100644 index 162561fad00..00000000000 --- a/gcc/testsuite/gfortran.dg/string_3_lp64.f90 +++ /dev/null @@ -1,20 +0,0 @@ -! { dg-do compile } -! { dg-require-effective-target lp64 } -! { dg-require-effective-target fortran_integer_16 } -subroutine foo(i) - implicit none - integer, intent(in) :: i - character(len=i) :: s - - s = '' - print *, s(1:2_16**64_16+3_16) ! { dg-error "too large" } - print *, s(2_16**64_16+3_16:2_16**64_16+4_16) ! { dg-error "too large" } - print *, len(s(1:2_16**64_16+3_16)) ! { dg-error "too large" } - print *, len(s(2_16**64_16+3_16:2_16**64_16+4_16)) ! { dg-error "too large" } - - print *, s(2_16**64_16+3_16:1) - print *, s(2_16**64_16+4_16:2_16**64_16+3_16) - print *, len(s(2_16**64_16+3_16:1)) - print *, len(s(2_16**64_16+4_16:2_16**64_16+3_16)) - -end subroutine diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 20b422153b4..1a687300a78 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,28 +1,3 @@ -2017-01-13 Janne Blomqvist <jb@gcc.gnu.org> - - PR fortran/78534 - * intrinsics/args.c (getarg_i4): Use gfc_charlen_type. - (get_command_argument_i4): Likewise. - (get_command_i4): Likewise. - * intrinsics/chmod.c (chmod_internal): Likewise. - * intrinsics/env.c (get_environment_variable_i4): Likewise. - * intrinsics/extends_type_of.c (struct vtype): Use size_t for size - member. - * intrinsics/gerror.c (gerror): Use gfc_charlen_type. - * intrinsics/getlog.c (getlog): Likewise. - * intrinsics/hostnm.c (hostnm_0): Likewise. - * intrinsics/string_intrinsics_inc.c (string_len_trim): Rework to - work if gfc_charlen_type is unsigned. - (string_scan): Likewise. - * io/transfer.c (transfer_character): Modify prototype. - (transfer_character_write): Likewise. - (transfer_character_wide): Likewise. - (transfer_character_wide_write): Likewise. - (transfer_array): Typecast to avoid signed-unsigned comparison. - * io/unit.c (is_trim_ok): Use gfc_charlen_type. - * io/write.c (namelist_write): Likewise. - * libgfortran.h (gfc_charlen_type): Change typedef to size_t. - 2017-01-13 Andre Vehreschild <vehre@gcc.gnu.org> PR fortran/70696 diff --git a/libgfortran/intrinsics/args.c b/libgfortran/intrinsics/args.c index ded5a35f415..c07181f3113 100644 --- a/libgfortran/intrinsics/args.c +++ b/libgfortran/intrinsics/args.c @@ -37,6 +37,7 @@ void getarg_i4 (GFC_INTEGER_4 *pos, char *val, gfc_charlen_type val_len) { int argc; + int arglen; char **argv; get_args (&argc, &argv); @@ -48,7 +49,7 @@ getarg_i4 (GFC_INTEGER_4 *pos, char *val, gfc_charlen_type val_len) if ((*pos) + 1 <= argc && *pos >=0 ) { - gfc_charlen_type arglen = strlen (argv[*pos]); + arglen = strlen (argv[*pos]); if (arglen > val_len) arglen = val_len; memcpy (val, argv[*pos], arglen); @@ -118,8 +119,7 @@ get_command_argument_i4 (GFC_INTEGER_4 *number, char *value, GFC_INTEGER_4 *length, GFC_INTEGER_4 *status, gfc_charlen_type value_len) { - int argc, stat_flag = GFC_GC_SUCCESS; - gfc_charlen_type arglen = 0; + int argc, arglen = 0, stat_flag = GFC_GC_SUCCESS; char **argv; if (number == NULL ) @@ -195,10 +195,10 @@ void get_command_i4 (char *command, GFC_INTEGER_4 *length, GFC_INTEGER_4 *status, gfc_charlen_type command_len) { - int i, argc, thisarg; + int i, argc, arglen, thisarg; int stat_flag = GFC_GC_SUCCESS; + int tot_len = 0; char **argv; - gfc_charlen_type arglen, tot_len = 0; if (command == NULL && length == NULL && status == NULL) return; /* No need to do anything. */ diff --git a/libgfortran/intrinsics/chmod.c b/libgfortran/intrinsics/chmod.c index 4e917a1c7f4..d08418d773f 100644 --- a/libgfortran/intrinsics/chmod.c +++ b/libgfortran/intrinsics/chmod.c @@ -64,6 +64,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see static int chmod_internal (char *file, char *mode, gfc_charlen_type mode_len) { + int i; bool ugo[3]; bool rwxXstugo[9]; int set_mode, part; @@ -103,7 +104,7 @@ chmod_internal (char *file, char *mode, gfc_charlen_type mode_len) honor_umask = false; #endif - for (gfc_charlen_type i = 0; i < mode_len; i++) + for (i = 0; i < mode_len; i++) { if (!continue_clause) { diff --git a/libgfortran/intrinsics/env.c b/libgfortran/intrinsics/env.c index f8e77584c26..f8e376e9dfe 100644 --- a/libgfortran/intrinsics/env.c +++ b/libgfortran/intrinsics/env.c @@ -93,8 +93,7 @@ get_environment_variable_i4 (char *name, char *value, GFC_INTEGER_4 *length, gfc_charlen_type name_len, gfc_charlen_type value_len) { - int stat = GFC_SUCCESS; - gfc_charlen_type res_len = 0; + int stat = GFC_SUCCESS, res_len = 0; char *name_nt; char *res; diff --git a/libgfortran/intrinsics/extends_type_of.c b/libgfortran/intrinsics/extends_type_of.c index 8dc9ef85e22..8177e0eefeb 100644 --- a/libgfortran/intrinsics/extends_type_of.c +++ b/libgfortran/intrinsics/extends_type_of.c @@ -30,7 +30,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see typedef struct vtype { GFC_INTEGER_4 hash; - size_t size; + GFC_INTEGER_4 size; struct vtype *extends; } vtype; diff --git a/libgfortran/intrinsics/gerror.c b/libgfortran/intrinsics/gerror.c index 51432a4d010..34ea1dfb73f 100644 --- a/libgfortran/intrinsics/gerror.c +++ b/libgfortran/intrinsics/gerror.c @@ -39,7 +39,7 @@ export_proto_np(PREFIX(gerror)); void PREFIX(gerror) (char * msg, gfc_charlen_type msg_len) { - gfc_charlen_type p_len; + int p_len; char *p; p = gf_strerror (errno, msg, msg_len); diff --git a/libgfortran/intrinsics/getlog.c b/libgfortran/intrinsics/getlog.c index 33ad52e470f..a856cd1eee8 100644 --- a/libgfortran/intrinsics/getlog.c +++ b/libgfortran/intrinsics/getlog.c @@ -70,6 +70,7 @@ export_proto_np(PREFIX(getlog)); void PREFIX(getlog) (char * login, gfc_charlen_type login_len) { + int p_len; char *p; memset (login, ' ', login_len); /* Blank the string. */ @@ -106,7 +107,7 @@ PREFIX(getlog) (char * login, gfc_charlen_type login_len) if (p == NULL) goto cleanup; - gfc_charlen_type p_len = strlen (p); + p_len = strlen (p); if (login_len < p_len) p_len = login_len; memcpy (login, p, p_len); diff --git a/libgfortran/intrinsics/hostnm.c b/libgfortran/intrinsics/hostnm.c index 2395067eae1..2ccb5bdb371 100644 --- a/libgfortran/intrinsics/hostnm.c +++ b/libgfortran/intrinsics/hostnm.c @@ -88,8 +88,8 @@ w32_gethostname (char *name, size_t len) static int hostnm_0 (char *name, gfc_charlen_type name_len) { + int val, i; char p[HOST_NAME_MAX + 1]; - int val; memset (name, ' ', name_len); @@ -99,7 +99,8 @@ hostnm_0 (char *name, gfc_charlen_type name_len) if (val == 0) { - for (gfc_charlen_type i = 0; i < name_len && p[i] != '\0'; i++) + i = -1; + while (i < name_len && p[++i] != '\0') name[i] = p[i]; } diff --git a/libgfortran/intrinsics/string_intrinsics_inc.c b/libgfortran/intrinsics/string_intrinsics_inc.c index 0da5130b653..f514f4c6a3e 100644 --- a/libgfortran/intrinsics/string_intrinsics_inc.c +++ b/libgfortran/intrinsics/string_intrinsics_inc.c @@ -224,15 +224,14 @@ string_len_trim (gfc_charlen_type len, const CHARTYPE *s) break; } } + + /* Now continue for the last characters with naive approach below. */ + assert (i >= 0); } /* Simply look for the first non-blank character. */ - while (s[i] == ' ') - { - if (i == 0) - return 0; - --i; - } + while (i >= 0 && s[i] == ' ') + --i; return i + 1; } @@ -328,12 +327,12 @@ string_scan (gfc_charlen_type slen, const CHARTYPE *str, if (back) { - for (i = slen; i != 0; i--) + for (i = slen - 1; i >= 0; i--) { for (j = 0; j < setlen; j++) { - if (str[i - 1] == set[j]) - return i; + if (str[i] == set[j]) + return (i + 1); } } } diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index 9724ccbe504..b47f4e07c82 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -93,17 +93,17 @@ export_proto(transfer_logical); extern void transfer_logical_write (st_parameter_dt *, void *, int); export_proto(transfer_logical_write); -extern void transfer_character (st_parameter_dt *, void *, gfc_charlen_type); +extern void transfer_character (st_parameter_dt *, void *, int); export_proto(transfer_character); -extern void transfer_character_write (st_parameter_dt *, void *, gfc_charlen_type); +extern void transfer_character_write (st_parameter_dt *, void *, int); export_proto(transfer_character_write); -extern void transfer_character_wide (st_parameter_dt *, void *, gfc_charlen_type, int); +extern void transfer_character_wide (st_parameter_dt *, void *, int, int); export_proto(transfer_character_wide); extern void transfer_character_wide_write (st_parameter_dt *, - void *, gfc_charlen_type, int); + void *, int, int); export_proto(transfer_character_wide_write); extern void transfer_complex (st_parameter_dt *, void *, int); @@ -2272,7 +2272,7 @@ transfer_logical_write (st_parameter_dt *dtp, void *p, int kind) } void -transfer_character (st_parameter_dt *dtp, void *p, gfc_charlen_type len) +transfer_character (st_parameter_dt *dtp, void *p, int len) { static char *empty_string[0]; @@ -2290,13 +2290,13 @@ transfer_character (st_parameter_dt *dtp, void *p, gfc_charlen_type len) } void -transfer_character_write (st_parameter_dt *dtp, void *p, gfc_charlen_type len) +transfer_character_write (st_parameter_dt *dtp, void *p, int len) { transfer_character (dtp, p, len); } void -transfer_character_wide (st_parameter_dt *dtp, void *p, gfc_charlen_type len, int kind) +transfer_character_wide (st_parameter_dt *dtp, void *p, int len, int kind) { static char *empty_string[0]; @@ -2314,7 +2314,7 @@ transfer_character_wide (st_parameter_dt *dtp, void *p, gfc_charlen_type len, in } void -transfer_character_wide_write (st_parameter_dt *dtp, void *p, gfc_charlen_type len, int kind) +transfer_character_wide_write (st_parameter_dt *dtp, void *p, int len, int kind) { transfer_character_wide (dtp, p, len, kind); } @@ -2351,7 +2351,7 @@ transfer_array (st_parameter_dt *dtp, gfc_array_char *desc, int kind, return; iotype = (bt) GFC_DESCRIPTOR_TYPE (desc); - size = iotype == BT_CHARACTER ? (index_type) charlen : GFC_DESCRIPTOR_SIZE (desc); + size = iotype == BT_CHARACTER ? charlen : GFC_DESCRIPTOR_SIZE (desc); rank = GFC_DESCRIPTOR_RANK (desc); for (n = 0; n < rank; n++) diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c index 2bd40e4cdcf..ed3bc3231ec 100644 --- a/libgfortran/io/unit.c +++ b/libgfortran/io/unit.c @@ -439,9 +439,10 @@ is_trim_ok (st_parameter_dt *dtp) if (dtp->common.flags & IOPARM_DT_HAS_FORMAT) { char *p = dtp->format; + off_t i; if (dtp->common.flags & IOPARM_DT_HAS_BLANK) return false; - for (gfc_charlen_type i = 0; i < dtp->format_len; i++) + for (i = 0; i < dtp->format_len; i++) { if (p[i] == '/') return false; if (p[i] == 'b' || p[i] == 'B') diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c index 86836df1b91..47970d42de1 100644 --- a/libgfortran/io/write.c +++ b/libgfortran/io/write.c @@ -2380,6 +2380,7 @@ void namelist_write (st_parameter_dt *dtp) { namelist_info * t1, *t2, *dummy = NULL; + index_type i; index_type dummy_offset = 0; char c; char * dummy_name = NULL; @@ -2401,7 +2402,7 @@ namelist_write (st_parameter_dt *dtp) write_character (dtp, "&", 1, 1, NODELIM); /* Write namelist name in upper case - f95 std. */ - for (gfc_charlen_type i = 0; i < dtp->namelist_name_len; i++ ) + for (i = 0 ;i < dtp->namelist_name_len ;i++ ) { c = toupper ((int) dtp->namelist_name[i]); write_character (dtp, &c, 1 ,1, NODELIM); diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h index 5b74a9dc8ac..cfe04760fe5 100644 --- a/libgfortran/libgfortran.h +++ b/libgfortran/libgfortran.h @@ -250,7 +250,7 @@ typedef GFC_INTEGER_4 GFC_IO_INT; typedef ptrdiff_t index_type; /* The type used for the lengths of character variables. */ -typedef size_t gfc_charlen_type; +typedef GFC_INTEGER_4 gfc_charlen_type; /* Definitions of CHARACTER data types: - CHARACTER(KIND=1) corresponds to the C char type, |