PR 78534, 83704 Large character lengths
This patch fixes various parts of the code to use a larger type than int for the character length. Depending on the situation, HOST_WIDE_INT, size_t, or gfc_charlen_t is appropriate. Regtested on x86_64-pc-linux-gnu and i686-pc-linux-gnu. gcc/fortran/ChangeLog: 2018-01-22 Janne Blomqvist <jb@gcc.gnu.org> PR 78534 PR 83704 * arith.c (gfc_arith_concat): Use size_t for string length. (gfc_compare_string): Likewise. (gfc_compare_with_Cstring): Likewise. * array.c (gfc_resolve_character_array_constructor): Use HOST_WIDE_INT, gfc_mpz_get_hwi. * check.c (gfc_check_fe_runtime_error): Use size_t. * data.c (create_character_initializer): Use HOST_WIDE_INT, gfc_extract_hwi. * decl.c (gfc_set_constant_character_len): Use gfc_charlen_t. (add_init_expr_to_sym): Use HOST_WIDE_INT. * expr.c (gfc_build_init_expr): Use HOST_WIDE_INT, gfc_extract_hwi. (gfc_apply_init): Likewise. * match.h (gfc_set_constant_character_len): Update prototype. * primary.c (match_string_constant): Use size_t. * resolve.c (resolve_ordinary_assign): Use HOST_WIDE_INT, gfc_mpz_get_hwi. * simplify.c (init_result_expr): Likewise. (gfc_simplify_len_trim): Use size_t. * target-memory.c (gfc_encode_character): Use size_t. (gfc_target_encode_expr): Use HOST_WIDE_INT, gfc_mpz_get_hwi. (interpret_array): Use size_t. (gfc_interpret_character): Likewise. * target-memory.h (gfc_encode_character): Update prototype. (gfc_interpret_character): Likewise. (gfc_target_interpret_expr): Likewise. * trans-const.c (gfc_build_string_const): Use size_t for length argument. (gfc_build_wide_string_const): Likewise. * trans-const.h (gfc_build_string_const): Likewise. (gfc_build_wide_string_const): Likewise. 2018-01-22 Janne Blomqvist <jb@gcc.gnu.org> PR 78534 PR 83704 * gfortran.dg/string_1.f90: Remove printing the length. From-SVN: r256944
This commit is contained in:
parent
1dba94d42c
commit
6b271a2ec4
17 changed files with 113 additions and 86 deletions
|
@ -1,3 +1,39 @@
|
|||
2018-01-22 Janne Blomqvist <jb@gcc.gnu.org>
|
||||
|
||||
PR 78534
|
||||
PR 83704
|
||||
* arith.c (gfc_arith_concat): Use size_t for string length.
|
||||
(gfc_compare_string): Likewise.
|
||||
(gfc_compare_with_Cstring): Likewise.
|
||||
* array.c (gfc_resolve_character_array_constructor): Use
|
||||
HOST_WIDE_INT, gfc_mpz_get_hwi.
|
||||
* check.c (gfc_check_fe_runtime_error): Use size_t.
|
||||
* data.c (create_character_initializer): Use HOST_WIDE_INT,
|
||||
gfc_extract_hwi.
|
||||
* decl.c (gfc_set_constant_character_len): Use gfc_charlen_t.
|
||||
(add_init_expr_to_sym): Use HOST_WIDE_INT.
|
||||
* expr.c (gfc_build_init_expr): Use HOST_WIDE_INT,
|
||||
gfc_extract_hwi.
|
||||
(gfc_apply_init): Likewise.
|
||||
* match.h (gfc_set_constant_character_len): Update prototype.
|
||||
* primary.c (match_string_constant): Use size_t.
|
||||
* resolve.c (resolve_ordinary_assign): Use HOST_WIDE_INT,
|
||||
gfc_mpz_get_hwi.
|
||||
* simplify.c (init_result_expr): Likewise.
|
||||
(gfc_simplify_len_trim): Use size_t.
|
||||
* target-memory.c (gfc_encode_character): Use size_t.
|
||||
(gfc_target_encode_expr): Use HOST_WIDE_INT, gfc_mpz_get_hwi.
|
||||
(interpret_array): Use size_t.
|
||||
(gfc_interpret_character): Likewise.
|
||||
* target-memory.h (gfc_encode_character): Update prototype.
|
||||
(gfc_interpret_character): Likewise.
|
||||
(gfc_target_interpret_expr): Likewise.
|
||||
* trans-const.c (gfc_build_string_const): Use size_t for length
|
||||
argument.
|
||||
(gfc_build_wide_string_const): Likewise.
|
||||
* trans-const.h (gfc_build_string_const): Likewise.
|
||||
(gfc_build_wide_string_const): Likewise.
|
||||
|
||||
2018-01-20 Steven G. Kargl <kargl@gcc.gnu.org>
|
||||
|
||||
PR fortran/83900
|
||||
|
|
|
@ -980,7 +980,7 @@ static arith
|
|||
gfc_arith_concat (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
|
||||
{
|
||||
gfc_expr *result;
|
||||
int len;
|
||||
size_t len;
|
||||
|
||||
gcc_assert (op1->ts.kind == op2->ts.kind);
|
||||
result = gfc_get_constant_expr (BT_CHARACTER, op1->ts.kind,
|
||||
|
@ -1089,7 +1089,7 @@ compare_complex (gfc_expr *op1, gfc_expr *op2)
|
|||
int
|
||||
gfc_compare_string (gfc_expr *a, gfc_expr *b)
|
||||
{
|
||||
int len, alen, blen, i;
|
||||
size_t len, alen, blen, i;
|
||||
gfc_char_t ac, bc;
|
||||
|
||||
alen = a->value.character.length;
|
||||
|
@ -1116,7 +1116,7 @@ gfc_compare_string (gfc_expr *a, gfc_expr *b)
|
|||
int
|
||||
gfc_compare_with_Cstring (gfc_expr *a, const char *b, bool case_sensitive)
|
||||
{
|
||||
int len, alen, blen, i;
|
||||
size_t len, alen, blen, i;
|
||||
gfc_char_t ac, bc;
|
||||
|
||||
alen = a->value.character.length;
|
||||
|
|
|
@ -1962,7 +1962,7 @@ bool
|
|||
gfc_resolve_character_array_constructor (gfc_expr *expr)
|
||||
{
|
||||
gfc_constructor *p;
|
||||
int found_length;
|
||||
HOST_WIDE_INT found_length;
|
||||
|
||||
gcc_assert (expr->expr_type == EXPR_ARRAY);
|
||||
gcc_assert (expr->ts.type == BT_CHARACTER);
|
||||
|
@ -1994,7 +1994,7 @@ got_charlen:
|
|||
for (p = gfc_constructor_first (expr->value.constructor);
|
||||
p; p = gfc_constructor_next (p))
|
||||
{
|
||||
int current_length = -1;
|
||||
HOST_WIDE_INT current_length = -1;
|
||||
gfc_ref *ref;
|
||||
for (ref = p->expr->ref; ref; ref = ref->next)
|
||||
if (ref->type == REF_SUBSTRING
|
||||
|
@ -2005,19 +2005,11 @@ got_charlen:
|
|||
if (p->expr->expr_type == EXPR_CONSTANT)
|
||||
current_length = p->expr->value.character.length;
|
||||
else if (ref)
|
||||
{
|
||||
long j;
|
||||
j = mpz_get_ui (ref->u.ss.end->value.integer)
|
||||
- mpz_get_ui (ref->u.ss.start->value.integer) + 1;
|
||||
current_length = (int) j;
|
||||
}
|
||||
current_length = gfc_mpz_get_hwi (ref->u.ss.end->value.integer)
|
||||
- gfc_mpz_get_hwi (ref->u.ss.start->value.integer) + 1;
|
||||
else if (p->expr->ts.u.cl && p->expr->ts.u.cl->length
|
||||
&& p->expr->ts.u.cl->length->expr_type == EXPR_CONSTANT)
|
||||
{
|
||||
long j;
|
||||
j = mpz_get_si (p->expr->ts.u.cl->length->value.integer);
|
||||
current_length = (int) j;
|
||||
}
|
||||
current_length = gfc_mpz_get_hwi (p->expr->ts.u.cl->length->value.integer);
|
||||
else
|
||||
return true;
|
||||
|
||||
|
@ -2027,9 +2019,9 @@ got_charlen:
|
|||
found_length = current_length;
|
||||
else if (found_length != current_length)
|
||||
{
|
||||
gfc_error ("Different CHARACTER lengths (%d/%d) in array"
|
||||
" constructor at %L", found_length, current_length,
|
||||
&p->expr->where);
|
||||
gfc_error ("Different CHARACTER lengths (%ld/%ld) in array"
|
||||
" constructor at %L", (long) found_length,
|
||||
(long) current_length, &p->expr->where);
|
||||
return false;
|
||||
}
|
||||
|
||||
|
@ -2051,7 +2043,7 @@ got_charlen:
|
|||
/* If we've got a constant character length, pad according to this.
|
||||
gfc_extract_int does check for BT_INTEGER and EXPR_CONSTANT and sets
|
||||
max_length only if they pass. */
|
||||
gfc_extract_int (expr->ts.u.cl->length, &found_length);
|
||||
gfc_extract_hwi (expr->ts.u.cl->length, &found_length);
|
||||
|
||||
/* Now pad/truncate the elements accordingly to the specified character
|
||||
length. This is ok inside this conditional, as in the case above
|
||||
|
@ -2063,13 +2055,13 @@ got_charlen:
|
|||
if (p->expr->expr_type == EXPR_CONSTANT)
|
||||
{
|
||||
gfc_expr *cl = NULL;
|
||||
int current_length = -1;
|
||||
HOST_WIDE_INT current_length = -1;
|
||||
bool has_ts;
|
||||
|
||||
if (p->expr->ts.u.cl && p->expr->ts.u.cl->length)
|
||||
{
|
||||
cl = p->expr->ts.u.cl->length;
|
||||
gfc_extract_int (cl, ¤t_length);
|
||||
gfc_extract_hwi (cl, ¤t_length);
|
||||
}
|
||||
|
||||
/* If gfc_extract_int above set current_length, we implicitly
|
||||
|
|
|
@ -5860,7 +5860,7 @@ bool
|
|||
gfc_check_fe_runtime_error (gfc_actual_arglist *a)
|
||||
{
|
||||
gfc_expr *e;
|
||||
int len, i;
|
||||
size_t len, i;
|
||||
int num_percent, nargs;
|
||||
|
||||
e = a->expr;
|
||||
|
|
|
@ -104,11 +104,11 @@ static gfc_expr *
|
|||
create_character_initializer (gfc_expr *init, gfc_typespec *ts,
|
||||
gfc_ref *ref, gfc_expr *rvalue)
|
||||
{
|
||||
int len, start, end, tlen;
|
||||
HOST_WIDE_INT len, start, end, tlen;
|
||||
gfc_char_t *dest;
|
||||
bool alloced_init = false;
|
||||
|
||||
gfc_extract_int (ts->u.cl->length, &len);
|
||||
gfc_extract_hwi (ts->u.cl->length, &len);
|
||||
|
||||
if (init == NULL)
|
||||
{
|
||||
|
@ -143,10 +143,10 @@ create_character_initializer (gfc_expr *init, gfc_typespec *ts,
|
|||
return NULL;
|
||||
}
|
||||
|
||||
gfc_extract_int (start_expr, &start);
|
||||
gfc_extract_hwi (start_expr, &start);
|
||||
gfc_free_expr (start_expr);
|
||||
start--;
|
||||
gfc_extract_int (end_expr, &end);
|
||||
gfc_extract_hwi (end_expr, &end);
|
||||
gfc_free_expr (end_expr);
|
||||
}
|
||||
else
|
||||
|
@ -174,16 +174,15 @@ create_character_initializer (gfc_expr *init, gfc_typespec *ts,
|
|||
else
|
||||
{
|
||||
gfc_warning_now (0, "Initialization string at %L was truncated to "
|
||||
"fit the variable (%d/%d)", &rvalue->where,
|
||||
tlen, len);
|
||||
"fit the variable (%ld/%ld)", &rvalue->where,
|
||||
(long) tlen, (long) len);
|
||||
len = tlen;
|
||||
}
|
||||
}
|
||||
|
||||
if (rvalue->ts.type == BT_HOLLERITH)
|
||||
{
|
||||
int i;
|
||||
for (i = 0; i < len; i++)
|
||||
for (size_t i = 0; i < (size_t) len; i++)
|
||||
dest[start+i] = rvalue->representation.string[i];
|
||||
}
|
||||
else
|
||||
|
|
|
@ -1538,10 +1538,11 @@ build_sym (const char *name, gfc_charlen *cl, bool cl_deferred,
|
|||
means no checking. */
|
||||
|
||||
void
|
||||
gfc_set_constant_character_len (int len, gfc_expr *expr, int check_len)
|
||||
gfc_set_constant_character_len (gfc_charlen_t len, gfc_expr *expr,
|
||||
gfc_charlen_t check_len)
|
||||
{
|
||||
gfc_char_t *s;
|
||||
int slen;
|
||||
gfc_charlen_t slen;
|
||||
|
||||
if (expr->ts.type != BT_CHARACTER)
|
||||
return;
|
||||
|
@ -1564,15 +1565,17 @@ gfc_set_constant_character_len (int len, gfc_expr *expr, int check_len)
|
|||
if (warn_character_truncation && slen > len)
|
||||
gfc_warning_now (OPT_Wcharacter_truncation,
|
||||
"CHARACTER expression at %L is being truncated "
|
||||
"(%d/%d)", &expr->where, slen, len);
|
||||
"(%ld/%ld)", &expr->where,
|
||||
(long) slen, (long) len);
|
||||
|
||||
/* Apply the standard by 'hand' otherwise it gets cleared for
|
||||
initializers. */
|
||||
if (check_len != -1 && slen != check_len
|
||||
&& !(gfc_option.allow_std & GFC_STD_GNU))
|
||||
gfc_error_now ("The CHARACTER elements of the array constructor "
|
||||
"at %L must have the same length (%d/%d)",
|
||||
&expr->where, slen, check_len);
|
||||
"at %L must have the same length (%ld/%ld)",
|
||||
&expr->where, (long) slen,
|
||||
(long) check_len);
|
||||
|
||||
s[len] = '\0';
|
||||
free (expr->value.character.string);
|
||||
|
@ -1751,12 +1754,10 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus)
|
|||
/* Update initializer character length according symbol. */
|
||||
else if (sym->ts.u.cl->length->expr_type == EXPR_CONSTANT)
|
||||
{
|
||||
int len;
|
||||
|
||||
if (!gfc_specification_expr (sym->ts.u.cl->length))
|
||||
return false;
|
||||
|
||||
len = mpz_get_si (sym->ts.u.cl->length->value.integer);
|
||||
HOST_WIDE_INT len = gfc_mpz_get_hwi (sym->ts.u.cl->length->value.integer);
|
||||
|
||||
if (init->expr_type == EXPR_CONSTANT)
|
||||
gfc_set_constant_character_len (len, init, -1);
|
||||
|
|
|
@ -4088,9 +4088,7 @@ gfc_build_default_init_expr (gfc_typespec *ts, locus *where)
|
|||
gfc_expr *
|
||||
gfc_build_init_expr (gfc_typespec *ts, locus *where, bool force)
|
||||
{
|
||||
int char_len;
|
||||
gfc_expr *init_expr;
|
||||
int i;
|
||||
|
||||
/* Try to build an initializer expression. */
|
||||
init_expr = gfc_get_constant_expr (ts->type, ts->kind, where);
|
||||
|
@ -4202,10 +4200,10 @@ gfc_build_init_expr (gfc_typespec *ts, locus *where, bool force)
|
|||
&& ts->u.cl->length
|
||||
&& ts->u.cl->length->expr_type == EXPR_CONSTANT)
|
||||
{
|
||||
char_len = mpz_get_si (ts->u.cl->length->value.integer);
|
||||
HOST_WIDE_INT char_len = gfc_mpz_get_hwi (ts->u.cl->length->value.integer);
|
||||
init_expr->value.character.length = char_len;
|
||||
init_expr->value.character.string = gfc_get_wide_string (char_len+1);
|
||||
for (i = 0; i < char_len; i++)
|
||||
for (size_t i = 0; i < (size_t) char_len; i++)
|
||||
init_expr->value.character.string[i]
|
||||
= (unsigned char) gfc_option.flag_init_character_value;
|
||||
}
|
||||
|
@ -4255,13 +4253,11 @@ gfc_apply_init (gfc_typespec *ts, symbol_attribute *attr, gfc_expr *init)
|
|||
&& ts->u.cl
|
||||
&& ts->u.cl->length && ts->u.cl->length->expr_type == EXPR_CONSTANT)
|
||||
{
|
||||
int len;
|
||||
|
||||
gcc_assert (ts->u.cl && ts->u.cl->length);
|
||||
gcc_assert (ts->u.cl->length->expr_type == EXPR_CONSTANT);
|
||||
gcc_assert (ts->u.cl->length->ts.type == BT_INTEGER);
|
||||
|
||||
len = mpz_get_si (ts->u.cl->length->value.integer);
|
||||
HOST_WIDE_INT len = gfc_mpz_get_hwi (ts->u.cl->length->value.integer);
|
||||
|
||||
if (init->expr_type == EXPR_CONSTANT)
|
||||
gfc_set_constant_character_len (len, init, -1);
|
||||
|
@ -4276,7 +4272,6 @@ gfc_apply_init (gfc_typespec *ts, symbol_attribute *attr, gfc_expr *init)
|
|||
|
||||
if (ctor)
|
||||
{
|
||||
int first_len;
|
||||
bool has_ts = (init->ts.u.cl
|
||||
&& init->ts.u.cl->length_from_typespec);
|
||||
|
||||
|
@ -4285,7 +4280,7 @@ gfc_apply_init (gfc_typespec *ts, symbol_attribute *attr, gfc_expr *init)
|
|||
length. This need not be the length of the LHS! */
|
||||
gcc_assert (ctor->expr->expr_type == EXPR_CONSTANT);
|
||||
gcc_assert (ctor->expr->ts.type == BT_CHARACTER);
|
||||
first_len = ctor->expr->value.character.length;
|
||||
gfc_charlen_t first_len = ctor->expr->value.character.length;
|
||||
|
||||
for ( ; ctor; ctor = gfc_constructor_next (ctor))
|
||||
if (ctor->expr->expr_type == EXPR_CONSTANT)
|
||||
|
|
|
@ -230,7 +230,8 @@ match gfc_match_type (gfc_statement *);
|
|||
match gfc_match_implicit_none (void);
|
||||
match gfc_match_implicit (void);
|
||||
|
||||
void gfc_set_constant_character_len (int, gfc_expr *, int);
|
||||
void gfc_set_constant_character_len (gfc_charlen_t, gfc_expr *,
|
||||
gfc_charlen_t);
|
||||
|
||||
/* Matchers for attribute declarations. */
|
||||
match gfc_match_allocatable (void);
|
||||
|
|
|
@ -1006,7 +1006,8 @@ static match
|
|||
match_string_constant (gfc_expr **result)
|
||||
{
|
||||
char name[GFC_MAX_SYMBOL_LEN + 1], peek;
|
||||
int i, kind, length, save_warn_ampersand, ret;
|
||||
size_t length;
|
||||
int kind,save_warn_ampersand, ret;
|
||||
locus old_locus, start_locus;
|
||||
gfc_symbol *sym;
|
||||
gfc_expr *e;
|
||||
|
@ -1125,7 +1126,7 @@ got_delim:
|
|||
warn_ampersand = false;
|
||||
|
||||
p = e->value.character.string;
|
||||
for (i = 0; i < length; i++)
|
||||
for (size_t i = 0; i < length; i++)
|
||||
{
|
||||
c = next_string_char (delimiter, &ret);
|
||||
|
||||
|
|
|
@ -10117,8 +10117,6 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns)
|
|||
bool rval = false;
|
||||
gfc_expr *lhs;
|
||||
gfc_expr *rhs;
|
||||
int llen = 0;
|
||||
int rlen = 0;
|
||||
int n;
|
||||
gfc_ref *ref;
|
||||
symbol_attribute attr;
|
||||
|
@ -10200,10 +10198,11 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns)
|
|||
if (lhs->ts.type == BT_CHARACTER
|
||||
&& warn_character_truncation)
|
||||
{
|
||||
HOST_WIDE_INT llen = 0, rlen = 0;
|
||||
if (lhs->ts.u.cl != NULL
|
||||
&& lhs->ts.u.cl->length != NULL
|
||||
&& lhs->ts.u.cl->length->expr_type == EXPR_CONSTANT)
|
||||
llen = mpz_get_si (lhs->ts.u.cl->length->value.integer);
|
||||
llen = gfc_mpz_get_hwi (lhs->ts.u.cl->length->value.integer);
|
||||
|
||||
if (rhs->expr_type == EXPR_CONSTANT)
|
||||
rlen = rhs->value.character.length;
|
||||
|
@ -10211,13 +10210,13 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns)
|
|||
else if (rhs->ts.u.cl != NULL
|
||||
&& rhs->ts.u.cl->length != NULL
|
||||
&& rhs->ts.u.cl->length->expr_type == EXPR_CONSTANT)
|
||||
rlen = mpz_get_si (rhs->ts.u.cl->length->value.integer);
|
||||
rlen = gfc_mpz_get_hwi (rhs->ts.u.cl->length->value.integer);
|
||||
|
||||
if (rlen && llen && rlen > llen)
|
||||
gfc_warning_now (OPT_Wcharacter_truncation,
|
||||
"CHARACTER expression will be truncated "
|
||||
"in assignment (%d/%d) at %L",
|
||||
llen, rlen, &code->loc);
|
||||
"in assignment (%ld/%ld) at %L",
|
||||
(long) llen, (long) rlen, &code->loc);
|
||||
}
|
||||
|
||||
/* Ensure that a vector index expression for the lvalue is evaluated
|
||||
|
|
|
@ -275,7 +275,7 @@ init_result_expr (gfc_expr *e, int init, gfc_expr *array)
|
|||
else if (e && e->expr_type == EXPR_CONSTANT)
|
||||
{
|
||||
int i = gfc_validate_kind (e->ts.type, e->ts.kind, false);
|
||||
int length;
|
||||
HOST_WIDE_INT length;
|
||||
gfc_char_t *string;
|
||||
|
||||
switch (e->ts.type)
|
||||
|
@ -313,14 +313,14 @@ init_result_expr (gfc_expr *e, int init, gfc_expr *array)
|
|||
if (init == INT_MIN)
|
||||
{
|
||||
gfc_expr *len = gfc_simplify_len (array, NULL);
|
||||
gfc_extract_int (len, &length);
|
||||
gfc_extract_hwi (len, &length);
|
||||
string = gfc_get_wide_string (length + 1);
|
||||
gfc_wide_memset (string, 0, length);
|
||||
}
|
||||
else if (init == INT_MAX)
|
||||
{
|
||||
gfc_expr *len = gfc_simplify_len (array, NULL);
|
||||
gfc_extract_int (len, &length);
|
||||
gfc_extract_hwi (len, &length);
|
||||
string = gfc_get_wide_string (length + 1);
|
||||
gfc_wide_memset (string, 255, length);
|
||||
}
|
||||
|
@ -4415,7 +4415,7 @@ gfc_expr *
|
|||
gfc_simplify_len_trim (gfc_expr *e, gfc_expr *kind)
|
||||
{
|
||||
gfc_expr *result;
|
||||
int count, len, i;
|
||||
size_t count, len, i;
|
||||
int k = get_kind (BT_INTEGER, kind, "LEN_TRIM", gfc_default_integer_kind);
|
||||
|
||||
if (k == -1)
|
||||
|
|
|
@ -216,8 +216,8 @@ 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,
|
||||
size_t
|
||||
gfc_encode_character (int kind, size_t length, const gfc_char_t *string,
|
||||
unsigned char *buffer, size_t buffer_size)
|
||||
{
|
||||
size_t elsize = size_character (1, kind);
|
||||
|
@ -225,7 +225,7 @@ gfc_encode_character (int kind, gfc_charlen_t length, const gfc_char_t *string,
|
|||
|
||||
gcc_assert (buffer_size >= size_character (length, kind));
|
||||
|
||||
for (size_t i = 0; i < (size_t) length; i++)
|
||||
for (size_t i = 0; i < length; i++)
|
||||
native_encode_expr (build_int_cst (type, string[i]), &buffer[i*elsize],
|
||||
elsize);
|
||||
|
||||
|
@ -318,11 +318,11 @@ gfc_target_encode_expr (gfc_expr *source, unsigned char *buffer,
|
|||
buffer, buffer_size);
|
||||
else
|
||||
{
|
||||
int start, end;
|
||||
HOST_WIDE_INT start, end;
|
||||
|
||||
gcc_assert (source->expr_type == EXPR_SUBSTRING);
|
||||
gfc_extract_int (source->ref->u.ss.start, &start);
|
||||
gfc_extract_int (source->ref->u.ss.end, &end);
|
||||
gfc_extract_hwi (source->ref->u.ss.start, &start);
|
||||
gfc_extract_hwi (source->ref->u.ss.end, &end);
|
||||
return gfc_encode_character (source->ts.kind, MAX(end - start + 1, 0),
|
||||
&source->value.character.string[start-1],
|
||||
buffer, buffer_size);
|
||||
|
@ -348,22 +348,21 @@ gfc_target_encode_expr (gfc_expr *source, unsigned char *buffer,
|
|||
}
|
||||
|
||||
|
||||
static int
|
||||
static size_t
|
||||
interpret_array (unsigned char *buffer, size_t buffer_size, gfc_expr *result)
|
||||
{
|
||||
gfc_constructor_base base = NULL;
|
||||
int array_size = 1;
|
||||
int i;
|
||||
int ptr = 0;
|
||||
size_t array_size = 1;
|
||||
size_t ptr = 0;
|
||||
|
||||
/* Calculate array size from its shape and rank. */
|
||||
gcc_assert (result->rank > 0 && result->shape);
|
||||
|
||||
for (i = 0; i < result->rank; i++)
|
||||
array_size *= (int)mpz_get_ui (result->shape[i]);
|
||||
for (int i = 0; i < result->rank; i++)
|
||||
array_size *= mpz_get_ui (result->shape[i]);
|
||||
|
||||
/* Iterate over array elements, producing constructors. */
|
||||
for (i = 0; i < array_size; i++)
|
||||
for (size_t i = 0; i < array_size; i++)
|
||||
{
|
||||
gfc_expr *e = gfc_get_constant_expr (result->ts.type, result->ts.kind,
|
||||
&result->where);
|
||||
|
@ -433,7 +432,7 @@ gfc_interpret_logical (int kind, unsigned char *buffer, size_t buffer_size,
|
|||
}
|
||||
|
||||
|
||||
int
|
||||
size_t
|
||||
gfc_interpret_character (unsigned char *buffer, size_t buffer_size,
|
||||
gfc_expr *result)
|
||||
{
|
||||
|
@ -452,7 +451,7 @@ gfc_interpret_character (unsigned char *buffer, size_t buffer_size,
|
|||
else
|
||||
{
|
||||
mpz_t integer;
|
||||
unsigned bytes = size_character (1, result->ts.kind);
|
||||
size_t bytes = size_character (1, result->ts.kind);
|
||||
mpz_init (integer);
|
||||
gcc_assert (bytes <= sizeof (unsigned long));
|
||||
|
||||
|
@ -556,7 +555,7 @@ gfc_interpret_derived (unsigned char *buffer, size_t buffer_size, gfc_expr *resu
|
|||
|
||||
|
||||
/* Read a binary buffer to a constant expression. */
|
||||
int
|
||||
size_t
|
||||
gfc_target_interpret_expr (unsigned char *buffer, size_t buffer_size,
|
||||
gfc_expr *result, bool convert_widechar)
|
||||
{
|
||||
|
|
|
@ -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 *,
|
||||
size_t gfc_encode_character (int, size_t, const gfc_char_t *, unsigned char *,
|
||||
size_t);
|
||||
unsigned HOST_WIDE_INT gfc_target_encode_expr (gfc_expr *, unsigned char *,
|
||||
size_t);
|
||||
|
@ -39,9 +39,9 @@ int gfc_interpret_integer (int, unsigned char *, size_t, mpz_t);
|
|||
int gfc_interpret_float (int, unsigned char *, size_t, mpfr_t);
|
||||
int gfc_interpret_complex (int, unsigned char *, size_t, mpc_t);
|
||||
int gfc_interpret_logical (int, unsigned char *, size_t, int *);
|
||||
int gfc_interpret_character (unsigned char *, size_t, gfc_expr *);
|
||||
size_t gfc_interpret_character (unsigned char *, size_t, gfc_expr *);
|
||||
int gfc_interpret_derived (unsigned char *, size_t, gfc_expr *);
|
||||
int gfc_target_interpret_expr (unsigned char *, size_t, gfc_expr *, bool);
|
||||
size_t gfc_target_interpret_expr (unsigned char *, size_t, gfc_expr *, bool);
|
||||
|
||||
/* Merge overlapping equivalence initializers for trans-common.c. */
|
||||
size_t gfc_merge_initializers (gfc_typespec, gfc_expr *, locus *,
|
||||
|
|
|
@ -69,7 +69,7 @@ gfc_build_const (tree type, tree intval)
|
|||
/* Build a string constant with C char type. */
|
||||
|
||||
tree
|
||||
gfc_build_string_const (int length, const char *s)
|
||||
gfc_build_string_const (size_t length, const char *s)
|
||||
{
|
||||
tree str;
|
||||
tree len;
|
||||
|
@ -89,7 +89,7 @@ gfc_build_string_const (int length, const char *s)
|
|||
non-default character kinds. */
|
||||
|
||||
tree
|
||||
gfc_build_wide_string_const (int kind, int length, const gfc_char_t *string)
|
||||
gfc_build_wide_string_const (int kind, size_t length, const gfc_char_t *string)
|
||||
{
|
||||
int i;
|
||||
tree str, len;
|
||||
|
|
|
@ -44,8 +44,8 @@ tree gfc_conv_constant_to_tree (gfc_expr *);
|
|||
structures. Also sets the length of CHARACTER strings in the gfc_se. */
|
||||
void gfc_conv_constant (gfc_se *, gfc_expr *);
|
||||
|
||||
tree gfc_build_string_const (int, const char *);
|
||||
tree gfc_build_wide_string_const (int, int, const gfc_char_t *);
|
||||
tree gfc_build_string_const (size_t, const char *);
|
||||
tree gfc_build_wide_string_const (int, size_t, const gfc_char_t *);
|
||||
tree gfc_build_cstring_const (const char *);
|
||||
tree gfc_build_localized_cstring_const (const char *);
|
||||
|
||||
|
|
|
@ -1,3 +1,9 @@
|
|||
2018-01-22 Janne Blomqvist <jb@gcc.gnu.org>
|
||||
|
||||
PR 78534
|
||||
PR 83704
|
||||
* gfortran.dg/string_1.f90: Remove printing the length.
|
||||
|
||||
2018-01-22 Richard Biener <rguenther@suse.de>
|
||||
|
||||
PR tree-optimization/83963
|
||||
|
|
|
@ -10,6 +10,4 @@ program main
|
|||
character (len=int(huge(0_4),kind=8) + 1_8) :: z ! { dg-error "too large" }
|
||||
character (len=int(huge(0_4),kind=8) + 0_8) :: w
|
||||
|
||||
print *, len(s)
|
||||
|
||||
end program main
|
||||
|
|
Loading…
Add table
Reference in a new issue