* [PATCH] PR 78534 Change character length from int to size_t
@ 2017-12-29 13:32 Janne Blomqvist
2017-12-30 14:59 ` Thomas Koenig
2018-01-03 18:34 ` Bob Deen
0 siblings, 2 replies; 76+ messages in thread
From: Janne Blomqvist @ 2017-12-29 13:32 UTC (permalink / raw)
To: fortran, gcc-patches; +Cc: Janne Blomqvist
In order to handle large character lengths on (L)LP64 targets, switch
the GFortran character length from an int to a size_t.
This is an ABI change, as procedures with character arguments take
hidden arguments with the character length.
I also changed the _size member in vtables from int to size_t, as
there were some cases where character lengths and sizes were
apparently mixed up and caused regressions otherwise. Although I
haven't tested, this might enable very large derived types as well.
Also, as there are some places in the frontend were negative character
lengths are used as special flag values, in the frontend the character
length is handled as a signed variable of the same size as a size_t,
although in the runtime library it really is size_t.
I haven't changed the character length variables for the co-array
intrinsics, as this is something that may need to be synchronized with
OpenCoarrays.
This is v5 of the patch. v4 was applied but caused breakage on big
endian targets. These have been fixed and tested, thanks to access to
the GCC compile farm.
Overview of v4 of the patch: v3 was applied but had to reverted due to
breaking bootstrap. The fix is in resolve.c:resolve_charlen, where
it's necessary to check that an expression is constant before using
mpz_sgn.
Overview of v3 of the patch: All the issues pointed out by FX's review
of v2 have been fixed. In particular, there are now new functions
gfc_mpz_get_hwi and gfc_mpz_set_hwi, similar to the GMP functions
mpz_get_si and mpz_set_si, except that they get/set a HOST_WIDE_INT
instead of a long value. Similarly, gfc_get_int_expr now takes a
HOST_WIDE_INT instead of a long, gfc_extract_long is replaced by
gfc_extract_hwi. Also, the preliminary work to handle
gfc_charlen_type_node being unsigned has been removed.
Regtested on x86_64-pc-linux-gnu, i686-pc-linux-gnu and
powerpc64-unknown-linux-gnu. Also regtested all three targets by
modifying gfortran-dg.exp to also test with "-g -flto", no new
failures observed.
frontend:
2017-12-29 Janne Blomqvist <jb@gcc.gnu.org>
PR fortran/78534
PR fortran/66310
* array.c (got_charlen): Use gfc_charlen_int_kind.
* class.c (gfc_find_derived_vtab): Use gfc_size_kind instead of
hardcoded kind.
(find_intrinsic_vtab): Likewise.
* decl.c (match_char_length): Use gfc_charlen_int_kind.
(add_init_expr_to_sym): Use gfc_charlen_t and gfc_charlen_int_kind.
(gfc_match_implicit): Use gfc_charlen_int_kind.
* dump-parse-tree.c (show_char_const): Use gfc_charlen_t and size_t.
(show_expr): Use HOST_WIDE_INT_PRINT_DEC.
* 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.
* frontend-passes.c (optimize_trim): Use gfc_charlen_int_kind.
* 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.
* gfortran.texi: Update description of hidden string length argument.
* iresolve.c (check_charlen_present): Use gfc_charlen_int_kind.
(gfc_resolve_char_achar): Likewise.
(gfc_resolve_repeat): Pass string length directly without
temporary, use gfc_charlen_int_kind.
(gfc_resolve_transfer): 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.
* primary.c (match_substring): Use gfc_charlen_int_kind.
* resolve.c (resolve_substring_charlen): Use gfc_charlen_int_kind.
(resolve_character_operator): Likewise.
(resolve_assoc_var): Likewise.
(resolve_select_type): Use HOST_WIDE_INT for charlen, use snprintf.
(resolve_charlen): Use mpz_sgn to determine sign.
* simplify.c (gfc_simplify_repeat): Use HOST_WIDE_INT/gfc_charlen_t
instead of long.
* symbol.c (generate_isocbinding_symbol): Use gfc_charlen_int_kind.
* 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 (gfc_trans_array_ctor_element): Use existing type.
(get_array_ctor_var_strlen): Use gfc_conv_mpz_to_tree_type.
(trans_array_constructor): Use existing type.
(get_array_charlen): Likewise.
* trans-const.c (gfc_conv_mpz_to_tree_type): New function.
* trans-const.h (gfc_conv_mpz_to_tree_type): New prototype.
* trans-decl.c (gfc_trans_deferred_vars): Use existing type.
(add_argument_checking): Likewise.
* 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.
(fill_with_spaces): Comment out memset() block due to spurious
-Wstringop-overflow warnings.
(gfc_trans_string_copy): Use gfc_charlen_type_node.
(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.
(set_string): Convert to right type in assignment.
* trans-stmt.c (gfc_trans_label_assign): Build const of
gfc_charlen_type_node.
(trans_associate_var): Likewise.
(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.
* trans-types.h: Fix comment.
testsuite:
2017-12-29 Janne Blomqvist <jb@gcc.gnu.org>
PR fortran/78534
PR fortran/66310
* gfortran.dg/char_cast_1.f90: Update scan pattern.
* gfortran.dg/dependency_49.f90: Likewise.
* 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.
libgfortran:
2017-12-29 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.
---
gcc/fortran/array.c | 2 +-
gcc/fortran/class.c | 12 ++--
gcc/fortran/decl.c | 12 ++--
gcc/fortran/dump-parse-tree.c | 9 ++-
gcc/fortran/expr.c | 76 +++++++++++++++++---
gcc/fortran/frontend-passes.c | 4 +-
gcc/fortran/gfortran.h | 23 ++++--
gcc/fortran/gfortran.texi | 42 +++++++++--
gcc/fortran/iresolve.c | 15 ++--
gcc/fortran/match.c | 8 +--
gcc/fortran/misc.c | 21 ++++++
gcc/fortran/module.c | 60 ++++++++++------
gcc/fortran/primary.c | 2 +-
gcc/fortran/resolve.c | 28 ++++----
gcc/fortran/simplify.c | 23 ++++--
gcc/fortran/symbol.c | 2 +-
gcc/fortran/target-memory.c | 19 +++--
gcc/fortran/target-memory.h | 2 +-
gcc/fortran/trans-array.c | 17 ++---
gcc/fortran/trans-const.c | 12 ++++
gcc/fortran/trans-const.h | 1 +
gcc/fortran/trans-decl.c | 10 +--
gcc/fortran/trans-expr.c | 97 +++++++++++++++-----------
gcc/fortran/trans-intrinsic.c | 46 ++++++------
gcc/fortran/trans-io.c | 7 +-
gcc/fortran/trans-stmt.c | 23 +++---
gcc/fortran/trans-types.c | 12 +++-
gcc/fortran/trans-types.h | 4 +-
gcc/testsuite/gfortran.dg/char_cast_1.f90 | 6 +-
gcc/testsuite/gfortran.dg/dependency_49.f90 | 2 +-
gcc/testsuite/gfortran.dg/repeat_4.f90 | 23 +++---
gcc/testsuite/gfortran.dg/repeat_7.f90 | 8 +++
gcc/testsuite/gfortran.dg/scan_2.f90 | 4 +-
gcc/testsuite/gfortran.dg/string_1.f90 | 1 +
gcc/testsuite/gfortran.dg/string_1_lp64.f90 | 15 ++++
gcc/testsuite/gfortran.dg/string_3.f90 | 1 +
gcc/testsuite/gfortran.dg/string_3_lp64.f90 | 20 ++++++
libgfortran/intrinsics/args.c | 10 +--
libgfortran/intrinsics/chmod.c | 3 +-
libgfortran/intrinsics/env.c | 3 +-
libgfortran/intrinsics/extends_type_of.c | 2 +-
libgfortran/intrinsics/gerror.c | 2 +-
libgfortran/intrinsics/getlog.c | 3 +-
libgfortran/intrinsics/hostnm.c | 5 +-
libgfortran/intrinsics/string_intrinsics_inc.c | 29 ++++----
libgfortran/io/transfer.c | 18 ++---
libgfortran/io/unit.c | 3 +-
libgfortran/io/write.c | 2 +-
libgfortran/libgfortran.h | 2 +-
49 files changed, 489 insertions(+), 262 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/repeat_7.f90
create mode 100644 gcc/testsuite/gfortran.dg/string_1_lp64.f90
create mode 100644 gcc/testsuite/gfortran.dg/string_3_lp64.f90
diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c
index 81476b2..2224540 100644
--- a/gcc/fortran/array.c
+++ b/gcc/fortran/array.c
@@ -2039,7 +2039,7 @@ got_charlen:
gcc_assert (found_length != -1);
/* Update the character length of the array constructor. */
- expr->ts.u.cl->length = gfc_get_int_expr (gfc_default_integer_kind,
+ expr->ts.u.cl->length = gfc_get_int_expr (gfc_charlen_int_kind,
NULL, found_length);
}
else
diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index a08fb8d..e3b550b 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(4) to store the string length when the unlimited
+ * _len: An integer(C_SIZE_T) 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'.
@@ -2317,13 +2317,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 = 4;
+ c->ts.kind = gfc_size_kind;
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_default_integer_kind,
+ c->initializer = gfc_get_int_expr (gfc_size_kind,
NULL, 0);
/* Add component _extends. */
@@ -2685,7 +2685,7 @@ find_intrinsic_vtab (gfc_typespec *ts)
if (!gfc_add_component (vtype, "_size", &c))
goto cleanup;
c->ts.type = BT_INTEGER;
- c->ts.kind = 4;
+ c->ts.kind = gfc_size_kind;
c->attr.access = ACCESS_PRIVATE;
/* Build a minimal expression to make use of
@@ -2696,11 +2696,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_default_integer_kind,
+ c->initializer = gfc_get_int_expr (gfc_size_kind,
NULL,
ts->type == BT_CHARACTER
? ts->kind
- : (int)gfc_element_size (e));
+ : gfc_element_size (e));
gfc_free_expr (e);
/* Add component _extends. */
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index d2c794f..414d0cb 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -995,7 +995,7 @@ match_char_length (gfc_expr **expr, bool *deferred, bool obsolescent_check)
if (obsolescent_check
&& !gfc_notify_std (GFC_STD_F95_OBS, "Old-style character length at %C"))
return MATCH_ERROR;
- *expr = gfc_get_int_expr (gfc_default_integer_kind, NULL, length);
+ *expr = gfc_get_int_expr (gfc_charlen_int_kind, NULL, length);
return m;
}
@@ -1702,7 +1702,7 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus)
if (sym->ts.u.cl->length == NULL)
{
- int clen;
+ gfc_charlen_t clen;
/* If there are multiple CHARACTER variables declared on the
same line, we don't want them to share the same length. */
sym->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL);
@@ -1713,7 +1713,7 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus)
{
clen = init->value.character.length;
sym->ts.u.cl->length
- = gfc_get_int_expr (gfc_default_integer_kind,
+ = gfc_get_int_expr (gfc_charlen_int_kind,
NULL, clen);
}
else if (init->expr_type == EXPR_ARRAY)
@@ -1740,7 +1740,7 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus)
else
gcc_unreachable ();
sym->ts.u.cl->length
- = gfc_get_int_expr (gfc_default_integer_kind,
+ = gfc_get_int_expr (gfc_charlen_int_kind,
NULL, clen);
}
else if (init->ts.u.cl && init->ts.u.cl->length)
@@ -3073,7 +3073,7 @@ done:
cl = gfc_new_charlen (gfc_current_ns, NULL);
if (seen_length == 0)
- cl->length = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1);
+ cl->length = gfc_get_int_expr (gfc_charlen_int_kind, NULL, 1);
else
cl->length = len;
@@ -4315,7 +4315,7 @@ gfc_match_implicit (void)
{
ts.kind = gfc_default_character_kind;
ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL);
- ts.u.cl->length = gfc_get_int_expr (gfc_default_integer_kind,
+ ts.u.cl->length = gfc_get_int_expr (gfc_charlen_int_kind,
NULL, 1);
}
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 5193c29..617bada 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -348,12 +348,10 @@ show_constructor (gfc_constructor_base base)
static void
-show_char_const (const gfc_char_t *c, int length)
+show_char_const (const gfc_char_t *c, gfc_charlen_t length)
{
- int i;
-
fputc ('\'', dumpfile);
- for (i = 0; i < length; i++)
+ for (size_t i = 0; i < (size_t) length; i++)
{
if (c[i] == '\'')
fputs ("''", dumpfile);
@@ -465,7 +463,8 @@ show_expr (gfc_expr *p)
break;
case BT_HOLLERITH:
- fprintf (dumpfile, "%dH", p->representation.length);
+ fprintf (dumpfile, HOST_WIDE_INT_PRINT_DEC "H",
+ 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 2cdd465..fe05440 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -27,6 +27,7 @@ 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
@@ -184,7 +185,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, int len)
+gfc_get_character_expr (int kind, locus *where, const char *src, gfc_charlen_t len)
{
gfc_expr *e;
gfc_char_t *dest;
@@ -210,13 +211,14 @@ gfc_get_character_expr (int kind, locus *where, const char *src, int len)
/* Get a new expression node that is an integer constant. */
gfc_expr *
-gfc_get_int_expr (int kind, locus *where, int value)
+gfc_get_int_expr (int kind, locus *where, HOST_WIDE_INT value)
{
gfc_expr *p;
p = gfc_get_constant_expr (BT_INTEGER, kind,
where ? where : &gfc_current_locus);
- mpz_set_si (p->value.integer, value);
+ const wide_int w = wi::shwi (value, kind * BITS_PER_UNIT);
+ wi::to_mpz (w, p->value.integer, SIGNED);
return p;
}
@@ -672,6 +674,62 @@ gfc_extract_int (gfc_expr *expr, int *result, int report_error)
}
+/* Same as gfc_extract_int, but use a HWI. */
+
+bool
+gfc_extract_hwi (gfc_expr *expr, HOST_WIDE_INT *result, int report_error)
+{
+ gfc_ref *ref;
+
+ /* A KIND component is a parameter too. The expression for it is
+ stored in the initializer and should be consistent with the tests
+ below. */
+ if (gfc_expr_attr(expr).pdt_kind)
+ {
+ for (ref = expr->ref; ref; ref = ref->next)
+ {
+ if (ref->u.c.component->attr.pdt_kind)
+ expr = ref->u.c.component->initializer;
+ }
+ }
+
+ if (expr->expr_type != EXPR_CONSTANT)
+ {
+ if (report_error > 0)
+ gfc_error ("Constant expression required at %C");
+ else if (report_error < 0)
+ gfc_error_now ("Constant expression required at %C");
+ return true;
+ }
+
+ if (expr->ts.type != BT_INTEGER)
+ {
+ if (report_error > 0)
+ gfc_error ("Integer expression required at %C");
+ else if (report_error < 0)
+ gfc_error_now ("Integer expression required at %C");
+ return true;
+ }
+
+ /* 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))
+ {
+ if (report_error > 0)
+ gfc_error ("Integer value too large in expression at %C");
+ else if (report_error < 0)
+ gfc_error_now ("Integer value too large in expression at %C");
+ return true;
+ }
+
+ *result = val.to_shwi ();
+
+ return false;
+}
+
+
/* Recursively copy a list of reference structures. */
gfc_ref *
@@ -1701,7 +1759,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). */
- int string_len;
+ gfc_charlen_t string_len;
if ((c = gfc_constructor_first (p->value.constructor)))
{
const gfc_expr* first = c->expr;
@@ -1719,7 +1777,7 @@ simplify_const_ref (gfc_expr *p)
gfc_free_expr (p->ts.u.cl->length);
p->ts.u.cl->length
- = gfc_get_int_expr (gfc_default_integer_kind,
+ = gfc_get_int_expr (gfc_charlen_int_kind,
NULL, string_len);
}
}
@@ -1870,18 +1928,18 @@ gfc_simplify_expr (gfc_expr *p, int type)
if (gfc_is_constant_expr (p))
{
gfc_char_t *s;
- int start, end;
+ HOST_WIDE_INT start, end;
start = 0;
if (p->ref && p->ref->u.ss.start)
{
- gfc_extract_int (p->ref->u.ss.start, &start);
+ gfc_extract_hwi (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_int (p->ref->u.ss.end, &end);
+ gfc_extract_hwi (p->ref->u.ss.end, &end);
if (end < start)
end = start;
@@ -1894,7 +1952,7 @@ gfc_simplify_expr (gfc_expr *p, int type)
p->value.character.string = s;
p->value.character.length = end - start;
p->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL);
- p->ts.u.cl->length = gfc_get_int_expr (gfc_default_integer_kind,
+ p->ts.u.cl->length = gfc_get_int_expr (gfc_charlen_int_kind,
NULL,
p->value.character.length);
gfc_free_ref_list (p->ref);
diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c
index 7c515f6..2123da4 100644
--- a/gcc/fortran/frontend-passes.c
+++ b/gcc/fortran/frontend-passes.c
@@ -2224,11 +2224,11 @@ optimize_trim (gfc_expr *e)
/* Set the start of the reference. */
- ref->u.ss.start = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1);
+ ref->u.ss.start = gfc_get_int_expr (gfc_charlen_int_kind, NULL, 1);
/* Build the function call to len_trim(x, gfc_default_integer_kind). */
- fcn = get_len_trim_call (gfc_copy_expr (e), gfc_default_integer_kind);
+ fcn = get_len_trim_call (gfc_copy_expr (e), gfc_charlen_int_kind);
/* Set the end of the reference to the call to len_trim. */
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 7b837c9..3236bf4 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2092,6 +2092,14 @@ 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;
@@ -2137,7 +2145,7 @@ typedef struct gfc_expr
the value. */
struct
{
- int length;
+ gfc_charlen_t length;
char *string;
}
representation;
@@ -2193,7 +2201,7 @@ typedef struct gfc_expr
struct
{
- int length;
+ gfc_charlen_t length;
gfc_char_t *string;
}
character;
@@ -2809,6 +2817,9 @@ vec_push (char **&optr, size_t &osz, const char *elt)
optr[++osz] = NULL;
}
+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 *);
@@ -2900,6 +2911,7 @@ 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;
@@ -3134,7 +3146,10 @@ void gfc_resolve_oacc_blocks (gfc_code *, gfc_namespace *);
/* expr.c */
void gfc_free_actual_arglist (gfc_actual_arglist *);
gfc_actual_arglist *gfc_copy_actual_arglist (gfc_actual_arglist *);
+
bool gfc_extract_int (gfc_expr *, int *, int = 0);
+bool gfc_extract_hwi (gfc_expr *, HOST_WIDE_INT *, int = 0);
+
bool is_subref_array (gfc_expr *);
bool gfc_is_simply_contiguous (gfc_expr *, bool, bool);
bool gfc_check_init_expr (gfc_expr *);
@@ -3152,8 +3167,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 *, int len);
-gfc_expr *gfc_get_int_expr (int, locus *, int);
+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_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 fc95ec0..160d406 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -3925,12 +3925,42 @@ 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 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.
+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__ > 7
+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.
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 3226a88..561cf28 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -82,7 +82,7 @@ check_charlen_present (gfc_expr *source)
if (source->expr_type == EXPR_CONSTANT)
{
source->ts.u.cl->length
- = gfc_get_int_expr (gfc_default_integer_kind, NULL,
+ = gfc_get_int_expr (gfc_charlen_int_kind, NULL,
source->value.character.length);
source->rank = 0;
}
@@ -90,7 +90,7 @@ check_charlen_present (gfc_expr *source)
{
gfc_constructor *c = gfc_constructor_first (source->value.constructor);
source->ts.u.cl->length
- = gfc_get_int_expr (gfc_default_integer_kind, NULL,
+ = gfc_get_int_expr (gfc_charlen_int_kind, NULL,
c->expr->value.character.length);
}
}
@@ -247,7 +247,7 @@ gfc_resolve_char_achar (gfc_expr *f, gfc_expr *x, gfc_expr *kind,
f->ts.kind = (kind == NULL)
? gfc_default_character_kind : mpz_get_si (kind->value.integer);
f->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL);
- f->ts.u.cl->length = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1);
+ f->ts.u.cl->length = gfc_get_int_expr (gfc_charlen_int_kind, NULL, 1);
f->value.function.name
= gfc_get_string ("__%schar_%d_%c%d", is_achar ? "a" : "", f->ts.kind,
@@ -2243,7 +2243,6 @@ 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;
@@ -2256,8 +2255,8 @@ gfc_resolve_repeat (gfc_expr *f, gfc_expr *string,
tmp = NULL;
if (string->expr_type == EXPR_CONSTANT)
{
- len = string->value.character.length;
- tmp = gfc_get_int_expr (gfc_default_integer_kind, NULL , len);
+ tmp = gfc_get_int_expr (gfc_charlen_int_kind, NULL,
+ string->value.character.length);
}
else if (string->ts.u.cl && string->ts.u.cl->length)
{
@@ -3023,14 +3022,14 @@ gfc_resolve_transfer (gfc_expr *f, gfc_expr *source ATTRIBUTE_UNUSED,
if (mold->expr_type == EXPR_CONSTANT)
{
len = mold->value.character.length;
- mold->ts.u.cl->length = gfc_get_int_expr (gfc_default_integer_kind,
+ mold->ts.u.cl->length = gfc_get_int_expr (gfc_charlen_int_kind,
NULL, len);
}
else
{
gfc_constructor *c = gfc_constructor_first (mold->value.constructor);
len = c->expr->value.character.length;
- mold->ts.u.cl->length = gfc_get_int_expr (gfc_default_integer_kind,
+ mold->ts.u.cl->length = gfc_get_int_expr (gfc_charlen_int_kind,
NULL, len);
}
}
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index d251a4d..4bc5a9c 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -5878,7 +5878,7 @@ select_intrinsic_set_tmp (gfc_typespec *ts)
{
char name[GFC_MAX_SYMBOL_LEN];
gfc_symtree *tmp;
- int charlen = 0;
+ HOST_WIDE_INT charlen = 0;
if (ts->type == BT_CLASS || ts->type == BT_DERIVED)
return NULL;
@@ -5889,14 +5889,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 = mpz_get_si (ts->u.cl->length->value.integer);
+ charlen = gfc_mpz_get_hwi (ts->u.cl->length->value.integer);
if (ts->type != BT_CHARACTER)
sprintf (name, "__tmp_%s_%d", gfc_basic_typename (ts->type),
ts->kind);
else
- sprintf (name, "__tmp_%s_%d_%d", gfc_basic_typename (ts->type),
- charlen, ts->kind);
+ snprintf (name, sizeof (name), "__tmp_%s_" HOST_WIDE_INT_PRINT_DEC "_%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 f47d111..52193c1 100644
--- a/gcc/fortran/misc.c
+++ b/gcc/fortran/misc.c
@@ -23,6 +23,7 @@ along with GCC; see the file COPYING3. If not see
#include "coretypes.h"
#include "gfortran.h"
#include "spellcheck.h"
+#include "tree.h"
/* Initialize a typespec to unknown. */
@@ -321,3 +322,23 @@ gfc_closest_fuzzy_match (const char *typo, char **candidates)
}
return best;
}
+
+/* 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 16585a9..3ebc9f7 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -143,7 +143,7 @@ enum gfc_wsym_state
typedef struct pointer_info
{
BBT_HEADER (pointer_info);
- int integer;
+ HOST_WIDE_INT integer;
pointer_t type;
/* The first component of each member of the union is the pointer
@@ -368,7 +368,7 @@ get_pointer (void *gp)
creating the node if not found. */
static pointer_info *
-get_integer (int integer)
+get_integer (HOST_WIDE_INT integer)
{
pointer_info *p, t;
int c;
@@ -468,7 +468,7 @@ associate_integer_pointer (pointer_info *p, void *gp)
sometime later. Returns the pointer_info structure. */
static pointer_info *
-add_fixup (int integer, void *gp)
+add_fixup (HOST_WIDE_INT integer, void *gp)
{
pointer_info *p;
fixup_t *f;
@@ -1145,7 +1145,7 @@ static atom_type last_atom;
#define MAX_ATOM_SIZE 100
-static int atom_int;
+static HOST_WIDE_INT atom_int;
static char *atom_string, atom_name[MAX_ATOM_SIZE];
@@ -1275,7 +1275,7 @@ parse_string (void)
}
-/* Parse a small integer. */
+/* Parse an integer. Should fit in a HOST_WIDE_INT. */
static void
parse_integer (int c)
@@ -1292,8 +1292,6 @@ parse_integer (int c)
}
atom_int = 10 * atom_int + c - '0';
- if (atom_int > 99999999)
- bad_module ("Integer overflow");
}
}
@@ -1635,11 +1633,12 @@ write_char (char out)
static void
write_atom (atom_type atom, const void *v)
{
- char buffer[20];
+ char buffer[32];
/* Workaround -Wmaybe-uninitialized false positive during
profiledbootstrap by initializing them. */
- int i = 0, len;
+ int len;
+ HOST_WIDE_INT i = 0;
const char *p;
switch (atom)
@@ -1658,11 +1657,9 @@ write_atom (atom_type atom, const void *v)
break;
case ATOM_INTEGER:
- i = *((const int *) v);
- if (i < 0)
- gfc_internal_error ("write_atom(): Writing negative integer");
+ i = *((const HOST_WIDE_INT *) v);
- sprintf (buffer, "%d", i);
+ snprintf (buffer, sizeof (buffer), HOST_WIDE_INT_PRINT_DEC, i);
p = buffer;
break;
@@ -1770,7 +1767,10 @@ static void
mio_integer (int *ip)
{
if (iomode == IO_OUTPUT)
- write_atom (ATOM_INTEGER, ip);
+ {
+ HOST_WIDE_INT hwi = *ip;
+ write_atom (ATOM_INTEGER, &hwi);
+ }
else
{
require_atom (ATOM_INTEGER);
@@ -1778,6 +1778,18 @@ 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. */
@@ -1787,7 +1799,7 @@ mio_intrinsic_op (gfc_intrinsic_op* op)
/* FIXME: Would be nicer to do this via the operators symbolic name. */
if (iomode == IO_OUTPUT)
{
- int converted = (int) *op;
+ HOST_WIDE_INT converted = (HOST_WIDE_INT) *op;
write_atom (ATOM_INTEGER, &converted);
}
else
@@ -2719,7 +2731,7 @@ mio_array_ref (gfc_array_ref *ar)
{
for (i = 0; i < ar->dimen; i++)
{
- int tmp = (int)ar->dimen_type[i];
+ HOST_WIDE_INT tmp = (HOST_WIDE_INT)ar->dimen_type[i];
write_atom (ATOM_INTEGER, &tmp);
}
}
@@ -2756,7 +2768,8 @@ mio_pointer_ref (void *gp)
if (iomode == IO_OUTPUT)
{
p = get_pointer (*((char **) gp));
- write_atom (ATOM_INTEGER, &p->integer);
+ HOST_WIDE_INT hwi = p->integer;
+ write_atom (ATOM_INTEGER, &hwi);
}
else
{
@@ -2794,18 +2807,18 @@ static void
mio_component (gfc_component *c, int vtype)
{
pointer_info *p;
- int n;
mio_lparen ();
if (iomode == IO_OUTPUT)
{
p = get_pointer (c);
- mio_integer (&p->integer);
+ mio_hwi (&p->integer);
}
else
{
- mio_integer (&n);
+ HOST_WIDE_INT n;
+ mio_hwi (&n);
p = get_integer (n);
associate_integer_pointer (p, c);
}
@@ -3430,6 +3443,7 @@ 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;
@@ -3644,7 +3658,9 @@ mio_expr (gfc_expr **ep)
break;
case BT_CHARACTER:
- mio_integer (&e->value.character.length);
+ hwi = e->value.character.length;
+ mio_hwi (&hwi);
+ e->value.character.length = hwi;
e->value.character.string
= CONST_CAST (gfc_char_t *,
mio_allocated_wide_string (e->value.character.string,
@@ -5946,7 +5962,7 @@ write_symtree (gfc_symtree *st)
mio_pool_string (&st->name);
mio_integer (&st->ambiguous);
- mio_integer (&p->integer);
+ mio_hwi (&p->integer);
}
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index 8537d93..31b7da8 100644
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -862,7 +862,7 @@ match_substring (gfc_charlen *cl, int init, gfc_ref **result, bool deferred)
ref->type = REF_SUBSTRING;
if (start == NULL)
- start = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1);
+ start = gfc_get_int_expr (gfc_charlen_int_kind, NULL, 1);
ref->u.ss.start = start;
if (end == NULL && cl)
end = gfc_copy_expr (cl->length);
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index cf75a78..b543015 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -4901,7 +4901,7 @@ gfc_resolve_substring_charlen (gfc_expr *e)
if (char_ref->u.ss.start)
start = gfc_copy_expr (char_ref->u.ss.start);
else
- start = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1);
+ start = gfc_get_int_expr (gfc_charlen_int_kind, NULL, 1);
if (char_ref->u.ss.end)
end = gfc_copy_expr (char_ref->u.ss.end);
@@ -4924,7 +4924,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_default_integer_kind,
+ gfc_get_int_expr (gfc_charlen_int_kind,
NULL, 1));
/* F2008, 6.4.1: Both the starting point and the ending point shall
@@ -5690,13 +5690,13 @@ gfc_resolve_character_operator (gfc_expr *e)
if (op1->ts.u.cl && op1->ts.u.cl->length)
e1 = gfc_copy_expr (op1->ts.u.cl->length);
else if (op1->expr_type == EXPR_CONSTANT)
- e1 = gfc_get_int_expr (gfc_default_integer_kind, NULL,
+ e1 = gfc_get_int_expr (gfc_charlen_int_kind, NULL,
op1->value.character.length);
if (op2->ts.u.cl && op2->ts.u.cl->length)
e2 = gfc_copy_expr (op2->ts.u.cl->length);
else if (op2->expr_type == EXPR_CONSTANT)
- e2 = gfc_get_int_expr (gfc_default_integer_kind, NULL,
+ e2 = gfc_get_int_expr (gfc_charlen_int_kind, NULL,
op2->value.character.length);
e->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL);
@@ -8630,7 +8630,7 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
if (!sym->ts.u.cl->length && !sym->ts.deferred
&& target->expr_type == EXPR_CONSTANT)
sym->ts.u.cl->length
- = gfc_get_int_expr (gfc_default_integer_kind,
+ = gfc_get_int_expr (gfc_charlen_int_kind,
NULL, target->value.character.length);
}
@@ -8715,7 +8715,6 @@ 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;
@@ -8966,11 +8965,13 @@ 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 = 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);
+ 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);
}
else
sprintf (name, "__tmp_%s_%d", gfc_basic_typename (c->ts.type),
@@ -11640,7 +11641,7 @@ resolve_index_expr (gfc_expr *e)
static bool
resolve_charlen (gfc_charlen *cl)
{
- int i, k;
+ int k;
bool saved_specification_expr;
if (cl->resolved)
@@ -11676,9 +11677,10 @@ 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 && !gfc_extract_int (cl->length, &i) && i < 0)
+ if (cl->length && cl->length->expr_type == EXPR_CONSTANT
+ && mpz_sgn (cl->length->value.integer) < 0)
gfc_replace_expr (cl->length,
- gfc_get_int_expr (gfc_default_integer_kind, NULL, 0));
+ gfc_get_int_expr (gfc_charlen_int_kind, NULL, 0));
/* Check that the character length is not too large. */
k = gfc_validate_kind (BT_INTEGER, gfc_charlen_int_kind, false);
@@ -15937,7 +15939,7 @@ resolve_equivalence (gfc_equiv *eq)
{
ref->type = REF_SUBSTRING;
if (start == NULL)
- start = gfc_get_int_expr (gfc_default_integer_kind,
+ start = gfc_get_int_expr (gfc_charlen_int_kind,
NULL, 1);
ref->u.ss.start = start;
if (end == NULL && e->ts.u.cl)
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 7c3fefe..0934a38 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -5209,7 +5209,7 @@ gfc_expr *
gfc_simplify_repeat (gfc_expr *e, gfc_expr *n)
{
gfc_expr *result;
- int i, j, len, ncop, nlen;
+ gfc_charlen_t len;
mpz_t ncopies;
bool have_length = false;
@@ -5229,7 +5229,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 = mpz_get_si (e->ts.u.cl->length->value.integer);
+ len = gfc_mpz_get_hwi (e->ts.u.cl->length->value.integer);
have_length = true;
}
else if (e->expr_type == EXPR_CONSTANT
@@ -5265,7 +5265,8 @@ gfc_simplify_repeat (gfc_expr *e, gfc_expr *n)
}
else
{
- mpz_init_set_si (mlen, len);
+ mpz_init (mlen);
+ gfc_mpz_set_hwi (mlen, len);
mpz_tdiv_q (max, gfc_integer_kinds[i].huge, mlen);
mpz_clear (mlen);
}
@@ -5289,11 +5290,12 @@ 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))
{
- bool fail = gfc_extract_int (n, &ncop);
+ bool fail = gfc_extract_hwi (n, &ncop);
gcc_assert (!fail);
}
else
@@ -5303,11 +5305,18 @@ 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;
- nlen = ncop * len;
+ 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;
result = gfc_get_character_expr (e->ts.kind, &e->where, NULL, nlen);
- for (i = 0; i < ncop; i++)
- for (j = 0; j < len; j++)
+ for (size_t i = 0; i < (size_t) ncop; i++)
+ for (size_t j = 0; j < (size_t) 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/symbol.c b/gcc/fortran/symbol.c
index dc1688a..f4a5c17 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -4856,7 +4856,7 @@ generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s,
tmp_sym->value->value.character.string[0]
= (gfc_char_t) c_interop_kinds_table[s].value;
tmp_sym->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL);
- tmp_sym->ts.u.cl->length = gfc_get_int_expr (gfc_default_integer_kind,
+ tmp_sym->ts.u.cl->length = gfc_get_int_expr (gfc_charlen_int_kind,
NULL, 1);
/* May not need this in both attr and ts, but do need in
diff --git a/gcc/fortran/target-memory.c b/gcc/fortran/target-memory.c
index b2fe8ee..f449278 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 (int length, int kind)
+size_character (gfc_charlen_t 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)
{
- int length;
+ HOST_WIDE_INT length;
- gfc_extract_int (e->ts.u.cl->length, &length);
+ gfc_extract_hwi (e->ts.u.cl->length, &length);
return size_character (length, e->ts.kind);
}
else
@@ -217,16 +217,15 @@ encode_logical (int kind, int logical, unsigned char *buffer, size_t buffer_size
int
-gfc_encode_character (int kind, int length, const gfc_char_t *string,
+gfc_encode_character (int kind, gfc_charlen_t 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 (i = 0; i < length; i++)
+ for (size_t i = 0; i < (size_t) length; i++)
native_encode_expr (build_int_cst (type, string[i]), &buffer[i*elsize],
elsize);
@@ -438,11 +437,9 @@ 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 =
- (int) mpz_get_ui (result->ts.u.cl->length->value.integer);
+ gfc_mpz_get_hwi (result->ts.u.cl->length->value.integer);
gcc_assert (buffer_size >= size_character (result->value.character.length,
result->ts.kind));
@@ -450,7 +447,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 (i = 0; i < result->value.character.length; i++)
+ for (size_t i = 0; i < (size_t) result->value.character.length; i++)
result->value.character.string[i] = (gfc_char_t) buffer[i];
else
{
@@ -459,7 +456,7 @@ gfc_interpret_character (unsigned char *buffer, size_t buffer_size,
mpz_init (integer);
gcc_assert (bytes <= sizeof (unsigned long));
- for (i = 0; i < result->value.character.length; i++)
+ for (size_t i = 0; i < (size_t) 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 5d46553..ddcaf60 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, int, const gfc_char_t *, unsigned char *,
+int gfc_encode_character (int, gfc_charlen_t, 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 1b6e215..2a534c7 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -1537,8 +1537,8 @@ gfc_trans_array_ctor_element (stmtblock_t * pblock, tree desc,
esize = size_in_bytes (gfc_get_element_type (TREE_TYPE (desc)));
esize = fold_convert (gfc_charlen_type_node, esize);
esize = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
- gfc_charlen_type_node, esize,
- build_int_cst (gfc_charlen_type_node,
+ TREE_TYPE (esize), esize,
+ build_int_cst (TREE_TYPE (esize),
gfc_character_kinds[i].bit_size / 8));
gfc_conv_string_parameter (se);
@@ -2059,8 +2059,7 @@ 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 (char_len, gfc_default_integer_kind);
- *len = convert (gfc_charlen_type_node, *len);
+ *len = gfc_conv_mpz_to_tree_type (char_len, gfc_charlen_type_node);
mpz_clear (char_len);
return;
@@ -2428,7 +2427,8 @@ trans_array_constructor (gfc_ss * ss, locus * where)
set LEN = 0. */
neg_len = fold_build2_loc (input_location, LT_EXPR,
logical_type_node, ss_info->string_length,
- build_int_cst (gfc_charlen_type_node, 0));
+ build_zero_cst (TREE_TYPE
+ (ss_info->string_length)));
/* Print a warning if bounds checking is enabled. */
if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
{
@@ -2441,7 +2441,8 @@ trans_array_constructor (gfc_ss * ss, locus * where)
ss_info->string_length
= fold_build3_loc (input_location, COND_EXPR,
gfc_charlen_type_node, neg_len,
- build_int_cst (gfc_charlen_type_node, 0),
+ build_zero_cst
+ (TREE_TYPE (ss_info->string_length)),
ss_info->string_length);
ss_info->string_length = gfc_evaluate_now (ss_info->string_length,
&length_se.pre);
@@ -6878,8 +6879,8 @@ get_array_charlen (gfc_expr *expr, gfc_se *se)
gfc_add_block_to_block (&se->post, &tse.post);
tse.expr = fold_convert (gfc_charlen_type_node, tse.expr);
tse.expr = fold_build2_loc (input_location, MAX_EXPR,
- gfc_charlen_type_node, tse.expr,
- build_int_cst (gfc_charlen_type_node, 0));
+ TREE_TYPE (tse.expr), tse.expr,
+ build_zero_cst (TREE_TYPE (tse.expr)));
expr->ts.u.cl->backend_decl = tse.expr;
gfc_free_interface_mapping (&mapping);
break;
diff --git a/gcc/fortran/trans-const.c b/gcc/fortran/trans-const.c
index 62b85f7..6ed852c 100644
--- a/gcc/fortran/trans-const.c
+++ b/gcc/fortran/trans-const.c
@@ -206,6 +206,18 @@ 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 9730867..7863e83 100644
--- a/gcc/fortran/trans-const.h
+++ b/gcc/fortran/trans-const.h
@@ -20,6 +20,7 @@ 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-decl.c b/gcc/fortran/trans-decl.c
index 35dee61..56fb3fd 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -4280,10 +4280,11 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
{
tmp = proc_sym->ts.u.cl->passed_length;
tmp = build_fold_indirect_ref_loc (input_location, tmp);
- tmp = fold_convert (gfc_charlen_type_node, tmp);
tmp = fold_build2_loc (input_location, MODIFY_EXPR,
- gfc_charlen_type_node, tmp,
- proc_sym->ts.u.cl->backend_decl);
+ TREE_TYPE (tmp), tmp,
+ fold_convert
+ (TREE_TYPE (tmp),
+ proc_sym->ts.u.cl->backend_decl));
}
else
tmp = NULL_TREE;
@@ -5840,7 +5841,8 @@ add_argument_checking (stmtblock_t *block, gfc_symbol *sym)
not_0length = fold_build2_loc (input_location, NE_EXPR,
logical_type_node,
cl->passed_length,
- build_zero_cst (gfc_charlen_type_node));
+ build_zero_cst
+ (TREE_TYPE (cl->passed_length)));
/* The symbol needs to be referenced for gfc_get_symbol_decl. */
fsym->attr.referenced = 1;
not_absent = gfc_conv_expr_present (fsym);
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 30151dd..dccfb95 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)
- : integer_zero_node;
+ : build_zero_cst (gfc_charlen_type_node);
}
@@ -884,7 +884,8 @@ 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, 4,
+ e->ts.u.cl->length = gfc_get_constant_expr (BT_INTEGER,
+ gfc_charlen_int_kind,
&e->where);
mpz_set_ui (e->ts.u.cl->length->value.integer,
e->value.character.length);
@@ -902,7 +903,7 @@ gfc_conv_intrinsic_to_class (gfc_se *parmse, gfc_expr *e,
else
tmp = integer_zero_node;
- gfc_add_modify (&parmse->pre, ctree, tmp);
+ gfc_add_modify (&parmse->pre, ctree, fold_convert (TREE_TYPE (ctree), tmp));
}
else if (class_ts.type == BT_CLASS
&& class_ts.u.derived->components
@@ -1045,7 +1046,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 = integer_zero_node;
+ slen = build_zero_cst (size_type_node);
}
else
{
@@ -1096,7 +1097,7 @@ gfc_conv_class_to_class (gfc_se *parmse, gfc_expr *e, gfc_typespec class_ts,
tmp = slen;
}
else
- tmp = integer_zero_node;
+ tmp = build_zero_cst (size_type_node);
gfc_add_modify (&parmse->pre, ctree,
fold_convert (TREE_TYPE (ctree), tmp));
@@ -1235,7 +1236,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 = integer_zero_node;
+ from_len = build_zero_cst (size_type_node);
}
if (GFC_CLASS_TYPE_P (TREE_TYPE (to)))
@@ -1347,7 +1348,7 @@ gfc_copy_class_to_class (tree from, tree to, tree nelems, bool unlimited)
tmp = fold_build2_loc (input_location, GT_EXPR,
logical_type_node, from_len,
- integer_zero_node);
+ build_zero_cst (TREE_TYPE (from_len)));
tmp = fold_build3_loc (input_location, COND_EXPR,
void_type_node, tmp, extcopy, stdcopy);
gfc_add_expr_to_block (&body, tmp);
@@ -1375,7 +1376,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,
logical_type_node, from_len,
- integer_zero_node);
+ build_zero_cst (TREE_TYPE (from_len)));
tmp = fold_build3_loc (input_location, COND_EXPR,
void_type_node, tmp, extcopy, stdcopy);
}
@@ -2206,7 +2207,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_int_cst (gfc_charlen_type_node, 0));
+ se.expr, build_zero_cst (TREE_TYPE (se.expr)));
gfc_add_block_to_block (pblock, &se.pre);
if (cl->backend_decl)
@@ -2278,7 +2279,7 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind,
/* Check lower bound. */
fault = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
start.expr,
- build_int_cst (gfc_charlen_type_node, 1));
+ build_one_cst (TREE_TYPE (start.expr)));
fault = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
logical_type_node, nonempty, fault);
if (name)
@@ -2314,9 +2315,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))
{
- int i_len;
+ HOST_WIDE_INT i_len;
- i_len = mpz_get_si (length) + 1;
+ i_len = gfc_mpz_get_hwi (length) + 1;
if (i_len < 0)
i_len = 0;
@@ -2326,7 +2327,8 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind,
else
{
tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_charlen_type_node,
- end.expr, start.expr);
+ fold_convert (gfc_charlen_type_node, end.expr),
+ fold_convert (gfc_charlen_type_node, 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,
@@ -3129,9 +3131,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, len,
- build_int_cst (gfc_charlen_type_node, 1));
- tmp = build_range_type (gfc_array_index_type, gfc_index_zero_node, tmp);
+ TREE_TYPE (len), len,
+ build_int_cst (TREE_TYPE (len), 1));
+ tmp = build_range_type (gfc_charlen_type_node, size_zero_node, tmp);
if (TREE_CODE (TREE_TYPE (type)) == ARRAY_TYPE)
tmp = build_array_type (TREE_TYPE (TREE_TYPE (type)), tmp);
@@ -3193,8 +3195,11 @@ gfc_conv_concat_op (gfc_se * se, gfc_expr * expr)
if (len == NULL_TREE)
{
len = fold_build2_loc (input_location, PLUS_EXPR,
- TREE_TYPE (lse.string_length),
- lse.string_length, rse.string_length);
+ gfc_charlen_type_node,
+ fold_convert (gfc_charlen_type_node,
+ lse.string_length),
+ fold_convert (gfc_charlen_type_node,
+ rse.string_length));
}
type = build_pointer_type (type);
@@ -5920,11 +5925,10 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
gfc_conv_expr (&parmse, ts.u.cl->length);
gfc_add_block_to_block (&se->pre, &parmse.pre);
gfc_add_block_to_block (&se->post, &parmse.post);
-
- tmp = fold_convert (gfc_charlen_type_node, parmse.expr);
+ tmp = parmse.expr;
tmp = fold_build2_loc (input_location, MAX_EXPR,
- gfc_charlen_type_node, tmp,
- build_int_cst (gfc_charlen_type_node, 0));
+ TREE_TYPE (tmp), tmp,
+ build_zero_cst (TREE_TYPE (tmp)));
cl.backend_decl = tmp;
}
@@ -6403,13 +6407,16 @@ fill_with_spaces (tree start, tree type, tree size)
tree i, el, exit_label, cond, tmp;
/* For a simple char type, we can call memset(). */
+ /* TODO: This code does work and is potentially more efficient, but
+ causes spurious -Wstringop-overflow warnings.
if (compare_tree_int (TYPE_SIZE_UNIT (type), 1) == 0)
return build_call_expr_loc (input_location,
builtin_decl_explicit (BUILT_IN_MEMSET),
3, start,
build_int_cst (gfc_get_int_type (gfc_c_int_kind),
lang_hooks.to_target_charset (' ')),
- size);
+ fold_convert (size_type_node, size));
+ */
/* Otherwise, we use a loop:
for (el = start, i = size; i > 0; el--, i+= TYPE_SIZE_UNIT (type))
@@ -6485,23 +6492,23 @@ gfc_trans_string_copy (stmtblock_t * block, tree dlength, tree dest,
if (slength != NULL_TREE)
{
- slen = fold_convert (size_type_node, gfc_evaluate_now (slength, block));
+ slen = gfc_evaluate_now (fold_convert (gfc_charlen_type_node, slength), block);
ssc = gfc_string_to_single_character (slen, src, skind);
}
else
{
- slen = build_int_cst (size_type_node, 1);
+ slen = build_one_cst (gfc_charlen_type_node);
ssc = src;
}
if (dlength != NULL_TREE)
{
- dlen = fold_convert (size_type_node, gfc_evaluate_now (dlength, block));
+ dlen = gfc_evaluate_now (fold_convert (gfc_charlen_type_node, dlength), block);
dsc = gfc_string_to_single_character (dlen, dest, dkind);
}
else
{
- dlen = build_int_cst (size_type_node, 1);
+ dlen = build_one_cst (gfc_charlen_type_node);
dsc = dest;
}
@@ -6524,18 +6531,18 @@ gfc_trans_string_copy (stmtblock_t * block, tree dlength, tree dest,
/* Do nothing if the destination length is zero. */
cond = fold_build2_loc (input_location, GT_EXPR, logical_type_node, dlen,
- build_int_cst (size_type_node, 0));
+ build_zero_cst (TREE_TYPE (dlen)));
/* For non-default character kinds, we have to multiply the string
length by the base type size. */
chartype = gfc_get_char_type (dkind);
- slen = fold_build2_loc (input_location, MULT_EXPR, size_type_node,
- fold_convert (size_type_node, slen),
- fold_convert (size_type_node,
+ slen = fold_build2_loc (input_location, MULT_EXPR, TREE_TYPE (slen),
+ slen,
+ fold_convert (TREE_TYPE (slen),
TYPE_SIZE_UNIT (chartype)));
- dlen = fold_build2_loc (input_location, MULT_EXPR, size_type_node,
- fold_convert (size_type_node, dlen),
- fold_convert (size_type_node,
+ dlen = fold_build2_loc (input_location, MULT_EXPR, TREE_TYPE (dlen),
+ dlen,
+ fold_convert (TREE_TYPE (dlen),
TYPE_SIZE_UNIT (chartype)));
if (dlength && POINTER_TYPE_P (TREE_TYPE (dest)))
@@ -6553,7 +6560,8 @@ gfc_trans_string_copy (stmtblock_t * block, tree dlength, tree dest,
slen);
tmp2 = build_call_expr_loc (input_location,
builtin_decl_explicit (BUILT_IN_MEMMOVE),
- 3, dest, src, tmp2);
+ 3, dest, src,
+ fold_convert (size_type_node, tmp2));
stmtblock_t tmpblock2;
gfc_init_block (&tmpblock2);
gfc_add_expr_to_block (&tmpblock2, tmp2);
@@ -7264,7 +7272,8 @@ 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, size);
+ gfc_add_modify (block, lhs_cl_size,
+ fold_convert (TREE_TYPE (lhs_cl_size), size));
}
@@ -7503,7 +7512,8 @@ 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, se.string_length);
+ gfc_add_modify (&block, strlen,
+ fold_convert (TREE_TYPE (strlen), se.string_length));
tmp = gfc_build_memcpy_call (dest, se.expr, size);
gfc_add_expr_to_block (&block, tmp);
}
@@ -8174,7 +8184,7 @@ trans_class_vptr_len_assignment (stmtblock_t *block, gfc_expr * le,
from_len = gfc_evaluate_now (se.expr, block);
}
else
- from_len = integer_zero_node;
+ from_len = build_zero_cst (gfc_charlen_type_node);
}
gfc_add_modify (pre, to_len, fold_convert (TREE_TYPE (to_len),
from_len));
@@ -8385,7 +8395,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_int_cst (gfc_charlen_type_node, 0));
+ build_zero_cst (TREE_TYPE (lse.string_length)));
}
gfc_add_modify (&block, lse.expr,
@@ -9643,7 +9653,9 @@ 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, logical_type_node,
- lse.string_length, size);
+ lse.string_length,
+ fold_convert (TREE_TYPE (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),
@@ -9660,7 +9672,8 @@ alloc_scalar_allocatable_for_assignment (stmtblock_t *block,
/* Update the lhs character length. */
size = string_length;
- gfc_add_modify (block, lse.string_length, size);
+ gfc_add_modify (block, lse.string_length,
+ fold_convert (TREE_TYPE (lse.string_length), size));
}
}
@@ -9842,7 +9855,7 @@ trans_class_assignment (stmtblock_t *block, gfc_expr *lhs, gfc_expr *rhs,
tmp = fold_build2_loc (input_location, GT_EXPR,
logical_type_node, from_len,
- integer_zero_node);
+ build_zero_cst (TREE_TYPE (from_len)));
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 c4aad1d..deea64a 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -7600,7 +7600,8 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr)
nonzero_charlen = fold_build2_loc (input_location, NE_EXPR,
logical_type_node,
arg1->expr->ts.u.cl->backend_decl,
- integer_zero_node);
+ build_zero_cst
+ (TREE_TYPE (arg1->expr->ts.u.cl->backend_decl)));
if (scalar)
{
/* A pointer to a scalar. */
@@ -7890,11 +7891,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 (size_type_node, gfc_character_kinds[i].bit_size / 8);
+ size = build_int_cst (sizetype, gfc_character_kinds[i].bit_size / 8);
/* Get the arguments. */
gfc_conv_intrinsic_function_args (se, expr, args, 3);
- slen = fold_convert (size_type_node, gfc_evaluate_now (args[0], &se->pre));
+ slen = fold_convert (sizetype, gfc_evaluate_now (args[0], &se->pre));
src = args[1];
ncopies = gfc_evaluate_now (args[2], &se->pre);
ncopies_type = TREE_TYPE (ncopies);
@@ -7911,7 +7912,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, logical_type_node, slen,
- build_int_cst (size_type_node, 0));
+ size_zero_node);
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);
@@ -7921,17 +7922,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. */
- 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;
+ 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;
cond = fold_build2_loc (input_location, GT_EXPR, logical_type_node,
fold_convert (largest, ncopies),
fold_convert (largest, max));
tmp = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, slen,
- build_int_cst (size_type_node, 0));
+ size_zero_node);
cond = fold_build3_loc (input_location, COND_EXPR, logical_type_node, tmp,
logical_false_node, cond);
gfc_trans_runtime_check (true, false, cond, &se->pre, &expr->where,
@@ -7948,8 +7949,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 (ncopies_type, "count");
- gfc_add_modify (&block, count, build_int_cst (ncopies_type, 0));
+ count = gfc_create_var (sizetype, "count");
+ gfc_add_modify (&block, count, size_zero_node);
exit_label = gfc_build_label_decl (NULL_TREE);
/* Start the loop body. */
@@ -7957,7 +7958,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, logical_type_node, count,
- ncopies);
+ fold_convert (sizetype, 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,
@@ -7965,25 +7966,22 @@ 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, 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_build2_loc (input_location, MULT_EXPR, sizetype, slen,
+ count);
+ tmp = fold_build2_loc (input_location, MULT_EXPR, sizetype, tmp,
+ 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,
- fold_convert (size_type_node,
- size)));
+ size_type_node, slen, size));
gfc_add_expr_to_block (&body, tmp);
/* Increment count. */
- tmp = fold_build2_loc (input_location, PLUS_EXPR, ncopies_type,
- count, build_int_cst (TREE_TYPE (count), 1));
+ tmp = fold_build2_loc (input_location, PLUS_EXPR, sizetype,
+ count, size_one_node);
gfc_add_modify (&body, count, tmp);
/* Build the loop. */
diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c
index 68486f8..7d3d485 100644
--- a/gcc/fortran/trans-io.c
+++ b/gcc/fortran/trans-io.c
@@ -345,11 +345,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_int4_type_node);
+ void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_charlen_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_int4_type_node);
+ void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_charlen_type_node);
iocall[IOCALL_X_CHARACTER_WIDE] = gfc_build_library_function_decl_with_spec (
get_identifier (PREFIX("transfer_character_wide")), ".wW",
@@ -852,7 +852,8 @@ set_string (stmtblock_t * block, stmtblock_t * postblock, tree var,
gfc_conv_string_parameter (&se);
gfc_add_modify (&se.pre, io, fold_convert (TREE_TYPE (io), se.expr));
- gfc_add_modify (&se.pre, len, se.string_length);
+ gfc_add_modify (&se.pre, len, fold_convert (TREE_TYPE (len),
+ se.string_length));
}
gfc_add_block_to_block (block, &se.pre);
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index e6569e0..892556e 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 = integer_minus_one_node;
+ len_tree = build_int_cst (gfc_charlen_type_node, -1);
}
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, len_tree);
+ gfc_add_modify (&se.pre, len, fold_convert (TREE_TYPE (len), len_tree));
gfc_add_modify (&se.pre, addr, label_tree);
return gfc_finish_block (&se.pre);
@@ -1600,7 +1600,7 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
&& se.string_length != sym->ts.u.cl->backend_decl)
{
gfc_add_modify (&se.pre, sym->ts.u.cl->backend_decl,
- fold_convert (gfc_charlen_type_node,
+ fold_convert (TREE_TYPE (sym->ts.u.cl->backend_decl),
se.string_length));
}
@@ -1777,7 +1777,7 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
&& se.string_length != sym->ts.u.cl->backend_decl)
{
gfc_add_modify (&se.pre, sym->ts.u.cl->backend_decl,
- fold_convert (gfc_charlen_type_node,
+ fold_convert (TREE_TYPE (sym->ts.u.cl->backend_decl),
se.string_length));
if (e->expr_type == EXPR_FUNCTION)
{
@@ -2838,7 +2838,7 @@ gfc_trans_character_select (gfc_code *code)
{
for (d = cp; d; d = d->right)
{
- int i;
+ gfc_charlen_t i;
if (d->low)
{
gcc_assert (d->low->expr_type == EXPR_CONSTANT
@@ -3043,7 +3043,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], integer_zero_node);
+ CONSTRUCTOR_APPEND_ELT (node, ss_string1_len[k], build_zero_cst (gfc_charlen_type_node));
}
else
{
@@ -3056,7 +3056,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], integer_zero_node);
+ CONSTRUCTOR_APPEND_ELT (node, ss_string2_len[k], build_zero_cst (gfc_charlen_type_node));
}
else
{
@@ -5747,7 +5747,7 @@ gfc_trans_allocate (gfc_code * code)
{
gfc_init_se (&se, NULL);
temp_var_needed = false;
- expr3_len = integer_zero_node;
+ expr3_len = build_zero_cst (gfc_charlen_type_node);
e3_is = E3_MOLD;
}
/* Prevent aliasing, i.e., se.expr may be already a
@@ -6152,7 +6152,8 @@ gfc_trans_allocate (gfc_code * code)
e.g., a string. */
memsz = fold_build2_loc (input_location, GT_EXPR,
logical_type_node, expr3_len,
- integer_zero_node);
+ build_zero_cst
+ (TREE_TYPE (expr3_len)));
memsz = fold_build3_loc (input_location, COND_EXPR,
TREE_TYPE (expr3_esize),
memsz, tmp, expr3_esize);
@@ -6521,7 +6522,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, ((int) strlen (msg)));
+ slen = build_int_cst (gfc_charlen_type_node, strlen (msg));
dlen = gfc_get_expr_charlen (code->expr2);
slen = fold_build2_loc (input_location, MIN_EXPR,
TREE_TYPE (slen), dlen, slen);
@@ -6818,7 +6819,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, ((int) strlen (msg)));
+ slen = build_int_cst (gfc_charlen_type_node, 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 6868329..3f010a7 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -123,6 +123,9 @@ 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;
@@ -1006,14 +1009,17 @@ gfc_init_types (void)
wi::mask (n, UNSIGNED,
TYPE_PRECISION (size_type_node)));
-
logical_type_node = gfc_get_logical_type (gfc_default_logical_kind);
logical_true_node = build_int_cst (logical_type_node, 1);
logical_false_node = build_int_cst (logical_type_node, 0);
- /* ??? Shouldn't this be based on gfc_index_integer_kind or so? */
- gfc_charlen_int_kind = 4;
+ /* Character lengths are of type size_t, except signed. */
+ gfc_charlen_int_kind = get_int_kind_from_node (size_type_node);
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 6dba78e..c7fdf16 100644
--- a/gcc/fortran/trans-types.h
+++ b/gcc/fortran/trans-types.h
@@ -23,6 +23,7 @@ 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;
@@ -49,10 +50,9 @@ extern GTY(()) tree logical_false_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/gfortran.dg/char_cast_1.f90 b/gcc/testsuite/gfortran.dg/char_cast_1.f90
index 02e695d..70963bb 100644
--- a/gcc/testsuite/gfortran.dg/char_cast_1.f90
+++ b/gcc/testsuite/gfortran.dg/char_cast_1.f90
@@ -25,6 +25,6 @@
return
end function Upper
end
-! The sign that all is well is that [S.6][1] appears twice.
-! Platform dependent variations are [S$6][1], [__S_6][1], [S___6][1]
-! { dg-final { scan-tree-dump-times "6\\\]\\\[1\\\]" 2 "original" } }
+! The sign that all is well is that [S.10][1] appears twice.
+! Platform dependent variations are [S$10][1], [__S_10][1], [S___10][1]
+! { dg-final { scan-tree-dump-times "10\\\]\\\[1\\\]" 2 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/dependency_49.f90 b/gcc/testsuite/gfortran.dg/dependency_49.f90
index 43ee284..73d517e 100644
--- a/gcc/testsuite/gfortran.dg/dependency_49.f90
+++ b/gcc/testsuite/gfortran.dg/dependency_49.f90
@@ -11,4 +11,4 @@ program main
a%x = a%x(2:3)
print *,a%x
end program main
-! { dg-final { scan-tree-dump-times "__var_1" 3 "original" } }
+! { dg-final { scan-tree-dump-times "__var_1" 4 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/repeat_4.f90 b/gcc/testsuite/gfortran.dg/repeat_4.f90
index e5b5acc..99e7aee 100644
--- a/gcc/testsuite/gfortran.dg/repeat_4.f90
+++ b/gcc/testsuite/gfortran.dg/repeat_4.f90
@@ -2,6 +2,7 @@
!
! { 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"
@@ -21,18 +22,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))
- 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))
+ 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)/2)
- print *, repeat(t1, huge(0)/2)
- print *, repeat(t2, huge(0)/2)
+ 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+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 " }
+ 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 " }
end program test
diff --git a/gcc/testsuite/gfortran.dg/repeat_7.f90 b/gcc/testsuite/gfortran.dg/repeat_7.f90
new file mode 100644
index 0000000..82f8dbf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/repeat_7.f90
@@ -0,0 +1,8 @@
+! { 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 c58a3a2..5ef0230 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 "iscan = _gfortran_string_scan \\(2," 1 "original" } }
-! { dg-final { scan-tree-dump-times "iverify = _gfortran_string_verify \\(2," 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_string_scan \\(2," 1 "original" } }
+! { dg-final { scan-tree-dump-times "_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 11dc5b7..6a6151e 100644
--- a/gcc/testsuite/gfortran.dg/string_1.f90
+++ b/gcc/testsuite/gfortran.dg/string_1.f90
@@ -1,4 +1,5 @@
! { 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
new file mode 100644
index 0000000..a0edbef
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/string_1_lp64.f90
@@ -0,0 +1,15 @@
+! { 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 7daf8d3..4a88b06 100644
--- a/gcc/testsuite/gfortran.dg/string_3.f90
+++ b/gcc/testsuite/gfortran.dg/string_3.f90
@@ -1,4 +1,5 @@
! { 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
new file mode 100644
index 0000000..162561f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/string_3_lp64.f90
@@ -0,0 +1,20 @@
+! { 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/intrinsics/args.c b/libgfortran/intrinsics/args.c
index c07181f..ded5a35 100644
--- a/libgfortran/intrinsics/args.c
+++ b/libgfortran/intrinsics/args.c
@@ -37,7 +37,6 @@ void
getarg_i4 (GFC_INTEGER_4 *pos, char *val, gfc_charlen_type val_len)
{
int argc;
- int arglen;
char **argv;
get_args (&argc, &argv);
@@ -49,7 +48,7 @@ getarg_i4 (GFC_INTEGER_4 *pos, char *val, gfc_charlen_type val_len)
if ((*pos) + 1 <= argc && *pos >=0 )
{
- arglen = strlen (argv[*pos]);
+ gfc_charlen_type arglen = strlen (argv[*pos]);
if (arglen > val_len)
arglen = val_len;
memcpy (val, argv[*pos], arglen);
@@ -119,7 +118,8 @@ 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, arglen = 0, stat_flag = GFC_GC_SUCCESS;
+ int argc, stat_flag = GFC_GC_SUCCESS;
+ gfc_charlen_type arglen = 0;
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, arglen, thisarg;
+ int i, argc, 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 d08418d..4e917a1 100644
--- a/libgfortran/intrinsics/chmod.c
+++ b/libgfortran/intrinsics/chmod.c
@@ -64,7 +64,6 @@ 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;
@@ -104,7 +103,7 @@ chmod_internal (char *file, char *mode, gfc_charlen_type mode_len)
honor_umask = false;
#endif
- for (i = 0; i < mode_len; i++)
+ for (gfc_charlen_type i = 0; i < mode_len; i++)
{
if (!continue_clause)
{
diff --git a/libgfortran/intrinsics/env.c b/libgfortran/intrinsics/env.c
index f8e376e..f8e7758 100644
--- a/libgfortran/intrinsics/env.c
+++ b/libgfortran/intrinsics/env.c
@@ -93,7 +93,8 @@ 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, res_len = 0;
+ int stat = GFC_SUCCESS;
+ gfc_charlen_type 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 8177e0e..8dc9ef8 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;
- GFC_INTEGER_4 size;
+ size_t size;
struct vtype *extends;
}
vtype;
diff --git a/libgfortran/intrinsics/gerror.c b/libgfortran/intrinsics/gerror.c
index 34ea1df..51432a4 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)
{
- int p_len;
+ gfc_charlen_type p_len;
char *p;
p = gf_strerror (errno, msg, msg_len);
diff --git a/libgfortran/intrinsics/getlog.c b/libgfortran/intrinsics/getlog.c
index a856cd1..33ad52e 100644
--- a/libgfortran/intrinsics/getlog.c
+++ b/libgfortran/intrinsics/getlog.c
@@ -70,7 +70,6 @@ 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. */
@@ -107,7 +106,7 @@ PREFIX(getlog) (char * login, gfc_charlen_type login_len)
if (p == NULL)
goto cleanup;
- p_len = strlen (p);
+ gfc_charlen_type 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 2ccb5bd..2395067 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,8 +99,7 @@ hostnm_0 (char *name, gfc_charlen_type name_len)
if (val == 0)
{
- i = -1;
- while (i < name_len && p[++i] != '\0')
+ for (gfc_charlen_type i = 0; i < name_len && p[i] != '\0'; i++)
name[i] = p[i];
}
diff --git a/libgfortran/intrinsics/string_intrinsics_inc.c b/libgfortran/intrinsics/string_intrinsics_inc.c
index f514f4c..74a994b 100644
--- a/libgfortran/intrinsics/string_intrinsics_inc.c
+++ b/libgfortran/intrinsics/string_intrinsics_inc.c
@@ -177,23 +177,25 @@ string_trim (gfc_charlen_type *len, CHARTYPE **dest, gfc_charlen_type slen,
gfc_charlen_type
string_len_trim (gfc_charlen_type len, const CHARTYPE *s)
{
- const gfc_charlen_type long_len = (gfc_charlen_type) sizeof (unsigned long);
- gfc_charlen_type i;
+ if (len <= 0)
+ return 0;
- i = len - 1;
+ const size_t long_len = sizeof (unsigned long);
+
+ size_t i = len - 1;
/* If we've got the standard (KIND=1) character type, we scan the string in
long word chunks to speed it up (until a long word is hit that does not
consist of ' 's). */
if (sizeof (CHARTYPE) == 1 && i >= long_len)
{
- int starting;
+ size_t starting;
unsigned long blank_longword;
/* Handle the first characters until we're aligned on a long word
boundary. Actually, s + i + 1 must be properly aligned, because
s + i will be the last byte of a long word read. */
- starting = ((unsigned long)
+ starting = (
#ifdef __INTPTR_TYPE__
(__INTPTR_TYPE__)
#endif
@@ -224,14 +226,15 @@ 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 (i >= 0 && s[i] == ' ')
- --i;
+ while (s[i] == ' ')
+ {
+ if (i == 0)
+ return 0;
+ --i;
+ }
return i + 1;
}
@@ -327,12 +330,12 @@ string_scan (gfc_charlen_type slen, const CHARTYPE *str,
if (back)
{
- for (i = slen - 1; i >= 0; i--)
+ for (i = slen; i != 0; i--)
{
for (j = 0; j < setlen; j++)
{
- if (str[i] == set[j])
- return (i + 1);
+ if (str[i - 1] == set[j])
+ return i;
}
}
}
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index 211dc34..bfa9565 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 *, int);
+extern void transfer_character (st_parameter_dt *, void *, gfc_charlen_type);
export_proto(transfer_character);
-extern void transfer_character_write (st_parameter_dt *, void *, int);
+extern void transfer_character_write (st_parameter_dt *, void *, gfc_charlen_type);
export_proto(transfer_character_write);
-extern void transfer_character_wide (st_parameter_dt *, void *, int, int);
+extern void transfer_character_wide (st_parameter_dt *, void *, gfc_charlen_type, int);
export_proto(transfer_character_wide);
extern void transfer_character_wide_write (st_parameter_dt *,
- void *, int, int);
+ void *, gfc_charlen_type, int);
export_proto(transfer_character_wide_write);
extern void transfer_complex (st_parameter_dt *, void *, int);
@@ -2331,7 +2331,7 @@ transfer_logical_write (st_parameter_dt *dtp, void *p, int kind)
}
void
-transfer_character (st_parameter_dt *dtp, void *p, int len)
+transfer_character (st_parameter_dt *dtp, void *p, gfc_charlen_type len)
{
static char *empty_string[0];
@@ -2349,13 +2349,13 @@ transfer_character (st_parameter_dt *dtp, void *p, int len)
}
void
-transfer_character_write (st_parameter_dt *dtp, void *p, int len)
+transfer_character_write (st_parameter_dt *dtp, void *p, gfc_charlen_type len)
{
transfer_character (dtp, p, len);
}
void
-transfer_character_wide (st_parameter_dt *dtp, void *p, int len, int kind)
+transfer_character_wide (st_parameter_dt *dtp, void *p, gfc_charlen_type len, int kind)
{
static char *empty_string[0];
@@ -2373,7 +2373,7 @@ transfer_character_wide (st_parameter_dt *dtp, void *p, int len, int kind)
}
void
-transfer_character_wide_write (st_parameter_dt *dtp, void *p, int len, int kind)
+transfer_character_wide_write (st_parameter_dt *dtp, void *p, gfc_charlen_type len, int kind)
{
transfer_character_wide (dtp, p, len, kind);
}
@@ -2410,7 +2410,7 @@ transfer_array (st_parameter_dt *dtp, gfc_array_char *desc, int kind,
return;
iotype = (bt) GFC_DESCRIPTOR_TYPE (desc);
- size = iotype == BT_CHARACTER ? charlen : GFC_DESCRIPTOR_SIZE (desc);
+ size = iotype == BT_CHARACTER ? (index_type) 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 2ca8525..ba240d2 100644
--- a/libgfortran/io/unit.c
+++ b/libgfortran/io/unit.c
@@ -432,10 +432,9 @@ 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 (i = 0; i < dtp->format_len; i++)
+ for (gfc_charlen_type 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 926d510..edb4f9a 100644
--- a/libgfortran/io/write.c
+++ b/libgfortran/io/write.c
@@ -2413,7 +2413,7 @@ namelist_write (st_parameter_dt *dtp)
write_character (dtp, "&", 1, 1, NODELIM);
/* Write namelist name in upper case - f95 std. */
- for (i = 0 ;i < dtp->namelist_name_len ;i++ )
+ for (gfc_charlen_type 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 94aedc8..3df7fbe 100644
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -255,7 +255,7 @@ typedef GFC_INTEGER_4 GFC_IO_INT;
typedef ptrdiff_t index_type;
/* The type used for the lengths of character variables. */
-typedef GFC_INTEGER_4 gfc_charlen_type;
+typedef size_t gfc_charlen_type;
/* Definitions of CHARACTER data types:
- CHARACTER(KIND=1) corresponds to the C char type,
--
2.7.4
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2017-12-29 13:32 [PATCH] PR 78534 Change character length from int to size_t Janne Blomqvist
@ 2017-12-30 14:59 ` Thomas Koenig
2017-12-30 15:25 ` Janne Blomqvist
2018-01-03 18:34 ` Bob Deen
1 sibling, 1 reply; 76+ messages in thread
From: Thomas Koenig @ 2017-12-30 14:59 UTC (permalink / raw)
To: Janne Blomqvist, fortran, gcc-patches
Hi Janne,
> In order to handle large character lengths on (L)LP64 targets, switch
> the GFortran character length from an int to a size_t.
Just running some tests on gcc110 (the big-endian PPC machine from
the compile farm).
Something does not seem to work with I/O with long strings.
With
program main
character(len=2_8**33), parameter :: a = ""
character(len=2_8**33) :: b
print '(A),a
b = ""
print '(A)',b
end program main
I get
$ strace ./a.out > /dev/null
...
write(1, "\n", 1) = 1
write(1, "\n", 1) = 1
so I suspect there still is a 32-bit quantity for string lengths
lurking somewhere in the I/O library.
The following program causes a segfault on compilation:
program main
integer(8), parameter :: n=2_8**32
character(len=*), parameter :: a1 = repeat('x',n)
end program main
The program
program main
integer(8), parameter :: n=2_8**32
character(len=n), parameter :: a1 = repeat('x',n), a2 = repeat('y',n)
character(len=*), parameter :: a3 = a1 // a2
end program main
is rejected with
tkoenig@gcc1-power7 String]$ gfortran concat.f90
concat.f90:4:37:
character(len=*), parameter :: a3 = a1 // a2
1
Error: Function ‘a1’ in initialization expression at (1) must be an
intrinsic function
That's all I could find for the moment. I will continue looking.
Thanks for tackling this!
Regards
Thomas
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2017-12-30 14:59 ` Thomas Koenig
@ 2017-12-30 15:25 ` Janne Blomqvist
2017-12-30 17:16 ` Thomas Koenig
0 siblings, 1 reply; 76+ messages in thread
From: Janne Blomqvist @ 2017-12-30 15:25 UTC (permalink / raw)
To: Thomas Koenig; +Cc: Fortran List, GCC Patches
On Sat, Dec 30, 2017 at 4:59 PM, Thomas Koenig <tkoenig@netcologne.de> wrote:
> That's all I could find for the moment. I will continue looking.
> Thanks for tackling this!
Thanks for testing!
To be honest, I haven't really done much testing with big strings, so
far my focus has been on getting the existing testsuite to pass and
getting the ABI right. As the library ABI has been broken for GCC 8
already by other changes, I'd like to piggyback this ABI change in for
the GCC 8 release as well. As the patch is already pretty big as is,
I'd prefer that other fixes to enable big strings would be done as
separate patches rather than trying to make everything perfect on the
first try.
Slightly related to your testcases, I think it would make sense to
create some separate "GFortran huge" testsuite, where we could collect
testcases that need lots of memory, or cpu time, or disk space and can
thus not be part of the default testsuite.
--
Janne Blomqvist
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2017-12-30 15:25 ` Janne Blomqvist
@ 2017-12-30 17:16 ` Thomas Koenig
2017-12-30 20:35 ` Janne Blomqvist
0 siblings, 1 reply; 76+ messages in thread
From: Thomas Koenig @ 2017-12-30 17:16 UTC (permalink / raw)
To: Janne Blomqvist; +Cc: Fortran List, GCC Patches
Hi Janne,
> To be honest, I haven't really done much testing with big strings, so
> far my focus has been on getting the existing testsuite to pass and
> getting the ABI right.
I agree that some of the test cases can be fixed later. However, I
would really prefer if the I/O worked, because that is very basic
functionality, but also because this is (likely to be) an ABI issue.
If this bug remains unfixed for any reason at all, then we are left with
no choice but to break the ABI when we fix that bug. I would like to
avoid that, if possible.
By the way, we also should forsee a few more ABI-breaking things
while we're at it. We should
- Put a "reserved" field in the array descriptor for things like
"did this come from an ALLOCATE statement or not", there is a PR
for this
- Put a pointer to void into the I/O structures, which we are certain
to need for async I/O
- Increase the maximum number of array dimensions to 15, as per f2008
- Insert a "BACK" argument in minloc, maxloc, minval, maxval, even
if we do not use it at the moment
> As the library ABI has been broken for GCC 8
> already by other changes, I'd like to piggyback this ABI change in for
> the GCC 8 release as well. As the patch is already pretty big as is,
> I'd prefer that other fixes to enable big strings would be done as
> separate patches rather than trying to make everything perfect on the
> first try.
I tend to concur for the other bugs, but not for the I/O issue.
Regards
Thomas
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2017-12-30 17:16 ` Thomas Koenig
@ 2017-12-30 20:35 ` Janne Blomqvist
2017-12-30 20:58 ` Jerry DeLisle
2017-12-31 16:42 ` Thomas Koenig
0 siblings, 2 replies; 76+ messages in thread
From: Janne Blomqvist @ 2017-12-30 20:35 UTC (permalink / raw)
To: Thomas Koenig; +Cc: Fortran List, GCC Patches
On Sat, Dec 30, 2017 at 7:16 PM, Thomas Koenig <tkoenig@netcologne.de> wrote:
> Hi Janne,
>
>> To be honest, I haven't really done much testing with big strings, so
>> far my focus has been on getting the existing testsuite to pass and
>> getting the ABI right.
>
>
> I agree that some of the test cases can be fixed later. However, I
> would really prefer if the I/O worked, because that is very basic
> functionality, but also because this is (likely to be) an ABI issue.
> If this bug remains unfixed for any reason at all, then we are left with
> no choice but to break the ABI when we fix that bug. I would like to
> avoid that, if possible.
Fair enough. I took a look at the I/O example you provided, and at
least that particular case is not due to an ABI issue, but rather that
the formatted I/O stuff inside libgfortran extensively uses int for
lengths. I managed to hack around it quickly to make your testcase
work, but a proper fix, while straightforward, implies fixing up the
types a bit more. But still only in the internals, the external ABI
visible interface is ok.
I can provide that stuff as a separate patch, or merge it into the
original megapatch and resubmit that, whichever way you prefer.
FWIW, by changing your example to use unformatted I/O, it works
correctly. And as unformatted uses the same library entry points for
transferring the data, this is thus further evidence that the problem
is in the internals of the formatted I/O rather than in the ABI.
--
Janne Blomqvist
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2017-12-30 20:35 ` Janne Blomqvist
@ 2017-12-30 20:58 ` Jerry DeLisle
2018-01-03 11:37 ` Janne Blomqvist
2017-12-31 16:42 ` Thomas Koenig
1 sibling, 1 reply; 76+ messages in thread
From: Jerry DeLisle @ 2017-12-30 20:58 UTC (permalink / raw)
To: Janne Blomqvist, Thomas Koenig; +Cc: Fortran List, GCC Patches
On 12/30/2017 12:35 PM, Janne Blomqvist wrote:
> On Sat, Dec 30, 2017 at 7:16 PM, Thomas Koenig <tkoenig@netcologne.de> wrote:
---snip---
>
> I can provide that stuff as a separate patch, or merge it into the
> original megapatch and resubmit that, whichever way you prefer.
I would prefer we split into two patches. This will make review of the library
I/O changes easier. The int len is used in a lot of places also where it really
happens to also be the kind (which is a length in our implementation).
Janne I trust your judgment about where it makes sense to change to size_t.
On Thomas earlier comment about adding a pointer to void to hold space for
async. I am OK with this too, though I am not convinced we have really defined
our async objective here. More later on that topic.
Regards,
Jerry
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2017-12-30 20:35 ` Janne Blomqvist
2017-12-30 20:58 ` Jerry DeLisle
@ 2017-12-31 16:42 ` Thomas Koenig
1 sibling, 0 replies; 76+ messages in thread
From: Thomas Koenig @ 2017-12-31 16:42 UTC (permalink / raw)
To: Janne Blomqvist; +Cc: Fortran List, GCC Patches
Hi Janne,
> FWIW, by changing your example to use unformatted I/O, it works
> correctly.
Not for me (again, on gcc110):
program main
character(len=2_8**33), parameter :: a = ""
write (10) a
end program main
with strace results in
open("fort.10", O_RDWR|O_CREAT|O_CLOEXEC, 0666) = 3
fstat(3, {st_mode=S_IFREG|0664, st_size=8, ...}) = 0
write(3, "\0\0\0\0\0\0\0\0", 8) = 8
ftruncate(3, 8) = 0
close(3) = 0
Regards
Thomas
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2017-12-30 20:58 ` Jerry DeLisle
@ 2018-01-03 11:37 ` Janne Blomqvist
2018-01-03 12:10 ` Thomas Koenig
2018-01-04 2:21 ` Jerry DeLisle
0 siblings, 2 replies; 76+ messages in thread
From: Janne Blomqvist @ 2018-01-03 11:37 UTC (permalink / raw)
To: Jerry DeLisle; +Cc: Thomas Koenig, Fortran List, GCC Patches
[-- Attachment #1: Type: text/plain, Size: 887 bytes --]
On Sat, Dec 30, 2017 at 10:58 PM, Jerry DeLisle <jvdelisle@charter.net> wrote:
> On 12/30/2017 12:35 PM, Janne Blomqvist wrote:
>> On Sat, Dec 30, 2017 at 7:16 PM, Thomas Koenig <tkoenig@netcologne.de> wrote:
> ---snip---
>>
>> I can provide that stuff as a separate patch, or merge it into the
>> original megapatch and resubmit that, whichever way you prefer.
>
> I would prefer we split into two patches. This will make review of the library
> I/O changes easier. The int len is used in a lot of places also where it really
> happens to also be the kind (which is a length in our implementation).
Hi,
attached is a patch that makes the two attached testcases work. It
applies on top of the charlen->size_t patch. In the formatted I/O
stuff, I have mostly used ptrdiff_t to avoid having to deal with
signed/unsigned issues, as the previous code was using int.
--
Janne Blomqvist
[-- Attachment #2: 0001-Use-ptrdiff_t-for-formatted-I-O-sizes.patch --]
[-- Type: text/x-patch, Size: 26957 bytes --]
From 72799c5587ee1e830bb424278286cff309d0c4a7 Mon Sep 17 00:00:00 2001
From: Janne Blomqvist <blomqvist.janne@gmail.com>
Date: Tue, 2 Jan 2018 14:17:57 +0200
Subject: [PATCH] Use ptrdiff_t for formatted I/O sizes
---
libgfortran/io/fbuf.c | 44 ++++++++++++++---------------
libgfortran/io/fbuf.h | 16 +++++------
libgfortran/io/io.h | 16 +++++------
libgfortran/io/list_read.c | 15 +++++-----
libgfortran/io/read.c | 70 +++++++++++++++++++++++-----------------------
libgfortran/io/transfer.c | 36 ++++++++++++------------
libgfortran/io/unix.c | 20 ++++++-------
libgfortran/io/unix.h | 12 ++++----
libgfortran/io/write.c | 21 +++++++-------
9 files changed, 126 insertions(+), 124 deletions(-)
diff --git a/libgfortran/io/fbuf.c b/libgfortran/io/fbuf.c
index 944469d..d38d003 100644
--- a/libgfortran/io/fbuf.c
+++ b/libgfortran/io/fbuf.c
@@ -33,7 +33,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
void
-fbuf_init (gfc_unit *u, int len)
+fbuf_init (gfc_unit *u, ptrdiff_t len)
{
if (len == 0)
len = 512; /* Default size. */
@@ -64,9 +64,9 @@ fbuf_debug (gfc_unit *u, const char *format, ...)
va_start(args, format);
vfprintf(stderr, format, args);
va_end(args);
- fprintf (stderr, "fbuf_debug pos: %d, act: %d, buf: ''",
- u->fbuf->pos, u->fbuf->act);
- for (int ii = 0; ii < u->fbuf->act; ii++)
+ fprintf (stderr, "fbuf_debug pos: %ld, act: %ld, buf: ''",
+ (long) u->fbuf->pos, (long) u->fbuf->act);
+ for (ptrdiff_t ii = 0; ii < u->fbuf->act; ii++)
{
putc (u->fbuf->buf[ii], stderr);
}
@@ -84,10 +84,10 @@ fbuf_debug (gfc_unit *u __attribute__ ((unused)),
underlying device. Returns how much the physical position was
modified. */
-int
+ptrdiff_t
fbuf_reset (gfc_unit *u)
{
- int seekval = 0;
+ ptrdiff_t seekval = 0;
if (!u->fbuf)
return 0;
@@ -99,7 +99,7 @@ fbuf_reset (gfc_unit *u)
if (u->mode == READING && u->fbuf->act > u->fbuf->pos)
{
seekval = - (u->fbuf->act - u->fbuf->pos);
- fbuf_debug (u, "fbuf_reset seekval %d, ", seekval);
+ fbuf_debug (u, "fbuf_reset seekval %ld, ", (long) seekval);
}
u->fbuf->act = u->fbuf->pos = 0;
return seekval;
@@ -111,11 +111,11 @@ fbuf_reset (gfc_unit *u)
reallocating if necessary. */
char *
-fbuf_alloc (gfc_unit *u, int len)
+fbuf_alloc (gfc_unit *u, ptrdiff_t len)
{
- int newlen;
+ ptrdiff_t newlen;
char *dest;
- fbuf_debug (u, "fbuf_alloc len %d, ", len);
+ fbuf_debug (u, "fbuf_alloc len %ld, ", (long) len);
if (u->fbuf->pos + len > u->fbuf->len)
{
/* Round up to nearest multiple of the current buffer length. */
@@ -138,7 +138,7 @@ fbuf_alloc (gfc_unit *u, int len)
int
fbuf_flush (gfc_unit *u, unit_mode mode)
{
- int nwritten;
+ ptrdiff_t nwritten;
if (!u->fbuf)
return 0;
@@ -177,7 +177,7 @@ fbuf_flush (gfc_unit *u, unit_mode mode)
int
fbuf_flush_list (gfc_unit *u, unit_mode mode)
{
- int nwritten;
+ ptrdiff_t nwritten;
if (!u->fbuf)
return 0;
@@ -206,8 +206,8 @@ fbuf_flush_list (gfc_unit *u, unit_mode mode)
}
-int
-fbuf_seek (gfc_unit *u, int off, int whence)
+ptrdiff_t
+fbuf_seek (gfc_unit *u, ptrdiff_t off, int whence)
{
if (!u->fbuf)
return -1;
@@ -226,7 +226,7 @@ fbuf_seek (gfc_unit *u, int off, int whence)
return -1;
}
- fbuf_debug (u, "fbuf_seek, off %d ", off);
+ fbuf_debug (u, "fbuf_seek, off %ld ", (long) off);
/* The start of the buffer is always equal to the left tab
limit. Moving to the left past the buffer is illegal in C and
would also imply moving past the left tab limit, which is never
@@ -248,21 +248,21 @@ fbuf_seek (gfc_unit *u, int off, int whence)
of bytes actually processed. */
char *
-fbuf_read (gfc_unit *u, int *len)
+fbuf_read (gfc_unit *u, ptrdiff_t *len)
{
char *ptr;
- int oldact, oldpos;
- int readlen = 0;
+ ptrdiff_t oldact, oldpos;
+ ptrdiff_t readlen = 0;
- fbuf_debug (u, "fbuf_read, len %d: ", *len);
+ fbuf_debug (u, "fbuf_read, len %ld: ", (long) *len);
oldact = u->fbuf->act;
oldpos = u->fbuf->pos;
ptr = fbuf_alloc (u, *len);
u->fbuf->pos = oldpos;
if (oldpos + *len > oldact)
{
- fbuf_debug (u, "reading %d bytes starting at %d ",
- oldpos + *len - oldact, oldact);
+ fbuf_debug (u, "reading %ld bytes starting at %ld ",
+ (long) oldpos + *len - oldact, (long) oldact);
readlen = sread (u->s, u->fbuf->buf + oldact, oldpos + *len - oldact);
if (readlen < 0)
return NULL;
@@ -281,7 +281,7 @@ fbuf_read (gfc_unit *u, int *len)
int
fbuf_getc_refill (gfc_unit *u)
{
- int nread;
+ ptrdiff_t nread;
char *p;
fbuf_debug (u, "fbuf_getc_refill ");
diff --git a/libgfortran/io/fbuf.h b/libgfortran/io/fbuf.h
index a0c5713..a18592f 100644
--- a/libgfortran/io/fbuf.h
+++ b/libgfortran/io/fbuf.h
@@ -39,21 +39,21 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
struct fbuf
{
char *buf; /* Start of buffer. */
- int len; /* Length of buffer. */
- int act; /* Active bytes in buffer. */
- int pos; /* Current position in buffer. */
+ ptrdiff_t len; /* Length of buffer. */
+ ptrdiff_t act; /* Active bytes in buffer. */
+ ptrdiff_t pos; /* Current position in buffer. */
};
-extern void fbuf_init (gfc_unit *, int);
+extern void fbuf_init (gfc_unit *, ptrdiff_t);
internal_proto(fbuf_init);
extern void fbuf_destroy (gfc_unit *);
internal_proto(fbuf_destroy);
-extern int fbuf_reset (gfc_unit *);
+extern ptrdiff_t fbuf_reset (gfc_unit *);
internal_proto(fbuf_reset);
-extern char *fbuf_alloc (gfc_unit *, int);
+extern char *fbuf_alloc (gfc_unit *, ptrdiff_t);
internal_proto(fbuf_alloc);
extern int fbuf_flush (gfc_unit *, unit_mode);
@@ -62,10 +62,10 @@ internal_proto(fbuf_flush);
extern int fbuf_flush_list (gfc_unit *, unit_mode);
internal_proto(fbuf_flush_list);
-extern int fbuf_seek (gfc_unit *, int, int);
+extern ptrdiff_t fbuf_seek (gfc_unit *, ptrdiff_t, int);
internal_proto(fbuf_seek);
-extern char *fbuf_read (gfc_unit *, int *);
+extern char *fbuf_read (gfc_unit *, ptrdiff_t *);
internal_proto(fbuf_read);
/* Never call this function, only use fbuf_getc(). */
diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h
index c5e73d8..b61b3fe 100644
--- a/libgfortran/io/io.h
+++ b/libgfortran/io/io.h
@@ -794,13 +794,13 @@ internal_proto(new_unit);
extern const char *type_name (bt);
internal_proto(type_name);
-extern void * read_block_form (st_parameter_dt *, int *);
+extern void * read_block_form (st_parameter_dt *, ptrdiff_t *);
internal_proto(read_block_form);
-extern void * read_block_form4 (st_parameter_dt *, int *);
+extern void * read_block_form4 (st_parameter_dt *, ptrdiff_t *);
internal_proto(read_block_form4);
-extern void *write_block (st_parameter_dt *, int);
+extern void *write_block (st_parameter_dt *, ptrdiff_t);
internal_proto(write_block);
extern gfc_offset next_array_record (st_parameter_dt *, array_loop_spec *,
@@ -834,10 +834,10 @@ internal_proto(convert_real);
extern int convert_infnan (st_parameter_dt *, void *, const char *, int);
internal_proto(convert_infnan);
-extern void read_a (st_parameter_dt *, const fnode *, char *, int);
+extern void read_a (st_parameter_dt *, const fnode *, char *, ptrdiff_t);
internal_proto(read_a);
-extern void read_a_char4 (st_parameter_dt *, const fnode *, char *, int);
+extern void read_a_char4 (st_parameter_dt *, const fnode *, char *, ptrdiff_t);
internal_proto(read_a);
extern void read_f (st_parameter_dt *, const fnode *, char *, int);
@@ -846,7 +846,7 @@ internal_proto(read_f);
extern void read_l (st_parameter_dt *, const fnode *, char *, int);
internal_proto(read_l);
-extern void read_x (st_parameter_dt *, int);
+extern void read_x (st_parameter_dt *, ptrdiff_t);
internal_proto(read_x);
extern void read_radix (st_parameter_dt *, const fnode *, char *, int, int);
@@ -878,10 +878,10 @@ internal_proto(namelist_write);
/* write.c */
-extern void write_a (st_parameter_dt *, const fnode *, const char *, int);
+extern void write_a (st_parameter_dt *, const fnode *, const char *, ptrdiff_t);
internal_proto(write_a);
-extern void write_a_char4 (st_parameter_dt *, const fnode *, const char *, int);
+extern void write_a_char4 (st_parameter_dt *, const fnode *, const char *, ptrdiff_t);
internal_proto(write_a_char4);
extern void write_b (st_parameter_dt *, const fnode *, const char *, int);
diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c
index 037f2da..da56c19 100644
--- a/libgfortran/io/list_read.c
+++ b/libgfortran/io/list_read.c
@@ -2100,7 +2100,8 @@ list_formatted_read_scalar (st_parameter_dt *dtp, bt type, void *p,
int kind, size_t size)
{
gfc_char4_t *q, *r;
- int c, i, m;
+ size_t m;
+ int c;
int err = 0;
/* Set the next_char and push_char worker functions. */
@@ -2255,20 +2256,20 @@ list_formatted_read_scalar (st_parameter_dt *dtp, bt type, void *p,
case BT_CHARACTER:
if (dtp->u.p.saved_string)
{
- m = ((int) size < dtp->u.p.saved_used)
- ? (int) size : dtp->u.p.saved_used;
+ m = (size < (size_t) dtp->u.p.saved_used)
+ ? size : (size_t) dtp->u.p.saved_used;
q = (gfc_char4_t *) p;
r = (gfc_char4_t *) dtp->u.p.saved_string;
if (dtp->u.p.current_unit->flags.encoding == ENCODING_UTF8)
- for (i = 0; i < m; i++)
+ for (size_t i = 0; i < m; i++)
*q++ = *r++;
else
{
if (kind == 1)
memcpy (p, dtp->u.p.saved_string, m);
else
- for (i = 0; i < m; i++)
+ for (size_t i = 0; i < m; i++)
*q++ = *r++;
}
}
@@ -2276,14 +2277,14 @@ list_formatted_read_scalar (st_parameter_dt *dtp, bt type, void *p,
/* Just delimiters encountered, nothing to copy but SPACE. */
m = 0;
- if (m < (int) size)
+ if (m < size)
{
if (kind == 1)
memset (((char *) p) + m, ' ', size - m);
else
{
q = (gfc_char4_t *) p;
- for (i = m; i < (int) size; i++)
+ for (size_t i = m; i < size; i++)
q[i] = (unsigned char) ' ';
}
}
diff --git a/libgfortran/io/read.c b/libgfortran/io/read.c
index 9eb2196..7f4e6b2 100644
--- a/libgfortran/io/read.c
+++ b/libgfortran/io/read.c
@@ -272,7 +272,7 @@ void
read_l (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
{
char *p;
- int w;
+ ptrdiff_t w;
w = f->u.w;
@@ -316,11 +316,11 @@ read_l (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
static gfc_char4_t
-read_utf8 (st_parameter_dt *dtp, int *nbytes)
+read_utf8 (st_parameter_dt *dtp, ptrdiff_t *nbytes)
{
static const uchar masks[6] = { 0x7F, 0x1F, 0x0F, 0x07, 0x02, 0x01 };
static const uchar patns[6] = { 0x00, 0xC0, 0xE0, 0xF0, 0xF8, 0xFC };
- int i, nb, nread;
+ ptrdiff_t i, nb, nread;
gfc_char4_t c;
char *s;
@@ -383,12 +383,11 @@ read_utf8 (st_parameter_dt *dtp, int *nbytes)
static void
-read_utf8_char1 (st_parameter_dt *dtp, char *p, int len, int width)
+read_utf8_char1 (st_parameter_dt *dtp, char *p, ptrdiff_t len, ptrdiff_t width)
{
gfc_char4_t c;
char *dest;
- int nbytes;
- int i, j;
+ ptrdiff_t nbytes, j;
len = (width < len) ? len : width;
@@ -407,16 +406,16 @@ read_utf8_char1 (st_parameter_dt *dtp, char *p, int len, int width)
}
/* If there was a short read, pad the remaining characters. */
- for (i = j; i < len; i++)
+ for (ptrdiff_t i = j; i < len; i++)
*dest++ = ' ';
return;
}
static void
-read_default_char1 (st_parameter_dt *dtp, char *p, int len, int width)
+read_default_char1 (st_parameter_dt *dtp, char *p, ptrdiff_t len, ptrdiff_t width)
{
char *s;
- int m, n;
+ ptrdiff_t m, n;
s = read_block_form (dtp, &width);
@@ -435,11 +434,10 @@ read_default_char1 (st_parameter_dt *dtp, char *p, int len, int width)
static void
-read_utf8_char4 (st_parameter_dt *dtp, void *p, int len, int width)
+read_utf8_char4 (st_parameter_dt *dtp, void *p, ptrdiff_t len, ptrdiff_t width)
{
gfc_char4_t *dest;
- int nbytes;
- int i, j;
+ ptrdiff_t nbytes, j;
len = (width < len) ? len : width;
@@ -456,16 +454,16 @@ read_utf8_char4 (st_parameter_dt *dtp, void *p, int len, int width)
}
/* If there was a short read, pad the remaining characters. */
- for (i = j; i < len; i++)
+ for (ptrdiff_t i = j; i < len; i++)
*dest++ = (gfc_char4_t) ' ';
return;
}
static void
-read_default_char4 (st_parameter_dt *dtp, char *p, int len, int width)
+read_default_char4 (st_parameter_dt *dtp, char *p, ptrdiff_t len, ptrdiff_t width)
{
- int m, n;
+ ptrdiff_t m, n;
gfc_char4_t *dest;
if (is_char4_unit(dtp))
@@ -479,14 +477,14 @@ read_default_char4 (st_parameter_dt *dtp, char *p, int len, int width)
if (width > len)
s4 += (width - len);
- m = ((int) width > len) ? len : (int) width;
+ m = (width > len) ? len : width;
dest = (gfc_char4_t *) p;
for (n = 0; n < m; n++)
*dest++ = *s4++;
- for (n = 0; n < len - (int) width; n++)
+ for (n = 0; n < len - width; n++)
*dest++ = (gfc_char4_t) ' ';
}
else
@@ -500,14 +498,14 @@ read_default_char4 (st_parameter_dt *dtp, char *p, int len, int width)
if (width > len)
s += (width - len);
- m = ((int) width > len) ? len : (int) width;
+ m = (width > len) ? len : width;
dest = (gfc_char4_t *) p;
for (n = 0; n < m; n++, dest++, s++)
*dest = (unsigned char ) *s;
- for (n = 0; n < len - (int) width; n++, dest++)
+ for (n = 0; n < len - width; n++, dest++)
*dest = (unsigned char) ' ';
}
}
@@ -517,15 +515,13 @@ read_default_char4 (st_parameter_dt *dtp, char *p, int len, int width)
processing UTF-8 encoding if necessary. */
void
-read_a (st_parameter_dt *dtp, const fnode *f, char *p, int length)
+read_a (st_parameter_dt *dtp, const fnode *f, char *p, ptrdiff_t length)
{
- int wi;
- int w;
+ ptrdiff_t w;
- wi = f->u.w;
- if (wi == -1) /* '(A)' edit descriptor */
- wi = length;
- w = wi;
+ w = f->u.w;
+ if (w == -1) /* '(A)' edit descriptor */
+ w = length;
/* Read in w characters, treating comma as not a separator. */
dtp->u.p.sf_read_comma = 0;
@@ -544,9 +540,9 @@ read_a (st_parameter_dt *dtp, const fnode *f, char *p, int length)
processing UTF-8 encoding if necessary. */
void
-read_a_char4 (st_parameter_dt *dtp, const fnode *f, char *p, int length)
+read_a_char4 (st_parameter_dt *dtp, const fnode *f, char *p, ptrdiff_t length)
{
- int w;
+ ptrdiff_t w;
w = f->u.w;
if (w == -1) /* '(A)' edit descriptor */
@@ -568,7 +564,7 @@ read_a_char4 (st_parameter_dt *dtp, const fnode *f, char *p, int length)
ignore the leading spaces. */
static char *
-eat_leading_spaces (int *width, char *p)
+eat_leading_spaces (ptrdiff_t *width, char *p)
{
for (;;)
{
@@ -584,7 +580,7 @@ eat_leading_spaces (int *width, char *p)
static char
-next_char (st_parameter_dt *dtp, char **p, int *w)
+next_char (st_parameter_dt *dtp, char **p, ptrdiff_t *w)
{
char c, *q;
@@ -624,7 +620,8 @@ read_decimal (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
{
GFC_UINTEGER_LARGEST value, maxv, maxv_10;
GFC_INTEGER_LARGEST v;
- int w, negative;
+ ptrdiff_t w;
+ int negative;
char c, *p;
w = f->u.w;
@@ -732,7 +729,8 @@ read_radix (st_parameter_dt *dtp, const fnode *f, char *dest, int length,
{
GFC_UINTEGER_LARGEST value, maxv, maxv_r;
GFC_INTEGER_LARGEST v;
- int w, negative;
+ ptrdiff_t w;
+ int negative;
char c, *p;
w = f->u.w;
@@ -882,7 +880,8 @@ read_f (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
#define READF_TMP 50
char tmp[READF_TMP];
size_t buf_size = 0;
- int w, seen_dp, exponent;
+ ptrdiff_t w;
+ int seen_dp, exponent;
int exponent_sign;
const char *p;
char *buffer;
@@ -1230,9 +1229,10 @@ bad_float:
and never look at it. */
void
-read_x (st_parameter_dt *dtp, int n)
+read_x (st_parameter_dt *dtp, ptrdiff_t n)
{
- int length, q, q2;
+ ptrdiff_t length;
+ int q, q2;
if ((dtp->u.p.current_unit->pad_status == PAD_NO || is_internal_unit (dtp))
&& dtp->u.p.current_unit->bytes_left < n)
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index bfa9565..721c146 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -223,11 +223,11 @@ current_mode (st_parameter_dt *dtp)
/* Read sequential file - internal unit */
static char *
-read_sf_internal (st_parameter_dt *dtp, int *length)
+read_sf_internal (st_parameter_dt *dtp, ptrdiff_t *length)
{
static char *empty_string[0];
char *base = NULL;
- int lorig;
+ ptrdiff_t lorig;
/* Zero size array gives internal unit len of 0. Nothing to read. */
if (dtp->internal_unit_len == 0
@@ -256,11 +256,10 @@ read_sf_internal (st_parameter_dt *dtp, int *length)
lorig = *length;
if (is_char4_unit(dtp))
{
- int i;
gfc_char4_t *p = (gfc_char4_t *) mem_alloc_r4 (dtp->u.p.current_unit->s,
length);
base = fbuf_alloc (dtp->u.p.current_unit, lorig);
- for (i = 0; i < *length; i++, p++)
+ for (ptrdiff_t i = 0; i < *length; i++, p++)
base[i] = *p > 255 ? '?' : (unsigned char) *p;
}
else
@@ -297,11 +296,12 @@ read_sf_internal (st_parameter_dt *dtp, int *length)
/* Read sequential file - external unit */
static char *
-read_sf (st_parameter_dt *dtp, int *length)
+read_sf (st_parameter_dt *dtp, ptrdiff_t *length)
{
static char *empty_string[0];
+ ptrdiff_t lorig, n;
int q, q2;
- int n, lorig, seen_comma;
+ int seen_comma;
/* If we have seen an eor previously, return a length of 0. The
caller is responsible for correctly padding the input field. */
@@ -439,10 +439,10 @@ read_sf (st_parameter_dt *dtp, int *length)
short reads. */
void *
-read_block_form (st_parameter_dt *dtp, int *nbytes)
+read_block_form (st_parameter_dt *dtp, ptrdiff_t *nbytes)
{
char *source;
- int norig;
+ ptrdiff_t norig;
if (!is_stream_io (dtp))
{
@@ -534,11 +534,11 @@ read_block_form (st_parameter_dt *dtp, int *nbytes)
a character(kind=4) variable. Note: Portions of this code borrowed from
read_sf_internal. */
void *
-read_block_form4 (st_parameter_dt *dtp, int *nbytes)
+read_block_form4 (st_parameter_dt *dtp, ptrdiff_t *nbytes)
{
static gfc_char4_t *empty_string[0];
gfc_char4_t *source;
- int lorig;
+ ptrdiff_t lorig;
if (dtp->u.p.current_unit->bytes_left < (gfc_offset) *nbytes)
*nbytes = dtp->u.p.current_unit->bytes_left;
@@ -743,7 +743,7 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t nbytes)
fill in. Returns NULL on error. */
void *
-write_block (st_parameter_dt *dtp, int length)
+write_block (st_parameter_dt *dtp, ptrdiff_t length)
{
char *dest;
@@ -1792,7 +1792,7 @@ static void
formatted_transfer_scalar_write (st_parameter_dt *dtp, bt type, void *p, int kind,
size_t size)
{
- int pos, bytes_used;
+ gfc_offset pos, bytes_used;
const fnode *f;
format_token t;
int n;
@@ -1856,10 +1856,10 @@ formatted_transfer_scalar_write (st_parameter_dt *dtp, bt type, void *p, int kin
{
if (dtp->u.p.skips > 0)
{
- int tmp;
+ gfc_offset tmp;
write_x (dtp, dtp->u.p.skips, dtp->u.p.pending_spaces);
- tmp = (int)(dtp->u.p.current_unit->recl
- - dtp->u.p.current_unit->bytes_left);
+ tmp = dtp->u.p.current_unit->recl
+ - dtp->u.p.current_unit->bytes_left;
dtp->u.p.max_pos =
dtp->u.p.max_pos > tmp ? dtp->u.p.max_pos : tmp;
dtp->u.p.skips = 0;
@@ -1875,8 +1875,8 @@ formatted_transfer_scalar_write (st_parameter_dt *dtp, bt type, void *p, int kin
dtp->u.p.skips = dtp->u.p.pending_spaces = 0;
}
- bytes_used = (int)(dtp->u.p.current_unit->recl
- - dtp->u.p.current_unit->bytes_left);
+ bytes_used = dtp->u.p.current_unit->recl
+ - dtp->u.p.current_unit->bytes_left;
if (is_stream_io(dtp))
bytes_used = 0;
@@ -2231,7 +2231,7 @@ formatted_transfer_scalar_write (st_parameter_dt *dtp, bt type, void *p, int kin
p = ((char *) p) + size;
}
- pos = (int)(dtp->u.p.current_unit->recl - dtp->u.p.current_unit->bytes_left);
+ pos = dtp->u.p.current_unit->recl - dtp->u.p.current_unit->bytes_left;
dtp->u.p.max_pos = (dtp->u.p.max_pos > pos) ? dtp->u.p.max_pos : pos;
}
diff --git a/libgfortran/io/unix.c b/libgfortran/io/unix.c
index 7a982b3..5df7848 100644
--- a/libgfortran/io/unix.c
+++ b/libgfortran/io/unix.c
@@ -776,7 +776,7 @@ buf_init (unix_stream *s)
*********************************************************************/
char *
-mem_alloc_r (stream *strm, int *len)
+mem_alloc_r (stream *strm, ptrdiff_t *len)
{
unix_stream *s = (unix_stream *) strm;
gfc_offset n;
@@ -796,7 +796,7 @@ mem_alloc_r (stream *strm, int *len)
char *
-mem_alloc_r4 (stream *strm, int *len)
+mem_alloc_r4 (stream *strm, ptrdiff_t *len)
{
unix_stream *s = (unix_stream *) strm;
gfc_offset n;
@@ -816,7 +816,7 @@ mem_alloc_r4 (stream *strm, int *len)
char *
-mem_alloc_w (stream *strm, int *len)
+mem_alloc_w (stream *strm, ptrdiff_t *len)
{
unix_stream *s = (unix_stream *)strm;
gfc_offset m;
@@ -837,7 +837,7 @@ mem_alloc_w (stream *strm, int *len)
gfc_char4_t *
-mem_alloc_w4 (stream *strm, int *len)
+mem_alloc_w4 (stream *strm, ptrdiff_t *len)
{
unix_stream *s = (unix_stream *)strm;
gfc_offset m;
@@ -863,7 +863,7 @@ static ssize_t
mem_read (stream *s, void *buf, ssize_t nbytes)
{
void *p;
- int nb = nbytes;
+ ptrdiff_t nb = nbytes;
p = mem_alloc_r (s, &nb);
if (p)
@@ -882,7 +882,7 @@ static ssize_t
mem_read4 (stream *s, void *buf, ssize_t nbytes)
{
void *p;
- int nb = nbytes;
+ ptrdiff_t nb = nbytes;
p = mem_alloc_r4 (s, &nb);
if (p)
@@ -901,7 +901,7 @@ static ssize_t
mem_write (stream *s, const void *buf, ssize_t nbytes)
{
void *p;
- int nb = nbytes;
+ ptrdiff_t nb = nbytes;
p = mem_alloc_w (s, &nb);
if (p)
@@ -920,7 +920,7 @@ static ssize_t
mem_write4 (stream *s, const void *buf, ssize_t nwords)
{
gfc_char4_t *p;
- int nw = nwords;
+ ptrdiff_t nw = nwords;
p = mem_alloc_w4 (s, &nw);
if (p)
@@ -1038,7 +1038,7 @@ static const struct stream_vtable mem4_vtable = {
internal file */
stream *
-open_internal (char *base, int length, gfc_offset offset)
+open_internal (char *base, ptrdiff_t length, gfc_offset offset)
{
unix_stream *s;
@@ -1058,7 +1058,7 @@ open_internal (char *base, int length, gfc_offset offset)
internal file */
stream *
-open_internal4 (char *base, int length, gfc_offset offset)
+open_internal4 (char *base, ptrdiff_t length, gfc_offset offset)
{
unix_stream *s;
diff --git a/libgfortran/io/unix.h b/libgfortran/io/unix.h
index 4ac92ee..80f7f43 100644
--- a/libgfortran/io/unix.h
+++ b/libgfortran/io/unix.h
@@ -108,22 +108,22 @@ internal_proto(compare_files);
extern stream *open_external (st_parameter_open *, unit_flags *);
internal_proto(open_external);
-extern stream *open_internal (char *, int, gfc_offset);
+extern stream *open_internal (char *, ptrdiff_t, gfc_offset);
internal_proto(open_internal);
-extern stream *open_internal4 (char *, int, gfc_offset);
+extern stream *open_internal4 (char *, ptrdiff_t, gfc_offset);
internal_proto(open_internal4);
-extern char *mem_alloc_w (stream *, int *);
+extern char *mem_alloc_w (stream *, ptrdiff_t *);
internal_proto(mem_alloc_w);
-extern char *mem_alloc_r (stream *, int *);
+extern char *mem_alloc_r (stream *, ptrdiff_t *);
internal_proto(mem_alloc_r);
-extern gfc_char4_t *mem_alloc_w4 (stream *, int *);
+extern gfc_char4_t *mem_alloc_w4 (stream *, ptrdiff_t *);
internal_proto(mem_alloc_w4);
-extern char *mem_alloc_r4 (stream *, int *);
+extern char *mem_alloc_r4 (stream *, ptrdiff_t *);
internal_proto(mem_alloc_r4);
extern stream *input_stream (void);
diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c
index 3b1168d..bcae439 100644
--- a/libgfortran/io/write.c
+++ b/libgfortran/io/write.c
@@ -235,7 +235,7 @@ write_utf8_char4 (st_parameter_dt *dtp, gfc_char4_t *source,
is set to the appropriate size to allocate. */
static void
-write_check_cc (st_parameter_dt *dtp, const char **source, int *alloc_len)
+write_check_cc (st_parameter_dt *dtp, const char **source, ptrdiff_t *alloc_len)
{
/* Only valid for CARRIAGECONTROL=FORTRAN. */
if (dtp->u.p.current_unit->flags.cc != CC_FORTRAN
@@ -311,7 +311,7 @@ write_check_cc (st_parameter_dt *dtp, const char **source, int *alloc_len)
after the start-of-record string was inserted. */
static char *
-write_cc (st_parameter_dt *dtp, char *p, int *source_len)
+write_cc (st_parameter_dt *dtp, char *p, ptrdiff_t *source_len)
{
/* Only valid for CARRIAGECONTROL=FORTRAN. */
if (dtp->u.p.current_unit->flags.cc != CC_FORTRAN || source_len == NULL)
@@ -360,9 +360,10 @@ write_cc (st_parameter_dt *dtp, char *p, int *source_len)
}
void
-write_a (st_parameter_dt *dtp, const fnode *f, const char *source, int len)
+
+write_a (st_parameter_dt *dtp, const fnode *f, const char *source, ptrdiff_t len)
{
- int wlen;
+ ptrdiff_t wlen;
char *p;
wlen = f->u.string.length < 0
@@ -376,7 +377,7 @@ write_a (st_parameter_dt *dtp, const fnode *f, const char *source, int len)
if (is_stream_io (dtp))
{
const char crlf[] = "\r\n";
- int i, q, bytes;
+ ptrdiff_t q, bytes;
q = bytes = 0;
/* Write out any padding if needed. */
@@ -389,7 +390,7 @@ write_a (st_parameter_dt *dtp, const fnode *f, const char *source, int len)
}
/* Scan the source string looking for '\n' and convert it if found. */
- for (i = 0; i < wlen; i++)
+ for (ptrdiff_t i = 0; i < wlen; i++)
{
if (source[i] == '\n')
{
@@ -471,9 +472,9 @@ write_a (st_parameter_dt *dtp, const fnode *f, const char *source, int len)
to the UTF-8 encoded string before writing out. */
void
-write_a_char4 (st_parameter_dt *dtp, const fnode *f, const char *source, int len)
+write_a_char4 (st_parameter_dt *dtp, const fnode *f, const char *source, ptrdiff_t len)
{
- int wlen;
+ ptrdiff_t wlen;
gfc_char4_t *q;
wlen = f->u.string.length < 0
@@ -488,7 +489,7 @@ write_a_char4 (st_parameter_dt *dtp, const fnode *f, const char *source, int len
if (is_stream_io (dtp))
{
const gfc_char4_t crlf[] = {0x000d,0x000a};
- int i, bytes;
+ ptrdiff_t bytes;
gfc_char4_t *qq;
bytes = 0;
@@ -504,7 +505,7 @@ write_a_char4 (st_parameter_dt *dtp, const fnode *f, const char *source, int len
/* Scan the source string looking for '\n' and convert it if found. */
qq = (gfc_char4_t *) source;
- for (i = 0; i < wlen; i++)
+ for (ptrdiff_t i = 0; i < wlen; i++)
{
if (qq[i] == '\n')
{
--
2.7.4
[-- Attachment #3: largewrite.f90 --]
[-- Type: text/x-fortran, Size: 921 bytes --]
program main
character(len=2_8**31+1) :: b
b = ""
b(len(b, 8):len(b, 8)) = "b"
open(10, file="largewrite.txt", status="replace", action="write")
write(10, '(A)') b
close(10)
! Try to read what we wrote
b(len(b, 8):len(b, 8)) = "x"
open(10, file="largewrite.txt", action="read")
read(10, '(A)') b
close(10)
if (b(len(b, 8):len(b, 8)) /= "b") then
print *, "Last char of b: ", b(len(b, 8):len(b, 8)), "END"
call abort()
end if
! Same but with list formatted read
b(len(b, 8):len(b, 8)) = "x"
b(1:1) = 'y'
open(10, file="largewrite.txt", action="read")
read(10, *) b
! List formatted skips the initial blanks, so the last and only
! character in the original string will become the first.
if (b(1:1) /= "b") then
print *, "First char of b: ", b(1:1), 'END'
print *, "Last char of b: ", b(len(b, 8):len(b, 8)), "END"
call abort()
end if
end program main
[-- Attachment #4: largewrite_charunform.f90 --]
[-- Type: text/x-fortran, Size: 407 bytes --]
program main
character(len=2_8**31+1) :: b
b = ""
b(len(b, 8):len(b, 8)) = "b"
open(10, file="largewrite_charunform.dat", access="stream", form="unformatted")
write (10) b
close(10)
b(len(b, 8):len(b, 8)) = "x"
open(10, file="largewrite_charunform.dat", access="stream", form="unformatted")
read (10) b
if (b(len(b, 8):len(b, 8)) /= 'b') then
call abort()
end if
end program main
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2018-01-03 11:37 ` Janne Blomqvist
@ 2018-01-03 12:10 ` Thomas Koenig
2018-01-03 12:22 ` Janne Blomqvist
2018-01-04 2:21 ` Jerry DeLisle
1 sibling, 1 reply; 76+ messages in thread
From: Thomas Koenig @ 2018-01-03 12:10 UTC (permalink / raw)
To: Janne Blomqvist, Jerry DeLisle; +Cc: Fortran List, GCC Patches
Hi Janne,
> attached is a patch that makes the two attached testcases work. It
> applies on top of the charlen->size_t patch. In the formatted I/O
> stuff, I have mostly used ptrdiff_t to avoid having to deal with
> signed/unsigned issues, as the previous code was using int.
Did you regression-test?
If yes, I'd say this patch is OK (all the changes look obvious
enough).
With this, your character length patch is also OK. We can then
open individual PRs for the other issues.
However, I'd ask you to wait for a day or so with committing
so that other people also have a chance for a (final) look
at this.
Regards
Thomas
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2018-01-03 12:10 ` Thomas Koenig
@ 2018-01-03 12:22 ` Janne Blomqvist
0 siblings, 0 replies; 76+ messages in thread
From: Janne Blomqvist @ 2018-01-03 12:22 UTC (permalink / raw)
To: Thomas Koenig; +Cc: Jerry DeLisle, Fortran List, GCC Patches
On Wed, Jan 3, 2018 at 2:10 PM, Thomas Koenig <tkoenig@netcologne.de> wrote:
> Hi Janne,
>
>> attached is a patch that makes the two attached testcases work. It
>> applies on top of the charlen->size_t patch. In the formatted I/O
>> stuff, I have mostly used ptrdiff_t to avoid having to deal with
>> signed/unsigned issues, as the previous code was using int.
>
>
> Did you regression-test?
Ah yes, I forgot to mention that. Yes, I did, though only on x86_64-linux-gnu
> If yes, I'd say this patch is OK (all the changes look obvious
> enough).
>
> With this, your character length patch is also OK. We can then
> open individual PRs for the other issues.
>
> However, I'd ask you to wait for a day or so with committing
> so that other people also have a chance for a (final) look
> at this.
Thanks! Dominique mentioned on IRC about some incoming comments, so I
guess it makes sense to wait a few days.
--
Janne Blomqvist
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2017-12-29 13:32 [PATCH] PR 78534 Change character length from int to size_t Janne Blomqvist
2017-12-30 14:59 ` Thomas Koenig
@ 2018-01-03 18:34 ` Bob Deen
2018-01-03 19:43 ` Janne Blomqvist
1 sibling, 1 reply; 76+ messages in thread
From: Bob Deen @ 2018-01-03 18:34 UTC (permalink / raw)
To: Janne Blomqvist, fortran, gcc-patches
On 12/29/17 5:31 AM, Janne Blomqvist wrote:
> In order to handle large character lengths on (L)LP64 targets, switch
> the GFortran character length from an int to a size_t.
>
> This is an ABI change, as procedures with character arguments take
> hidden arguments with the character length.
Did this change not make it into gcc 7 then? I am one of those who
still use these hidden arguments for Fortran <-> C interfaces. Based on
discussions a year ago, I added this to my code:
#if defined(__GNUC__) && (__GNUC__ > 6)
#include <stddef.h>
#define FORSTR_STDARG_TYPE size_t
#else
#define FORSTR_STDARG_TYPE int
#endif
I infer from this thread that I should change this to __GNUC__ > 7 now.
Is this still the correct/best way to determine the hidden argument size?
(note that we're still using 4.x... ugh, don't ask... so the >6 check
hasn't actually been used yet, I just want to future-proof things as
much as possible without having to rewrite the entire Fortran <-> C
interface.)
Thanks...
-Bob
Bob Deen @ NASA-JPL Multmission Image Processing Lab
Bob.Deen@jpl.nasa.gov
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2018-01-03 18:34 ` Bob Deen
@ 2018-01-03 19:43 ` Janne Blomqvist
2018-01-08 19:08 ` Bob Deen
0 siblings, 1 reply; 76+ messages in thread
From: Janne Blomqvist @ 2018-01-03 19:43 UTC (permalink / raw)
To: Bob Deen; +Cc: Fortran List, GCC Patches
On Wed, Jan 3, 2018 at 8:34 PM, Bob Deen <Bob.Deen@jpl.nasa.gov> wrote:
> On 12/29/17 5:31 AM, Janne Blomqvist wrote:
>>
>> In order to handle large character lengths on (L)LP64 targets, switch
>> the GFortran character length from an int to a size_t.
>>
>> This is an ABI change, as procedures with character arguments take
>> hidden arguments with the character length.
>
>
> Did this change not make it into gcc 7 then?
No, it caused regressions on big endian targets, and it was so late in
the gcc 7 cycle that there was no time to fix them (at the time I
didn't have access to a big endian target to test on, and getting said
access took time), so I had to revert it. Those regressions have now
been fixed, and the ABI has been broken anyway due to other changes,
so I'm trying again for gcc 8.
> I am one of those who still
> use these hidden arguments for Fortran <-> C interfaces. Based on
> discussions a year ago, I added this to my code:
>
> #if defined(__GNUC__) && (__GNUC__ > 6)
> #include <stddef.h>
> #define FORSTR_STDARG_TYPE size_t
> #else
> #define FORSTR_STDARG_TYPE int
> #endif
>
> I infer from this thread that I should change this to __GNUC__ > 7 now. Is
> this still the correct/best way to determine the hidden argument size?
Yes, I would say so.
> (note that we're still using 4.x... ugh, don't ask... so the >6 check hasn't
> actually been used yet, I just want to future-proof things as much as
> possible without having to rewrite the entire Fortran <-> C interface.)
>
> Thanks...
>
> -Bob
>
> Bob Deen @ NASA-JPL Multmission Image Processing Lab
> Bob.Deen@jpl.nasa.gov
>
--
Janne Blomqvist
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2018-01-03 11:37 ` Janne Blomqvist
2018-01-03 12:10 ` Thomas Koenig
@ 2018-01-04 2:21 ` Jerry DeLisle
2018-01-04 7:20 ` Janne Blomqvist
1 sibling, 1 reply; 76+ messages in thread
From: Jerry DeLisle @ 2018-01-04 2:21 UTC (permalink / raw)
To: Janne Blomqvist; +Cc: Thomas Koenig, Fortran List, GCC Patches
On 01/03/2018 03:37 AM, Janne Blomqvist wrote:
> On Sat, Dec 30, 2017 at 10:58 PM, Jerry DeLisle <jvdelisle@charter.net> wrote:
>> On 12/30/2017 12:35 PM, Janne Blomqvist wrote:
>>> On Sat, Dec 30, 2017 at 7:16 PM, Thomas Koenig <tkoenig@netcologne.de> wrote:
>> ---snip---
>>>
>>> I can provide that stuff as a separate patch, or merge it into the
>>> original megapatch and resubmit that, whichever way you prefer.
>>
>> I would prefer we split into two patches. This will make review of the library
>> I/O changes easier. The int len is used in a lot of places also where it really
>> happens to also be the kind (which is a length in our implementation).
>
> Hi,
>
> attached is a patch that makes the two attached testcases work. It
> applies on top of the charlen->size_t patch. In the formatted I/O
> stuff, I have mostly used ptrdiff_t to avoid having to deal with
> signed/unsigned issues, as the previous code was using int.
>
>
>
Well I have started reviewing. One concern I have is that in many places you
are changing formatted field widths, like w in read_l, to ptrdiff_t. I don't
think this is necessary. If someone is printing a value that has a field width
that big, it will never finish.
I did not check the definitions of format data structures that use these values
all over. So I think in the least, the patch goes too far.
Another issue I have is that the readability of the code just sucks to me. The
type ptrdiff_t is so not intuitive in a very many places. If this is really
necessary lets hide it behind a macro or something so I don't have to cringe
every time I look at this code. (such as gfc_int)
Sometimes we can get too pedantic about things like this. A lot of these
variables have nothing to do with pointers, though they may be used as modifiers
to offsets in large memory spaces.
I need a day or two to go through all of this. Sorry if I am just a downer about it.
Regards,
Jerry
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2018-01-04 2:21 ` Jerry DeLisle
@ 2018-01-04 7:20 ` Janne Blomqvist
0 siblings, 0 replies; 76+ messages in thread
From: Janne Blomqvist @ 2018-01-04 7:20 UTC (permalink / raw)
To: Jerry DeLisle; +Cc: Thomas Koenig, Fortran List, GCC Patches
On Thu, Jan 4, 2018 at 4:21 AM, Jerry DeLisle <jvdelisle@charter.net> wrote:
> On 01/03/2018 03:37 AM, Janne Blomqvist wrote:
>> On Sat, Dec 30, 2017 at 10:58 PM, Jerry DeLisle <jvdelisle@charter.net> wrote:
>>> On 12/30/2017 12:35 PM, Janne Blomqvist wrote:
>>>> On Sat, Dec 30, 2017 at 7:16 PM, Thomas Koenig <tkoenig@netcologne.de> wrote:
>>> ---snip---
>>>>
>>>> I can provide that stuff as a separate patch, or merge it into the
>>>> original megapatch and resubmit that, whichever way you prefer.
>>>
>>> I would prefer we split into two patches. This will make review of the library
>>> I/O changes easier. The int len is used in a lot of places also where it really
>>> happens to also be the kind (which is a length in our implementation).
>>
>> Hi,
>>
>> attached is a patch that makes the two attached testcases work. It
>> applies on top of the charlen->size_t patch. In the formatted I/O
>> stuff, I have mostly used ptrdiff_t to avoid having to deal with
>> signed/unsigned issues, as the previous code was using int.
>>
>>
>>
>
> Well I have started reviewing. One concern I have is that in many places you
> are changing formatted field widths, like w in read_l, to ptrdiff_t. I don't
> think this is necessary. If someone is printing a value that has a field width
> that big, it will never finish.
>
> I did not check the definitions of format data structures that use these values
> all over. So I think in the least, the patch goes too far.
I don't expect to support format widths larger than INT_MAX. The
reason why ptrdiff_t is used is that read_block_form_* and many
similar functions take a pointer to a ptrdiff_t (to handle the one
case where a scalar variable can be wider than INT_MAX, namely a
character), and we can't pass a pointer to an incompatible type.
Now, you could argue that the internal API should be refactored so
that we pass integers by value rather than as pointers, and then only
the character case would need to care to use a larger type and the
rest could keep using plain int. And I would agree that would be good,
but I think such a refactor would be stage 1 material, not stage 3.
> Another issue I have is that the readability of the code just sucks to me. The
> type ptrdiff_t is so not intuitive in a very many places. If this is really
> necessary lets hide it behind a macro or something so I don't have to cringe
> every time I look at this code. (such as gfc_int)
>
> Sometimes we can get too pedantic about things like this. A lot of these
> variables have nothing to do with pointers, though they may be used as modifiers
> to offsets in large memory spaces.
Well, ptrdiff_t is one of the two "pointer-sized integer" typedefs
introduced in C89, the other being size_t. So I would argue that if
one is doing stuff like pointer arithmetic, or calculating array
indices etc., and the variable might for some reason be negative,
ptrdiff_t is the natural type to use. I do agree that ptrdiff_t is a
bit of a mouthful, but I don't have any really good alternatives
either; I'm not convinced that a libgfortran-specific typedef would
make things clearer.
Or we can blame Microsoft which made win64 LLP64 and not LP64 like the
rest of the world, and thus spoiled the use of long for portable code.
:)
FWIW, we have "index_type" which is a typedef for ptrdiff_t, but
that's used mostly in code that deals with array descriptors, so I
thought it would be cleaner to not use it here.
--
Janne Blomqvist
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2018-01-03 19:43 ` Janne Blomqvist
@ 2018-01-08 19:08 ` Bob Deen
0 siblings, 0 replies; 76+ messages in thread
From: Bob Deen @ 2018-01-08 19:08 UTC (permalink / raw)
To: Janne Blomqvist; +Cc: Fortran List, GCC Patches
On 1/3/18 11:43 AM, Janne Blomqvist wrote:
> On Wed, Jan 3, 2018 at 8:34 PM, Bob Deen <Bob.Deen@jpl.nasa.gov> wrote:
>> On 12/29/17 5:31 AM, Janne Blomqvist wrote:
>>>
>>> In order to handle large character lengths on (L)LP64 targets, switch
>>> the GFortran character length from an int to a size_t.
>>>
>>> This is an ABI change, as procedures with character arguments take
>>> hidden arguments with the character length.
>>
>>
>> Did this change not make it into gcc 7 then?
>
> No, it caused regressions on big endian targets, and it was so late in
> the gcc 7 cycle that there was no time to fix them (at the time I
> didn't have access to a big endian target to test on, and getting said
> access took time), so I had to revert it. Those regressions have now
> been fixed, and the ABI has been broken anyway due to other changes,
> so I'm trying again for gcc 8.
Okay. If for some reason it doesn't make 8, it would be nice to know.
I lurk here and try to pay attention but obviously I missed that it was
pulled from 7. (which is why I'd prefer something specific to test
rather than a version number, but it is what it is).
Thanks...
-Bob
>
>> I am one of those who still
>> use these hidden arguments for Fortran <-> C interfaces. Based on
>> discussions a year ago, I added this to my code:
>>
>> #if defined(__GNUC__) && (__GNUC__ > 6)
>> #include <stddef.h>
>> #define FORSTR_STDARG_TYPE size_t
>> #else
>> #define FORSTR_STDARG_TYPE int
>> #endif
>>
>> I infer from this thread that I should change this to __GNUC__ > 7 now. Is
>> this still the correct/best way to determine the hidden argument size?
>
> Yes, I would say so.
>
>> (note that we're still using 4.x... ugh, don't ask... so the >6 check hasn't
>> actually been used yet, I just want to future-proof things as much as
>> possible without having to rewrite the entire Fortran <-> C interface.)
>>
>> Thanks...
>>
>> -Bob
>>
>> Bob Deen @ NASA-JPL Multmission Image Processing Lab
>> Bob.Deen@jpl.nasa.gov
>>
>
>
>
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2017-01-14 8:46 ` Janne Blomqvist
2017-01-14 20:30 ` Janne Blomqvist
@ 2017-01-14 21:29 ` Jerry DeLisle
1 sibling, 0 replies; 76+ messages in thread
From: Jerry DeLisle @ 2017-01-14 21:29 UTC (permalink / raw)
To: Janne Blomqvist
Cc: FX, Dominique d'Humières, GCC-Fortran-ML, GCC-Patches-ML
On 01/14/2017 12:46 AM, Janne Blomqvist wrote:
> On Sat, Jan 14, 2017 at 1:13 AM, Jerry DeLisle <jvdelisle@charter.net> wrote:
>> On 01/13/2017 11:46 AM, David Edelsohn wrote:
>>> On Fri, Jan 13, 2017 at 12:09 PM, Janne Blomqvist
>>> <blomqvist.janne@gmail.com> wrote:
>>>> On Thu, Jan 12, 2017 at 10:46 AM, FX <fxcoudert@gmail.com> wrote:
>>>>>> I was finally able to get a 32-bit i686 compiler going (my attempts to
>>>>>> do this on a x86_64-pc-linux-gnu host failed, in the end I resorted to
>>>>>> running 32-bit builds/tests on a i686 container). At least on i686,
>>>>>> the patch below on top of the big charlen->size_t patch fixes the
>>>>>> failures
>>>>>
>>>>> Patch approved. The old code used gfc_extract_int, which bails out if a non-constant expression is passed, so this is the right thing to do.
>>>>>
>>>>> FX
>>>>
>>>> Committed as r244448.
>>>>
>>>> David, can you verify that it works alright on ppc?
>>>
>>> Unfortunately, no. This patch broke bootstrap again with the same
>>> failure as earlier.
>>>
>>> - David
>>>
>>
>> Janne, can you access gcc112 on the compile farm? If not, I can, maybe I can
>> test the patch.
>>
>> Jerry
>
> No, I don't have such access. I'd appreciate it very much if you'd
> have a go at it. Attached is the r244448 patch combined with the
> patch to fix the sanitizer bugs found by Dominique.
>
I will try to do this tonight
Jerry
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2017-01-14 8:46 ` Janne Blomqvist
@ 2017-01-14 20:30 ` Janne Blomqvist
2017-01-14 21:29 ` Jerry DeLisle
1 sibling, 0 replies; 76+ messages in thread
From: Janne Blomqvist @ 2017-01-14 20:30 UTC (permalink / raw)
To: Jerry DeLisle
Cc: FX, Dominique d'Humières, GCC-Fortran-ML, GCC-Patches-ML
[-- Attachment #1: Type: text/plain, Size: 1983 bytes --]
On Sat, Jan 14, 2017 at 10:46 AM, Janne Blomqvist
<blomqvist.janne@gmail.com> wrote:
> On Sat, Jan 14, 2017 at 1:13 AM, Jerry DeLisle <jvdelisle@charter.net> wrote:
>> On 01/13/2017 11:46 AM, David Edelsohn wrote:
>>> On Fri, Jan 13, 2017 at 12:09 PM, Janne Blomqvist
>>> <blomqvist.janne@gmail.com> wrote:
>>>> On Thu, Jan 12, 2017 at 10:46 AM, FX <fxcoudert@gmail.com> wrote:
>>>>>> I was finally able to get a 32-bit i686 compiler going (my attempts to
>>>>>> do this on a x86_64-pc-linux-gnu host failed, in the end I resorted to
>>>>>> running 32-bit builds/tests on a i686 container). At least on i686,
>>>>>> the patch below on top of the big charlen->size_t patch fixes the
>>>>>> failures
>>>>>
>>>>> Patch approved. The old code used gfc_extract_int, which bails out if a non-constant expression is passed, so this is the right thing to do.
>>>>>
>>>>> FX
>>>>
>>>> Committed as r244448.
>>>>
>>>> David, can you verify that it works alright on ppc?
>>>
>>> Unfortunately, no. This patch broke bootstrap again with the same
>>> failure as earlier.
>>>
>>> - David
>>>
>>
>> Janne, can you access gcc112 on the compile farm? If not, I can, maybe I can
>> test the patch.
>>
>> Jerry
>
> No, I don't have such access. I'd appreciate it very much if you'd
> have a go at it. Attached is the r244448 patch combined with the
> patch to fix the sanitizer bugs found by Dominique.
>
> --
> Janne Blomqvist
Since David had problems with module generation, I took a look at the
parts of the patch that changes module.c, and found a few places for
improvements. module.c is a collection of all the ugly type punning
tricks one can think of, in particular wrongly punning to a wider type
might cause a different result on a big endian machine, whereas on a
little endian it would apparently just work.. So could you also try
the attached small patch on top of the previous one?
(I also sent Laurent Guerby an email requesting an account on the compile farm).
--
Janne Blomqvist
[-- Attachment #2: charlen-module.diff --]
[-- Type: text/plain, Size: 1750 bytes --]
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index ca53016..90b77ca 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -143,7 +143,7 @@ enum gfc_wsym_state
typedef struct pointer_info
{
BBT_HEADER (pointer_info);
- int integer;
+ HOST_WIDE_INT integer;
pointer_t type;
/* The first component of each member of the union is the pointer
@@ -372,7 +372,7 @@ get_pointer (void *gp)
creating the node if not found. */
static pointer_info *
-get_integer (int integer)
+get_integer (HOST_WIDE_INT integer)
{
pointer_info *p, t;
int c;
@@ -472,7 +472,7 @@ associate_integer_pointer (pointer_info *p, void *gp)
sometime later. Returns the pointer_info structure. */
static pointer_info *
-add_fixup (int integer, void *gp)
+add_fixup (HOST_WIDE_INT integer, void *gp)
{
pointer_info *p;
fixup_t *f;
@@ -2729,7 +2729,8 @@ mio_pointer_ref (void *gp)
if (iomode == IO_OUTPUT)
{
p = get_pointer (*((char **) gp));
- write_atom (ATOM_INTEGER, &p->integer);
+ HOST_WIDE_INT hwi = p->integer;
+ write_atom (ATOM_INTEGER, &hwi);
}
else
{
@@ -2766,18 +2767,18 @@ static void
mio_component (gfc_component *c, int vtype)
{
pointer_info *p;
- int n;
mio_lparen ();
if (iomode == IO_OUTPUT)
{
p = get_pointer (c);
- mio_integer (&p->integer);
+ mio_hwi (&p->integer);
}
else
{
- mio_integer (&n);
+ HOST_WIDE_INT n;
+ mio_hwi (&n);
p = get_integer (n);
associate_integer_pointer (p, c);
}
@@ -5924,7 +5925,7 @@ write_symtree (gfc_symtree *st)
mio_pool_string (&st->name);
mio_integer (&st->ambiguous);
- mio_integer (&p->integer);
+ mio_hwi (&p->integer);
}
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2017-01-14 8:39 ` Janne Blomqvist
@ 2017-01-14 17:01 ` Dominique d'Humières
0 siblings, 0 replies; 76+ messages in thread
From: Dominique d'Humières @ 2017-01-14 17:01 UTC (permalink / raw)
To: Janne Blomqvist; +Cc: GCC-Fortran-ML, GCC-Patches-ML
> The following patch fixes these issues for me, does it work for you?
Yes, it does!
Dominique
> Janne Blomqvist
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2017-01-13 23:13 ` Jerry DeLisle
@ 2017-01-14 8:46 ` Janne Blomqvist
2017-01-14 20:30 ` Janne Blomqvist
2017-01-14 21:29 ` Jerry DeLisle
0 siblings, 2 replies; 76+ messages in thread
From: Janne Blomqvist @ 2017-01-14 8:46 UTC (permalink / raw)
To: Jerry DeLisle
Cc: FX, Dominique d'Humières, GCC-Fortran-ML, GCC-Patches-ML
[-- Attachment #1: Type: text/plain, Size: 1285 bytes --]
On Sat, Jan 14, 2017 at 1:13 AM, Jerry DeLisle <jvdelisle@charter.net> wrote:
> On 01/13/2017 11:46 AM, David Edelsohn wrote:
>> On Fri, Jan 13, 2017 at 12:09 PM, Janne Blomqvist
>> <blomqvist.janne@gmail.com> wrote:
>>> On Thu, Jan 12, 2017 at 10:46 AM, FX <fxcoudert@gmail.com> wrote:
>>>>> I was finally able to get a 32-bit i686 compiler going (my attempts to
>>>>> do this on a x86_64-pc-linux-gnu host failed, in the end I resorted to
>>>>> running 32-bit builds/tests on a i686 container). At least on i686,
>>>>> the patch below on top of the big charlen->size_t patch fixes the
>>>>> failures
>>>>
>>>> Patch approved. The old code used gfc_extract_int, which bails out if a non-constant expression is passed, so this is the right thing to do.
>>>>
>>>> FX
>>>
>>> Committed as r244448.
>>>
>>> David, can you verify that it works alright on ppc?
>>
>> Unfortunately, no. This patch broke bootstrap again with the same
>> failure as earlier.
>>
>> - David
>>
>
> Janne, can you access gcc112 on the compile farm? If not, I can, maybe I can
> test the patch.
>
> Jerry
No, I don't have such access. I'd appreciate it very much if you'd
have a go at it. Attached is the r244448 patch combined with the
patch to fix the sanitizer bugs found by Dominique.
--
Janne Blomqvist
[-- Attachment #2: 0001-PR-78534-Change-character-length-from-int-to-size_t.patch.gz --]
[-- Type: application/x-gzip, Size: 19340 bytes --]
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2017-01-08 14:29 Dominique d'Humières
2017-01-11 22:17 ` Janne Blomqvist
@ 2017-01-14 8:39 ` Janne Blomqvist
2017-01-14 17:01 ` Dominique d'Humières
1 sibling, 1 reply; 76+ messages in thread
From: Janne Blomqvist @ 2017-01-14 8:39 UTC (permalink / raw)
To: Dominique d'Humières; +Cc: GCC-Fortran-ML, GCC-Patches-ML
On Sun, Jan 8, 2017 at 4:29 PM, Dominique d'Humières <dominiq@lps.ens.fr> wrote:
>> r244027 reverts r244011. Sorry for the breakage. It seems to affect
>> all i686 as well in addition to power, maybe all 32-bit hosts.
>
> For the record, I see the following failures with an instrumented r244026 (as in pr78672)
>
> FAIL: gfortran.dg/char_length_20.f90 -O* execution test
> FAIL: gfortran.dg/char_length_21.f90 -O* execution test
> FAIL: gfortran.dg/repeat_2.f90 -O1 execution test
> …
> FAIL: gfortran.dg/repeat_2.f90 -Os execution test
> FAIL: gfortran.dg/widechar_6.f90 -O1 execution test
> …
> FAIL: gfortran.dg/widechar_6.f90 -Os execution test
> FAIL: gfortran.dg/widechar_intrinsics_6.f90 -O* execution test
>
> The run time failures are all of the kind
Sorry, I missed that I had to use an instrumented build to catch
these, and assumed everything was Ok once I managed to regtest cleanly
on i686.
The following patch fixes these issues for me, does it work for you?
diff --git a/libgfortran/intrinsics/string_intrinsics_inc.c
b/libgfortran/intrinsics/string_intrinsics_inc.c
index 0da5130..74a994b 100644
--- a/libgfortran/intrinsics/string_intrinsics_inc.c
+++ b/libgfortran/intrinsics/string_intrinsics_inc.c
@@ -177,23 +177,25 @@ string_trim (gfc_charlen_type *len, CHARTYPE
**dest, gfc_charlen_type slen,
gfc_charlen_type
string_len_trim (gfc_charlen_type len, const CHARTYPE *s)
{
- const gfc_charlen_type long_len = (gfc_charlen_type) sizeof (unsigned long);
- gfc_charlen_type i;
+ if (len <= 0)
+ return 0;
+
+ const size_t long_len = sizeof (unsigned long);
- i = len - 1;
+ size_t i = len - 1;
/* If we've got the standard (KIND=1) character type, we scan the string in
long word chunks to speed it up (until a long word is hit that does not
consist of ' 's). */
if (sizeof (CHARTYPE) == 1 && i >= long_len)
{
- int starting;
+ size_t starting;
unsigned long blank_longword;
/* Handle the first characters until we're aligned on a long word
boundary. Actually, s + i + 1 must be properly aligned, because
s + i will be the last byte of a long word read. */
- starting = ((unsigned long)
+ starting = (
#ifdef __INTPTR_TYPE__
(__INTPTR_TYPE__)
#endif
--
Janne Blomqvist
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2017-01-13 19:46 ` David Edelsohn
@ 2017-01-13 23:13 ` Jerry DeLisle
2017-01-14 8:46 ` Janne Blomqvist
0 siblings, 1 reply; 76+ messages in thread
From: Jerry DeLisle @ 2017-01-13 23:13 UTC (permalink / raw)
To: Janne Blomqvist
Cc: FX, Dominique d'Humières, GCC-Fortran-ML, GCC-Patches-ML
On 01/13/2017 11:46 AM, David Edelsohn wrote:
> On Fri, Jan 13, 2017 at 12:09 PM, Janne Blomqvist
> <blomqvist.janne@gmail.com> wrote:
>> On Thu, Jan 12, 2017 at 10:46 AM, FX <fxcoudert@gmail.com> wrote:
>>>> I was finally able to get a 32-bit i686 compiler going (my attempts to
>>>> do this on a x86_64-pc-linux-gnu host failed, in the end I resorted to
>>>> running 32-bit builds/tests on a i686 container). At least on i686,
>>>> the patch below on top of the big charlen->size_t patch fixes the
>>>> failures
>>>
>>> Patch approved. The old code used gfc_extract_int, which bails out if a non-constant expression is passed, so this is the right thing to do.
>>>
>>> FX
>>
>> Committed as r244448.
>>
>> David, can you verify that it works alright on ppc?
>
> Unfortunately, no. This patch broke bootstrap again with the same
> failure as earlier.
>
> - David
>
Janne, can you access gcc112 on the compile farm? If not, I can, maybe I can
test the patch.
Jerry
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2017-01-13 17:09 ` Janne Blomqvist
@ 2017-01-13 19:46 ` David Edelsohn
2017-01-13 23:13 ` Jerry DeLisle
0 siblings, 1 reply; 76+ messages in thread
From: David Edelsohn @ 2017-01-13 19:46 UTC (permalink / raw)
To: Janne Blomqvist
Cc: FX, Dominique d'Humières, GCC-Fortran-ML, GCC-Patches-ML
On Fri, Jan 13, 2017 at 12:09 PM, Janne Blomqvist
<blomqvist.janne@gmail.com> wrote:
> On Thu, Jan 12, 2017 at 10:46 AM, FX <fxcoudert@gmail.com> wrote:
>>> I was finally able to get a 32-bit i686 compiler going (my attempts to
>>> do this on a x86_64-pc-linux-gnu host failed, in the end I resorted to
>>> running 32-bit builds/tests on a i686 container). At least on i686,
>>> the patch below on top of the big charlen->size_t patch fixes the
>>> failures
>>
>> Patch approved. The old code used gfc_extract_int, which bails out if a non-constant expression is passed, so this is the right thing to do.
>>
>> FX
>
> Committed as r244448.
>
> David, can you verify that it works alright on ppc?
Unfortunately, no. This patch broke bootstrap again with the same
failure as earlier.
- David
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2017-01-12 8:46 ` FX
@ 2017-01-13 17:09 ` Janne Blomqvist
2017-01-13 19:46 ` David Edelsohn
0 siblings, 1 reply; 76+ messages in thread
From: Janne Blomqvist @ 2017-01-13 17:09 UTC (permalink / raw)
To: FX
Cc: Dominique d'Humières, GCC-Fortran-ML, GCC-Patches-ML,
David Edelsohn
On Thu, Jan 12, 2017 at 10:46 AM, FX <fxcoudert@gmail.com> wrote:
>> I was finally able to get a 32-bit i686 compiler going (my attempts to
>> do this on a x86_64-pc-linux-gnu host failed, in the end I resorted to
>> running 32-bit builds/tests on a i686 container). At least on i686,
>> the patch below on top of the big charlen->size_t patch fixes the
>> failures
>
> Patch approved. The old code used gfc_extract_int, which bails out if a non-constant expression is passed, so this is the right thing to do.
>
> FX
Committed as r244448.
David, can you verify that it works alright on ppc?
--
Janne Blomqvist
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2017-01-11 22:17 ` Janne Blomqvist
@ 2017-01-12 8:46 ` FX
2017-01-13 17:09 ` Janne Blomqvist
0 siblings, 1 reply; 76+ messages in thread
From: FX @ 2017-01-12 8:46 UTC (permalink / raw)
To: Janne Blomqvist
Cc: Dominique d'Humières, GCC-Fortran-ML, GCC-Patches-ML
> I was finally able to get a 32-bit i686 compiler going (my attempts to
> do this on a x86_64-pc-linux-gnu host failed, in the end I resorted to
> running 32-bit builds/tests on a i686 container). At least on i686,
> the patch below on top of the big charlen->size_t patch fixes the
> failures
Patch approved. The old code used gfc_extract_int, which bails out if a non-constant expression is passed, so this is the right thing to do.
FX
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2017-01-08 14:29 Dominique d'Humières
@ 2017-01-11 22:17 ` Janne Blomqvist
2017-01-12 8:46 ` FX
2017-01-14 8:39 ` Janne Blomqvist
1 sibling, 1 reply; 76+ messages in thread
From: Janne Blomqvist @ 2017-01-11 22:17 UTC (permalink / raw)
To: Dominique d'Humières; +Cc: GCC-Fortran-ML, GCC-Patches-ML
On Sun, Jan 8, 2017 at 4:29 PM, Dominique d'Humières <dominiq@lps.ens.fr> wrote:
>> r244027 reverts r244011. Sorry for the breakage. It seems to affect
>> all i686 as well in addition to power, maybe all 32-bit hosts.
>
> For the record, I see the following failures with an instrumented r244026 (as in pr78672)
[snip]
I was finally able to get a 32-bit i686 compiler going (my attempts to
do this on a x86_64-pc-linux-gnu host failed, in the end I resorted to
running 32-bit builds/tests on a i686 container). At least on i686,
the patch below on top of the big charlen->size_t patch fixes the
failures:
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index be63038..82319ed 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_default_integer_kind,
+ gfc_get_int_expr (gfc_charlen_int_kind,
NULL, 1));
/* F2008, 6.4.1: Both the starting point and the ending point shall
@@ -11420,9 +11420,10 @@ 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 && mpz_sgn (cl->length->value.integer) < 0)
+ if (cl->length && cl->length->expr_type == EXPR_CONSTANT
+ && mpz_sgn (cl->length->value.integer) < 0)
gfc_replace_expr (cl->length,
- gfc_get_int_expr (gfc_default_integer_kind, NULL, 0));
+ gfc_get_int_expr (gfc_charlen_int_kind, NULL, 0));
/* Check that the character length is not too large. */
k = gfc_validate_kind (BT_INTEGER, gfc_charlen_int_kind, false);
So what happened was that without the EXPR_CONSTANT check, I was
accessing uninitialized memory (for some reason probably due to memory
layout or such, this didn't cause failures on x86_64-pc-linux-gnu).
Also, I found a couple of additional places where gfc_charlen_int_kind
should be used instead of gfc_default_integer_kind which is included
in the patch above, although AFAICT they have nothing to do with the
testcase failures.
Unless there are objections, I'll commit the fixed patch in a few days.
--
Janne Blomqvist
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
@ 2017-01-08 14:29 Dominique d'Humières
2017-01-11 22:17 ` Janne Blomqvist
2017-01-14 8:39 ` Janne Blomqvist
0 siblings, 2 replies; 76+ messages in thread
From: Dominique d'Humières @ 2017-01-08 14:29 UTC (permalink / raw)
To: Janne Blomqvist; +Cc: GCC-Fortran-ML, GCC-Patches-ML
> r244027 reverts r244011. Sorry for the breakage. It seems to affect
> all i686 as well in addition to power, maybe all 32-bit hosts.
For the record, I see the following failures with an instrumented r244026 (as in pr78672)
FAIL: gfortran.dg/char_length_20.f90 -O* execution test
FAIL: gfortran.dg/char_length_21.f90 -O* execution test
FAIL: gfortran.dg/repeat_2.f90 -O1 execution test
…
FAIL: gfortran.dg/repeat_2.f90 -Os execution test
FAIL: gfortran.dg/widechar_6.f90 -O1 execution test
…
FAIL: gfortran.dg/widechar_6.f90 -Os execution test
FAIL: gfortran.dg/widechar_intrinsics_6.f90 -O* execution test
The run time failures are all of the kind
=================================================================
==43614==ERROR: AddressSanitizer: heap-buffer-overflow on address 0x602000000168 at pc 0x00010abfb578 bp 0x7fff55735250 sp 0x7fff55735248
READ of size 8 at 0x602000000168 thread T0
#0 0x10abfb577 in _gfortran_string_len_trim (/opt/gcc/gcc7gp/lib/libgfortran.4.dylib+0x728577)
#1 0x10a4cae2c in MAIN__ (/Users/dominiq/Documents/Fortran/g95bench/win/f90/bug/a.out+0x100000e2c)
#2 0x10a4caea6 in main (/Users/dominiq/Documents/Fortran/g95bench/win/f90/bug/a.out+0x100000ea6)
#3 0x7fffbd674254 in start (/usr/lib/system/libdyld.dylib+0x5254)
0x602000000168 is located 8 bytes to the left of 1-byte region [0x602000000170,0x602000000171)
allocated by thread T0 here:
#0 0x10c043319 in wrap_malloc (/opt/gcc/gcc7a/lib/libasan.4.dylib+0x61319)
#1 0x10a4cad11 in MAIN__ (/Users/dominiq/Documents/Fortran/g95bench/win/f90/bug/a.out+0x100000d11)
#2 0x10a4caea6 in main (/Users/dominiq/Documents/Fortran/g95bench/win/f90/bug/a.out+0x100000ea6)
#3 0x7fffbd674254 in start (/usr/lib/system/libdyld.dylib+0x5254)
SUMMARY: AddressSanitizer: heap-buffer-overflow (/opt/gcc/gcc7gp/lib/libgfortran.4.dylib+0x728577) in _gfortran_string_len_trim
Shadow bytes around the buggy address:
0x1c03ffffffd0: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
0x1c03ffffffe0: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
0x1c03fffffff0: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
0x1c0400000000: fa fa fd fd fa fa fd fd fa fa 00 07 fa fa 00 06
0x1c0400000010: fa fa 03 fa fa fa 00 00 fa fa 00 06 fa fa 06 fa
=>0x1c0400000020: fa fa 07 fa fa fa 07 fa fa fa fd fa fa[fa]01 fa
0x1c0400000030: fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa
0x1c0400000040: fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa
0x1c0400000050: fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa
0x1c0400000060: fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa
0x1c0400000070: fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa
Shadow byte legend (one shadow byte represents 8 application bytes):
Addressable: 00
Partially addressable: 01 02 03 04 05 06 07
Heap left redzone: fa
Freed heap region: fd
Stack left redzone: f1
Stack mid redzone: f2
Stack right redzone: f3
Stack after return: f5
Stack use after scope: f8
Global redzone: f9
Global init order: f6
Poisoned by user: f7
Container overflow: fc
Array cookie: ac
Intra object redzone: bb
ASan internal: fe
Left alloca redzone: ca
Right alloca redzone: cb
==43614==ABORTING
Program received signal SIGABRT: Process abort signal.
Backtrace for this error:
#0 0x10a4d8558
#1 0x10a4d65f5
#2 0x7fffbd881bb9
Abort
Dominique
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2017-01-03 19:21 ` FX
@ 2017-01-03 19:32 ` Janne Blomqvist
0 siblings, 0 replies; 76+ messages in thread
From: Janne Blomqvist @ 2017-01-03 19:32 UTC (permalink / raw)
To: FX; +Cc: David Edelsohn, Fortran List, GCC Patches, Jakub Jelinek
On Tue, Jan 3, 2017 at 9:21 PM, FX <fxcoudert@gmail.com> wrote:
>> r244027 reverts r244011. Sorry for the breakage. It seems to affect
>> all i686 as well in addition to power, maybe all 32-bit hosts.
>
> The breakage is surprising, as the rejects-valid does not involve character length at all.
> Jane, any chance you might have accidentally committed some unrelated change along?
Yes, I'm surprised, and I don't understand it yet. I'm planning to
fire up a 32-bit VM and build there in order see what the issue is.
--
Janne Blomqvist
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2017-01-03 18:04 ` Janne Blomqvist
@ 2017-01-03 19:21 ` FX
2017-01-03 19:32 ` Janne Blomqvist
0 siblings, 1 reply; 76+ messages in thread
From: FX @ 2017-01-03 19:21 UTC (permalink / raw)
To: Janne Blomqvist; +Cc: David Edelsohn, Fortran List, GCC Patches, Jakub Jelinek
> r244027 reverts r244011. Sorry for the breakage. It seems to affect
> all i686 as well in addition to power, maybe all 32-bit hosts.
The breakage is surprising, as the rejects-valid does not involve character length at all.
Jane, any chance you might have accidentally committed some unrelated change along?
FX
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2017-01-03 14:07 David Edelsohn
@ 2017-01-03 18:04 ` Janne Blomqvist
2017-01-03 19:21 ` FX
0 siblings, 1 reply; 76+ messages in thread
From: Janne Blomqvist @ 2017-01-03 18:04 UTC (permalink / raw)
To: David Edelsohn; +Cc: Fortran List, GCC Patches, Jakub Jelinek
On Tue, Jan 3, 2017 at 4:07 PM, David Edelsohn <dje.gcc@gmail.com> wrote:
> This patch broke bootstrap. I now am seeing numerous errors when
> building libgomp.
>
> Please fix or revert immediately.
r244027 reverts r244011. Sorry for the breakage. It seems to affect
all i686 as well in addition to power, maybe all 32-bit hosts.
--
Janne Blomqvist
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
@ 2017-01-03 14:07 David Edelsohn
2017-01-03 18:04 ` Janne Blomqvist
0 siblings, 1 reply; 76+ messages in thread
From: David Edelsohn @ 2017-01-03 14:07 UTC (permalink / raw)
To: Janne Blomqvist; +Cc: Fortran List, GCC Patches, Jakub Jelinek
This patch broke bootstrap. I now am seeing numerous errors when
building libgomp.
Please fix or revert immediately.
Thanks, David
omp_lib.f90:184:40:
logical (4) :: omp_test_lock
1
Error: Symbol 'omp_test_lock' at (1) has already been host associated
omp_lib.f90:216:45:
integer (4) :: omp_test_nest_lock
1
Error: Symbol 'omp_test_nest_lock' at (1) has already been host associated
omp_lib.f90:329:61:
integer (omp_proc_bind_kind) :: omp_get_proc_bind
1
Error: Symbol 'omp_get_proc_bind' at (1) has already been host associated
and
/nasfarm/edelsohn/src/src/libgomp/openacc.f90:466:6:
use openacc_internal
1
Error: 'acc_device_nvidia' of module 'openacc_internal', imported at (1), is als
o the name of the current program unit
/nasfarm/edelsohn/src/src/libgomp/openacc.f90:466:6:
use openacc_internal
1
Error: Alternate return specifier in function 'acc_async_test_h' at (1) is not a
llowed
/nasfarm/edelsohn/src/src/libgomp/openacc.f90:466:6:
use openacc_internal
1
Error: Alternate return specifier in function 'acc_async_test_
^ permalink raw reply [flat|nested] 76+ messages in thread
* [PATCH] PR 78534 Change character length from int to size_t
2016-12-23 15:09 ` Janne Blomqvist
2016-12-26 11:25 ` FX
@ 2017-01-01 11:26 ` Janne Blomqvist
1 sibling, 0 replies; 76+ messages in thread
From: Janne Blomqvist @ 2017-01-01 11:26 UTC (permalink / raw)
To: fortran, gcc-patches; +Cc: Janne Blomqvist
In order to handle large character lengths on (L)LP64 targets, switch
the GFortran character length from an int to a size_t.
This is an ABI change, as procedures with character arguments take
hidden arguments with the character length.
I also changed the _size member in vtables from int to size_t, as
there were some cases where character lengths and sizes were
apparently mixed up and caused regressions otherwise. Although I
haven't tested, this might enable very large derived types as well.
Also, as there are some places in the frontend were negative character
lengths are used as special flag values, in the frontend the character
length is handled as a signed variable of the same size as a size_t,
although in the runtime library it really is size_t.
I haven't changed the character length variables for the co-array
intrinsics, as this is something that may need to be synchronized with
OpenCoarrays.
Another change in this place is that the algorithm for
gfc_trans_string_copy has been rewritten to avoid a
-Wstringop-overflow warning.
This is v3 of the patch. All the issues pointed out by FX's review of
v2 have been fixed. In particular, there are now new functions
gfc_mpz_get_hwi and gfc_mpz_set_hwi, similar to the GMP functions
mpz_get_si and mpz_set_si, except that they get/set a HOST_WIDE_INT
instead of a long value. Similarly, gfc_get_int_expr now takes a
HOST_WIDE_INT instead of a long, gfc_extract_long is replaced by
gfc_extract_hwi. Also, the preliminary work to handle
gfc_charlen_type_node being unsigned has been removed.
Regtested on x86_64-pc-linux-gnu, Ok for trunk?
frontend:
2017-01-01 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_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.
(gfc_trans_string_copy): Rewrite to avoid -Wstringop-overflow
warning in generated code.
(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.
testsuite:
2017-01-01 Janne Blomqvist <jb@gcc.gnu.org>
PR fortran/78534
PR fortran/66310
* gfortran.dg/dependency_49.f90: Change scan-tree-dump-times
due to gfc_trans_string_copy change to avoid
-Wstringop-overflow.
* 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.
* gfortran.dg/transfer_intrinsic_1.f90: Change
scan-tree-dump-times due to gfc_trans_string_copy change to
avoid -Wstringop-overflow.
libgfortran:
2017-01-01 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.
---
gcc/fortran/class.c | 12 +--
gcc/fortran/dump-parse-tree.c | 9 +-
gcc/fortran/expr.c | 42 ++++++--
gcc/fortran/gfortran.h | 21 +++-
gcc/fortran/gfortran.texi | 42 ++++++--
gcc/fortran/iresolve.c | 5 +-
gcc/fortran/match.c | 8 +-
gcc/fortran/misc.c | 22 ++++
gcc/fortran/module.c | 43 +++++---
gcc/fortran/resolve.c | 13 +--
gcc/fortran/simplify.c | 23 +++--
gcc/fortran/target-memory.c | 19 ++--
gcc/fortran/target-memory.h | 2 +-
gcc/fortran/trans-array.c | 3 +-
gcc/fortran/trans-const.c | 12 +++
gcc/fortran/trans-const.h | 1 +
gcc/fortran/trans-expr.c | 113 ++++++++++-----------
gcc/fortran/trans-intrinsic.c | 53 +++++-----
gcc/fortran/trans-io.c | 4 +-
gcc/fortran/trans-stmt.c | 19 ++--
gcc/fortran/trans-types.c | 11 +-
gcc/fortran/trans-types.h | 4 +-
gcc/testsuite/gfortran.dg/dependency_49.f90 | 2 +-
gcc/testsuite/gfortran.dg/repeat_4.f90 | 23 +++--
gcc/testsuite/gfortran.dg/repeat_7.f90 | 8 ++
gcc/testsuite/gfortran.dg/scan_2.f90 | 4 +-
gcc/testsuite/gfortran.dg/string_1.f90 | 1 +
gcc/testsuite/gfortran.dg/string_1_lp64.f90 | 15 +++
gcc/testsuite/gfortran.dg/string_3.f90 | 1 +
gcc/testsuite/gfortran.dg/string_3_lp64.f90 | 20 ++++
gcc/testsuite/gfortran.dg/transfer_intrinsic_1.f90 | 2 +-
libgfortran/intrinsics/args.c | 10 +-
libgfortran/intrinsics/chmod.c | 3 +-
libgfortran/intrinsics/env.c | 3 +-
libgfortran/intrinsics/extends_type_of.c | 2 +-
libgfortran/intrinsics/gerror.c | 2 +-
libgfortran/intrinsics/getlog.c | 3 +-
libgfortran/intrinsics/hostnm.c | 5 +-
libgfortran/intrinsics/string_intrinsics_inc.c | 17 ++--
libgfortran/io/transfer.c | 18 ++--
libgfortran/io/unit.c | 3 +-
libgfortran/io/write.c | 3 +-
libgfortran/libgfortran.h | 2 +-
43 files changed, 401 insertions(+), 227 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/repeat_7.f90
create mode 100644 gcc/testsuite/gfortran.dg/string_1_lp64.f90
create mode 100644 gcc/testsuite/gfortran.dg/string_3_lp64.f90
diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index 1fba6c9..570859d 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(4) to store the string length when the unlimited
+ * _len: An integer(C_SIZE_T) 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 = 4;
+ c->ts.kind = gfc_size_kind;
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_default_integer_kind,
+ c->initializer = gfc_get_int_expr (gfc_size_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 = 4;
+ c->ts.kind = gfc_size_kind;
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_default_integer_kind,
+ c->initializer = gfc_get_int_expr (gfc_size_kind,
NULL,
ts->type == BT_CHARACTER
? ts->kind
- : (int)gfc_element_size (e));
+ : 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 585f25d..b2c872d 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -348,12 +348,10 @@ show_constructor (gfc_constructor_base base)
static void
-show_char_const (const gfc_char_t *c, int length)
+show_char_const (const gfc_char_t *c, gfc_charlen_t length)
{
- int i;
-
fputc ('\'', dumpfile);
- for (i = 0; i < length; i++)
+ for (size_t i = 0; i < (size_t) length; i++)
{
if (c[i] == '\'')
fputs ("''", dumpfile);
@@ -465,7 +463,8 @@ show_expr (gfc_expr *p)
break;
case BT_HOLLERITH:
- fprintf (dumpfile, "%dH", p->representation.length);
+ fprintf (dumpfile, HOST_WIDE_INT_PRINT_DEC "H",
+ 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 f57198f..1ddd3c37 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -27,6 +27,7 @@ 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
@@ -184,7 +185,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, int len)
+gfc_get_character_expr (int kind, locus *where, const char *src, gfc_charlen_t len)
{
gfc_expr *e;
gfc_char_t *dest;
@@ -210,13 +211,14 @@ gfc_get_character_expr (int kind, locus *where, const char *src, int len)
/* Get a new expression node that is an integer constant. */
gfc_expr *
-gfc_get_int_expr (int kind, locus *where, int value)
+gfc_get_int_expr (int kind, locus *where, HOST_WIDE_INT value)
{
gfc_expr *p;
p = gfc_get_constant_expr (BT_INTEGER, kind,
where ? where : &gfc_current_locus);
- mpz_set_si (p->value.integer, value);
+ const wide_int w = wi::shwi (value, kind * BITS_PER_UNIT);
+ wi::to_mpz (w, p->value.integer, SIGNED);
return p;
}
@@ -636,6 +638,32 @@ 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 *
@@ -1655,7 +1683,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). */
- int string_len;
+ gfc_charlen_t string_len;
if ((c = gfc_constructor_first (p->value.constructor)))
{
const gfc_expr* first = c->expr;
@@ -1824,18 +1852,18 @@ gfc_simplify_expr (gfc_expr *p, int type)
if (gfc_is_constant_expr (p))
{
gfc_char_t *s;
- int start, end;
+ HOST_WIDE_INT start, end;
start = 0;
if (p->ref && p->ref->u.ss.start)
{
- gfc_extract_int (p->ref->u.ss.start, &start);
+ gfc_extract_hwi (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_int (p->ref->u.ss.end, &end);
+ gfc_extract_hwi (p->ref->u.ss.end, &end);
if (end < start)
end = start;
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 799c2ac..6936176 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2064,6 +2064,14 @@ 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;
@@ -2109,7 +2117,7 @@ typedef struct gfc_expr
the value. */
struct
{
- int length;
+ gfc_charlen_t length;
char *string;
}
representation;
@@ -2165,7 +2173,7 @@ typedef struct gfc_expr
struct
{
- int length;
+ gfc_charlen_t length;
gfc_char_t *string;
}
character;
@@ -2759,6 +2767,9 @@ 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 *);
@@ -2850,6 +2861,7 @@ 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;
@@ -3081,6 +3093,7 @@ 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 *);
@@ -3098,8 +3111,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 *, int len);
-gfc_expr *gfc_get_int_expr (int, locus *, int);
+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_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 5e2a750..1980fb55 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -3810,12 +3810,42 @@ 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 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.
+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.
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 a30ed9f..5893224 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -2147,7 +2147,6 @@ 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;
@@ -2160,8 +2159,8 @@ gfc_resolve_repeat (gfc_expr *f, gfc_expr *string,
tmp = NULL;
if (string->expr_type == EXPR_CONSTANT)
{
- len = string->value.character.length;
- tmp = gfc_get_int_expr (gfc_default_integer_kind, NULL , len);
+ tmp = gfc_get_int_expr (gfc_charlen_int_kind, NULL,
+ string->value.character.length);
}
else if (string->ts.u.cl && string->ts.u.cl->length)
{
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 523cba4..ea7283f 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;
- int charlen = 0;
+ HOST_WIDE_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 = mpz_get_si (ts->u.cl->length->value.integer);
+ charlen = gfc_mpz_get_hwi (ts->u.cl->length->value.integer);
if (ts->type != BT_CHARACTER)
sprintf (name, "__tmp_%s_%d", gfc_basic_typename (ts->type),
ts->kind);
else
- sprintf (name, "__tmp_%s_%d_%d", gfc_basic_typename (ts->type),
- charlen, ts->kind);
+ snprintf (name, sizeof (name), "__tmp_%s_" HOST_WIDE_INT_PRINT_DEC "_%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 1747ff2..3819e21 100644
--- a/gcc/fortran/misc.c
+++ b/gcc/fortran/misc.c
@@ -22,6 +22,7 @@ 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. */
@@ -280,3 +281,24 @@ 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 713f272..cf5b0f5 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 int atom_int;
+static HOST_WIDE_INT atom_int;
static char *atom_string, atom_name[MAX_ATOM_SIZE];
@@ -1271,7 +1271,7 @@ parse_string (void)
}
-/* Parse a small integer. */
+/* Parse an integer. Should fit in a HOST_WIDE_INT. */
static void
parse_integer (int c)
@@ -1288,8 +1288,6 @@ parse_integer (int c)
}
atom_int = 10 * atom_int + c - '0';
- if (atom_int > 99999999)
- bad_module ("Integer overflow");
}
}
@@ -1631,11 +1629,12 @@ write_char (char out)
static void
write_atom (atom_type atom, const void *v)
{
- char buffer[20];
+ char buffer[32];
/* Workaround -Wmaybe-uninitialized false positive during
profiledbootstrap by initializing them. */
- int i = 0, len;
+ int len;
+ HOST_WIDE_INT i = 0;
const char *p;
switch (atom)
@@ -1654,11 +1653,9 @@ write_atom (atom_type atom, const void *v)
break;
case ATOM_INTEGER:
- i = *((const int *) v);
- if (i < 0)
- gfc_internal_error ("write_atom(): Writing negative integer");
+ i = *((const HOST_WIDE_INT *) v);
- sprintf (buffer, "%d", i);
+ snprintf (buffer, sizeof (buffer), HOST_WIDE_INT_PRINT_DEC, i);
p = buffer;
break;
@@ -1766,7 +1763,10 @@ static void
mio_integer (int *ip)
{
if (iomode == IO_OUTPUT)
- write_atom (ATOM_INTEGER, ip);
+ {
+ HOST_WIDE_INT hwi = *ip;
+ write_atom (ATOM_INTEGER, &hwi);
+ }
else
{
require_atom (ATOM_INTEGER);
@@ -1774,6 +1774,18 @@ 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. */
@@ -1783,7 +1795,7 @@ mio_intrinsic_op (gfc_intrinsic_op* op)
/* FIXME: Would be nicer to do this via the operators symbolic name. */
if (iomode == IO_OUTPUT)
{
- int converted = (int) *op;
+ HOST_WIDE_INT converted = (HOST_WIDE_INT) *op;
write_atom (ATOM_INTEGER, &converted);
}
else
@@ -2680,7 +2692,7 @@ mio_array_ref (gfc_array_ref *ar)
{
for (i = 0; i < ar->dimen; i++)
{
- int tmp = (int)ar->dimen_type[i];
+ HOST_WIDE_INT tmp = (HOST_WIDE_INT)ar->dimen_type[i];
write_atom (ATOM_INTEGER, &tmp);
}
}
@@ -3382,6 +3394,7 @@ 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;
@@ -3596,7 +3609,9 @@ mio_expr (gfc_expr **ep)
break;
case BT_CHARACTER:
- mio_integer (&e->value.character.length);
+ hwi = e->value.character.length;
+ mio_hwi (&hwi);
+ e->value.character.length = hwi;
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 7cf7a41..a297331 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -8469,7 +8469,6 @@ 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;
@@ -8717,11 +8716,13 @@ 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 = 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);
+ 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);
}
else
sprintf (name, "__tmp_%s_%d", gfc_basic_typename (c->ts.type),
@@ -11383,7 +11384,7 @@ resolve_index_expr (gfc_expr *e)
static bool
resolve_charlen (gfc_charlen *cl)
{
- int i, k;
+ int k;
bool saved_specification_expr;
if (cl->resolved)
@@ -11419,7 +11420,7 @@ 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 && !gfc_extract_int (cl->length, &i) && i < 0)
+ if (cl->length && mpz_sgn (cl->length->value.integer) < 0)
gfc_replace_expr (cl->length,
gfc_get_int_expr (gfc_default_integer_kind, NULL, 0));
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index a46fbc5..fff095f 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -5190,7 +5190,7 @@ gfc_expr *
gfc_simplify_repeat (gfc_expr *e, gfc_expr *n)
{
gfc_expr *result;
- int i, j, len, ncop, nlen;
+ gfc_charlen_t len;
mpz_t ncopies;
bool have_length = false;
@@ -5210,7 +5210,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 = mpz_get_si (e->ts.u.cl->length->value.integer);
+ len = gfc_mpz_get_hwi (e->ts.u.cl->length->value.integer);
have_length = true;
}
else if (e->expr_type == EXPR_CONSTANT
@@ -5246,7 +5246,8 @@ gfc_simplify_repeat (gfc_expr *e, gfc_expr *n)
}
else
{
- mpz_init_set_si (mlen, len);
+ mpz_init (mlen);
+ gfc_mpz_set_hwi (mlen, len);
mpz_tdiv_q (max, gfc_integer_kinds[i].huge, mlen);
mpz_clear (mlen);
}
@@ -5270,11 +5271,12 @@ 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_int (n, &ncop);
+ const char *res = gfc_extract_hwi (n, &ncop);
gcc_assert (res == NULL);
}
else
@@ -5284,11 +5286,18 @@ 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;
- nlen = ncop * len;
+ 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;
result = gfc_get_character_expr (e->ts.kind, &e->where, NULL, nlen);
- for (i = 0; i < ncop; i++)
- for (j = 0; j < len; j++)
+ for (size_t i = 0; i < (size_t) ncop; i++)
+ for (size_t j = 0; j < (size_t) 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 ac9cce2..ad01be9 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 (int length, int kind)
+size_character (gfc_charlen_t 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)
{
- int length;
+ HOST_WIDE_INT length;
- gfc_extract_int (e->ts.u.cl->length, &length);
+ gfc_extract_hwi (e->ts.u.cl->length, &length);
return size_character (length, e->ts.kind);
}
else
@@ -217,16 +217,15 @@ encode_logical (int kind, int logical, unsigned char *buffer, size_t buffer_size
int
-gfc_encode_character (int kind, int length, const gfc_char_t *string,
+gfc_encode_character (int kind, gfc_charlen_t 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 (i = 0; i < length; i++)
+ for (size_t i = 0; i < (size_t) length; i++)
native_encode_expr (build_int_cst (type, string[i]), &buffer[i*elsize],
elsize);
@@ -438,11 +437,9 @@ 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 =
- (int) mpz_get_ui (result->ts.u.cl->length->value.integer);
+ gfc_mpz_get_hwi (result->ts.u.cl->length->value.integer);
gcc_assert (buffer_size >= size_character (result->value.character.length,
result->ts.kind));
@@ -450,7 +447,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 (i = 0; i < result->value.character.length; i++)
+ for (size_t i = 0; i < (size_t) result->value.character.length; i++)
result->value.character.string[i] = (gfc_char_t) buffer[i];
else
{
@@ -459,7 +456,7 @@ gfc_interpret_character (unsigned char *buffer, size_t buffer_size,
mpz_init (integer);
gcc_assert (bytes <= sizeof (unsigned long));
- for (i = 0; i < result->value.character.length; i++)
+ for (size_t i = 0; i < (size_t) 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 0d79c10..321c133 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, int, const gfc_char_t *, unsigned char *,
+int gfc_encode_character (int, gfc_charlen_t, 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 0cd83f4..48d5a79 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -1909,8 +1909,7 @@ 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 (char_len, gfc_default_integer_kind);
- *len = convert (gfc_charlen_type_node, *len);
+ *len = gfc_conv_mpz_to_tree_type (char_len, gfc_charlen_type_node);
mpz_clear (char_len);
return;
diff --git a/gcc/fortran/trans-const.c b/gcc/fortran/trans-const.c
index 812dcc6..3438979 100644
--- a/gcc/fortran/trans-const.c
+++ b/gcc/fortran/trans-const.c
@@ -206,6 +206,18 @@ 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 14b0f79..072de47 100644
--- a/gcc/fortran/trans-const.h
+++ b/gcc/fortran/trans-const.h
@@ -20,6 +20,7 @@ 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 00fddfe..64e268a 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)
- : integer_zero_node;
+ : build_zero_cst (gfc_charlen_type_node);
}
@@ -884,7 +884,8 @@ 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, 4,
+ e->ts.u.cl->length = gfc_get_constant_expr (BT_INTEGER,
+ gfc_charlen_int_kind,
&e->where);
mpz_set_ui (e->ts.u.cl->length->value.integer,
e->value.character.length);
@@ -902,7 +903,7 @@ gfc_conv_intrinsic_to_class (gfc_se *parmse, gfc_expr *e,
else
tmp = integer_zero_node;
- gfc_add_modify (&parmse->pre, ctree, tmp);
+ gfc_add_modify (&parmse->pre, ctree, fold_convert (TREE_TYPE (ctree), tmp));
}
else if (class_ts.type == BT_CLASS
&& class_ts.u.derived->components
@@ -1041,7 +1042,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 = integer_zero_node;
+ slen = build_zero_cst (size_type_node);
}
else
{
@@ -1088,7 +1089,7 @@ gfc_conv_class_to_class (gfc_se *parmse, gfc_expr *e, gfc_typespec class_ts,
tmp = slen;
}
else
- tmp = integer_zero_node;
+ tmp = build_zero_cst (size_type_node);
gfc_add_modify (&parmse->pre, ctree,
fold_convert (TREE_TYPE (ctree), tmp));
@@ -1227,7 +1228,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 = integer_zero_node;
+ from_len = build_zero_cst (size_type_node);
}
if (GFC_CLASS_TYPE_P (TREE_TYPE (to)))
@@ -1339,7 +1340,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,
- integer_zero_node);
+ build_zero_cst (TREE_TYPE (from_len)));
tmp = fold_build3_loc (input_location, COND_EXPR,
void_type_node, tmp, extcopy, stdcopy);
gfc_add_expr_to_block (&body, tmp);
@@ -1367,7 +1368,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,
- integer_zero_node);
+ build_zero_cst (TREE_TYPE (from_len)));
tmp = fold_build3_loc (input_location, COND_EXPR,
void_type_node, tmp, extcopy, stdcopy);
}
@@ -2195,7 +2196,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_int_cst (gfc_charlen_type_node, 0));
+ se.expr, build_zero_cst (TREE_TYPE (se.expr)));
gfc_add_block_to_block (pblock, &se.pre);
if (cl->backend_decl)
@@ -2267,7 +2268,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_int_cst (gfc_charlen_type_node, 1));
+ build_one_cst (TREE_TYPE (start.expr)));
fault = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
boolean_type_node, nonempty, fault);
if (name)
@@ -2303,9 +2304,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))
{
- int i_len;
+ HOST_WIDE_INT i_len;
- i_len = mpz_get_si (length) + 1;
+ i_len = gfc_mpz_get_hwi (length) + 1;
if (i_len < 0)
i_len = 0;
@@ -2315,7 +2316,8 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind,
else
{
tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_charlen_type_node,
- end.expr, start.expr);
+ fold_convert (gfc_charlen_type_node, end.expr),
+ fold_convert (gfc_charlen_type_node, 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,
@@ -3115,9 +3117,10 @@ 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, len,
+ gfc_charlen_type_node,
+ fold_convert (gfc_charlen_type_node, len),
build_int_cst (gfc_charlen_type_node, 1));
- tmp = build_range_type (gfc_array_index_type, gfc_index_zero_node, tmp);
+ tmp = build_range_type (gfc_charlen_type_node, gfc_index_zero_node, tmp);
if (TREE_CODE (TREE_TYPE (type)) == ARRAY_TYPE)
tmp = build_array_type (TREE_TYPE (TREE_TYPE (type)), tmp);
@@ -3180,7 +3183,9 @@ 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, rse.string_length);
+ lse.string_length,
+ fold_convert (TREE_TYPE (lse.string_length),
+ rse.string_length));
}
type = build_pointer_type (type);
@@ -5872,7 +5877,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_int_cst (gfc_charlen_type_node, 0));
+ build_zero_cst (TREE_TYPE (tmp)));
cl.backend_decl = tmp;
}
@@ -6450,33 +6455,19 @@ gfc_trans_string_copy (stmtblock_t * block, tree dlength, tree dest,
return;
}
+ /* The string copy algorithm below generates code like
+
+ if (dlen > 0) {
+ memmove (dest, src, min(dlen, slen));
+ if (slen < dlen)
+ memset(&dest[slen], ' ', dlen - slen);
+ }
+ */
+
/* Do nothing if the destination length is zero. */
cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, dlen,
build_int_cst (size_type_node, 0));
- /* The following code was previously in _gfortran_copy_string:
-
- // The two strings may overlap so we use memmove.
- void
- copy_string (GFC_INTEGER_4 destlen, char * dest,
- GFC_INTEGER_4 srclen, const char * src)
- {
- if (srclen >= destlen)
- {
- // This will truncate if too long.
- memmove (dest, src, destlen);
- }
- else
- {
- memmove (dest, src, srclen);
- // Pad with spaces.
- memset (&dest[srclen], ' ', destlen - srclen);
- }
- }
-
- We're now doing it here for better optimization, but the logic
- is the same. */
-
/* For non-default character kinds, we have to multiply the string
length by the base type size. */
chartype = gfc_get_char_type (dkind);
@@ -6499,17 +6490,19 @@ gfc_trans_string_copy (stmtblock_t * block, tree dlength, tree dest,
else
src = gfc_build_addr_expr (pvoid_type_node, src);
- /* Truncate string if source is too long. */
- cond2 = fold_build2_loc (input_location, GE_EXPR, boolean_type_node, slen,
- dlen);
+ /* First do the memmove. */
+ tmp2 = fold_build2_loc (input_location, MIN_EXPR, TREE_TYPE (dlen), dlen,
+ slen);
tmp2 = build_call_expr_loc (input_location,
builtin_decl_explicit (BUILT_IN_MEMMOVE),
- 3, dest, src, dlen);
+ 3, dest, src, tmp2);
+ stmtblock_t tmpblock2;
+ gfc_init_block (&tmpblock2);
+ gfc_add_expr_to_block (&tmpblock2, tmp2);
- /* Else copy and pad with spaces. */
- tmp3 = build_call_expr_loc (input_location,
- builtin_decl_explicit (BUILT_IN_MEMMOVE),
- 3, dest, src, slen);
+ /* If the destination is longer, fill the end with spaces. */
+ cond2 = fold_build2_loc (input_location, LT_EXPR, boolean_type_node, slen,
+ dlen);
/* Wstringop-overflow appears at -O3 even though this warning is not
explicitly available in fortran nor can it be switched off. If the
@@ -6525,13 +6518,14 @@ gfc_trans_string_copy (stmtblock_t * block, tree dlength, tree dest,
tmp4 = fill_with_spaces (tmp4, chartype, tmp);
gfc_init_block (&tempblock);
- gfc_add_expr_to_block (&tempblock, tmp3);
gfc_add_expr_to_block (&tempblock, tmp4);
tmp3 = gfc_finish_block (&tempblock);
/* The whole copy_string function is there. */
tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond2,
- tmp2, tmp3);
+ tmp3, build_empty_stmt (input_location));
+ gfc_add_expr_to_block (&tmpblock2, tmp);
+ tmp = gfc_finish_block (&tmpblock2);
tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond, tmp,
build_empty_stmt (input_location));
gfc_add_expr_to_block (block, tmp);
@@ -7212,7 +7206,8 @@ 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, size);
+ gfc_add_modify (block, lhs_cl_size,
+ fold_convert (TREE_TYPE (lhs_cl_size), size));
}
@@ -7451,7 +7446,8 @@ 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, se.string_length);
+ gfc_add_modify (&block, strlen,
+ fold_convert (TREE_TYPE (strlen), se.string_length));
tmp = gfc_build_memcpy_call (dest, se.expr, size);
gfc_add_expr_to_block (&block, tmp);
}
@@ -8117,7 +8113,7 @@ trans_class_vptr_len_assignment (stmtblock_t *block, gfc_expr * le,
from_len = gfc_evaluate_now (se.expr, block);
}
else
- from_len = integer_zero_node;
+ from_len = build_zero_cst (gfc_charlen_type_node);
}
gfc_add_modify (pre, to_len, fold_convert (TREE_TYPE (to_len),
from_len));
@@ -8246,7 +8242,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_int_cst (gfc_charlen_type_node, 0));
+ build_zero_cst (TREE_TYPE (lse.string_length)));
}
gfc_add_modify (&block, lse.expr,
@@ -9501,7 +9497,9 @@ 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, size);
+ lse.string_length,
+ fold_convert (TREE_TYPE (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),
@@ -9518,7 +9516,8 @@ alloc_scalar_allocatable_for_assignment (stmtblock_t *block,
/* Update the lhs character length. */
size = string_length;
- gfc_add_modify (block, lse.string_length, size);
+ gfc_add_modify (block, lse.string_length,
+ fold_convert (TREE_TYPE (lse.string_length), size));
}
}
@@ -9700,7 +9699,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,
- integer_zero_node);
+ build_zero_cst (TREE_TYPE (from_len)));
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 d7612f6..5461666 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -7491,10 +7491,12 @@ 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,
- integer_zero_node);
+ 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)));
if (scalar)
{
/* A pointer to a scalar. */
@@ -7784,11 +7786,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 (size_type_node, gfc_character_kinds[i].bit_size / 8);
+ size = build_int_cst (sizetype, gfc_character_kinds[i].bit_size / 8);
/* Get the arguments. */
gfc_conv_intrinsic_function_args (se, expr, args, 3);
- slen = fold_convert (size_type_node, gfc_evaluate_now (args[0], &se->pre));
+ slen = fold_convert (sizetype, gfc_evaluate_now (args[0], &se->pre));
src = args[1];
ncopies = gfc_evaluate_now (args[2], &se->pre);
ncopies_type = TREE_TYPE (ncopies);
@@ -7805,7 +7807,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,
- build_int_cst (size_type_node, 0));
+ size_zero_node);
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);
@@ -7815,17 +7817,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. */
- 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;
+ 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;
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,
- build_int_cst (size_type_node, 0));
+ size_zero_node);
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,
@@ -7842,8 +7844,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 (ncopies_type, "count");
- gfc_add_modify (&block, count, build_int_cst (ncopies_type, 0));
+ count = gfc_create_var (sizetype, "count");
+ gfc_add_modify (&block, count, size_zero_node);
exit_label = gfc_build_label_decl (NULL_TREE);
/* Start the loop body. */
@@ -7851,7 +7853,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,
- ncopies);
+ fold_convert (sizetype, 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,
@@ -7859,25 +7861,22 @@ 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, 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_build2_loc (input_location, MULT_EXPR, sizetype, slen,
+ count);
+ tmp = fold_build2_loc (input_location, MULT_EXPR, sizetype, tmp,
+ 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,
- fold_convert (size_type_node,
- size)));
+ size_type_node, slen, size));
gfc_add_expr_to_block (&body, tmp);
/* Increment count. */
- tmp = fold_build2_loc (input_location, PLUS_EXPR, ncopies_type,
- count, build_int_cst (TREE_TYPE (count), 1));
+ tmp = fold_build2_loc (input_location, PLUS_EXPR, sizetype,
+ count, size_one_node);
gfc_add_modify (&body, count, tmp);
/* Build the loop. */
diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c
index 5f9c191..993b65d 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_int4_type_node);
+ void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_charlen_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_int4_type_node);
+ void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_charlen_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 ccfaee6..07b18a6 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 = integer_minus_one_node;
+ len_tree = build_int_cst (gfc_charlen_type_node, -1);
}
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, len_tree);
+ gfc_add_modify (&se.pre, len, fold_convert (TREE_TYPE (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)
{
- int i;
+ gfc_charlen_t 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], integer_zero_node);
+ CONSTRUCTOR_APPEND_ELT (node, ss_string1_len[k], build_zero_cst (gfc_charlen_type_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], integer_zero_node);
+ CONSTRUCTOR_APPEND_ELT (node, ss_string2_len[k], build_zero_cst (gfc_charlen_type_node));
}
else
{
@@ -5640,7 +5640,7 @@ gfc_trans_allocate (gfc_code * code)
{
gfc_init_se (&se, NULL);
temp_var_needed = false;
- expr3_len = integer_zero_node;
+ expr3_len = build_zero_cst (gfc_charlen_type_node);
e3_is = E3_MOLD;
}
/* Prevent aliasing, i.e., se.expr may be already a
@@ -6036,7 +6036,8 @@ gfc_trans_allocate (gfc_code * code)
e.g., a string. */
memsz = fold_build2_loc (input_location, GT_EXPR,
boolean_type_node, expr3_len,
- integer_zero_node);
+ build_zero_cst
+ (TREE_TYPE (expr3_len)));
memsz = fold_build3_loc (input_location, COND_EXPR,
TREE_TYPE (expr3_esize),
memsz, tmp, expr3_esize);
@@ -6332,7 +6333,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, ((int) strlen (msg)));
+ slen = build_int_cst (gfc_charlen_type_node, strlen (msg));
dlen = gfc_get_expr_charlen (code->expr2);
slen = fold_build2_loc (input_location, MIN_EXPR,
TREE_TYPE (slen), dlen, slen);
@@ -6613,7 +6614,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, ((int) strlen (msg)));
+ slen = build_int_cst (gfc_charlen_type_node, 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 e8dafa0..8dbc9ce 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -118,6 +118,9 @@ 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;
@@ -961,9 +964,13 @@ gfc_init_types (void)
wi::mask (n, UNSIGNED,
TYPE_PRECISION (size_type_node)));
- /* ??? Shouldn't this be based on gfc_index_integer_kind or so? */
- gfc_charlen_int_kind = 4;
+ /* Character lengths are of type size_t, except signed. */
+ gfc_charlen_int_kind = get_int_kind_from_node (size_type_node);
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 e8e92bf..ac280b3 100644
--- a/gcc/fortran/trans-types.h
+++ b/gcc/fortran/trans-types.h
@@ -23,6 +23,7 @@ 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;
@@ -35,10 +36,9 @@ 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/gfortran.dg/dependency_49.f90 b/gcc/testsuite/gfortran.dg/dependency_49.f90
index 73d517e..43ee284 100644
--- a/gcc/testsuite/gfortran.dg/dependency_49.f90
+++ b/gcc/testsuite/gfortran.dg/dependency_49.f90
@@ -11,4 +11,4 @@ program main
a%x = a%x(2:3)
print *,a%x
end program main
-! { dg-final { scan-tree-dump-times "__var_1" 4 "original" } }
+! { dg-final { scan-tree-dump-times "__var_1" 3 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/repeat_4.f90 b/gcc/testsuite/gfortran.dg/repeat_4.f90
index e5b5acc..99e7aee 100644
--- a/gcc/testsuite/gfortran.dg/repeat_4.f90
+++ b/gcc/testsuite/gfortran.dg/repeat_4.f90
@@ -2,6 +2,7 @@
!
! { 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"
@@ -21,18 +22,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))
- 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))
+ 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)/2)
- print *, repeat(t1, huge(0)/2)
- print *, repeat(t2, huge(0)/2)
+ 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+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 " }
+ 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 " }
end program test
diff --git a/gcc/testsuite/gfortran.dg/repeat_7.f90 b/gcc/testsuite/gfortran.dg/repeat_7.f90
new file mode 100644
index 0000000..82f8dbf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/repeat_7.f90
@@ -0,0 +1,8 @@
+! { 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 c58a3a2..5ef0230 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 "iscan = _gfortran_string_scan \\(2," 1 "original" } }
-! { dg-final { scan-tree-dump-times "iverify = _gfortran_string_verify \\(2," 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_string_scan \\(2," 1 "original" } }
+! { dg-final { scan-tree-dump-times "_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 11dc5b7..6a6151e 100644
--- a/gcc/testsuite/gfortran.dg/string_1.f90
+++ b/gcc/testsuite/gfortran.dg/string_1.f90
@@ -1,4 +1,5 @@
! { 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
new file mode 100644
index 0000000..a0edbef
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/string_1_lp64.f90
@@ -0,0 +1,15 @@
+! { 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 7daf8d3..4a88b06 100644
--- a/gcc/testsuite/gfortran.dg/string_3.f90
+++ b/gcc/testsuite/gfortran.dg/string_3.f90
@@ -1,4 +1,5 @@
! { 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
new file mode 100644
index 0000000..162561f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/string_3_lp64.f90
@@ -0,0 +1,20 @@
+! { 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/gcc/testsuite/gfortran.dg/transfer_intrinsic_1.f90 b/gcc/testsuite/gfortran.dg/transfer_intrinsic_1.f90
index 5f46cd0..73a7e77 100644
--- a/gcc/testsuite/gfortran.dg/transfer_intrinsic_1.f90
+++ b/gcc/testsuite/gfortran.dg/transfer_intrinsic_1.f90
@@ -14,4 +14,4 @@ subroutine BytesToString(bytes, string)
character(len=*) :: string
string = transfer(bytes, string)
end subroutine
-! { dg-final { scan-tree-dump-times "MIN_EXPR" 1 "original" } }
+! { dg-final { scan-tree-dump-times "MIN_EXPR" 2 "original" } }
diff --git a/libgfortran/intrinsics/args.c b/libgfortran/intrinsics/args.c
index 517ebc9..0a5923e 100644
--- a/libgfortran/intrinsics/args.c
+++ b/libgfortran/intrinsics/args.c
@@ -37,7 +37,6 @@ void
getarg_i4 (GFC_INTEGER_4 *pos, char *val, gfc_charlen_type val_len)
{
int argc;
- int arglen;
char **argv;
get_args (&argc, &argv);
@@ -49,7 +48,7 @@ getarg_i4 (GFC_INTEGER_4 *pos, char *val, gfc_charlen_type val_len)
if ((*pos) + 1 <= argc && *pos >=0 )
{
- arglen = strlen (argv[*pos]);
+ gfc_charlen_type arglen = strlen (argv[*pos]);
if (arglen > val_len)
arglen = val_len;
memcpy (val, argv[*pos], arglen);
@@ -119,7 +118,8 @@ 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, arglen = 0, stat_flag = GFC_GC_SUCCESS;
+ int argc, stat_flag = GFC_GC_SUCCESS;
+ gfc_charlen_type arglen = 0;
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, arglen, thisarg;
+ int i, argc, 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 503d337..8b2209c 100644
--- a/libgfortran/intrinsics/chmod.c
+++ b/libgfortran/intrinsics/chmod.c
@@ -64,7 +64,6 @@ 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;
@@ -104,7 +103,7 @@ chmod_internal (char *file, char *mode, gfc_charlen_type mode_len)
honor_umask = false;
#endif
- for (i = 0; i < mode_len; i++)
+ for (gfc_charlen_type i = 0; i < mode_len; i++)
{
if (!continue_clause)
{
diff --git a/libgfortran/intrinsics/env.c b/libgfortran/intrinsics/env.c
index 5eb01e1..512b03f 100644
--- a/libgfortran/intrinsics/env.c
+++ b/libgfortran/intrinsics/env.c
@@ -93,7 +93,8 @@ 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, res_len = 0;
+ int stat = GFC_SUCCESS;
+ gfc_charlen_type 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 17af28d..cbfdeb2 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;
- GFC_INTEGER_4 size;
+ size_t size;
struct vtype *extends;
}
vtype;
diff --git a/libgfortran/intrinsics/gerror.c b/libgfortran/intrinsics/gerror.c
index d3b28da..ff05737 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)
{
- int p_len;
+ gfc_charlen_type p_len;
char *p;
p = gf_strerror (errno, msg, msg_len);
diff --git a/libgfortran/intrinsics/getlog.c b/libgfortran/intrinsics/getlog.c
index 024f4da..211641f 100644
--- a/libgfortran/intrinsics/getlog.c
+++ b/libgfortran/intrinsics/getlog.c
@@ -70,7 +70,6 @@ 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. */
@@ -107,7 +106,7 @@ PREFIX(getlog) (char * login, gfc_charlen_type login_len)
if (p == NULL)
goto cleanup;
- p_len = strlen (p);
+ gfc_charlen_type 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 221852b..aff4d26 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,8 +99,7 @@ hostnm_0 (char *name, gfc_charlen_type name_len)
if (val == 0)
{
- i = -1;
- while (i < name_len && p[++i] != '\0')
+ for (gfc_charlen_type i = 0; i < name_len && p[i] != '\0'; i++)
name[i] = p[i];
}
diff --git a/libgfortran/intrinsics/string_intrinsics_inc.c b/libgfortran/intrinsics/string_intrinsics_inc.c
index aa132ce..4131377 100644
--- a/libgfortran/intrinsics/string_intrinsics_inc.c
+++ b/libgfortran/intrinsics/string_intrinsics_inc.c
@@ -224,14 +224,15 @@ 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 (i >= 0 && s[i] == ' ')
- --i;
+ while (s[i] == ' ')
+ {
+ if (i == 0)
+ return 0;
+ --i;
+ }
return i + 1;
}
@@ -327,12 +328,12 @@ string_scan (gfc_charlen_type slen, const CHARTYPE *str,
if (back)
{
- for (i = slen - 1; i >= 0; i--)
+ for (i = slen; i != 0; i--)
{
for (j = 0; j < setlen; j++)
{
- if (str[i] == set[j])
- return (i + 1);
+ if (str[i - 1] == set[j])
+ return i;
}
}
}
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index be8c8a6..0b9636e 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 *, int);
+extern void transfer_character (st_parameter_dt *, void *, gfc_charlen_type);
export_proto(transfer_character);
-extern void transfer_character_write (st_parameter_dt *, void *, int);
+extern void transfer_character_write (st_parameter_dt *, void *, gfc_charlen_type);
export_proto(transfer_character_write);
-extern void transfer_character_wide (st_parameter_dt *, void *, int, int);
+extern void transfer_character_wide (st_parameter_dt *, void *, gfc_charlen_type, int);
export_proto(transfer_character_wide);
extern void transfer_character_wide_write (st_parameter_dt *,
- void *, int, int);
+ void *, gfc_charlen_type, 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, int len)
+transfer_character (st_parameter_dt *dtp, void *p, gfc_charlen_type len)
{
static char *empty_string[0];
@@ -2290,13 +2290,13 @@ transfer_character (st_parameter_dt *dtp, void *p, int len)
}
void
-transfer_character_write (st_parameter_dt *dtp, void *p, int len)
+transfer_character_write (st_parameter_dt *dtp, void *p, gfc_charlen_type len)
{
transfer_character (dtp, p, len);
}
void
-transfer_character_wide (st_parameter_dt *dtp, void *p, int len, int kind)
+transfer_character_wide (st_parameter_dt *dtp, void *p, gfc_charlen_type len, int kind)
{
static char *empty_string[0];
@@ -2314,7 +2314,7 @@ transfer_character_wide (st_parameter_dt *dtp, void *p, int len, int kind)
}
void
-transfer_character_wide_write (st_parameter_dt *dtp, void *p, int len, int kind)
+transfer_character_wide_write (st_parameter_dt *dtp, void *p, gfc_charlen_type 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 ? charlen : GFC_DESCRIPTOR_SIZE (desc);
+ size = iotype == BT_CHARACTER ? (index_type) 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 b0ba310..213f9e3 100644
--- a/libgfortran/io/unit.c
+++ b/libgfortran/io/unit.c
@@ -439,10 +439,9 @@ 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 (i = 0; i < dtp->format_len; i++)
+ for (gfc_charlen_type 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 340f767..51dc60e 100644
--- a/libgfortran/io/write.c
+++ b/libgfortran/io/write.c
@@ -2380,7 +2380,6 @@ 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;
@@ -2402,7 +2401,7 @@ namelist_write (st_parameter_dt *dtp)
write_character (dtp, "&", 1, 1, NODELIM);
/* Write namelist name in upper case - f95 std. */
- for (i = 0 ;i < dtp->namelist_name_len ;i++ )
+ for (gfc_charlen_type 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 9bf8dcd..201d07a 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 GFC_INTEGER_4 gfc_charlen_type;
+typedef size_t gfc_charlen_type;
/* Definitions of CHARACTER data types:
- CHARACTER(KIND=1) corresponds to the C char type,
--
2.7.4
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2016-12-20 9:24 ` FX
@ 2016-12-29 21:54 ` Gerald Pfeifer
0 siblings, 0 replies; 76+ messages in thread
From: Gerald Pfeifer @ 2016-12-29 21:54 UTC (permalink / raw)
To: FX; +Cc: Bob Deen, Janne Blomqvist, Fortran List, GCC Patches
[-- Attachment #1: Type: text/plain, Size: 667 bytes --]
On Tue, 20 Dec 2016, FX wrote:
> Finally, if weΒ’re making this change, we welcome any feedback on how
> to make it as easy as possible to handle in user code. Documentation,
> preprocessor macros, etc.
I believe including this in the (yet to be created) gcc-7/porting_to.html,
would be great.
Historically the porting_to.html documents have mostly covered C and
C++, since that is the source language of the majority of packages in
a GNU/Linux distribution that GCC touches. Adding more focus on
Fortran users as well feels like a good idea, though.
(If you want to go ahead, but prefer the page to be created first,
let me know, and I'll take care.)
Gerald
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2016-12-27 11:03 ` Janne Blomqvist
2016-12-27 18:18 ` FX
@ 2016-12-29 11:50 ` Andre Vehreschild
1 sibling, 0 replies; 76+ messages in thread
From: Andre Vehreschild @ 2016-12-29 11:50 UTC (permalink / raw)
To: Janne Blomqvist; +Cc: FX, Fortran List, GCC Patches
Hi Janne, hi FX,
On Tue, 27 Dec 2016 12:56:19 +0200
Janne Blomqvist <blomqvist.janne@gmail.com> wrote:
> >> I also changed the _size member in vtables from int to size_t, as
> >> there were some cases where character lengths and sizes were
> >> apparently mixed up and caused regressions otherwise. Although I
I can confirm this. Being responsible for adding the _len component for char
arrays in unlimited polymorphic objects. This is the only use case where the
_len component is used to my knowledge. The separation should have been:
- _size: store the size in bytes of a single character
- _len: the number of characters stored in the char array in the unlimited
polymorphic object.
Unfortunately there were some case, which Janne also experienced, where these go
stray. I at least succeeded to remove the length from the vtab's-name that is
generated for storing in the unlimited polymorphic object. Over time I hope to
get the separation of concerns correctly modeled as told above, but for the
time being we have to stick with _size have the array size sometimes. I think
that is the case when a fixed length char array is stored in the unlimited
polymorphic object.
Regards,
Andre
--
Andre Vehreschild * Email: vehre ad gmx dot de
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2016-12-27 11:03 ` Janne Blomqvist
@ 2016-12-27 18:18 ` FX
2016-12-29 11:50 ` Andre Vehreschild
1 sibling, 0 replies; 76+ messages in thread
From: FX @ 2016-12-27 18:18 UTC (permalink / raw)
To: Janne Blomqvist; +Cc: Fortran List, GCC Patches
> The _size member is the size of the object; for polymorphic objects
> the size isn't known at compile time, so it is to be stored in the
> vtable (in principle, since the vtable tells the exact class of a
> polymorphic object, it should be possible to figure out the size
> without an explicit _size member, but I'll let the OOP experts handle
> that, if they want). There is another vtable member _len which is used
> for character lengths, and that is indeed of type
> gfc_charlen_type_node.
Understood, thanks.
> I think when the dust settles, I might make sense to get rid of
> gfc_charlen_type_node/gfc_charlen_type and just use
> size_type_node/size_t also for string lengths, but at least for now I
> think it's clearer to use separate names.
I agree with keeping them for now.
> So strictly speaking it's not necessary, as long as
> gfc_charlen_type_node is a signed integer.
>
> OTOH, if/when one wants to make gfc_charlen_type_node unsigned,
> perhaps some more far-reaching changes are needed and that work is not
> necessary anymore. Say, introducing BT_UNSIGNED_INTEGER (??) and
> teaching gfc_typespec to handle unsigned integers? Or maybe it's
> better to put a tree node specifying the type in the typespec and use
> that instead of the bt type + kind to tell what type it is?
>
> Do you want me to remove that for the time being?
Let’s remove that, at least for now.
>> There are other cases (resolve.c, simplify.c) where you introduce a dependency on middle-end entities (tree.h, trans-types.h) in what are pure Fortran front-end stages. This breaks the separation that currently exists, and which I strongly think we should keep.
>
> These changes are similar to the above, i.e. a check that uses
> get_type_static_bounds() and works also if gfc_charlen_type_node is
> changed to be an unsigned type.
OK then let’s remove them too.
> - Should I remove the so-far preliminary work to handle
> gfc_charlen_type_node being unsigned?
I think it makes more sense.
> - Should I fix the uses of mpz_{get,set}_{s,u}i?
I think so, otherwise there is little reason to break the ABI and not support long strings :)
>> - trans-types.h: why do we now need to include trans.h?
>
> IIRC this was due to some of the new .c files including trans-types.h
> but not trans.h and failing to compile. AFAIU the convention is that
> headers should include whatever is necessary to use said header. So
> this is some latent bug that has been exposed by my other changes.
If, with the final version of the patch, you can remove it, please do. And if you don’t, please remove the trans.h includes from source files that already include trans-types.h
FX
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2016-12-27 10:56 ` Andre Vehreschild
@ 2016-12-27 11:37 ` Janne Blomqvist
0 siblings, 0 replies; 76+ messages in thread
From: Janne Blomqvist @ 2016-12-27 11:37 UTC (permalink / raw)
To: Andre Vehreschild; +Cc: Jakub Jelinek, Fortran List, GCC Patches
On Tue, Dec 27, 2016 at 12:47 PM, Andre Vehreschild <vehre@gmx.de> wrote:
> Hi Janne,
>
> sorry for being late in voicing my opinion, but I personally would prefer to
> have this patch in a separately. That way bisecting for performance
> regressions points only to the offending code and not to the change of the
> character length (the latter might add a tiny bit of cost, too).
No worries. I included this in the updated charlen-size_t patch I
posted and which FX reviewed, but I can certainly commit this part
separately.
>
> Regards,
> Andre
>
>
> On Fri, 23 Dec 2016 11:27:10 +0200
> Janne Blomqvist <blomqvist.janne@gmail.com> wrote:
>
>> On Wed, Dec 21, 2016 at 3:14 PM, Andre Vehreschild <vehre@gmx.de> wrote:
>> >> Now when I think about this some more, I have a vague recollection
>> >> that a long time ago it used to be something like that. The problem
>> >> is that MIN_EXPR<CONSTANT, NON-CONSTANT> will of course be
>> >> NON-CONSTANT, so the memcpy call can't be inlined. Hence it was
>> >> changed to two separate __builtin_memmove() calls to have better
>> >> opportunity to inline. So probably a no-go to change it back. :(
>> >
>> > I don't get that. From the former only one of the memmove's could have been
>> > inlined assuming that only CONSTANT sizes are inlined.
>>
>> Yes. Which is better than not being able to inline, assuming the
>> inlined branch is more likely to be taken, no?
>>
>> > The other one had a
>> > NON-CONSTANT as long as pointer following and constant propagation was not
>> > effective together. In our case the "NON-CONSTANT branch" would have been
>> > used, which is resolved by constant propagation (of the size of constant
>> > memory p points to). I assume the warning is triggered, because dead-code
>> > elimination has not removed the else part.
>>
>> Probably yes, in this case. My performance worries were more about the
>> general case. But perhaps they are unfounded, IDK really. Does anybody
>> have a battery of string operation benchmarks that mirrors how real
>> Fortran code does string handling?
>>
>> Anyway, the attached patch accomplishes that. It turns the tree dump I
>> showed two days ago into something like
>>
>> {
>> integer(kind=8) D.3484;
>> unsigned long D.3485;
>>
>> D.3484 = *_p;
>> D.3485 = (unsigned long) D.3484 + 18446744073709551608;
>> if (D.3484 != 0)
>> {
>> __builtin_memmove ((void *) *p, (void *) &"12345679"[1]{lb: 1
>> sz: 1}, MIN_EXPR <(unsigned long) D.3484, 8>);
>> if ((unsigned long) D.3484 > 8)
>> {
>> __builtin_memset ((void *) *p + 8, 32, D.3485);
>> }
>> }
>> }
>>
>> and gets rid of the -Wstringop-overflow warning. (It causes a two new
>> testsuite failures (gfortran.dg/dependency_49.f90 and
>> gfortran.dg/transfer_intrinsic_1.f90), but those are just tests that
>> grep for patterns in the .original dump and need to be adjusted).
>>
>> If that is Ok, do you prefer it as part of the charlen-size_t patch,
>> or would you (GFortran maintainers in general) prefer that it's a
>> separate patch?
>>
>
>
> --
> Andre Vehreschild * Email: vehre ad gmx dot de
--
Janne Blomqvist
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2016-12-26 11:25 ` FX
@ 2016-12-27 11:03 ` Janne Blomqvist
2016-12-27 18:18 ` FX
2016-12-29 11:50 ` Andre Vehreschild
0 siblings, 2 replies; 76+ messages in thread
From: Janne Blomqvist @ 2016-12-27 11:03 UTC (permalink / raw)
To: FX; +Cc: Fortran List, GCC Patches
On Mon, Dec 26, 2016 at 12:32 PM, FX <fxcoudert@gmail.com> wrote:
> Hi Janne,
>
> Thanks for the patch, it is hard and tedious work. Here is the formal review. I don’t want to be a pain, but I have several questions about the patch, and given its size and the importance I think we should be double-sure :)
Thanks for the in-depth review, I appreciate it!
>> I also changed the _size member in vtables from int to size_t, as
>> there were some cases where character lengths and sizes were
>> apparently mixed up and caused regressions otherwise. Although I
>> haven't tested, this might enable very large derived types as well.
>
> Regarding that one, why are you making it an explicit size_t and not a charlen type? I know the two will be the same, at least for now, but given that it’s explicitly a character length we should use that variable type. This is a preexisting issue with the front-end and library, where we generally use a mix of types (because they end up being the same anyway, such as C int and GFC_INTEGER_4).
The _size member is the size of the object; for polymorphic objects
the size isn't known at compile time, so it is to be stored in the
vtable (in principle, since the vtable tells the exact class of a
polymorphic object, it should be possible to figure out the size
without an explicit _size member, but I'll let the OOP experts handle
that, if they want). There is another vtable member _len which is used
for character lengths, and that is indeed of type
gfc_charlen_type_node.
I think when the dust settles, I might make sense to get rid of
gfc_charlen_type_node/gfc_charlen_type and just use
size_type_node/size_t also for string lengths, but at least for now I
think it's clearer to use separate names.
> Regarding the introduction of is_charlen in gfc_typespec, I am unclear as to why it is needed. It is used exclusively in arith.c, which is not where we should be checking character lengths I think. It is visible by the fact that we normally shouldn’t need access to middle-end headers (tree.h and trans-types.h) at that level. So, can’t we make the check where we currently do it, i.e. later when we translate the constant string? That sounds more reasonable that introducing a new special-cased entity.
This is, well, a leftover from my attempts to make
gfc_charlen_type_node an alias for size_type_node, an unsigned type.
Since the gfc_typespec doesn't understand unsigned integers, it had to
be extended in some fashion. You can see that the check in arith.c
checks that the charlen is in the range [0,
TYPE_MAX_VALUE(gfc_charlen_type_node)], which the "normal" check isn't
able to do.
So strictly speaking it's not necessary, as long as
gfc_charlen_type_node is a signed integer.
OTOH, if/when one wants to make gfc_charlen_type_node unsigned,
perhaps some more far-reaching changes are needed and that work is not
necessary anymore. Say, introducing BT_UNSIGNED_INTEGER (??) and
teaching gfc_typespec to handle unsigned integers? Or maybe it's
better to put a tree node specifying the type in the typespec and use
that instead of the bt type + kind to tell what type it is?
Do you want me to remove that for the time being?
> There are other cases (resolve.c, simplify.c) where you introduce a dependency on middle-end entities (tree.h, trans-types.h) in what are pure Fortran front-end stages. This breaks the separation that currently exists, and which I strongly think we should keep.
These changes are similar to the above, i.e. a check that uses
get_type_static_bounds() and works also if gfc_charlen_type_node is
changed to be an unsigned type.
> ** libgfortran **
>
> - in io/write.c, the “for” clauses in in namelist_write() have weird spacing around their semicolons (i.e. space should be after, not before)
Ah, I hadn't noticed that. As one can see, it's a pre-existing issue,
but I might as well fix it when I'm changing that line. Will do.
> - in intrinsics/extends_type_of.c, use gfc_charlen_type instead of size_t vtype->size
As I explained earlier, this is because the size member is the size of
the object rather than the charlen, so I think it should stay a
size_t.
> ** front-end **
>
> - class.c: use gfc_charlen_int_kind instead of gfc_size_kind
Same here.
> - class.c, in find_intrinsic_vtab(): in the call to gfc_get_int_expr, the third argument cannot be cast from (size_t) to (long), as this would fail on LLP64 hosts
Yes, but... the issue is that gfc_get_int_expr uses mpz_set_si, so
can't handle more than long anyway. But hmm, maybe that typecast
should be removed anyway, so that when/if gfc_get_int_expr is fixed
this would be automatically fixed as well.
> - expr.c, regarding gfc_extract_long(): we could definitely extract an host wide int or an mpz value. This new function is called twice: once in resolve_charlen() where we could use the GMP function mpz_sgn() to check if the constant value is negative; the second time in gfc_simplify_repeat, where we should simply bail out (return NULL) if the integer is too big to fit into a long (we would bail out a few lines later anyway, see “semi-arbitrary limit”).
Yes, similar to the above. In general, code which use
mpz_{get,set}_{s,u}i and are handling string lengths should be changed
to do something else instead in order to work on LLP64 hosts. It might
be possible to go via a wide_int to convert between tree's and mpz_t's
and vice versa, but I haven't looked further into it yet. But I think
that can be left for a follow-up patch.
> - iresolve.c, extra space after NULL in call to gfc_get_int_expr() in gfc_resolve_repeat()
> - match.c, in select_intrinsic_set_tmp(), charlen should be a gfc_charlen_t and mpz_get_si will break for long string sizes
> - in resolve.c, like in arith.c, we should not use tree.h and trans-types.h. We should do the comparison by looking at integer kinds, not through the charlen_type_node
> - in resolve.c, in resolve_select_type(), another case of mpz_get_si() that will break for long string sizes
> - in simplify.c, again, we should not use tree.h and trans-types.h
Yes, so these again boil down to what I've written above:
- Should I remove the so-far preliminary work to handle
gfc_charlen_type_node being unsigned?
- Should I fix the uses of mpz_{get,set}_{s,u}i?
> - trans-decl.c seems like unrelated changes
Ah yes, leftover from some debugging. Will remove.
> - trans-types.h: why do we now need to include trans.h?
IIRC this was due to some of the new .c files including trans-types.h
but not trans.h and failing to compile. AFAIU the convention is that
headers should include whatever is necessary to use said header. So
this is some latent bug that has been exposed by my other changes.
--
Janne Blomqvist
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2016-12-23 9:57 ` Janne Blomqvist
@ 2016-12-27 10:56 ` Andre Vehreschild
2016-12-27 11:37 ` Janne Blomqvist
0 siblings, 1 reply; 76+ messages in thread
From: Andre Vehreschild @ 2016-12-27 10:56 UTC (permalink / raw)
To: Janne Blomqvist; +Cc: Jakub Jelinek, Fortran List, GCC Patches
Hi Janne,
sorry for being late in voicing my opinion, but I personally would prefer to
have this patch in a separately. That way bisecting for performance
regressions points only to the offending code and not to the change of the
character length (the latter might add a tiny bit of cost, too).
Regards,
Andre
On Fri, 23 Dec 2016 11:27:10 +0200
Janne Blomqvist <blomqvist.janne@gmail.com> wrote:
> On Wed, Dec 21, 2016 at 3:14 PM, Andre Vehreschild <vehre@gmx.de> wrote:
> >> Now when I think about this some more, I have a vague recollection
> >> that a long time ago it used to be something like that. The problem
> >> is that MIN_EXPR<CONSTANT, NON-CONSTANT> will of course be
> >> NON-CONSTANT, so the memcpy call can't be inlined. Hence it was
> >> changed to two separate __builtin_memmove() calls to have better
> >> opportunity to inline. So probably a no-go to change it back. :(
> >
> > I don't get that. From the former only one of the memmove's could have been
> > inlined assuming that only CONSTANT sizes are inlined.
>
> Yes. Which is better than not being able to inline, assuming the
> inlined branch is more likely to be taken, no?
>
> > The other one had a
> > NON-CONSTANT as long as pointer following and constant propagation was not
> > effective together. In our case the "NON-CONSTANT branch" would have been
> > used, which is resolved by constant propagation (of the size of constant
> > memory p points to). I assume the warning is triggered, because dead-code
> > elimination has not removed the else part.
>
> Probably yes, in this case. My performance worries were more about the
> general case. But perhaps they are unfounded, IDK really. Does anybody
> have a battery of string operation benchmarks that mirrors how real
> Fortran code does string handling?
>
> Anyway, the attached patch accomplishes that. It turns the tree dump I
> showed two days ago into something like
>
> {
> integer(kind=8) D.3484;
> unsigned long D.3485;
>
> D.3484 = *_p;
> D.3485 = (unsigned long) D.3484 + 18446744073709551608;
> if (D.3484 != 0)
> {
> __builtin_memmove ((void *) *p, (void *) &"12345679"[1]{lb: 1
> sz: 1}, MIN_EXPR <(unsigned long) D.3484, 8>);
> if ((unsigned long) D.3484 > 8)
> {
> __builtin_memset ((void *) *p + 8, 32, D.3485);
> }
> }
> }
>
> and gets rid of the -Wstringop-overflow warning. (It causes a two new
> testsuite failures (gfortran.dg/dependency_49.f90 and
> gfortran.dg/transfer_intrinsic_1.f90), but those are just tests that
> grep for patterns in the .original dump and need to be adjusted).
>
> If that is Ok, do you prefer it as part of the charlen-size_t patch,
> or would you (GFortran maintainers in general) prefer that it's a
> separate patch?
>
--
Andre Vehreschild * Email: vehre ad gmx dot de
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2016-12-23 15:09 ` Janne Blomqvist
@ 2016-12-26 11:25 ` FX
2016-12-27 11:03 ` Janne Blomqvist
2017-01-01 11:26 ` Janne Blomqvist
1 sibling, 1 reply; 76+ messages in thread
From: FX @ 2016-12-26 11:25 UTC (permalink / raw)
To: Janne Blomqvist; +Cc: fortran, gcc-patches
Hi Janne,
Thanks for the patch, it is hard and tedious work. Here is the formal review. I don’t want to be a pain, but I have several questions about the patch, and given its size and the importance I think we should be double-sure :)
> I also changed the _size member in vtables from int to size_t, as
> there were some cases where character lengths and sizes were
> apparently mixed up and caused regressions otherwise. Although I
> haven't tested, this might enable very large derived types as well.
Regarding that one, why are you making it an explicit size_t and not a charlen type? I know the two will be the same, at least for now, but given that it’s explicitly a character length we should use that variable type. This is a preexisting issue with the front-end and library, where we generally use a mix of types (because they end up being the same anyway, such as C int and GFC_INTEGER_4).
Regarding the introduction of is_charlen in gfc_typespec, I am unclear as to why it is needed. It is used exclusively in arith.c, which is not where we should be checking character lengths I think. It is visible by the fact that we normally shouldn’t need access to middle-end headers (tree.h and trans-types.h) at that level. So, can’t we make the check where we currently do it, i.e. later when we translate the constant string? That sounds more reasonable that introducing a new special-cased entity.
There are other cases (resolve.c, simplify.c) where you introduce a dependency on middle-end entities (tree.h, trans-types.h) in what are pure Fortran front-end stages. This breaks the separation that currently exists, and which I strongly think we should keep.
** libgfortran **
- in io/write.c, the “for” clauses in in namelist_write() have weird spacing around their semicolons (i.e. space should be after, not before)
- in intrinsics/extends_type_of.c, use gfc_charlen_type instead of size_t vtype->size
** front-end **
- class.c: use gfc_charlen_int_kind instead of gfc_size_kind
- class.c, in find_intrinsic_vtab(): in the call to gfc_get_int_expr, the third argument cannot be cast from (size_t) to (long), as this would fail on LLP64 hosts
- expr.c, regarding gfc_extract_long(): we could definitely extract an host wide int or an mpz value. This new function is called twice: once in resolve_charlen() where we could use the GMP function mpz_sgn() to check if the constant value is negative; the second time in gfc_simplify_repeat, where we should simply bail out (return NULL) if the integer is too big to fit into a long (we would bail out a few lines later anyway, see “semi-arbitrary limit”).
- iresolve.c, extra space after NULL in call to gfc_get_int_expr() in gfc_resolve_repeat()
- match.c, in select_intrinsic_set_tmp(), charlen should be a gfc_charlen_t and mpz_get_si will break for long string sizes
- in resolve.c, like in arith.c, we should not use tree.h and trans-types.h. We should do the comparison by looking at integer kinds, not through the charlen_type_node
- in resolve.c, in resolve_select_type(), another case of mpz_get_si() that will break for long string sizes
- in simplify.c, again, we should not use tree.h and trans-types.h
- trans-decl.c seems like unrelated changes
- trans-types.h: why do we now need to include trans.h?
Thanks again for working on that!
FX
^ permalink raw reply [flat|nested] 76+ messages in thread
* [PATCH] PR 78534 Change character length from int to size_t
2016-12-12 9:53 Janne Blomqvist
2016-12-12 10:20 ` FX
2016-12-12 17:39 ` Andre Vehreschild
@ 2016-12-23 15:09 ` Janne Blomqvist
2016-12-26 11:25 ` FX
2017-01-01 11:26 ` Janne Blomqvist
2 siblings, 2 replies; 76+ messages in thread
From: Janne Blomqvist @ 2016-12-23 15:09 UTC (permalink / raw)
To: fortran, gcc-patches; +Cc: Janne Blomqvist
In order to handle large character lengths on (L)LP64 targets, switch
the GFortran character length from an int to a size_t.
This is an ABI change, as procedures with character arguments take
hidden arguments with the character length.
I also changed the _size member in vtables from int to size_t, as
there were some cases where character lengths and sizes were
apparently mixed up and caused regressions otherwise. Although I
haven't tested, this might enable very large derived types as well.
Also, as there are some places in the frontend were negative character
lengths are used as special flag values, in the frontend the character
length is handled as a signed variable of the same size as a size_t,
although in the runtime library it really is size_t.
I haven't changed the character length variables for the co-array
intrinsics, as this is something that may need to be synchronized with
OpenCoarrays.
Another change in this place is that the algorithm for
gfc_trans_string_copy has been rewritten to avoid a
-Wstringop-overflow warning.
Regtested on x86_64-pc-linux-gnu, Ok for trunk?
frontend:
2016-12-23 Janne Blomqvist <jb@gcc.gnu.org>
PR fortran/78534
PR fortran/66310
* arith.c (gfc_check_charlen_range): New function.
(gfc_range_check): Use gfc_check_charlen_range.
* 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 long.
(gfc_extract_long): New function.
* gfortran.h (gfc_typespec): New member is_charlen.
(gfc_charlen_t): New typedef.
(gfc_expr): Use gfc_charlen_t for character lengths.
(gfc_size_kind): New extern variable.
(gfc_extract_long): New prototype.
(gfc_get_character_expr): Use gfc_charlen_t for character length.
(gfc_get_int_expr): Use long type for value argument.
* iresolve.c (gfc_resolve_repeat): Use gfc_charlen_t,
gfc_charlen_int_kind, set is_charlen.
* match.c (select_intrinsic_set_tmp): Use long for charlen.
* 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_substring): Use get_type_static_bounds.
(resolve_select_type): Use long for charlen.
(resolve_charlen): Use long for charlen, get_type_static_bounds.
* simplify.c (gfc_simplify_repeat): Likewise.
* target-memory.c (gfc_interpret_character): Use gfc_charlen_t.
* 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-decl.c (create_function_arglist): Assert that length is
not NULL_TREE.
* 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 long 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.
(gfc_trans_string_copy): Rewrite to avoid -Wstringop-overflow
warning in generated code.
(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.
* trans-types.h: Include trans.h, tidying.
testsuite:
2016-12-23 Janne Blomqvist <jb@gcc.gnu.org>
PR fortran/78534
PR fortran/66310
* gfortran.dg/dependency_49.f90: Change scan-tree-dump-times
due to gfc_trans_string_copy change to avoid
-Wstringop-overflow.
* 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.
* gfortran.dg/transfer_intrinsic_1.f90: Change
scan-tree-dump-times due to gfc_trans_string_copy change to
avoid -Wstringop-overflow.
libgfortran:
2016-12-23 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.
---
gcc/fortran/arith.c | 28 ++++++
gcc/fortran/class.c | 12 +--
gcc/fortran/dump-parse-tree.c | 9 +-
gcc/fortran/expr.c | 30 +++++-
gcc/fortran/gfortran.h | 20 +++-
gcc/fortran/gfortran.texi | 42 ++++++--
gcc/fortran/iresolve.c | 10 +-
gcc/fortran/match.c | 4 +-
gcc/fortran/module.c | 43 +++++---
gcc/fortran/resolve.c | 33 ++++--
gcc/fortran/simplify.c | 33 ++++--
gcc/fortran/target-memory.c | 8 +-
gcc/fortran/trans-array.c | 3 +-
gcc/fortran/trans-const.c | 12 +++
gcc/fortran/trans-const.h | 1 +
gcc/fortran/trans-decl.c | 3 +-
gcc/fortran/trans-expr.c | 111 ++++++++++-----------
gcc/fortran/trans-intrinsic.c | 53 +++++-----
gcc/fortran/trans-io.c | 4 +-
gcc/fortran/trans-stmt.c | 19 ++--
gcc/fortran/trans-types.c | 11 +-
gcc/fortran/trans-types.h | 5 +-
gcc/testsuite/gfortran.dg/dependency_49.f90 | 2 +-
gcc/testsuite/gfortran.dg/repeat_4.f90 | 23 +++--
gcc/testsuite/gfortran.dg/repeat_7.f90 | 8 ++
gcc/testsuite/gfortran.dg/scan_2.f90 | 4 +-
gcc/testsuite/gfortran.dg/string_1.f90 | 1 +
gcc/testsuite/gfortran.dg/string_1_lp64.f90 | 15 +++
gcc/testsuite/gfortran.dg/string_3.f90 | 1 +
gcc/testsuite/gfortran.dg/string_3_lp64.f90 | 20 ++++
gcc/testsuite/gfortran.dg/transfer_intrinsic_1.f90 | 2 +-
libgfortran/intrinsics/args.c | 10 +-
libgfortran/intrinsics/chmod.c | 3 +-
libgfortran/intrinsics/env.c | 3 +-
libgfortran/intrinsics/extends_type_of.c | 2 +-
libgfortran/intrinsics/gerror.c | 2 +-
libgfortran/intrinsics/getlog.c | 3 +-
libgfortran/intrinsics/hostnm.c | 5 +-
libgfortran/intrinsics/string_intrinsics_inc.c | 17 ++--
libgfortran/io/transfer.c | 18 ++--
libgfortran/io/unit.c | 3 +-
libgfortran/io/write.c | 3 +-
libgfortran/libgfortran.h | 2 +-
43 files changed, 420 insertions(+), 221 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/repeat_7.f90
create mode 100644 gcc/testsuite/gfortran.dg/string_1_lp64.f90
create mode 100644 gcc/testsuite/gfortran.dg/string_3_lp64.f90
diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c
index 2781f10..ef4b884 100644
--- a/gcc/fortran/arith.c
+++ b/gcc/fortran/arith.c
@@ -31,6 +31,8 @@ along with GCC; see the file COPYING3. If not see
#include "arith.h"
#include "target-memory.h"
#include "constructor.h"
+#include "tree.h"
+#include "trans-types.h"
/* MPFR does not have a direct replacement for mpz_set_f() from GMP.
It's easily implemented with a few calls though. */
@@ -281,6 +283,27 @@ gfc_check_character_range (gfc_char_t c, int kind)
}
+/* Check whether a character length is within the range
+ [0, TYPE_MAX_VALUE(gfc_charlen_type_node)]. */
+
+arith
+gfc_check_charlen_range (mpz_t p)
+{
+ mpz_t min, max;
+ arith result = ARITH_OK;
+
+ mpz_init (min);
+ mpz_init (max);
+ get_type_static_bounds (gfc_charlen_type_node, min, max);
+ mpz_clear (min);
+ if ((mpz_sgn (p) < 0) || (mpz_cmp (p, max) > 0))
+ result = ARITH_OVERFLOW;
+
+ mpz_clear (max);
+ return result;
+}
+
+
/* Given an integer and a kind, make sure that the integer lies within
the range of the kind. Returns ARITH_OK, ARITH_ASYMMETRIC or
ARITH_OVERFLOW. */
@@ -487,6 +510,9 @@ gfc_range_check (gfc_expr *e)
arith rc;
arith rc2;
+ if (e->ts.is_charlen)
+ return gfc_check_charlen_range (e->value.integer);
+
switch (e->ts.type)
{
case BT_INTEGER:
@@ -689,6 +715,8 @@ gfc_arith_times (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
{
case BT_INTEGER:
mpz_mul (result->value.integer, op1->value.integer, op2->value.integer);
+ if (op1->ts.is_charlen || op2->ts.is_charlen)
+ result->ts.is_charlen = true;
break;
case BT_REAL:
diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index 1fba6c9..62c751e 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(4) to store the string length when the unlimited
+ * _len: An integer(C_SIZE_T) 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 = 4;
+ c->ts.kind = gfc_size_kind;
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_default_integer_kind,
+ c->initializer = gfc_get_int_expr (gfc_size_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 = 4;
+ c->ts.kind = gfc_size_kind;
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_default_integer_kind,
+ c->initializer = gfc_get_int_expr (gfc_size_kind,
NULL,
ts->type == BT_CHARACTER
? ts->kind
- : (int)gfc_element_size (e));
+ : (long)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 585f25d..7aafe54 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -348,12 +348,10 @@ show_constructor (gfc_constructor_base base)
static void
-show_char_const (const gfc_char_t *c, int length)
+show_char_const (const gfc_char_t *c, gfc_charlen_t length)
{
- int i;
-
fputc ('\'', dumpfile);
- for (i = 0; i < length; i++)
+ for (gfc_charlen_t i = 0; i < length; i++)
{
if (c[i] == '\'')
fputs ("''", dumpfile);
@@ -465,7 +463,8 @@ show_expr (gfc_expr *p)
break;
case BT_HOLLERITH:
- fprintf (dumpfile, "%dH", p->representation.length);
+ fprintf (dumpfile, HOST_WIDE_INT_PRINT_DEC "H",
+ 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 f57198f..d351d0f 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -184,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, int len)
+gfc_get_character_expr (int kind, locus *where, const char *src, gfc_charlen_t len)
{
gfc_expr *e;
gfc_char_t *dest;
@@ -210,7 +210,7 @@ gfc_get_character_expr (int kind, locus *where, const char *src, int len)
/* Get a new expression node that is an integer constant. */
gfc_expr *
-gfc_get_int_expr (int kind, locus *where, int value)
+gfc_get_int_expr (int kind, locus *where, long value)
{
gfc_expr *p;
p = gfc_get_constant_expr (BT_INTEGER, kind,
@@ -636,6 +636,32 @@ gfc_extract_int (gfc_expr *expr, int *result)
}
+/* Same as gfc_extract_int, but use a long. long isn't optimal either,
+ since it won't help on LLP64 targets like win64, but it's the best
+ we can do due to the mpz_*_si functions that take arguments of type
+ long. */
+
+const char *
+gfc_extract_long (gfc_expr *expr, long *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");
+
+ if ((mpz_cmp_si (expr->value.integer, LONG_MAX) > 0)
+ || (mpz_cmp_si (expr->value.integer, LONG_MIN) < 0))
+ {
+ return _("Integer value too large in expression at %C");
+ }
+
+ *result = mpz_get_si (expr->value.integer);
+
+ return NULL;
+}
+
+
/* Recursively copy a list of reference structures. */
gfc_ref *
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index b303189..8a143a4 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1009,6 +1009,8 @@ typedef struct
int is_iso_c;
bt f90_type;
bool deferred;
+ bool is_charlen; /* If the expression is a character length, ignore
+ type and kind. */
}
gfc_typespec;
@@ -2064,6 +2066,14 @@ 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;
@@ -2109,7 +2119,7 @@ typedef struct gfc_expr
the value. */
struct
{
- int length;
+ gfc_charlen_t length;
char *string;
}
representation;
@@ -2165,7 +2175,7 @@ typedef struct gfc_expr
struct
{
- int length;
+ gfc_charlen_t length;
gfc_char_t *string;
}
character;
@@ -2850,6 +2860,7 @@ 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;
@@ -3081,6 +3092,7 @@ 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_long (gfc_expr *, long *);
bool is_subref_array (gfc_expr *);
bool gfc_is_simply_contiguous (gfc_expr *, bool, bool);
bool gfc_check_init_expr (gfc_expr *);
@@ -3098,8 +3110,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 *, int len);
-gfc_expr *gfc_get_int_expr (int, locus *, int);
+gfc_expr *gfc_get_character_expr (int, locus *, const char *, gfc_charlen_t len);
+gfc_expr *gfc_get_int_expr (int, locus *, long);
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 5e2a750..1980fb55 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -3810,12 +3810,42 @@ 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 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.
+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.
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 a30ed9f..3571a16 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -2147,7 +2147,7 @@ void
gfc_resolve_repeat (gfc_expr *f, gfc_expr *string,
gfc_expr *ncopies)
{
- int len;
+ gfc_charlen_t len;
gfc_expr *tmp;
f->ts.type = BT_CHARACTER;
f->ts.kind = string->ts.kind;
@@ -2161,7 +2161,7 @@ gfc_resolve_repeat (gfc_expr *f, gfc_expr *string,
if (string->expr_type == EXPR_CONSTANT)
{
len = string->value.character.length;
- tmp = gfc_get_int_expr (gfc_default_integer_kind, NULL , len);
+ tmp = gfc_get_int_expr (gfc_charlen_int_kind, NULL , len);
}
else if (string->ts.u.cl && string->ts.u.cl->length)
{
@@ -2169,7 +2169,11 @@ gfc_resolve_repeat (gfc_expr *f, gfc_expr *string,
}
if (tmp)
- f->ts.u.cl->length = gfc_multiply (tmp, gfc_copy_expr (ncopies));
+ {
+ tmp->ts.kind = gfc_charlen_int_kind; /* Why is this fixup needed? */
+ tmp->ts.is_charlen = true;
+ f->ts.u.cl->length = gfc_multiply (tmp, gfc_copy_expr (ncopies));
+ }
}
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 523cba4..6184289 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;
- int charlen = 0;
+ long charlen = 0;
if (ts->type == BT_CLASS || ts->type == BT_DERIVED)
return NULL;
@@ -5782,7 +5782,7 @@ select_intrinsic_set_tmp (gfc_typespec *ts)
sprintf (name, "__tmp_%s_%d", gfc_basic_typename (ts->type),
ts->kind);
else
- sprintf (name, "__tmp_%s_%d_%d", gfc_basic_typename (ts->type),
+ sprintf (name, "__tmp_%s_%ld_%d", gfc_basic_typename (ts->type),
charlen, ts->kind);
gfc_get_sym_tree (name, gfc_current_ns, &tmp, false);
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 713f272..cf5b0f5 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 int atom_int;
+static HOST_WIDE_INT atom_int;
static char *atom_string, atom_name[MAX_ATOM_SIZE];
@@ -1271,7 +1271,7 @@ parse_string (void)
}
-/* Parse a small integer. */
+/* Parse an integer. Should fit in a HOST_WIDE_INT. */
static void
parse_integer (int c)
@@ -1288,8 +1288,6 @@ parse_integer (int c)
}
atom_int = 10 * atom_int + c - '0';
- if (atom_int > 99999999)
- bad_module ("Integer overflow");
}
}
@@ -1631,11 +1629,12 @@ write_char (char out)
static void
write_atom (atom_type atom, const void *v)
{
- char buffer[20];
+ char buffer[32];
/* Workaround -Wmaybe-uninitialized false positive during
profiledbootstrap by initializing them. */
- int i = 0, len;
+ int len;
+ HOST_WIDE_INT i = 0;
const char *p;
switch (atom)
@@ -1654,11 +1653,9 @@ write_atom (atom_type atom, const void *v)
break;
case ATOM_INTEGER:
- i = *((const int *) v);
- if (i < 0)
- gfc_internal_error ("write_atom(): Writing negative integer");
+ i = *((const HOST_WIDE_INT *) v);
- sprintf (buffer, "%d", i);
+ snprintf (buffer, sizeof (buffer), HOST_WIDE_INT_PRINT_DEC, i);
p = buffer;
break;
@@ -1766,7 +1763,10 @@ static void
mio_integer (int *ip)
{
if (iomode == IO_OUTPUT)
- write_atom (ATOM_INTEGER, ip);
+ {
+ HOST_WIDE_INT hwi = *ip;
+ write_atom (ATOM_INTEGER, &hwi);
+ }
else
{
require_atom (ATOM_INTEGER);
@@ -1774,6 +1774,18 @@ 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. */
@@ -1783,7 +1795,7 @@ mio_intrinsic_op (gfc_intrinsic_op* op)
/* FIXME: Would be nicer to do this via the operators symbolic name. */
if (iomode == IO_OUTPUT)
{
- int converted = (int) *op;
+ HOST_WIDE_INT converted = (HOST_WIDE_INT) *op;
write_atom (ATOM_INTEGER, &converted);
}
else
@@ -2680,7 +2692,7 @@ mio_array_ref (gfc_array_ref *ar)
{
for (i = 0; i < ar->dimen; i++)
{
- int tmp = (int)ar->dimen_type[i];
+ HOST_WIDE_INT tmp = (HOST_WIDE_INT)ar->dimen_type[i];
write_atom (ATOM_INTEGER, &tmp);
}
}
@@ -3382,6 +3394,7 @@ 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;
@@ -3596,7 +3609,9 @@ mio_expr (gfc_expr **ep)
break;
case BT_CHARACTER:
- mio_integer (&e->value.character.length);
+ hwi = e->value.character.length;
+ mio_hwi (&hwi);
+ e->value.character.length = hwi;
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 2c70e6c..74f151f 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -29,6 +29,8 @@ along with GCC; see the file COPYING3. If not see
#include "data.h"
#include "target-memory.h" /* for gfc_simplify_transfer */
#include "constructor.h"
+#include "tree.h"
+#include "trans-types.h" /* For gfc_charlen_type_node */
/* Types used in equivalence statements. */
@@ -4589,7 +4591,7 @@ resolve_array_ref (gfc_array_ref *ar)
static bool
resolve_substring (gfc_ref *ref)
{
- int k = gfc_validate_kind (BT_INTEGER, gfc_charlen_int_kind, false);
+ mpz_t min, max;
if (ref->u.ss.start != NULL)
{
@@ -4649,15 +4651,20 @@ resolve_substring (gfc_ref *ref)
return false;
}
- if (compare_bound_mpz_t (ref->u.ss.end,
- gfc_integer_kinds[k].huge) == CMP_GT
+ mpz_init (min);
+ mpz_init (max);
+ get_type_static_bounds (gfc_charlen_type_node, min, max);
+ mpz_clear (min);
+ if (compare_bound_mpz_t (ref->u.ss.end, max) == CMP_GT
&& (compare_bound (ref->u.ss.end, ref->u.ss.start) == CMP_EQ
|| compare_bound (ref->u.ss.end, ref->u.ss.start) == CMP_GT))
{
+ mpz_clear (max);
gfc_error ("Substring end index at %L is too large",
&ref->u.ss.end->where);
return false;
}
+ mpz_clear (max);
}
return true;
@@ -8469,7 +8476,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;
+ long charlen = 0;
int rank = 0;
gfc_ref* ref = NULL;
gfc_expr *selector_expr = NULL;
@@ -8720,8 +8727,8 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns)
if (c->ts.u.cl && c->ts.u.cl->length
&& c->ts.u.cl->length->expr_type == EXPR_CONSTANT)
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);
+ sprintf (name, "__tmp_%s_%ld_%d", gfc_basic_typename (c->ts.type),
+ charlen, c->ts.kind);
}
else
sprintf (name, "__tmp_%s_%d", gfc_basic_typename (c->ts.type),
@@ -11383,7 +11390,8 @@ resolve_index_expr (gfc_expr *e)
static bool
resolve_charlen (gfc_charlen *cl)
{
- int i, k;
+ long i;
+ mpz_t min, max;
bool saved_specification_expr;
if (cl->resolved)
@@ -11419,22 +11427,27 @@ 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 && !gfc_extract_int (cl->length, &i) && i < 0)
+ if (cl->length && !gfc_extract_long (cl->length, &i) && i < 0)
gfc_replace_expr (cl->length,
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);
+ mpz_init (min);
+ mpz_init (max);
+ get_type_static_bounds (gfc_charlen_type_node, min, max);
+ mpz_clear (min);
if (cl->length && cl->length->expr_type == EXPR_CONSTANT
&& cl->length->ts.type == BT_INTEGER
- && mpz_cmp (cl->length->value.integer, gfc_integer_kinds[k].huge) > 0)
+ && mpz_cmp (cl->length->value.integer, max) > 0)
{
gfc_error ("String length at %L is too large", &cl->length->where);
specification_expr = saved_specification_expr;
+ mpz_clear (max);
return false;
}
specification_expr = saved_specification_expr;
+ mpz_clear (max);
return true;
}
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index a46fbc5..ea835f4 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -28,6 +28,8 @@ along with GCC; see the file COPYING3. If not see
#include "target-memory.h"
#include "constructor.h"
#include "version.h" /* For version_string. */
+#include "tree.h"
+#include "trans-types.h"
gfc_expr gfc_bad_expr;
@@ -5190,7 +5192,7 @@ gfc_expr *
gfc_simplify_repeat (gfc_expr *e, gfc_expr *n)
{
gfc_expr *result;
- int i, j, len, ncop, nlen;
+ long len, ncop;
mpz_t ncopies;
bool have_length = false;
@@ -5232,24 +5234,26 @@ gfc_simplify_repeat (gfc_expr *e, gfc_expr *n)
/* Check that NCOPIES isn't too large. */
if (len)
{
- mpz_t max, mlen;
- int i;
+ mpz_t min, max, mlen, maxb;
/* Compute the maximum value allowed for NCOPIES: huge(cl) / len. */
+ mpz_init (min);
+ mpz_init (maxb);
mpz_init (max);
- i = gfc_validate_kind (BT_INTEGER, gfc_charlen_int_kind, false);
+ get_type_static_bounds (gfc_charlen_type_node, min, maxb);
+ mpz_clear (min);
if (have_length)
{
- mpz_tdiv_q (max, gfc_integer_kinds[i].huge,
- e->ts.u.cl->length->value.integer);
+ mpz_tdiv_q (max, maxb, e->ts.u.cl->length->value.integer);
}
else
{
mpz_init_set_si (mlen, len);
- mpz_tdiv_q (max, gfc_integer_kinds[i].huge, mlen);
+ mpz_tdiv_q (max, maxb, mlen);
mpz_clear (mlen);
}
+ mpz_clear (maxb);
/* The check itself. */
if (mpz_cmp (ncopies, max) > 0)
@@ -5274,7 +5278,7 @@ gfc_simplify_repeat (gfc_expr *e, gfc_expr *n)
(e->ts.u.cl->length &&
mpz_sgn (e->ts.u.cl->length->value.integer) != 0))
{
- const char *res = gfc_extract_int (n, &ncop);
+ const char *res = gfc_extract_long (n, &ncop);
gcc_assert (res == NULL);
}
else
@@ -5284,11 +5288,18 @@ 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;
- nlen = ncop * len;
+ size_t nlen = ncop * len;
+
+ /* Here's a semi-arbitrary limit. If the string is longer than 4 MB
+ (2**20 elements * 4 bytes (wide chars) per element) defer to
+ runtime instead of consuming (unbounded) memory and CPU at
+ compile time. */
+ if (nlen > 1048576)
+ return NULL;
result = gfc_get_character_expr (e->ts.kind, &e->where, NULL, nlen);
- for (i = 0; i < ncop; i++)
- for (j = 0; j < len; j++)
+ for (size_t i = 0; i < (size_t) ncop; i++)
+ for (size_t j = 0; j < (size_t) 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 ac9cce2..a62d4c2 100644
--- a/gcc/fortran/target-memory.c
+++ b/gcc/fortran/target-memory.c
@@ -438,11 +438,9 @@ 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 =
- (int) mpz_get_ui (result->ts.u.cl->length->value.integer);
+ (gfc_charlen_t) mpz_get_ui (result->ts.u.cl->length->value.integer);
gcc_assert (buffer_size >= size_character (result->value.character.length,
result->ts.kind));
@@ -450,7 +448,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 (i = 0; i < result->value.character.length; i++)
+ for (gfc_charlen_t i = 0; i < result->value.character.length; i++)
result->value.character.string[i] = (gfc_char_t) buffer[i];
else
{
@@ -459,7 +457,7 @@ gfc_interpret_character (unsigned char *buffer, size_t buffer_size,
mpz_init (integer);
gcc_assert (bytes <= sizeof (unsigned long));
- for (i = 0; i < result->value.character.length; i++)
+ for (gfc_charlen_t 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/trans-array.c b/gcc/fortran/trans-array.c
index 0cd83f4..48d5a79 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -1909,8 +1909,7 @@ 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 (char_len, gfc_default_integer_kind);
- *len = convert (gfc_charlen_type_node, *len);
+ *len = gfc_conv_mpz_to_tree_type (char_len, gfc_charlen_type_node);
mpz_clear (char_len);
return;
diff --git a/gcc/fortran/trans-const.c b/gcc/fortran/trans-const.c
index 812dcc6..3438979 100644
--- a/gcc/fortran/trans-const.c
+++ b/gcc/fortran/trans-const.c
@@ -206,6 +206,18 @@ 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 14b0f79..072de47 100644
--- a/gcc/fortran/trans-const.h
+++ b/gcc/fortran/trans-const.h
@@ -20,6 +20,7 @@ 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-decl.c b/gcc/fortran/trans-decl.c
index 9d62d51..504407d 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -2333,7 +2333,7 @@ create_function_arglist (gfc_symbol * sym)
if (gfc_return_by_reference (sym))
{
- tree type = TREE_VALUE (typelist), length = NULL;
+ tree type = TREE_VALUE (typelist), length = NULL_TREE;
if (sym->ts.type == BT_CHARACTER)
{
@@ -2404,6 +2404,7 @@ create_function_arglist (gfc_symbol * sym)
if (sym->ts.type == BT_CHARACTER)
{
gfc_allocate_lang_decl (parm);
+ gcc_assert (length != NULL_TREE);
arglist = chainon (arglist, length);
typelist = TREE_CHAIN (typelist);
}
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 6ebdc8b..6708ee03 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)
- : integer_zero_node;
+ : build_zero_cst (gfc_charlen_type_node);
}
@@ -884,7 +884,8 @@ 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, 4,
+ e->ts.u.cl->length = gfc_get_constant_expr (BT_INTEGER,
+ gfc_charlen_int_kind,
&e->where);
mpz_set_ui (e->ts.u.cl->length->value.integer,
e->value.character.length);
@@ -902,7 +903,7 @@ gfc_conv_intrinsic_to_class (gfc_se *parmse, gfc_expr *e,
else
tmp = integer_zero_node;
- gfc_add_modify (&parmse->pre, ctree, tmp);
+ gfc_add_modify (&parmse->pre, ctree, fold_convert (TREE_TYPE (ctree), tmp));
}
else if (class_ts.type == BT_CLASS
&& class_ts.u.derived->components
@@ -1041,7 +1042,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 = integer_zero_node;
+ slen = build_zero_cst (size_type_node);
}
else
{
@@ -1088,7 +1089,7 @@ gfc_conv_class_to_class (gfc_se *parmse, gfc_expr *e, gfc_typespec class_ts,
tmp = slen;
}
else
- tmp = integer_zero_node;
+ tmp = build_zero_cst (size_type_node);
gfc_add_modify (&parmse->pre, ctree,
fold_convert (TREE_TYPE (ctree), tmp));
@@ -1227,7 +1228,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 = integer_zero_node;
+ from_len = build_zero_cst (size_type_node);
}
if (GFC_CLASS_TYPE_P (TREE_TYPE (to)))
@@ -1339,7 +1340,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,
- integer_zero_node);
+ build_zero_cst (TREE_TYPE (from_len)));
tmp = fold_build3_loc (input_location, COND_EXPR,
void_type_node, tmp, extcopy, stdcopy);
gfc_add_expr_to_block (&body, tmp);
@@ -1367,7 +1368,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,
- integer_zero_node);
+ build_zero_cst (TREE_TYPE (from_len)));
tmp = fold_build3_loc (input_location, COND_EXPR,
void_type_node, tmp, extcopy, stdcopy);
}
@@ -2195,7 +2196,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_int_cst (gfc_charlen_type_node, 0));
+ se.expr, build_zero_cst (TREE_TYPE (se.expr)));
gfc_add_block_to_block (pblock, &se.pre);
if (cl->backend_decl)
@@ -2267,7 +2268,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_int_cst (gfc_charlen_type_node, 1));
+ build_one_cst (TREE_TYPE (start.expr)));
fault = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
boolean_type_node, nonempty, fault);
if (name)
@@ -2303,7 +2304,7 @@ 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))
{
- int i_len;
+ long i_len;
i_len = mpz_get_si (length) + 1;
if (i_len < 0)
@@ -2315,7 +2316,8 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind,
else
{
tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_charlen_type_node,
- end.expr, start.expr);
+ fold_convert (gfc_charlen_type_node, end.expr),
+ fold_convert (gfc_charlen_type_node, 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,
@@ -3115,9 +3117,10 @@ 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, len,
+ gfc_charlen_type_node,
+ fold_convert (gfc_charlen_type_node, len),
build_int_cst (gfc_charlen_type_node, 1));
- tmp = build_range_type (gfc_array_index_type, gfc_index_zero_node, tmp);
+ tmp = build_range_type (gfc_charlen_type_node, gfc_index_zero_node, tmp);
if (TREE_CODE (TREE_TYPE (type)) == ARRAY_TYPE)
tmp = build_array_type (TREE_TYPE (TREE_TYPE (type)), tmp);
@@ -3180,7 +3183,9 @@ 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, rse.string_length);
+ lse.string_length,
+ fold_convert (TREE_TYPE (lse.string_length),
+ rse.string_length));
}
type = build_pointer_type (type);
@@ -5872,7 +5877,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_int_cst (gfc_charlen_type_node, 0));
+ build_zero_cst (TREE_TYPE (tmp)));
cl.backend_decl = tmp;
}
@@ -6450,33 +6455,19 @@ gfc_trans_string_copy (stmtblock_t * block, tree dlength, tree dest,
return;
}
+ /* The string copy algorithm below generates code like
+
+ if (dlen > 0) {
+ memmove (dest, src, min(dlen, slen));
+ if (slen < dlen)
+ memset(&dest[slen], ' ', dlen - slen);
+ }
+ */
+
/* Do nothing if the destination length is zero. */
cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, dlen,
build_int_cst (size_type_node, 0));
- /* The following code was previously in _gfortran_copy_string:
-
- // The two strings may overlap so we use memmove.
- void
- copy_string (GFC_INTEGER_4 destlen, char * dest,
- GFC_INTEGER_4 srclen, const char * src)
- {
- if (srclen >= destlen)
- {
- // This will truncate if too long.
- memmove (dest, src, destlen);
- }
- else
- {
- memmove (dest, src, srclen);
- // Pad with spaces.
- memset (&dest[srclen], ' ', destlen - srclen);
- }
- }
-
- We're now doing it here for better optimization, but the logic
- is the same. */
-
/* For non-default character kinds, we have to multiply the string
length by the base type size. */
chartype = gfc_get_char_type (dkind);
@@ -6499,17 +6490,19 @@ gfc_trans_string_copy (stmtblock_t * block, tree dlength, tree dest,
else
src = gfc_build_addr_expr (pvoid_type_node, src);
- /* Truncate string if source is too long. */
- cond2 = fold_build2_loc (input_location, GE_EXPR, boolean_type_node, slen,
- dlen);
+ /* First do the memmove. */
+ tmp2 = fold_build2_loc (input_location, MIN_EXPR, TREE_TYPE (dlen), dlen,
+ slen);
tmp2 = build_call_expr_loc (input_location,
builtin_decl_explicit (BUILT_IN_MEMMOVE),
- 3, dest, src, dlen);
+ 3, dest, src, tmp2);
+ stmtblock_t tmpblock2;
+ gfc_init_block (&tmpblock2);
+ gfc_add_expr_to_block (&tmpblock2, tmp2);
- /* Else copy and pad with spaces. */
- tmp3 = build_call_expr_loc (input_location,
- builtin_decl_explicit (BUILT_IN_MEMMOVE),
- 3, dest, src, slen);
+ /* If the destination is longer, fill the end with spaces. */
+ cond2 = fold_build2_loc (input_location, LT_EXPR, boolean_type_node, slen,
+ dlen);
/* Wstringop-overflow appears at -O3 even though this warning is not
explicitly available in fortran nor can it be switched off. If the
@@ -6525,13 +6518,14 @@ gfc_trans_string_copy (stmtblock_t * block, tree dlength, tree dest,
tmp4 = fill_with_spaces (tmp4, chartype, tmp);
gfc_init_block (&tempblock);
- gfc_add_expr_to_block (&tempblock, tmp3);
gfc_add_expr_to_block (&tempblock, tmp4);
tmp3 = gfc_finish_block (&tempblock);
/* The whole copy_string function is there. */
tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond2,
- tmp2, tmp3);
+ tmp3, build_empty_stmt (input_location));
+ gfc_add_expr_to_block (&tmpblock2, tmp);
+ tmp = gfc_finish_block (&tmpblock2);
tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond, tmp,
build_empty_stmt (input_location));
gfc_add_expr_to_block (block, tmp);
@@ -7212,7 +7206,8 @@ 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, size);
+ gfc_add_modify (block, lhs_cl_size,
+ fold_convert (TREE_TYPE (lhs_cl_size), size));
}
@@ -7451,7 +7446,8 @@ 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, se.string_length);
+ gfc_add_modify (&block, strlen,
+ fold_convert (TREE_TYPE (strlen), se.string_length));
tmp = gfc_build_memcpy_call (dest, se.expr, size);
gfc_add_expr_to_block (&block, tmp);
}
@@ -8117,7 +8113,7 @@ trans_class_vptr_len_assignment (stmtblock_t *block, gfc_expr * le,
from_len = gfc_evaluate_now (se.expr, block);
}
else
- from_len = integer_zero_node;
+ from_len = build_zero_cst (gfc_charlen_type_node);
}
gfc_add_modify (pre, to_len, fold_convert (TREE_TYPE (to_len),
from_len));
@@ -8246,7 +8242,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_int_cst (gfc_charlen_type_node, 0));
+ build_zero_cst (TREE_TYPE (lse.string_length)));
}
gfc_add_modify (&block, lse.expr,
@@ -9501,7 +9497,9 @@ 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, size);
+ lse.string_length,
+ fold_convert (TREE_TYPE (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),
@@ -9518,7 +9516,8 @@ alloc_scalar_allocatable_for_assignment (stmtblock_t *block,
/* Update the lhs character length. */
size = string_length;
- gfc_add_modify (block, lse.string_length, size);
+ gfc_add_modify (block, lse.string_length,
+ fold_convert (TREE_TYPE (lse.string_length), size));
}
}
@@ -9679,7 +9678,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,
- integer_zero_node);
+ build_zero_cst (TREE_TYPE (from_len)));
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 d7612f6..5461666 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -7491,10 +7491,12 @@ 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,
- integer_zero_node);
+ 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)));
if (scalar)
{
/* A pointer to a scalar. */
@@ -7784,11 +7786,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 (size_type_node, gfc_character_kinds[i].bit_size / 8);
+ size = build_int_cst (sizetype, gfc_character_kinds[i].bit_size / 8);
/* Get the arguments. */
gfc_conv_intrinsic_function_args (se, expr, args, 3);
- slen = fold_convert (size_type_node, gfc_evaluate_now (args[0], &se->pre));
+ slen = fold_convert (sizetype, gfc_evaluate_now (args[0], &se->pre));
src = args[1];
ncopies = gfc_evaluate_now (args[2], &se->pre);
ncopies_type = TREE_TYPE (ncopies);
@@ -7805,7 +7807,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,
- build_int_cst (size_type_node, 0));
+ size_zero_node);
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);
@@ -7815,17 +7817,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. */
- 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;
+ 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;
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,
- build_int_cst (size_type_node, 0));
+ size_zero_node);
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,
@@ -7842,8 +7844,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 (ncopies_type, "count");
- gfc_add_modify (&block, count, build_int_cst (ncopies_type, 0));
+ count = gfc_create_var (sizetype, "count");
+ gfc_add_modify (&block, count, size_zero_node);
exit_label = gfc_build_label_decl (NULL_TREE);
/* Start the loop body. */
@@ -7851,7 +7853,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,
- ncopies);
+ fold_convert (sizetype, 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,
@@ -7859,25 +7861,22 @@ 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, 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_build2_loc (input_location, MULT_EXPR, sizetype, slen,
+ count);
+ tmp = fold_build2_loc (input_location, MULT_EXPR, sizetype, tmp,
+ 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,
- fold_convert (size_type_node,
- size)));
+ size_type_node, slen, size));
gfc_add_expr_to_block (&body, tmp);
/* Increment count. */
- tmp = fold_build2_loc (input_location, PLUS_EXPR, ncopies_type,
- count, build_int_cst (TREE_TYPE (count), 1));
+ tmp = fold_build2_loc (input_location, PLUS_EXPR, sizetype,
+ count, size_one_node);
gfc_add_modify (&body, count, tmp);
/* Build the loop. */
diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c
index 5f9c191..993b65d 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_int4_type_node);
+ void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_charlen_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_int4_type_node);
+ void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_charlen_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 ccfaee6..07b18a6 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 = integer_minus_one_node;
+ len_tree = build_int_cst (gfc_charlen_type_node, -1);
}
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, len_tree);
+ gfc_add_modify (&se.pre, len, fold_convert (TREE_TYPE (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)
{
- int i;
+ gfc_charlen_t 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], integer_zero_node);
+ CONSTRUCTOR_APPEND_ELT (node, ss_string1_len[k], build_zero_cst (gfc_charlen_type_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], integer_zero_node);
+ CONSTRUCTOR_APPEND_ELT (node, ss_string2_len[k], build_zero_cst (gfc_charlen_type_node));
}
else
{
@@ -5640,7 +5640,7 @@ gfc_trans_allocate (gfc_code * code)
{
gfc_init_se (&se, NULL);
temp_var_needed = false;
- expr3_len = integer_zero_node;
+ expr3_len = build_zero_cst (gfc_charlen_type_node);
e3_is = E3_MOLD;
}
/* Prevent aliasing, i.e., se.expr may be already a
@@ -6036,7 +6036,8 @@ gfc_trans_allocate (gfc_code * code)
e.g., a string. */
memsz = fold_build2_loc (input_location, GT_EXPR,
boolean_type_node, expr3_len,
- integer_zero_node);
+ build_zero_cst
+ (TREE_TYPE (expr3_len)));
memsz = fold_build3_loc (input_location, COND_EXPR,
TREE_TYPE (expr3_esize),
memsz, tmp, expr3_esize);
@@ -6332,7 +6333,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, ((int) strlen (msg)));
+ slen = build_int_cst (gfc_charlen_type_node, strlen (msg));
dlen = gfc_get_expr_charlen (code->expr2);
slen = fold_build2_loc (input_location, MIN_EXPR,
TREE_TYPE (slen), dlen, slen);
@@ -6613,7 +6614,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, ((int) strlen (msg)));
+ slen = build_int_cst (gfc_charlen_type_node, 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 e8dafa0..8dbc9ce 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -118,6 +118,9 @@ 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;
@@ -961,9 +964,13 @@ gfc_init_types (void)
wi::mask (n, UNSIGNED,
TYPE_PRECISION (size_type_node)));
- /* ??? Shouldn't this be based on gfc_index_integer_kind or so? */
- gfc_charlen_int_kind = 4;
+ /* Character lengths are of type size_t, except signed. */
+ gfc_charlen_int_kind = get_int_kind_from_node (size_type_node);
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 e8e92bf..6328125 100644
--- a/gcc/fortran/trans-types.h
+++ b/gcc/fortran/trans-types.h
@@ -23,6 +23,8 @@ along with GCC; see the file COPYING3. If not see
#ifndef GFC_BACKEND_H
#define GFC_BACKEND_H
+#include "trans.h"
+
extern GTY(()) tree gfc_array_index_type;
extern GTY(()) tree gfc_array_range_type;
extern GTY(()) tree gfc_character1_type_node;
@@ -35,10 +37,9 @@ 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/gfortran.dg/dependency_49.f90 b/gcc/testsuite/gfortran.dg/dependency_49.f90
index 73d517e..43ee284 100644
--- a/gcc/testsuite/gfortran.dg/dependency_49.f90
+++ b/gcc/testsuite/gfortran.dg/dependency_49.f90
@@ -11,4 +11,4 @@ program main
a%x = a%x(2:3)
print *,a%x
end program main
-! { dg-final { scan-tree-dump-times "__var_1" 4 "original" } }
+! { dg-final { scan-tree-dump-times "__var_1" 3 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/repeat_4.f90 b/gcc/testsuite/gfortran.dg/repeat_4.f90
index e5b5acc..99e7aee 100644
--- a/gcc/testsuite/gfortran.dg/repeat_4.f90
+++ b/gcc/testsuite/gfortran.dg/repeat_4.f90
@@ -2,6 +2,7 @@
!
! { 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"
@@ -21,18 +22,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))
- 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))
+ 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)/2)
- print *, repeat(t1, huge(0)/2)
- print *, repeat(t2, huge(0)/2)
+ 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+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 " }
+ 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 " }
end program test
diff --git a/gcc/testsuite/gfortran.dg/repeat_7.f90 b/gcc/testsuite/gfortran.dg/repeat_7.f90
new file mode 100644
index 0000000..82f8dbf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/repeat_7.f90
@@ -0,0 +1,8 @@
+! { 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 c58a3a2..5ef0230 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 "iscan = _gfortran_string_scan \\(2," 1 "original" } }
-! { dg-final { scan-tree-dump-times "iverify = _gfortran_string_verify \\(2," 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_string_scan \\(2," 1 "original" } }
+! { dg-final { scan-tree-dump-times "_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 11dc5b7..6a6151e 100644
--- a/gcc/testsuite/gfortran.dg/string_1.f90
+++ b/gcc/testsuite/gfortran.dg/string_1.f90
@@ -1,4 +1,5 @@
! { 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
new file mode 100644
index 0000000..a0edbef
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/string_1_lp64.f90
@@ -0,0 +1,15 @@
+! { 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 7daf8d3..4a88b06 100644
--- a/gcc/testsuite/gfortran.dg/string_3.f90
+++ b/gcc/testsuite/gfortran.dg/string_3.f90
@@ -1,4 +1,5 @@
! { 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
new file mode 100644
index 0000000..162561f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/string_3_lp64.f90
@@ -0,0 +1,20 @@
+! { 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/gcc/testsuite/gfortran.dg/transfer_intrinsic_1.f90 b/gcc/testsuite/gfortran.dg/transfer_intrinsic_1.f90
index 5f46cd0..73a7e77 100644
--- a/gcc/testsuite/gfortran.dg/transfer_intrinsic_1.f90
+++ b/gcc/testsuite/gfortran.dg/transfer_intrinsic_1.f90
@@ -14,4 +14,4 @@ subroutine BytesToString(bytes, string)
character(len=*) :: string
string = transfer(bytes, string)
end subroutine
-! { dg-final { scan-tree-dump-times "MIN_EXPR" 1 "original" } }
+! { dg-final { scan-tree-dump-times "MIN_EXPR" 2 "original" } }
diff --git a/libgfortran/intrinsics/args.c b/libgfortran/intrinsics/args.c
index 517ebc9..0a5923e 100644
--- a/libgfortran/intrinsics/args.c
+++ b/libgfortran/intrinsics/args.c
@@ -37,7 +37,6 @@ void
getarg_i4 (GFC_INTEGER_4 *pos, char *val, gfc_charlen_type val_len)
{
int argc;
- int arglen;
char **argv;
get_args (&argc, &argv);
@@ -49,7 +48,7 @@ getarg_i4 (GFC_INTEGER_4 *pos, char *val, gfc_charlen_type val_len)
if ((*pos) + 1 <= argc && *pos >=0 )
{
- arglen = strlen (argv[*pos]);
+ gfc_charlen_type arglen = strlen (argv[*pos]);
if (arglen > val_len)
arglen = val_len;
memcpy (val, argv[*pos], arglen);
@@ -119,7 +118,8 @@ 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, arglen = 0, stat_flag = GFC_GC_SUCCESS;
+ int argc, stat_flag = GFC_GC_SUCCESS;
+ gfc_charlen_type arglen = 0;
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, arglen, thisarg;
+ int i, argc, 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 503d337..8b2209c 100644
--- a/libgfortran/intrinsics/chmod.c
+++ b/libgfortran/intrinsics/chmod.c
@@ -64,7 +64,6 @@ 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;
@@ -104,7 +103,7 @@ chmod_internal (char *file, char *mode, gfc_charlen_type mode_len)
honor_umask = false;
#endif
- for (i = 0; i < mode_len; i++)
+ for (gfc_charlen_type i = 0; i < mode_len; i++)
{
if (!continue_clause)
{
diff --git a/libgfortran/intrinsics/env.c b/libgfortran/intrinsics/env.c
index 5eb01e1..512b03f 100644
--- a/libgfortran/intrinsics/env.c
+++ b/libgfortran/intrinsics/env.c
@@ -93,7 +93,8 @@ 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, res_len = 0;
+ int stat = GFC_SUCCESS;
+ gfc_charlen_type 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 17af28d..cbfdeb2 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;
- GFC_INTEGER_4 size;
+ size_t size;
struct vtype *extends;
}
vtype;
diff --git a/libgfortran/intrinsics/gerror.c b/libgfortran/intrinsics/gerror.c
index d3b28da..ff05737 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)
{
- int p_len;
+ gfc_charlen_type p_len;
char *p;
p = gf_strerror (errno, msg, msg_len);
diff --git a/libgfortran/intrinsics/getlog.c b/libgfortran/intrinsics/getlog.c
index 024f4da..211641f 100644
--- a/libgfortran/intrinsics/getlog.c
+++ b/libgfortran/intrinsics/getlog.c
@@ -70,7 +70,6 @@ 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. */
@@ -107,7 +106,7 @@ PREFIX(getlog) (char * login, gfc_charlen_type login_len)
if (p == NULL)
goto cleanup;
- p_len = strlen (p);
+ gfc_charlen_type 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 221852b..aff4d26 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,8 +99,7 @@ hostnm_0 (char *name, gfc_charlen_type name_len)
if (val == 0)
{
- i = -1;
- while (i < name_len && p[++i] != '\0')
+ for (gfc_charlen_type i = 0; i < name_len && p[i] != '\0'; i++)
name[i] = p[i];
}
diff --git a/libgfortran/intrinsics/string_intrinsics_inc.c b/libgfortran/intrinsics/string_intrinsics_inc.c
index aa132ce..4131377 100644
--- a/libgfortran/intrinsics/string_intrinsics_inc.c
+++ b/libgfortran/intrinsics/string_intrinsics_inc.c
@@ -224,14 +224,15 @@ 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 (i >= 0 && s[i] == ' ')
- --i;
+ while (s[i] == ' ')
+ {
+ if (i == 0)
+ return 0;
+ --i;
+ }
return i + 1;
}
@@ -327,12 +328,12 @@ string_scan (gfc_charlen_type slen, const CHARTYPE *str,
if (back)
{
- for (i = slen - 1; i >= 0; i--)
+ for (i = slen; i != 0; i--)
{
for (j = 0; j < setlen; j++)
{
- if (str[i] == set[j])
- return (i + 1);
+ if (str[i - 1] == set[j])
+ return i;
}
}
}
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index be8c8a6..0b9636e 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 *, int);
+extern void transfer_character (st_parameter_dt *, void *, gfc_charlen_type);
export_proto(transfer_character);
-extern void transfer_character_write (st_parameter_dt *, void *, int);
+extern void transfer_character_write (st_parameter_dt *, void *, gfc_charlen_type);
export_proto(transfer_character_write);
-extern void transfer_character_wide (st_parameter_dt *, void *, int, int);
+extern void transfer_character_wide (st_parameter_dt *, void *, gfc_charlen_type, int);
export_proto(transfer_character_wide);
extern void transfer_character_wide_write (st_parameter_dt *,
- void *, int, int);
+ void *, gfc_charlen_type, 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, int len)
+transfer_character (st_parameter_dt *dtp, void *p, gfc_charlen_type len)
{
static char *empty_string[0];
@@ -2290,13 +2290,13 @@ transfer_character (st_parameter_dt *dtp, void *p, int len)
}
void
-transfer_character_write (st_parameter_dt *dtp, void *p, int len)
+transfer_character_write (st_parameter_dt *dtp, void *p, gfc_charlen_type len)
{
transfer_character (dtp, p, len);
}
void
-transfer_character_wide (st_parameter_dt *dtp, void *p, int len, int kind)
+transfer_character_wide (st_parameter_dt *dtp, void *p, gfc_charlen_type len, int kind)
{
static char *empty_string[0];
@@ -2314,7 +2314,7 @@ transfer_character_wide (st_parameter_dt *dtp, void *p, int len, int kind)
}
void
-transfer_character_wide_write (st_parameter_dt *dtp, void *p, int len, int kind)
+transfer_character_wide_write (st_parameter_dt *dtp, void *p, gfc_charlen_type 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 ? charlen : GFC_DESCRIPTOR_SIZE (desc);
+ size = iotype == BT_CHARACTER ? (index_type) 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 b0ba310..213f9e3 100644
--- a/libgfortran/io/unit.c
+++ b/libgfortran/io/unit.c
@@ -439,10 +439,9 @@ 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 (i = 0; i < dtp->format_len; i++)
+ for (gfc_charlen_type 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 340f767..60d36d6 100644
--- a/libgfortran/io/write.c
+++ b/libgfortran/io/write.c
@@ -2380,7 +2380,6 @@ 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;
@@ -2402,7 +2401,7 @@ namelist_write (st_parameter_dt *dtp)
write_character (dtp, "&", 1, 1, NODELIM);
/* Write namelist name in upper case - f95 std. */
- for (i = 0 ;i < dtp->namelist_name_len ;i++ )
+ for (gfc_charlen_type 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 9bf8dcd..201d07a 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 GFC_INTEGER_4 gfc_charlen_type;
+typedef size_t gfc_charlen_type;
/* Definitions of CHARACTER data types:
- CHARACTER(KIND=1) corresponds to the C char type,
--
2.7.4
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2016-12-21 13:36 ` Andre Vehreschild
@ 2016-12-23 9:57 ` Janne Blomqvist
2016-12-27 10:56 ` Andre Vehreschild
0 siblings, 1 reply; 76+ messages in thread
From: Janne Blomqvist @ 2016-12-23 9:57 UTC (permalink / raw)
To: Andre Vehreschild; +Cc: Jakub Jelinek, Fortran List, GCC Patches
[-- Attachment #1: Type: text/plain, Size: 2313 bytes --]
On Wed, Dec 21, 2016 at 3:14 PM, Andre Vehreschild <vehre@gmx.de> wrote:
>> Now when I think about this some more, I have a vague recollection
>> that a long time ago it used to be something like that. The problem
>> is that MIN_EXPR<CONSTANT, NON-CONSTANT> will of course be
>> NON-CONSTANT, so the memcpy call can't be inlined. Hence it was
>> changed to two separate __builtin_memmove() calls to have better
>> opportunity to inline. So probably a no-go to change it back. :(
>
> I don't get that. From the former only one of the memmove's could have been
> inlined assuming that only CONSTANT sizes are inlined.
Yes. Which is better than not being able to inline, assuming the
inlined branch is more likely to be taken, no?
> The other one had a
> NON-CONSTANT as long as pointer following and constant propagation was not
> effective together. In our case the "NON-CONSTANT branch" would have been used,
> which is resolved by constant propagation (of the size of constant memory p
> points to). I assume the warning is triggered, because dead-code elimination
> has not removed the else part.
Probably yes, in this case. My performance worries were more about the
general case. But perhaps they are unfounded, IDK really. Does anybody
have a battery of string operation benchmarks that mirrors how real
Fortran code does string handling?
Anyway, the attached patch accomplishes that. It turns the tree dump I
showed two days ago into something like
{
integer(kind=8) D.3484;
unsigned long D.3485;
D.3484 = *_p;
D.3485 = (unsigned long) D.3484 + 18446744073709551608;
if (D.3484 != 0)
{
__builtin_memmove ((void *) *p, (void *) &"12345679"[1]{lb: 1
sz: 1}, MIN_EXPR <(unsigned long) D.3484, 8>);
if ((unsigned long) D.3484 > 8)
{
__builtin_memset ((void *) *p + 8, 32, D.3485);
}
}
}
and gets rid of the -Wstringop-overflow warning. (It causes a two new
testsuite failures (gfortran.dg/dependency_49.f90 and
gfortran.dg/transfer_intrinsic_1.f90), but those are just tests that
grep for patterns in the .original dump and need to be adjusted).
If that is Ok, do you prefer it as part of the charlen-size_t patch,
or would you (GFortran maintainers in general) prefer that it's a
separate patch?
--
Janne Blomqvist
[-- Attachment #2: stringcopy.diff --]
[-- Type: text/plain, Size: 3445 bytes --]
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 3767a28..6708ee03 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -6455,33 +6455,19 @@ gfc_trans_string_copy (stmtblock_t * block, tree dlength, tree dest,
return;
}
+ /* The string copy algorithm below generates code like
+
+ if (dlen > 0) {
+ memmove (dest, src, min(dlen, slen));
+ if (slen < dlen)
+ memset(&dest[slen], ' ', dlen - slen);
+ }
+ */
+
/* Do nothing if the destination length is zero. */
cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, dlen,
build_int_cst (size_type_node, 0));
- /* The following code was previously in _gfortran_copy_string:
-
- // The two strings may overlap so we use memmove.
- void
- copy_string (GFC_INTEGER_4 destlen, char * dest,
- GFC_INTEGER_4 srclen, const char * src)
- {
- if (srclen >= destlen)
- {
- // This will truncate if too long.
- memmove (dest, src, destlen);
- }
- else
- {
- memmove (dest, src, srclen);
- // Pad with spaces.
- memset (&dest[srclen], ' ', destlen - srclen);
- }
- }
-
- We're now doing it here for better optimization, but the logic
- is the same. */
-
/* For non-default character kinds, we have to multiply the string
length by the base type size. */
chartype = gfc_get_char_type (dkind);
@@ -6504,17 +6490,19 @@ gfc_trans_string_copy (stmtblock_t * block, tree dlength, tree dest,
else
src = gfc_build_addr_expr (pvoid_type_node, src);
- /* Truncate string if source is too long. */
- cond2 = fold_build2_loc (input_location, GE_EXPR, boolean_type_node, slen,
- dlen);
+ /* First do the memmove. */
+ tmp2 = fold_build2_loc (input_location, MIN_EXPR, TREE_TYPE (dlen), dlen,
+ slen);
tmp2 = build_call_expr_loc (input_location,
builtin_decl_explicit (BUILT_IN_MEMMOVE),
- 3, dest, src, dlen);
+ 3, dest, src, tmp2);
+ stmtblock_t tmpblock2;
+ gfc_init_block (&tmpblock2);
+ gfc_add_expr_to_block (&tmpblock2, tmp2);
- /* Else copy and pad with spaces. */
- tmp3 = build_call_expr_loc (input_location,
- builtin_decl_explicit (BUILT_IN_MEMMOVE),
- 3, dest, src, slen);
+ /* If the destination is longer, fill the end with spaces. */
+ cond2 = fold_build2_loc (input_location, LT_EXPR, boolean_type_node, slen,
+ dlen);
/* Wstringop-overflow appears at -O3 even though this warning is not
explicitly available in fortran nor can it be switched off. If the
@@ -6530,13 +6518,14 @@ gfc_trans_string_copy (stmtblock_t * block, tree dlength, tree dest,
tmp4 = fill_with_spaces (tmp4, chartype, tmp);
gfc_init_block (&tempblock);
- gfc_add_expr_to_block (&tempblock, tmp3);
gfc_add_expr_to_block (&tempblock, tmp4);
tmp3 = gfc_finish_block (&tempblock);
/* The whole copy_string function is there. */
tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond2,
- tmp2, tmp3);
+ tmp3, build_empty_stmt (input_location));
+ gfc_add_expr_to_block (&tmpblock2, tmp);
+ tmp = gfc_finish_block (&tmpblock2);
tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond, tmp,
build_empty_stmt (input_location));
gfc_add_expr_to_block (block, tmp);
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2016-12-21 12:58 ` Janne Blomqvist
@ 2016-12-21 13:36 ` Andre Vehreschild
2016-12-23 9:57 ` Janne Blomqvist
0 siblings, 1 reply; 76+ messages in thread
From: Andre Vehreschild @ 2016-12-21 13:36 UTC (permalink / raw)
To: Janne Blomqvist; +Cc: Jakub Jelinek, Fortran List, GCC Patches
> Now when I think about this some more, I have a vague recollection
> that a long time ago it used to be something like that. The problem
> is that MIN_EXPR<CONSTANT, NON-CONSTANT> will of course be
> NON-CONSTANT, so the memcpy call can't be inlined. Hence it was
> changed to two separate __builtin_memmove() calls to have better
> opportunity to inline. So probably a no-go to change it back. :(
I don't get that. From the former only one of the memmove's could have been
inlined assuming that only CONSTANT sizes are inlined. The other one had a
NON-CONSTANT as long as pointer following and constant propagation was not
effective together. In our case the "NON-CONSTANT branch" would have been used,
which is resolved by constant propagation (of the size of constant memory p
points to). I assume the warning is triggered, because dead-code elimination
has not removed the else part.
Following this thought the MIN_EXPR would be propagated to 5 and the inliner
can do its magic. Albeit it may be that now some other optimization level will
trigger a warning, because some part has not been removed/constant replaced.
What do you think of that?
--
Andre Vehreschild * Email: vehre ad gmx dot de
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2016-12-21 12:06 ` Andre Vehreschild
@ 2016-12-21 12:58 ` Janne Blomqvist
2016-12-21 13:36 ` Andre Vehreschild
0 siblings, 1 reply; 76+ messages in thread
From: Janne Blomqvist @ 2016-12-21 12:58 UTC (permalink / raw)
To: Andre Vehreschild; +Cc: Jakub Jelinek, Fortran List, GCC Patches
On Wed, Dec 21, 2016 at 1:50 PM, Andre Vehreschild <vehre@gmx.de> wrote:
>> Here p is the character variable, and _p is the charlen. My guess is
>> that the problem is that with -O1 it sees that the second memmove
>> would overflow p, but it doesn't realize that branch is never taken.
>> Cranking up the optimization level to -O2 and beyond makes it realize
>> it, and thus the warning disappears.
>>
>> Perhaps one could rewrite that to something like
>>
>> __builtin_memmove ((void *) *p, (void *) &"12345679"[1]{lb: 1 sz: 1},
>> MIN_EXPR<(unsigned long) D.3598,8>);
>> if ((unsigned long) D.3598 > 8)
>> {
>> __builtin_memset ((void*) *p + 8, 32, D.3599);
>> }
>
> That looks interesting. It assumes though, that D.3598 will *never* be
> negative. Because when it is negative 8 characters (cast to unsigned makes the
> negative number huge) will be copied, while in the former code memmove will
> reject the coping of a negative number of bytes. Therefore I propose to omit
> the cast in the MIN_EXPR and make the constant 8 signed, too. That should
> comply and mimick the former behavior more closely. What do you think? Who's
> going to try?
Now when I think about this some more, I have a vague recollection
that a long time ago it used to be something like that. The problem
is that MIN_EXPR<CONSTANT, NON-CONSTANT> will of course be
NON-CONSTANT, so the memcpy call can't be inlined. Hence it was
changed to two separate __builtin_memmove() calls to have better
opportunity to inline. So probably a no-go to change it back. :(
--
Janne Blomqvist
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2016-12-21 11:18 ` Janne Blomqvist
@ 2016-12-21 12:06 ` Andre Vehreschild
2016-12-21 12:58 ` Janne Blomqvist
0 siblings, 1 reply; 76+ messages in thread
From: Andre Vehreschild @ 2016-12-21 12:06 UTC (permalink / raw)
To: Janne Blomqvist; +Cc: Jakub Jelinek, Fortran List, GCC Patches
> Here p is the character variable, and _p is the charlen. My guess is
> that the problem is that with -O1 it sees that the second memmove
> would overflow p, but it doesn't realize that branch is never taken.
> Cranking up the optimization level to -O2 and beyond makes it realize
> it, and thus the warning disappears.
>
> Perhaps one could rewrite that to something like
>
> __builtin_memmove ((void *) *p, (void *) &"12345679"[1]{lb: 1 sz: 1},
> MIN_EXPR<(unsigned long) D.3598,8>);
> if ((unsigned long) D.3598 > 8)
> {
> __builtin_memset ((void*) *p + 8, 32, D.3599);
> }
That looks interesting. It assumes though, that D.3598 will *never* be
negative. Because when it is negative 8 characters (cast to unsigned makes the
negative number huge) will be copied, while in the former code memmove will
reject the coping of a negative number of bytes. Therefore I propose to omit
the cast in the MIN_EXPR and make the constant 8 signed, too. That should
comply and mimick the former behavior more closely. What do you think? Who's
going to try?
--
Andre Vehreschild * Email: vehre ad gmx dot de
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2016-12-21 10:40 ` Andre Vehreschild
@ 2016-12-21 11:18 ` Janne Blomqvist
2016-12-21 12:06 ` Andre Vehreschild
0 siblings, 1 reply; 76+ messages in thread
From: Janne Blomqvist @ 2016-12-21 11:18 UTC (permalink / raw)
To: Andre Vehreschild; +Cc: Jakub Jelinek, Fortran List, GCC Patches
On Wed, Dec 21, 2016 at 12:33 PM, Andre Vehreschild <vehre@gmx.de> wrote:
> Hi Janne,
>
>> But yes, I'm still seeing the warning messages with -O1 for
>> allocate_deferred_char_scalar_1.f03. AFAICT it's a bogus warning, but
>> I don't know how to get rid of it..
>
> No, that warning isn't at all bogus. The warning in fact is astonishingly
> precise. When I remember correctly, then the warning complains about trying to
> put a string of length 8 into memory of length 5. There is never a memory
> access error at runtime, because the code generated ensures that only 5 chars
> are copied, but I am impressed by the analysis done by some intermediate step
> of gcc. It figures, that memory is available for 5 characters only derefing a
> "static/constant" pointer and then learning that initially 8 chars are to be
> copied. I already tried to fix this by only generating code to copy the 5
> characters and make this knowledge available to the gimplifier, but I failed to
> deref the pointer and get the information statically. So IMHO the warning is
> not bogus. It is absolutely correct and it is quite sophisticated to learn all
> the necessary facts, but I didn't find a way to get this done in the front-end.
> We might be able to prevent the warning when there is a chance to add some hook
> into the middle stages of the compiler, telling it, that everything is fine.
> But I have no idea what is possible and available there.
I suspect it's complaining about (from the -fdump-tree-original):
{
integer(kind=8) D.3598;
unsigned long D.3599;
D.3598 = *_p;
D.3599 = (unsigned long) D.3598 + 18446744073709551608;
if (D.3598 != 0)
{
if ((unsigned long) D.3598 <= 8)
{
__builtin_memmove ((void *) *p, (void *)
&"12345679"[1]{lb: 1 sz: 1}, (unsigned long) D.3598);
}
else
{
__builtin_memmove ((void *) *p, (void *)
&"12345679"[1]{lb: 1 sz: 1}, 8);
__builtin_memset ((void *) *p + 8, 32, D.3599);
}
}
}
Here p is the character variable, and _p is the charlen. My guess is
that the problem is that with -O1 it sees that the second memmove
would overflow p, but it doesn't realize that branch is never taken.
Cranking up the optimization level to -O2 and beyond makes it realize
it, and thus the warning disappears.
Perhaps one could rewrite that to something like
__builtin_memmove ((void *) *p, (void *) &"12345679"[1]{lb: 1 sz: 1},
MIN_EXPR<(unsigned long) D.3598,8>);
if ((unsigned long) D.3598 > 8)
{
__builtin_memset ((void*) *p + 8, 32, D.3599);
}
?
--
Janne Blomqvist
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2016-12-21 10:28 ` Janne Blomqvist
@ 2016-12-21 10:40 ` Andre Vehreschild
2016-12-21 11:18 ` Janne Blomqvist
0 siblings, 1 reply; 76+ messages in thread
From: Andre Vehreschild @ 2016-12-21 10:40 UTC (permalink / raw)
To: Janne Blomqvist; +Cc: Jakub Jelinek, Fortran List, GCC Patches
Hi Janne,
> But yes, I'm still seeing the warning messages with -O1 for
> allocate_deferred_char_scalar_1.f03. AFAICT it's a bogus warning, but
> I don't know how to get rid of it..
No, that warning isn't at all bogus. The warning in fact is astonishingly
precise. When I remember correctly, then the warning complains about trying to
put a string of length 8 into memory of length 5. There is never a memory
access error at runtime, because the code generated ensures that only 5 chars
are copied, but I am impressed by the analysis done by some intermediate step
of gcc. It figures, that memory is available for 5 characters only derefing a
"static/constant" pointer and then learning that initially 8 chars are to be
copied. I already tried to fix this by only generating code to copy the 5
characters and make this knowledge available to the gimplifier, but I failed to
deref the pointer and get the information statically. So IMHO the warning is
not bogus. It is absolutely correct and it is quite sophisticated to learn all
the necessary facts, but I didn't find a way to get this done in the front-end.
We might be able to prevent the warning when there is a chance to add some hook
into the middle stages of the compiler, telling it, that everything is fine.
But I have no idea what is possible and available there.
Regards,
Andre
--
Andre Vehreschild * Email: vehre ad gmx dot de
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2016-12-21 10:06 ` Andre Vehreschild
@ 2016-12-21 10:28 ` Janne Blomqvist
2016-12-21 10:40 ` Andre Vehreschild
0 siblings, 1 reply; 76+ messages in thread
From: Janne Blomqvist @ 2016-12-21 10:28 UTC (permalink / raw)
To: Andre Vehreschild; +Cc: Jakub Jelinek, Fortran List, GCC Patches
On Wed, Dec 21, 2016 at 12:05 PM, Andre Vehreschild <vehre@gmx.de> wrote:
> Hi all,
>
> so I have learned that proposing to write "speaking code" is not very well
> taken.
If you want to make a patch introducing gfc_size_t_zero_node, go
ahead, at least I won't object. I don't think
build_zero_cst(size_type_node) is that terrible myself, but I don't
have any hard opinions on this.
> Anyway, there is a patch (in two parts) hanging about changing the character
> length from int to size_t. It looks ok to me, but I do not have the privilege
> to ok it. Furthermore am I still not convinced that we can't do anything about
> the failing testcase allocate_deferred_char_scalar_1. So how do we proceed?
I have just verified that my fix for PR 78867 fixes the -flto failures
Dominique noticed. I have some other minor cleanup to do to the
charlen->size_t patch, and then I'll resubmit it.
But yes, I'm still seeing the warning messages with -O1 for
allocate_deferred_char_scalar_1.f03. AFAICT it's a bogus warning, but
I don't know how to get rid of it..
--
Janne Blomqvist
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2016-12-20 16:25 ` Jakub Jelinek
@ 2016-12-21 10:06 ` Andre Vehreschild
2016-12-21 10:28 ` Janne Blomqvist
0 siblings, 1 reply; 76+ messages in thread
From: Andre Vehreschild @ 2016-12-21 10:06 UTC (permalink / raw)
To: Jakub Jelinek; +Cc: Janne Blomqvist, Fortran List, GCC Patches
Hi all,
so I have learned that proposing to write "speaking code" is not very well
taken.
Anyway, there is a patch (in two parts) hanging about changing the character
length from int to size_t. It looks ok to me, but I do not have the privilege
to ok it. Furthermore am I still not convinced that we can't do anything about
the failing testcase allocate_deferred_char_scalar_1. So how do we proceed?
- Andre
On Tue, 20 Dec 2016 17:08:54 +0100
Jakub Jelinek <jakub@redhat.com> wrote:
> On Tue, Dec 20, 2016 at 05:04:54PM +0100, Andre Vehreschild wrote:
> > Well, then how about:
> >
> > #define gfc_size_t_zero_node build_int_cst (size_type_node, 0)
> >
> > We can't get any faster and for new and old gfortran-hackers one
> > identifier's meaning is faster to grasp than two's.
>
> Such macros can cause various maintenance issues, so I'm not in favor of
> that. But if you as fortran maintainers want it, I won't object strongly.
>
> Jakub
--
Andre Vehreschild * Email: vehre ad gmx dot de
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2016-12-20 16:05 ` Andre Vehreschild
@ 2016-12-20 16:25 ` Jakub Jelinek
2016-12-21 10:06 ` Andre Vehreschild
0 siblings, 1 reply; 76+ messages in thread
From: Jakub Jelinek @ 2016-12-20 16:25 UTC (permalink / raw)
To: Andre Vehreschild; +Cc: Janne Blomqvist, Fortran List, GCC Patches
On Tue, Dec 20, 2016 at 05:04:54PM +0100, Andre Vehreschild wrote:
> Well, then how about:
>
> #define gfc_size_t_zero_node build_int_cst (size_type_node, 0)
>
> We can't get any faster and for new and old gfortran-hackers one identifier's
> meaning is faster to grasp than two's.
Such macros can cause various maintenance issues, so I'm not in favor of
that. But if you as fortran maintainers want it, I won't object strongly.
Jakub
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2016-12-20 15:50 ` Jakub Jelinek
@ 2016-12-20 16:05 ` Andre Vehreschild
2016-12-20 16:25 ` Jakub Jelinek
0 siblings, 1 reply; 76+ messages in thread
From: Andre Vehreschild @ 2016-12-20 16:05 UTC (permalink / raw)
To: Jakub Jelinek; +Cc: Janne Blomqvist, Fortran List, GCC Patches
On Tue, 20 Dec 2016 16:40:13 +0100
Jakub Jelinek <jakub@redhat.com> wrote:
> On Tue, Dec 20, 2016 at 04:29:07PM +0100, Andre Vehreschild wrote:
> > > The first one is GCC internal type for representing sizes, the latter is
> > > the C size_t (usually they have the same precision, they always have the
> > > same signedness (unsigned)).
> > > In the past sizetype actually has been a signed type with very special
> > > behavior.
> >
> > I am still wondering if it does not make sense to have something like
> > gfc_size_t_zero_node to prevent us from repeating build_zero_cst
> > (size_type_node) all the time. I had to use it 16 times, i.e., 16 times the
> > code for building a zero size type node is generated instead of a reference
> > to a "constant". And I don't want to know how often size_zero_node is used
> > in the wrong location.
>
> built_int_cst (size_type_node, 0) is actually faster than build_zero_cst,
> one fewer level of indirection.
> The 0 constant is cached in the type itself, so it actually in the end
> is basically just:
> return TREE_VEC_ELT (TYPE_CACHED_VALUES (type), 1);
>
> Adding a variable to hold gfc_size_t_zero_node would mean you'd need to add
> a GC root to hold it.
>
> Note, sizetype should be still what is usually used, only if you in the ABI
> have something declared as C size_t, then size_type_node should be used.
Well, then how about:
#define gfc_size_t_zero_node build_int_cst (size_type_node, 0)
We can't get any faster and for new and old gfortran-hackers one identifier's
meaning is faster to grasp than two's.
- Andre
--
Andre Vehreschild * Email: vehre ad gmx dot de
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2016-12-20 15:40 ` Andre Vehreschild
@ 2016-12-20 15:50 ` Jakub Jelinek
2016-12-20 16:05 ` Andre Vehreschild
0 siblings, 1 reply; 76+ messages in thread
From: Jakub Jelinek @ 2016-12-20 15:50 UTC (permalink / raw)
To: Andre Vehreschild; +Cc: Janne Blomqvist, Fortran List, GCC Patches
On Tue, Dec 20, 2016 at 04:29:07PM +0100, Andre Vehreschild wrote:
> > The first one is GCC internal type for representing sizes, the latter is
> > the C size_t (usually they have the same precision, they always have the
> > same signedness (unsigned)).
> > In the past sizetype actually has been a signed type with very special
> > behavior.
>
> I am still wondering if it does not make sense to have something like
> gfc_size_t_zero_node to prevent us from repeating build_zero_cst
> (size_type_node) all the time. I had to use it 16 times, i.e., 16 times the
> code for building a zero size type node is generated instead of a reference to
> a "constant". And I don't want to know how often size_zero_node is used in the
> wrong location.
built_int_cst (size_type_node, 0) is actually faster than build_zero_cst,
one fewer level of indirection.
The 0 constant is cached in the type itself, so it actually in the end
is basically just:
return TREE_VEC_ELT (TYPE_CACHED_VALUES (type), 1);
Adding a variable to hold gfc_size_t_zero_node would mean you'd need to add
a GC root to hold it.
Note, sizetype should be still what is usually used, only if you in the ABI
have something declared as C size_t, then size_type_node should be used.
Jakub
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2016-12-20 15:09 ` Jakub Jelinek
@ 2016-12-20 15:40 ` Andre Vehreschild
2016-12-20 15:50 ` Jakub Jelinek
0 siblings, 1 reply; 76+ messages in thread
From: Andre Vehreschild @ 2016-12-20 15:40 UTC (permalink / raw)
To: Jakub Jelinek; +Cc: Janne Blomqvist, Fortran List, GCC Patches
On Tue, 20 Dec 2016 16:00:19 +0100
Jakub Jelinek <jakub@redhat.com> wrote:
> On Tue, Dec 20, 2016 at 04:55:29PM +0200, Janne Blomqvist wrote:
> > On Tue, Dec 20, 2016 at 3:42 PM, Andre Vehreschild <vehre@gmx.de> wrote:
> > > Hi all,
> > >
> > >> I think you should use build_zero_cst(size_type_node) instead of
> > >> size_zero_node as size_zero_node is of type sizetype which is not the
> > >> same as size_type_node. Otherwise looks good.
> > >
> > > In the software design classes I took this was called a design error: Not
> > > choosing sufficiently different names for different artifacts. It was
> > > considered a beginner's error.
> >
> > Yeah, sizetype vs. size_type_node is confusing, to say the least..
>
> The first one is GCC internal type for representing sizes, the latter is
> the C size_t (usually they have the same precision, they always have the
> same signedness (unsigned)).
> In the past sizetype actually has been a signed type with very special
> behavior.
I am still wondering if it does not make sense to have something like
gfc_size_t_zero_node to prevent us from repeating build_zero_cst
(size_type_node) all the time. I had to use it 16 times, i.e., 16 times the
code for building a zero size type node is generated instead of a reference to
a "constant". And I don't want to know how often size_zero_node is used in the
wrong location.
- Andre
--
Andre Vehreschild * Email: vehre ad gmx dot de
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2016-12-20 14:56 ` Janne Blomqvist
@ 2016-12-20 15:09 ` Jakub Jelinek
2016-12-20 15:40 ` Andre Vehreschild
0 siblings, 1 reply; 76+ messages in thread
From: Jakub Jelinek @ 2016-12-20 15:09 UTC (permalink / raw)
To: Janne Blomqvist; +Cc: Andre Vehreschild, Fortran List, GCC Patches
On Tue, Dec 20, 2016 at 04:55:29PM +0200, Janne Blomqvist wrote:
> On Tue, Dec 20, 2016 at 3:42 PM, Andre Vehreschild <vehre@gmx.de> wrote:
> > Hi all,
> >
> >> I think you should use build_zero_cst(size_type_node) instead of
> >> size_zero_node as size_zero_node is of type sizetype which is not the
> >> same as size_type_node. Otherwise looks good.
> >
> > In the software design classes I took this was called a design error: Not
> > choosing sufficiently different names for different artifacts. It was
> > considered a beginner's error.
>
> Yeah, sizetype vs. size_type_node is confusing, to say the least..
The first one is GCC internal type for representing sizes, the latter is
the C size_t (usually they have the same precision, they always have the
same signedness (unsigned)).
In the past sizetype actually has been a signed type with very special
behavior.
Jakub
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2016-12-20 14:10 ` Andre Vehreschild
@ 2016-12-20 14:56 ` Janne Blomqvist
2016-12-20 15:09 ` Jakub Jelinek
0 siblings, 1 reply; 76+ messages in thread
From: Janne Blomqvist @ 2016-12-20 14:56 UTC (permalink / raw)
To: Andre Vehreschild; +Cc: Fortran List, GCC Patches
On Tue, Dec 20, 2016 at 3:42 PM, Andre Vehreschild <vehre@gmx.de> wrote:
> Hi all,
>
>> I think you should use build_zero_cst(size_type_node) instead of
>> size_zero_node as size_zero_node is of type sizetype which is not the
>> same as size_type_node. Otherwise looks good.
>
> In the software design classes I took this was called a design error: Not
> choosing sufficiently different names for different artifacts. It was
> considered a beginner's error.
Yeah, sizetype vs. size_type_node is confusing, to say the least..
> So now I have to repeat myself 16 times only to work around this b***. Nothing
> that will improve gfortran's maintainability.
>
> Second version of the changes needed for caf attached. Bootstrapped and
> regtested fine besides prior known
>
> FAIL: gfortran.dg/allocate_deferred_char_scalar_1.f03 -O1 (test for excess
> errors)
>
> on x86_64-linux/f23.
Ok, looks good.
--
Janne Blomqvist
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2016-12-16 18:02 ` Janne Blomqvist
@ 2016-12-20 14:10 ` Andre Vehreschild
2016-12-20 14:56 ` Janne Blomqvist
0 siblings, 1 reply; 76+ messages in thread
From: Andre Vehreschild @ 2016-12-20 14:10 UTC (permalink / raw)
To: Janne Blomqvist; +Cc: Fortran List, GCC Patches
[-- Attachment #1: Type: text/plain, Size: 774 bytes --]
Hi all,
> I think you should use build_zero_cst(size_type_node) instead of
> size_zero_node as size_zero_node is of type sizetype which is not the
> same as size_type_node. Otherwise looks good.
In the software design classes I took this was called a design error: Not
choosing sufficiently different names for different artifacts. It was
considered a beginner's error.
So now I have to repeat myself 16 times only to work around this b***. Nothing
that will improve gfortran's maintainability.
Second version of the changes needed for caf attached. Bootstrapped and
regtested fine besides prior known
FAIL: gfortran.dg/allocate_deferred_char_scalar_1.f03 -O1 (test for excess
errors)
on x86_64-linux/f23.
- Andre
--
Andre Vehreschild * Email: vehre ad gmx dot de
[-- Attachment #2: pr78534_caf_v2.clog --]
[-- Type: application/octet-stream, Size: 1191 bytes --]
gcc/fortran/ChangeLog:
2016-12-20 Andre Vehreschild <vehre@gcc.gnu.org>
* gfortran.texi: Changed string length to size_t and added missing
documenation of parameters.
* trans-array.c (gfc_alloc_allocatable_for_assignment): Adapted to
string length being of size_t.
* trans-decl.c (gfc_build_builtin_function_decls): Likewise.
(generate_coarray_sym_init): Likewise.
* trans-expr.c (gfc_trans_structure_assign): Likewise.
* trans-intrinsic.c (conv_co_collective): Likewise.
(conv_intrinsic_move_alloc): Likewise.
* trans-stmt.c (gfc_trans_stop): Likewise.
(gfc_trans_lock_unlock): Likewise.
(gfc_trans_event_post_wait): Likewise.
(gfc_trans_sync): Likewise.
(gfc_trans_critical): Likewise.
(gfc_trans_allocate): Likewise.
* trans.c (gfc_allocate_using_caf_lib): Likewise.
(gfc_deallocate_with_status): Likewise.
(gfc_deallocate_scalar_with_status): Likewise.
libgfortran/ChangeLog:
2016-12-20 Andre Vehreschild <vehre@gcc.gnu.org>
* caf/libcaf.h: Fixed prototypes to use size_t for string lengths.
* caf/single.c (_gfortran_caf_sync_images): Adapted string length
parameter to use size_t now.
(_gfortran_caf_lock): Likewise.
(_gfortran_caf_unlock): Likewise.
[-- Attachment #3: pr78534_caf_v2.patch --]
[-- Type: text/x-patch, Size: 35299 bytes --]
diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index 5b05a3d..1604bc8 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -4211,7 +4211,7 @@ size or one for a scalar.
@item @emph{Syntax}:
@code{void caf_register (size_t size, caf_register_t type, caf_token_t *token,
-gfc_descriptor_t *desc, int *stat, char *errmsg, int errmsg_len)}
+gfc_descriptor_t *desc, int *stat, char *errmsg, size_t errmsg_len)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@@ -4263,7 +4263,7 @@ library is only expected to free memory it allocated itself during a call to
@item @emph{Syntax}:
@code{void caf_deregister (caf_token_t *token, caf_deregister_t type,
-int *stat, char *errmsg, int errmsg_len)}
+int *stat, char *errmsg, size_t errmsg_len)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@@ -4322,7 +4322,8 @@ to a remote image identified by the image_index.
@item @emph{Syntax}:
@code{void _gfortran_caf_send (caf_token_t token, size_t offset,
int image_index, gfc_descriptor_t *dest, caf_vector_t *dst_vector,
-gfc_descriptor_t *src, int dst_kind, int src_kind, bool may_require_tmp)}
+gfc_descriptor_t *src, int dst_kind, int src_kind, bool may_require_tmp,
+int *stat)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@@ -4345,6 +4346,9 @@ time that the @var{dest} and @var{src} either cannot overlap or overlap (fully
or partially) such that walking @var{src} and @var{dest} in element wise
element order (honoring the stride value) will not lead to wrong results.
Otherwise, the value is true.
+@item @var{stat} @tab intent(out) when non-NULL give the result of the
+operation, i.e., zero on success and non-zero on error. When NULL and error
+occurs, then an error message is printed and the program is terminated.
@end multitable
@item @emph{NOTES}
@@ -4375,7 +4379,8 @@ image identified by the image_index.
@item @emph{Syntax}:
@code{void _gfortran_caf_get (caf_token_t token, size_t offset,
int image_index, gfc_descriptor_t *src, caf_vector_t *src_vector,
-gfc_descriptor_t *dest, int src_kind, int dst_kind, bool may_require_tmp)}
+gfc_descriptor_t *dest, int src_kind, int dst_kind, bool may_require_tmp,
+int *stat)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@@ -4398,6 +4403,9 @@ time that the @var{dest} and @var{src} either cannot overlap or overlap (fully
or partially) such that walking @var{src} and @var{dest} in element wise
element order (honoring the stride value) will not lead to wrong results.
Otherwise, the value is true.
+@item @var{stat} @tab intent(out) when non-NULL give the result of the
+operation, i.e., zero on success and non-zero on error. When NULL and error
+occurs, then an error message is printed and the program is terminated.
@end multitable
@item @emph{NOTES}
@@ -4430,7 +4438,7 @@ dst_image_index.
int dst_image_index, gfc_descriptor_t *dest, caf_vector_t *dst_vector,
caf_token_t src_token, size_t src_offset, int src_image_index,
gfc_descriptor_t *src, caf_vector_t *src_vector, int dst_kind, int src_kind,
-bool may_require_tmp)}
+bool may_require_tmp, int *stat)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@@ -4461,6 +4469,9 @@ time that the @var{dest} and @var{src} either cannot overlap or overlap (fully
or partially) such that walking @var{src} and @var{dest} in element wise
element order (honoring the stride value) will not lead to wrong results.
Otherwise, the value is true.
+@item @var{stat} @tab intent(out) when non-NULL give the result of the
+operation, i.e., zero on success and non-zero on error. When NULL and error
+occurs, then an error message is printed and the program is terminated.
@end multitable
@item @emph{NOTES}
@@ -4673,7 +4684,7 @@ been locked by the same image is an error.
@item @emph{Syntax}:
@code{void _gfortran_caf_lock (caf_token_t token, size_t index, int image_index,
-int *aquired_lock, int *stat, char *errmsg, int errmsg_len)}
+int *aquired_lock, int *stat, char *errmsg, size_t errmsg_len)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@@ -4708,7 +4719,7 @@ which is unlocked or has been locked by a different image is an error.
@item @emph{Syntax}:
@code{void _gfortran_caf_unlock (caf_token_t token, size_t index, int image_index,
-int *stat, char *errmsg, int errmsg_len)}
+int *stat, char *errmsg, size_t errmsg_len)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@@ -4740,7 +4751,7 @@ Increment the event count of the specified event variable.
@item @emph{Syntax}:
@code{void _gfortran_caf_event_post (caf_token_t token, size_t index,
-int image_index, int *stat, char *errmsg, int errmsg_len)}
+int image_index, int *stat, char *errmsg, size_t errmsg_len)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@@ -4777,7 +4788,7 @@ amount and return.
@item @emph{Syntax}:
@code{void _gfortran_caf_event_wait (caf_token_t token, size_t index,
-int until_count, int *stat, char *errmsg, int errmsg_len)}
+int until_count, int *stat, char *errmsg, size_t errmsg_len)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@@ -4880,7 +4891,7 @@ transfers of previous segment have completed.
@item @emph{Syntax}:
@code{void _gfortran_caf_sync_images (int count, int images[], int *stat,
-char *errmsg, int errmsg_len)}
+char *errmsg, size_t errmsg_len)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@@ -4908,7 +4919,8 @@ Acts as optimization barrier between different segments. It also ensures that
all pending memory operations of this image have been completed.
@item @emph{Syntax}:
-@code{void _gfortran_caf_sync_memory (int *stat, char *errmsg, int errmsg_len)}
+@code{void _gfortran_caf_sync_memory (int *stat, char *errmsg,
+size_t errmsg_len)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@@ -4955,7 +4967,7 @@ Invoked for an @code{ERROR STOP} statement which has a string as argument. The
function should terminate the program with a nonzero-exit code.
@item @emph{Syntax}:
-@code{void _gfortran_caf_error_stop (const char *string, int32_t len)}
+@code{void _gfortran_caf_error_stop (const char *string, size_t len)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@@ -5116,7 +5128,7 @@ be called collectively.
@item @emph{Syntax}:
@code{void _gfortran_caf_co_broadcast (gfc_descriptor_t *a,
-int source_image, int *stat, char *errmsg, int errmsg_len)}
+int source_image, int *stat, char *errmsg, size_t errmsg_len)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@@ -5147,7 +5159,7 @@ strings.
@item @emph{Syntax}:
@code{void _gfortran_caf_co_max (gfc_descriptor_t *a, int result_image,
-int *stat, char *errmsg, int a_len, int errmsg_len)}
+int *stat, char *errmsg, int a_len, size_t errmsg_len)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@@ -5183,7 +5195,7 @@ strings.
@item @emph{Syntax}:
@code{void _gfortran_caf_co_min (gfc_descriptor_t *a, int result_image,
-int *stat, char *errmsg, int a_len, int errmsg_len)}
+int *stat, char *errmsg, int a_len, size_t errmsg_len)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@@ -5218,7 +5230,7 @@ specified image. This function operates on numeric values.
@item @emph{Syntax}:
@code{void _gfortran_caf_co_sum (gfc_descriptor_t *a, int result_image,
-int *stat, char *errmsg, int errmsg_len)}
+int *stat, char *errmsg, size_t errmsg_len)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@@ -5262,7 +5274,7 @@ string lengths shall be specified as hidden argument;
@item @emph{Syntax}:
@code{void _gfortran_caf_co_reduce (gfc_descriptor_t *a,
void * (*opr) (void *, void *), int opr_flags, int result_image,
-int *stat, char *errmsg, int a_len, int errmsg_len)}
+int *stat, char *errmsg, int a_len, size_t errmsg_len)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 48d5a79..c559d0e 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -9369,7 +9369,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
build_int_cst (integer_type_node,
GFC_CAF_COARRAY_DEALLOCATE_ONLY),
null_pointer_node, null_pointer_node,
- integer_zero_node);
+ build_zero_cst (size_type_node));
gfc_add_expr_to_block (&realloc_block, tmp);
tmp = build_call_expr_loc (input_location,
gfor_fndecl_caf_register,
@@ -9378,7 +9378,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
GFC_CAF_COARRAY_ALLOC_ALLOCATE_ONLY),
token, gfc_build_addr_expr (NULL_TREE, desc),
null_pointer_node, null_pointer_node,
- integer_zero_node);
+ build_zero_cst (size_type_node));
gfc_add_expr_to_block (&realloc_block, tmp);
}
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 504407d..fe07038 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -3599,12 +3599,12 @@ gfc_build_builtin_function_decls (void)
gfor_fndecl_caf_register = gfc_build_library_function_decl_with_spec (
get_identifier (PREFIX("caf_register")), "RRWWWWR", void_type_node, 7,
size_type_node, integer_type_node, ppvoid_type_node, pvoid_type_node,
- pint_type, pchar_type_node, integer_type_node);
+ pint_type, pchar_type_node, size_type_node);
gfor_fndecl_caf_deregister = gfc_build_library_function_decl_with_spec (
get_identifier (PREFIX("caf_deregister")), "WRWWR", void_type_node, 5,
ppvoid_type_node, integer_type_node, pint_type, pchar_type_node,
- integer_type_node);
+ size_type_node);
gfor_fndecl_caf_get = gfc_build_library_function_decl_with_spec (
get_identifier (PREFIX("caf_get")), ".R.RRWRRRW", void_type_node, 10,
@@ -3646,17 +3646,17 @@ gfc_build_builtin_function_decls (void)
boolean_type_node, pint_type, pint_type);
gfor_fndecl_caf_sync_all = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_sync_all")), ".WW", void_type_node,
- 3, pint_type, pchar_type_node, integer_type_node);
+ get_identifier (PREFIX("caf_sync_all")), ".WR", void_type_node,
+ 3, pint_type, pchar_type_node, size_type_node);
gfor_fndecl_caf_sync_memory = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_sync_memory")), ".WW", void_type_node,
- 3, pint_type, pchar_type_node, integer_type_node);
+ get_identifier (PREFIX("caf_sync_memory")), ".WR", void_type_node,
+ 3, pint_type, pchar_type_node, size_type_node);
gfor_fndecl_caf_sync_images = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_sync_images")), ".RRWW", void_type_node,
+ get_identifier (PREFIX("caf_sync_images")), ".RRWR", void_type_node,
5, integer_type_node, pint_type, pint_type,
- pchar_type_node, integer_type_node);
+ pchar_type_node, size_type_node);
gfor_fndecl_caf_error_stop = gfc_build_library_function_decl (
get_identifier (PREFIX("caf_error_stop")),
@@ -3665,97 +3665,99 @@ gfc_build_builtin_function_decls (void)
TREE_THIS_VOLATILE (gfor_fndecl_caf_error_stop) = 1;
gfor_fndecl_caf_error_stop_str = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_error_stop_str")), ".R.",
- void_type_node, 2, pchar_type_node, gfc_int4_type_node);
+ get_identifier (PREFIX("caf_error_stop_str")), "RR",
+ void_type_node, 2, pchar_type_node, size_type_node);
/* CAF's ERROR STOP doesn't return. */
TREE_THIS_VOLATILE (gfor_fndecl_caf_error_stop_str) = 1;
gfor_fndecl_caf_stop_numeric = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_stop_numeric")), ".R.",
+ get_identifier (PREFIX("caf_stop_numeric")), "R",
void_type_node, 1, gfc_int4_type_node);
/* CAF's STOP doesn't return. */
TREE_THIS_VOLATILE (gfor_fndecl_caf_stop_numeric) = 1;
gfor_fndecl_caf_stop_str = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_stop_str")), ".R.",
- void_type_node, 2, pchar_type_node, gfc_int4_type_node);
+ get_identifier (PREFIX("caf_stop_str")), "RR",
+ void_type_node, 2, pchar_type_node, size_type_node);
/* CAF's STOP doesn't return. */
TREE_THIS_VOLATILE (gfor_fndecl_caf_stop_str) = 1;
gfor_fndecl_caf_atomic_def = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_atomic_define")), "R..RW",
+ get_identifier (PREFIX("caf_atomic_define")), "WRRRWRR",
void_type_node, 7, pvoid_type_node, size_type_node, integer_type_node,
pvoid_type_node, pint_type, integer_type_node, integer_type_node);
gfor_fndecl_caf_atomic_ref = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_atomic_ref")), "R..WW",
+ get_identifier (PREFIX("caf_atomic_ref")), "RRRWWRR",
void_type_node, 7, pvoid_type_node, size_type_node, integer_type_node,
pvoid_type_node, pint_type, integer_type_node, integer_type_node);
gfor_fndecl_caf_atomic_cas = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_atomic_cas")), "R..WRRW",
+ get_identifier (PREFIX("caf_atomic_cas")), "RRRWRRWRR",
void_type_node, 9, pvoid_type_node, size_type_node, integer_type_node,
pvoid_type_node, pvoid_type_node, pvoid_type_node, pint_type,
integer_type_node, integer_type_node);
gfor_fndecl_caf_atomic_op = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_atomic_op")), ".R..RWW",
+ get_identifier (PREFIX("caf_atomic_op")), "RRRRWRWRR",
void_type_node, 9, integer_type_node, pvoid_type_node, size_type_node,
integer_type_node, pvoid_type_node, pvoid_type_node, pint_type,
integer_type_node, integer_type_node);
gfor_fndecl_caf_lock = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_lock")), "R..WWW",
+ get_identifier (PREFIX("caf_lock")), "RRRWWWR",
void_type_node, 7, pvoid_type_node, size_type_node, integer_type_node,
- pint_type, pint_type, pchar_type_node, integer_type_node);
+ pint_type, pint_type, pchar_type_node, size_type_node);
gfor_fndecl_caf_unlock = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_unlock")), "R..WW",
+ get_identifier (PREFIX("caf_unlock")), "RRRWWR",
void_type_node, 6, pvoid_type_node, size_type_node, integer_type_node,
- pint_type, pchar_type_node, integer_type_node);
+ pint_type, pchar_type_node, size_type_node);
gfor_fndecl_caf_event_post = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_event_post")), "R..WW",
+ get_identifier (PREFIX("caf_event_post")), "RRRWWR",
void_type_node, 6, pvoid_type_node, size_type_node, integer_type_node,
- pint_type, pchar_type_node, integer_type_node);
+ pint_type, pchar_type_node, size_type_node);
gfor_fndecl_caf_event_wait = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_event_wait")), "R..WW",
+ get_identifier (PREFIX("caf_event_wait")), "RRRWWR",
void_type_node, 6, pvoid_type_node, size_type_node, integer_type_node,
- pint_type, pchar_type_node, integer_type_node);
+ pint_type, pchar_type_node, size_type_node);
gfor_fndecl_caf_event_query = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_event_query")), "R..WW",
+ get_identifier (PREFIX("caf_event_query")), "RRRWW",
void_type_node, 5, pvoid_type_node, size_type_node, integer_type_node,
pint_type, pint_type);
gfor_fndecl_co_broadcast = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_co_broadcast")), "W.WW",
+ get_identifier (PREFIX("caf_co_broadcast")), "WRWWR",
void_type_node, 5, pvoid_type_node, integer_type_node,
- pint_type, pchar_type_node, integer_type_node);
+ pint_type, pchar_type_node, size_type_node);
gfor_fndecl_co_max = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_co_max")), "W.WW",
+ get_identifier (PREFIX("caf_co_max")), "WRWWRR",
void_type_node, 6, pvoid_type_node, integer_type_node,
- pint_type, pchar_type_node, integer_type_node, integer_type_node);
+ pint_type, pchar_type_node, size_type_node,
+ size_type_node);
gfor_fndecl_co_min = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_co_min")), "W.WW",
+ get_identifier (PREFIX("caf_co_min")), "WRWWRR",
void_type_node, 6, pvoid_type_node, integer_type_node,
- pint_type, pchar_type_node, integer_type_node, integer_type_node);
+ pint_type, pchar_type_node, size_type_node,
+ size_type_node);
gfor_fndecl_co_reduce = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_co_reduce")), "W.R.WW",
+ get_identifier (PREFIX("caf_co_reduce")), "WRRRWWRR",
void_type_node, 8, pvoid_type_node,
build_pointer_type (build_varargs_function_type_list (void_type_node,
NULL_TREE)),
integer_type_node, integer_type_node, pint_type, pchar_type_node,
- integer_type_node, integer_type_node);
+ size_type_node, size_type_node);
gfor_fndecl_co_sum = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_co_sum")), "W.WW",
+ get_identifier (PREFIX("caf_co_sum")), "WRWWR",
void_type_node, 5, pvoid_type_node, integer_type_node,
- pint_type, pchar_type_node, integer_type_node);
+ pint_type, pchar_type_node, size_type_node);
gfor_fndecl_caf_is_present = gfc_build_library_function_decl_with_spec (
get_identifier (PREFIX("caf_is_present")), "RRR",
@@ -5134,7 +5136,7 @@ generate_coarray_sym_init (gfc_symbol *sym)
token, gfc_build_addr_expr (pvoid_type_node, desc),
null_pointer_node, /* stat. */
null_pointer_node, /* errgmsg. */
- integer_zero_node); /* errmsg_len. */
+ build_zero_cst (size_type_node));/* errmsg_len. */
gfc_add_expr_to_block (&caf_init_block, tmp);
gfc_add_modify (&caf_init_block, decl, fold_convert (TREE_TYPE (decl),
gfc_conv_descriptor_data_get (desc)));
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index fb08ea4..cbff9ae 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -7573,7 +7573,7 @@ gfc_trans_structure_assign (tree dest, gfc_expr * expr, bool init, bool coarray)
token),
gfc_build_addr_expr (NULL_TREE, desc),
null_pointer_node, null_pointer_node,
- integer_zero_node);
+ build_zero_cst (size_type_node));
gfc_add_expr_to_block (&block, tmp);
}
field = cm->backend_decl;
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 5461666..bd2b212 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -9605,12 +9605,12 @@ conv_co_collective (gfc_code *code)
gfc_add_block_to_block (&block, &argse.pre);
gfc_add_block_to_block (&post_block, &argse.post);
errmsg = argse.expr;
- errmsg_len = fold_convert (integer_type_node, argse.string_length);
+ errmsg_len = fold_convert (size_type_node, argse.string_length);
}
else
{
errmsg = null_pointer_node;
- errmsg_len = integer_zero_node;
+ errmsg_len = build_zero_cst (size_type_node);
}
/* Generate the function call. */
@@ -10493,7 +10493,7 @@ conv_intrinsic_move_alloc (gfc_code *code)
null_pointer_node));
tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_sync_all,
3, null_pointer_node, null_pointer_node,
- build_int_cst (integer_type_node, 0));
+ build_zero_cst (size_type_node));
tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
tmp, build_empty_stmt (input_location));
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 07b18a6..6741683 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -629,7 +629,6 @@ gfc_trans_stop (gfc_code *code, bool error_stop)
if (code->expr1 == NULL)
{
- tmp = build_int_cst (gfc_int4_type_node, 0);
tmp = build_call_expr_loc (input_location,
error_stop
? (flag_coarray == GFC_FCOARRAY_LIB
@@ -638,7 +637,8 @@ gfc_trans_stop (gfc_code *code, bool error_stop)
: (flag_coarray == GFC_FCOARRAY_LIB
? gfor_fndecl_caf_stop_str
: gfor_fndecl_stop_string),
- 2, build_int_cst (pchar_type_node, 0), tmp);
+ 2, null_pointer_node,
+ build_zero_cst (size_type_node));
}
else if (code->expr1->ts.type == BT_INTEGER)
{
@@ -787,12 +787,12 @@ gfc_trans_lock_unlock (gfc_code *code, gfc_exec_op op)
gfc_conv_expr (&argse, code->expr3);
gfc_add_block_to_block (&se.pre, &argse.pre);
errmsg = argse.expr;
- errmsg_len = fold_convert (integer_type_node, argse.string_length);
+ errmsg_len = fold_convert (size_type_node, argse.string_length);
}
else
{
errmsg = null_pointer_node;
- errmsg_len = integer_zero_node;
+ errmsg_len = build_zero_cst (size_type_node);
}
if (stat != null_pointer_node && TREE_TYPE (stat) != integer_type_node)
@@ -986,12 +986,12 @@ gfc_trans_event_post_wait (gfc_code *code, gfc_exec_op op)
gfc_conv_expr (&argse, code->expr3);
gfc_add_block_to_block (&se.pre, &argse.pre);
errmsg = argse.expr;
- errmsg_len = fold_convert (integer_type_node, argse.string_length);
+ errmsg_len = fold_convert (size_type_node, argse.string_length);
}
else
{
errmsg = null_pointer_node;
- errmsg_len = integer_zero_node;
+ errmsg_len = build_zero_cst (size_type_node);
}
if (stat != null_pointer_node && TREE_TYPE (stat) != integer_type_node)
@@ -1075,7 +1075,7 @@ gfc_trans_sync (gfc_code *code, gfc_exec_op type)
else if (flag_coarray == GFC_FCOARRAY_LIB)
{
errmsg = null_pointer_node;
- errmsglen = build_int_cst (integer_type_node, 0);
+ errmsglen = build_zero_cst (size_type_node);
}
/* Check SYNC IMAGES(imageset) for valid image index.
@@ -1436,7 +1436,8 @@ gfc_trans_critical (gfc_code *code)
tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_lock, 7,
token, integer_zero_node, integer_one_node,
null_pointer_node, null_pointer_node,
- null_pointer_node, integer_zero_node);
+ null_pointer_node,
+ build_zero_cst (size_type_node));
gfc_add_expr_to_block (&block, tmp);
/* It guarantees memory consistency within the same segment */
@@ -1459,7 +1460,7 @@ gfc_trans_critical (gfc_code *code)
tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_unlock, 6,
token, integer_zero_node, integer_one_node,
null_pointer_node, null_pointer_node,
- integer_zero_node);
+ build_zero_cst (size_type_node));
gfc_add_expr_to_block (&block, tmp);
/* It guarantees memory consistency within the same segment */
@@ -5540,7 +5541,7 @@ gfc_trans_allocate (gfc_code * code)
else
{
errmsg = null_pointer_node;
- errlen = build_int_cst (gfc_charlen_type_node, 0);
+ errlen = build_zero_cst (size_type_node);
}
/* GOTO destinations. */
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index e5dd986..4222d3a 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -728,8 +728,10 @@ gfc_allocate_using_caf_lib (stmtblock_t * block, tree pointer, tree size,
{
gcc_assert(errlen == NULL_TREE);
errmsg = null_pointer_node;
- errlen = build_int_cst (integer_type_node, 0);
+ errlen = build_zero_cst (size_type_node);
}
+ else
+ errlen = fold_convert (size_type_node, errlen);
size = fold_convert (size_type_node, size);
tmp = build_call_expr_loc (input_location,
@@ -1415,7 +1417,7 @@ gfc_deallocate_with_status (tree pointer, tree status, tree errmsg,
{
gcc_assert (errlen == NULL_TREE);
errmsg = null_pointer_node;
- errlen = build_zero_cst (integer_type_node);
+ errlen = build_zero_cst (size_type_node);
}
else
{
@@ -1597,7 +1599,8 @@ gfc_deallocate_scalar_with_status (tree pointer, tree status, tree label_finish,
gfor_fndecl_caf_deregister, 5,
token, build_int_cst (integer_type_node,
caf_dereg_type),
- pstat, null_pointer_node, integer_zero_node);
+ pstat, null_pointer_node,
+ build_zero_cst (size_type_node));
gfc_add_expr_to_block (&non_null, tmp);
/* It guarantees memory consistency within the same segment. */
diff --git a/libgfortran/caf/libcaf.h b/libgfortran/caf/libcaf.h
index 1bb5176..af45356 100644
--- a/libgfortran/caf/libcaf.h
+++ b/libgfortran/caf/libcaf.h
@@ -183,28 +183,31 @@ int _gfortran_caf_this_image (int);
int _gfortran_caf_num_images (int, int);
void _gfortran_caf_register (size_t, caf_register_t, caf_token_t *,
- gfc_descriptor_t *, int *, char *, int);
+ gfc_descriptor_t *, int *, char *, size_t);
void _gfortran_caf_deregister (caf_token_t *, caf_deregister_t, int *, char *,
- int);
+ size_t);
-void _gfortran_caf_sync_all (int *, char *, int);
-void _gfortran_caf_sync_memory (int *, char *, int);
-void _gfortran_caf_sync_images (int, int[], int *, char *, int);
+void _gfortran_caf_sync_all (int *, char *, size_t);
+void _gfortran_caf_sync_memory (int *, char *, size_t);
+void _gfortran_caf_sync_images (int, int[], int *, char *, size_t);
void _gfortran_caf_stop_numeric (int32_t)
__attribute__ ((noreturn));
-void _gfortran_caf_stop_str (const char *, int32_t)
+void _gfortran_caf_stop_str (const char *, size_t)
__attribute__ ((noreturn));
-void _gfortran_caf_error_stop_str (const char *, int32_t)
+void _gfortran_caf_error_stop_str (const char *, size_t)
__attribute__ ((noreturn));
void _gfortran_caf_error_stop (int32_t) __attribute__ ((noreturn));
-void _gfortran_caf_co_broadcast (gfc_descriptor_t *, int, int *, char *, int);
-void _gfortran_caf_co_sum (gfc_descriptor_t *, int, int *, char *, int);
-void _gfortran_caf_co_min (gfc_descriptor_t *, int, int *, char *, int, int);
-void _gfortran_caf_co_max (gfc_descriptor_t *, int, int *, char *, int, int);
+void _gfortran_caf_co_broadcast (gfc_descriptor_t *, int, int *, char *,
+ size_t);
+void _gfortran_caf_co_sum (gfc_descriptor_t *, int, int *, char *, size_t);
+void _gfortran_caf_co_min (gfc_descriptor_t *, int, int *, char *, size_t,
+ size_t);
+void _gfortran_caf_co_max (gfc_descriptor_t *, int, int *, char *, size_t,
+ size_t);
void _gfortran_caf_co_reduce (gfc_descriptor_t *, void* (*) (void *, void*),
- int, int, int *, char *, int, int);
+ int, int, int *, char *, size_t, size_t);
void _gfortran_caf_get (caf_token_t, size_t, int, gfc_descriptor_t *,
caf_vector_t *, gfc_descriptor_t *, int, int, bool,
@@ -237,10 +240,11 @@ void _gfortran_caf_atomic_cas (caf_token_t, size_t, int, void *, void *,
void _gfortran_caf_atomic_op (int, caf_token_t, size_t, int, void *, void *,
int *, int, int);
-void _gfortran_caf_lock (caf_token_t, size_t, int, int *, int *, char *, int);
-void _gfortran_caf_unlock (caf_token_t, size_t, int, int *, char *, int);
-void _gfortran_caf_event_post (caf_token_t, size_t, int, int *, char *, int);
-void _gfortran_caf_event_wait (caf_token_t, size_t, int, int *, char *, int);
+void _gfortran_caf_lock (caf_token_t, size_t, int, int *, int *, char *,
+ size_t);
+void _gfortran_caf_unlock (caf_token_t, size_t, int, int *, char *, size_t);
+void _gfortran_caf_event_post (caf_token_t, size_t, int, int *, char *, size_t);
+void _gfortran_caf_event_wait (caf_token_t, size_t, int, int *, char *, size_t);
void _gfortran_caf_event_query (caf_token_t, size_t, int, int *, int *);
int _gfortran_caf_is_present (caf_token_t, int, caf_reference_t *);
diff --git a/libgfortran/caf/single.c b/libgfortran/caf/single.c
index d1b3359..6d37965 100644
--- a/libgfortran/caf/single.c
+++ b/libgfortran/caf/single.c
@@ -134,7 +134,7 @@ _gfortran_caf_num_images (int distance __attribute__ ((unused)),
void
_gfortran_caf_register (size_t size, caf_register_t type, caf_token_t *token,
gfc_descriptor_t *data, int *stat, char *errmsg,
- int errmsg_len)
+ size_t errmsg_len)
{
const char alloc_fail_msg[] = "Failed to allocate coarray";
void *local;
@@ -192,7 +192,7 @@ _gfortran_caf_register (size_t size, caf_register_t type, caf_token_t *token,
void
_gfortran_caf_deregister (caf_token_t *token, caf_deregister_t type, int *stat,
char *errmsg __attribute__ ((unused)),
- int errmsg_len __attribute__ ((unused)))
+ size_t errmsg_len __attribute__ ((unused)))
{
caf_single_token_t single_token = TOKEN (*token);
@@ -218,7 +218,7 @@ _gfortran_caf_deregister (caf_token_t *token, caf_deregister_t type, int *stat,
void
_gfortran_caf_sync_all (int *stat,
char *errmsg __attribute__ ((unused)),
- int errmsg_len __attribute__ ((unused)))
+ size_t errmsg_len __attribute__ ((unused)))
{
__asm__ __volatile__ ("":::"memory");
if (stat)
@@ -229,7 +229,7 @@ _gfortran_caf_sync_all (int *stat,
void
_gfortran_caf_sync_memory (int *stat,
char *errmsg __attribute__ ((unused)),
- int errmsg_len __attribute__ ((unused)))
+ size_t errmsg_len __attribute__ ((unused)))
{
__asm__ __volatile__ ("":::"memory");
if (stat)
@@ -242,7 +242,7 @@ _gfortran_caf_sync_images (int count __attribute__ ((unused)),
int images[] __attribute__ ((unused)),
int *stat,
char *errmsg __attribute__ ((unused)),
- int errmsg_len __attribute__ ((unused)))
+ size_t errmsg_len __attribute__ ((unused)))
{
#ifdef GFC_CAF_CHECK
int i;
@@ -262,14 +262,14 @@ _gfortran_caf_sync_images (int count __attribute__ ((unused)),
}
void
-_gfortran_caf_stop_numeric(int32_t stop_code)
+_gfortran_caf_stop_numeric (int32_t stop_code)
{
fprintf (stderr, "STOP %d\n", stop_code);
exit (0);
}
void
-_gfortran_caf_stop_str(const char *string, int32_t len)
+_gfortran_caf_stop_str (const char *string, size_t len)
{
fputs ("STOP ", stderr);
while (len--)
@@ -280,7 +280,7 @@ _gfortran_caf_stop_str(const char *string, int32_t len)
}
void
-_gfortran_caf_error_stop_str (const char *string, int32_t len)
+_gfortran_caf_error_stop_str (const char *string, size_t len)
{
fputs ("ERROR STOP ", stderr);
while (len--)
@@ -303,7 +303,7 @@ void
_gfortran_caf_co_broadcast (gfc_descriptor_t *a __attribute__ ((unused)),
int source_image __attribute__ ((unused)),
int *stat, char *errmsg __attribute__ ((unused)),
- int errmsg_len __attribute__ ((unused)))
+ size_t errmsg_len __attribute__ ((unused)))
{
if (stat)
*stat = 0;
@@ -313,7 +313,7 @@ void
_gfortran_caf_co_sum (gfc_descriptor_t *a __attribute__ ((unused)),
int result_image __attribute__ ((unused)),
int *stat, char *errmsg __attribute__ ((unused)),
- int errmsg_len __attribute__ ((unused)))
+ size_t errmsg_len __attribute__ ((unused)))
{
if (stat)
*stat = 0;
@@ -323,8 +323,8 @@ void
_gfortran_caf_co_min (gfc_descriptor_t *a __attribute__ ((unused)),
int result_image __attribute__ ((unused)),
int *stat, char *errmsg __attribute__ ((unused)),
- int a_len __attribute__ ((unused)),
- int errmsg_len __attribute__ ((unused)))
+ size_t a_len __attribute__ ((unused)),
+ size_t errmsg_len __attribute__ ((unused)))
{
if (stat)
*stat = 0;
@@ -334,8 +334,8 @@ void
_gfortran_caf_co_max (gfc_descriptor_t *a __attribute__ ((unused)),
int result_image __attribute__ ((unused)),
int *stat, char *errmsg __attribute__ ((unused)),
- int a_len __attribute__ ((unused)),
- int errmsg_len __attribute__ ((unused)))
+ size_t a_len __attribute__ ((unused)),
+ size_t errmsg_len __attribute__ ((unused)))
{
if (stat)
*stat = 0;
@@ -344,13 +344,13 @@ _gfortran_caf_co_max (gfc_descriptor_t *a __attribute__ ((unused)),
void
_gfortran_caf_co_reduce (gfc_descriptor_t *a __attribute__ ((unused)),
- void * (*opr) (void *, void *)
- __attribute__ ((unused)),
- int opr_flags __attribute__ ((unused)),
- int result_image __attribute__ ((unused)),
- int *stat, char *errmsg __attribute__ ((unused)),
- int a_len __attribute__ ((unused)),
- int errmsg_len __attribute__ ((unused)))
+ void * (*opr) (void *, void *)
+ __attribute__ ((unused)),
+ int opr_flags __attribute__ ((unused)),
+ int result_image __attribute__ ((unused)),
+ int *stat, char *errmsg __attribute__ ((unused)),
+ size_t a_len __attribute__ ((unused)),
+ size_t errmsg_len __attribute__ ((unused)))
{
if (stat)
*stat = 0;
@@ -2783,7 +2783,7 @@ void
_gfortran_caf_event_post (caf_token_t token, size_t index,
int image_index __attribute__ ((unused)),
int *stat, char *errmsg __attribute__ ((unused)),
- int errmsg_len __attribute__ ((unused)))
+ size_t errmsg_len __attribute__ ((unused)))
{
uint32_t value = 1;
uint32_t *event = (uint32_t *) ((char *) MEMTOK (token) + index
@@ -2798,7 +2798,7 @@ void
_gfortran_caf_event_wait (caf_token_t token, size_t index,
int until_count, int *stat,
char *errmsg __attribute__ ((unused)),
- int errmsg_len __attribute__ ((unused)))
+ size_t errmsg_len __attribute__ ((unused)))
{
uint32_t *event = (uint32_t *) ((char *) MEMTOK (token) + index
* sizeof (uint32_t));
@@ -2825,7 +2825,8 @@ _gfortran_caf_event_query (caf_token_t token, size_t index,
void
_gfortran_caf_lock (caf_token_t token, size_t index,
int image_index __attribute__ ((unused)),
- int *aquired_lock, int *stat, char *errmsg, int errmsg_len)
+ int *aquired_lock, int *stat, char *errmsg,
+ size_t errmsg_len)
{
const char *msg = "Already locked";
bool *lock = &((bool *) MEMTOK (token))[index];
@@ -2854,22 +2855,21 @@ _gfortran_caf_lock (caf_token_t token, size_t index,
*stat = 1;
if (errmsg_len > 0)
{
- int len = ((int) sizeof (msg) > errmsg_len) ? errmsg_len
- : (int) sizeof (msg);
+ size_t len = (sizeof (msg) > errmsg_len) ? errmsg_len : sizeof (msg);
memcpy (errmsg, msg, len);
if (errmsg_len > len)
memset (&errmsg[len], ' ', errmsg_len-len);
}
return;
}
- _gfortran_caf_error_stop_str (msg, (int32_t) strlen (msg));
+ _gfortran_caf_error_stop_str (msg, strlen (msg));
}
void
_gfortran_caf_unlock (caf_token_t token, size_t index,
int image_index __attribute__ ((unused)),
- int *stat, char *errmsg, int errmsg_len)
+ int *stat, char *errmsg, size_t errmsg_len)
{
const char *msg = "Variable is not locked";
bool *lock = &((bool *) MEMTOK (token))[index];
@@ -2887,15 +2887,14 @@ _gfortran_caf_unlock (caf_token_t token, size_t index,
*stat = 1;
if (errmsg_len > 0)
{
- int len = ((int) sizeof (msg) > errmsg_len) ? errmsg_len
- : (int) sizeof (msg);
+ size_t len = (sizeof (msg) > errmsg_len) ? errmsg_len : sizeof (msg);
memcpy (errmsg, msg, len);
if (errmsg_len > len)
memset (&errmsg[len], ' ', errmsg_len-len);
}
return;
}
- _gfortran_caf_error_stop_str (msg, (int32_t) strlen (msg));
+ _gfortran_caf_error_stop_str (msg, strlen (msg));
}
int
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2016-12-20 3:02 ` Bob Deen
@ 2016-12-20 9:24 ` FX
2016-12-29 21:54 ` Gerald Pfeifer
0 siblings, 1 reply; 76+ messages in thread
From: FX @ 2016-12-20 9:24 UTC (permalink / raw)
To: Bob Deen; +Cc: Janne Blomqvist, Fortran List, GCC Patches
Dear Bob,
First, regarding the ABI vs. API question: there is no consistent API for how to pass between Fortran and C strings, unless one uses Fortran 2003’s ISO_C_BINDING. It’s an ABI detail, in the sense that every compiler will choose to do things their own way: most compilers who pass a hidden length parameter, although its size (32-bit or 64-bit or size_t) and position (either after the char pointer, or at the end of the argument list) are variable between compilers. So, any code that does this is already compiler-specific.
Second, there are good reasons we might want to change this. One is possible use cases (although there are few, by definition, because we simply don’t support those right now). The second one is compatibility with C string-handling functions, who operate on size_t arguments, which means we can now use those functions without casting types around all the time.
Finally, if we’re making this change, we welcome any feedback on how to make it as easy as possible to handle in user code. Documentation, preprocessor macros, etc.
In particular, one of the things we will need to address is on helping widely used code to adapt to the change, so that. One example I am thinking of, that uses old-style C/Fortran interfaces, is MPI libraries (openmpi & mpich). We definitely need to test those to make sure nothing breaks if we are going to proceed — or they need to be fixed upstream well before we release, and with due note of the incompatibility in our release notes.
Cheers,
FX
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2016-12-19 19:49 ` Janne Blomqvist
@ 2016-12-20 3:02 ` Bob Deen
2016-12-20 9:24 ` FX
0 siblings, 1 reply; 76+ messages in thread
From: Bob Deen @ 2016-12-20 3:02 UTC (permalink / raw)
To: Janne Blomqvist; +Cc: FX, Fortran List, GCC Patches
On 12/19/16 11:33 AM, Janne Blomqvist wrote:
> On Mon, Dec 19, 2016 at 6:43 PM, Bob Deen <Bob.Deen@jpl.nasa.gov> wrote:
>> Hi all...
>>
>> I never saw any followup on this...?
>>
>> It's one thing to break the ABI between the compiler and the gfortran
>> library; those can generally be expected to be in sync. It's another to
>> break the ABI between two *languages*, when there might be no such
>> expectation (especially if gcc does NOT break their ABI at the same version
>> number transition). Yes, the pre-ISO_C_BINDING method may be old-fashioned,
>> but it is a de-facto standard, and breaking it should not be done lightly.
>
> First: No, it's not done "lightly". And secondly, cross-language
> interfacing is always tricky, which is why most languages, including
> Fortran with ISO_C_BINDING, have devised standardized ways for
> communication with C so users don't need to rely on various cross-call
> mechanisms that are not guaranteed to work.
Apologies if I offended (and to Steve too). I see all the deliberation
you're doing for breaking the language->library ABI, and appreciate
that. It's well-justified. My point, however, is that with this change
you are breaking an entirely *different* ABI - that between Fortran and
C - and the sum total of discussion was one message from Janne pointing
out that it was breaking (thanks for that heads-up, I had missed it!),
with no followup. Janne, you yourself in that message questioned the
need for large strings, and had no use cases in response to FX's inquiry.
Now that I think about it, it's not even an ABI change, it's an API
change... requiring a code change, not just a recompile.
So in this case, this change represents (AFAIK) the only breakage in the
old-style Fortran<->C ABI/API, with no known use cases... and thus my
question about whether it's justified. It's a fair question. I'm not
arguing the language->library ABI at all.
> C changed to use size_t for string lengths instead of int with ANSI C
> in, what, 1989. With 2-socket servers, typically used e.g. in HPC
> clusters, today easily having hundreds of gigs of RAM, limiting
> GFortran char lengths to 2 GB for all eternity in the name of
> compatibility seems quaint at best. Maybe in your organization Fortran
> is legacy code that YE SHALL NOT TOUCH, but GFortran also has to cater
> to users who have chosen to write new code in Fortran.
I understand that. It just seems that opening up an entirely *new*
ABI/API for breakage deserved a little more discussion. Y'all are the
ones doing the (mostly volunteer) work on gfortran, and I appreciate it.
You're also much more invested in the future of the language than I
(yeah, it's mostly legacy code for us). If you end up deciding that it
needs to be done, then I'll deal with it. I just wanted to chime in
that there are users who will be affected. If I'm the only one, I
wouldn't want to stand in the way of progress - but also don't want to
get steamrolled if it's not an important change, or if there are other
affected users.
So... ARE there any other affected users out there??
> Oh, you have macros rather than hard-coded int all over the place?
> Shouldn't it be a relatively trivial affair then to define that macro
> appropriately depending on which compiler and which version you're
> using?
I wouldn't call it trivial by any means... it's tricky code I haven't
had to look at in 10 years. But in the end, probably doable.
> Steve showed how you can do it for Fortran. From the C side, just
> check the version from the __GNUC__ macro.
I dislike having to check for version numbers (feels kludgy) but that's
a personal preference. That will probably work, with a bit of futzing.
Thanks for your attention...
-Bob
Bob Deen @ NASA-JPL Multimission Image Processing Lab
Bob.Deen@jpl.nasa.gov
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2016-12-19 16:43 ` Bob Deen
2016-12-19 18:30 ` Steve Kargl
@ 2016-12-19 19:49 ` Janne Blomqvist
2016-12-20 3:02 ` Bob Deen
1 sibling, 1 reply; 76+ messages in thread
From: Janne Blomqvist @ 2016-12-19 19:49 UTC (permalink / raw)
To: Bob Deen; +Cc: FX, Fortran List, GCC Patches
On Mon, Dec 19, 2016 at 6:43 PM, Bob Deen <Bob.Deen@jpl.nasa.gov> wrote:
> Hi all...
>
> I never saw any followup on this...?
>
> It's one thing to break the ABI between the compiler and the gfortran
> library; those can generally be expected to be in sync. It's another to
> break the ABI between two *languages*, when there might be no such
> expectation (especially if gcc does NOT break their ABI at the same version
> number transition). Yes, the pre-ISO_C_BINDING method may be old-fashioned,
> but it is a de-facto standard, and breaking it should not be done lightly.
First: No, it's not done "lightly". And secondly, cross-language
interfacing is always tricky, which is why most languages, including
Fortran with ISO_C_BINDING, have devised standardized ways for
communication with C so users don't need to rely on various cross-call
mechanisms that are not guaranteed to work.
That the charlen is a hidden argument added at the end of type int is
AFAIK a fairly common implementation choice, though I'm not sure if it
can be called a de-facto standard. Considering that Intel Fortran has
switched to size_t several years ago (5-ish?), and AFAIU it's the most
used Fortran compiler around in addition to GFortran, and the world
hasn't crashed down due to it, I suspect users can adapt to the change
with relatively little drama.
That gcc would change it's ABI at all, and especially in conjunction
with gfortran, is a pipe dream.
C changed to use size_t for string lengths instead of int with ANSI C
in, what, 1989. With 2-socket servers, typically used e.g. in HPC
clusters, today easily having hundreds of gigs of RAM, limiting
GFortran char lengths to 2 GB for all eternity in the name of
compatibility seems quaint at best. Maybe in your organization Fortran
is legacy code that YE SHALL NOT TOUCH, but GFortran also has to cater
to users who have chosen to write new code in Fortran.
> If you do proceed with changing the size, I would request that there at
> least be a facility to reliably tell at compile time (on the C side) which
> definition is being used, so I can adjust our macros accordingly.
Oh, you have macros rather than hard-coded int all over the place?
Shouldn't it be a relatively trivial affair then to define that macro
appropriately depending on which compiler and which version you're
using?
Steve showed how you can do it for Fortran. From the C side, just
check the version from the __GNUC__ macro.
> Our code
> does depend on the size, and it has to cross-platform (and now, if this
> change is made, cross-version), so with this change I would have to support
> both int and size_t.
Well, if you add the option to use size_t you should be able to use
ifort as well. :)
> A C-side preprocessor symbol definition would do the trick. Of course that
> assumes the versions of gcc/g++ and gfortran are in sync, which is never
> guaranteed. But that assumption is better than nothing. Unless someone has
> a better idea...?
Yeah, I think that's the best idea.
Another option would be to implement some kind of
-fcharacter-length=[int,size_t] command-line option. But that would
make the patch a lot more complicated since one would need to typecast
the character length argument when calling libgfortran. And, you'd
still have to have some version-dependent checks to see if gfortran
would accept that option. And like other similar options like
-fdefault-this-or-that it would change the ABI, so code compiled with
that option would be incompatible with code compiled without it. So in
the end I'm not convinced such an option would actually make life any
easier for our users.
> Perhaps it might be best to wait until a time when gcc is also breaking
> their ABI, so that there's no question of code (on either side) working
> across the transition...?
AFAIK there is no ABI change planned for gcc. For better or worse, the
C language is relatively stable and doesn't change much.
> P.S. I'm just a lurker here, but I lurk specifically to look for things
> that will break our code base, like this.... ;-)
Well, then you ought to be aware the ABI cleanup page on the wiki,
where the char length issue has been listed for, what, 5 years or so,
so it can't really be a surprise that it will happen at some point,
can it...?
>
> Bob.Deen @ NASA-JPL Multimission Image Processing Lab
> Bob.Deen@jpl.nasa.gov
>
>
>
> On 12/12/16 10:26 AM, Bob Deen wrote:
>>
>>
>>> However, this will also affect people doing C->Fortran calls the
>>> old-fashioned way without ISO_C_BINDING, as they will have to change
>>> the string length argument from int to size_t in their prototypes.
>>> Then again, Intel Fortran did this some years ago so I guess at least
>>> people who care about portability to several compilers are aware.
>>
>>
>> We do a ton of this (old fashioned c-fortran binding) and changing the
>> string length argument size will have a big impact on us. We don't use the
>> Intel compiler so we never noticed a change there.
>>
>> Is there really a use case for strings > 2 GB that justifies the breakage?
>> I certainly understand wanting to do it "right" but I'm probably not the
>> only one with practical considerations that argue against it if there are no
>> compelling use cases.
>>
>> Thanks...
>>
>> -Bob
>>
>> Bob Deen @ NASA-JPL Multimission Image Processing Lab
>> Bob.Deen@jpl.nasa.gov
>>
>>
>
--
Janne Blomqvist
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2016-12-19 16:43 ` Bob Deen
@ 2016-12-19 18:30 ` Steve Kargl
2016-12-19 19:49 ` Janne Blomqvist
1 sibling, 0 replies; 76+ messages in thread
From: Steve Kargl @ 2016-12-19 18:30 UTC (permalink / raw)
To: Bob Deen; +Cc: Janne Blomqvist, FX, Fortran List, GCC Patches
On Mon, Dec 19, 2016 at 08:43:01AM -0800, Bob Deen wrote:
>
> It's one thing to break the ABI between the compiler and the gfortran
> library; those can generally be expected to be in sync. It's another to
> break the ABI between two *languages*, when there might be no such
> expectation (especially if gcc does NOT break their ABI at the same
> version number transition). Yes, the pre-ISO_C_BINDING method may be
> old-fashioned, but it is a de-facto standard, and breaking it should not
> be done lightly.
Do you really think that those of us who actively contribute to
gfortran development take breaking the ABI lightly? We have put
off changes to gfortran's library for several years to specifically
avoid ABI breakage. It seems that there is never a "Good Time" to
break the ABI. However, in this case, support for F2008 9.6.4.8,
Defined Input/Output, necessitates a change in the ABI. Instead of
breaking the ABI multiple times, it has been decided to try to cleanup
some long standing issues with libgfortran.
> If you do proceed with changing the size, I would request that there at
> least be a facility to reliably tell at compile time (on the C side)
> which definition is being used, so I can adjust our macros accordingly.
> Our code does depend on the size, and it has to cross-platform (and now,
> if this change is made, cross-version), so with this change I would have
> to support both int and size_t.
As the breakage is going to occur with gfortran 7.0, you do
% cat a.F90
#if defined(__GFORTRAN__) && (__GNUC__ > 6)
print *, '7'
#else
print *, 'not 7'
#endif
end
% gfc7 -E a.F90 | cat -s
] gfc7 -E a.F90 | cat -s
# 1 "a.F90"
# 1 "<built-in>"
# 1 "<command-line>"
# 1 "a.F90"
print *, '7'
end
% gfortran6 -E a.F90 | cat -s
# 1 "a.F90"
# 1 "<built-in>"
# 1 "<command-line>"
# 1 "a.F90"
print *, 'not 7'
end
> Perhaps it might be best to wait until a time when gcc is also breaking
> their ABI, so that there's no question of code (on either side) working
> across the transition...?
There is never a good time. If we are to wait for gcc, should
we remove support for Defined Input/Output from the compiler?
--
Steve
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2016-12-12 18:26 ` Bob Deen
@ 2016-12-19 16:43 ` Bob Deen
2016-12-19 18:30 ` Steve Kargl
2016-12-19 19:49 ` Janne Blomqvist
0 siblings, 2 replies; 76+ messages in thread
From: Bob Deen @ 2016-12-19 16:43 UTC (permalink / raw)
To: Janne Blomqvist; +Cc: FX, Fortran List, GCC Patches
Hi all...
I never saw any followup on this...?
It's one thing to break the ABI between the compiler and the gfortran
library; those can generally be expected to be in sync. It's another to
break the ABI between two *languages*, when there might be no such
expectation (especially if gcc does NOT break their ABI at the same
version number transition). Yes, the pre-ISO_C_BINDING method may be
old-fashioned, but it is a de-facto standard, and breaking it should not
be done lightly.
If you do proceed with changing the size, I would request that there at
least be a facility to reliably tell at compile time (on the C side)
which definition is being used, so I can adjust our macros accordingly.
Our code does depend on the size, and it has to cross-platform (and now,
if this change is made, cross-version), so with this change I would have
to support both int and size_t.
A C-side preprocessor symbol definition would do the trick. Of course
that assumes the versions of gcc/g++ and gfortran are in sync, which is
never guaranteed. But that assumption is better than nothing. Unless
someone has a better idea...?
Perhaps it might be best to wait until a time when gcc is also breaking
their ABI, so that there's no question of code (on either side) working
across the transition...?
Thanks...
-Bob
P.S. I'm just a lurker here, but I lurk specifically to look for things
that will break our code base, like this.... ;-)
Bob.Deen @ NASA-JPL Multimission Image Processing Lab
Bob.Deen@jpl.nasa.gov
On 12/12/16 10:26 AM, Bob Deen wrote:
>
>> However, this will also affect people doing C->Fortran calls the
>> old-fashioned way without ISO_C_BINDING, as they will have to change
>> the string length argument from int to size_t in their prototypes.
>> Then again, Intel Fortran did this some years ago so I guess at least
>> people who care about portability to several compilers are aware.
>
> We do a ton of this (old fashioned c-fortran binding) and changing the string length argument size will have a big impact on us. We don't use the Intel compiler so we never noticed a change there.
>
> Is there really a use case for strings > 2 GB that justifies the breakage? I certainly understand wanting to do it "right" but I'm probably not the only one with practical considerations that argue against it if there are no compelling use cases.
>
> Thanks...
>
> -Bob
>
> Bob Deen @ NASA-JPL Multimission Image Processing Lab
> Bob.Deen@jpl.nasa.gov
>
>
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2016-12-16 18:07 ` Janne Blomqvist
@ 2016-12-16 18:23 ` Dominique d'Humières
0 siblings, 0 replies; 76+ messages in thread
From: Dominique d'Humières @ 2016-12-16 18:23 UTC (permalink / raw)
To: Janne Blomqvist; +Cc: Andre Vehreschild, GCC-Fortran-ML, GCC-Patches-ML
> Le 16 déc. 2016 à 19:06, Janne Blomqvist <blomqvist.janne@gmail.com> a écrit :
>
> On Fri, Dec 16, 2016 at 5:50 PM, Dominique d'Humières
> <dominiq@lps.ens.fr> wrote:
>> Hi Janne,
>>
>> I have applied your two patches and found that I had to skip the patches for resolve.c and match.c due to the errors
>>
>> ../../p_work/gcc/fortran/resolve.c: In function 'void resolve_select_type(gfc_code*, gfc_namespace*)':
>> ../../p_work/gcc/fortran/resolve.c:8731:58: error: format '%lld' expects argument of type 'long long int', but argument 4 has type 'long int' [-Werror=format=]
>> gfc_basic_typename (c->ts.type), charlen, c->ts.kind);
>>
>> and
>>
>> ../../p_work/gcc/fortran/match.c: In function 'gfc_symtree* select_intrinsic_set_tmp(gfc_typespec*)':
>> ../../p_work/gcc/fortran/match.c:5786:55: error: format '%lld' expects argument of type 'long long int', but argument 4 has type 'long int' [-Werror=format=]
>> gfc_basic_typename (ts->type), charlen, ts->kind);
>>
>
> Oh, blast. Of course you're right, from the second patch, the part
> that touched resolve.c and match.c are incorrect.
>
>> while the patch for dump-parse-tree.c was needed.
>>
>> With the patches applied I see several failures in the test suite compiled with ‘-m64 -flto’, but not with ‘-m32 -flto’ of the kind
>
> Ok, thanks for the hint. I haven't tested with -flto. Do you just run
> it with something like
>
> CFLAGS="-flto" make -j $NCPUS check-fortran
>
> or how do you do it?
Due to recurrent problems with -flto, I have the following change in my working tree
--- ../_clean/gcc/testsuite/lib/gfortran-dg.exp 2016-02-12 20:21:04.000000000 +0100
+++ gcc/testsuite/lib/gfortran-dg.exp 2016-02-13 10:03:11.000000000 +0100
@@ -140,8 +140,16 @@ proc gfortran-dg-runtest { testcases fla
# we cycle through the option list, otherwise we don't
if [expr [search_for $test "dg-do run"]] {
set option_list $torture_with_loops
+ if [check_effective_target_lto] {
+ lappend option_list { -g -flto }
+ # lappend option_list { -g -O3 -fwhole-program -flto }
+ }
} else {
set option_list [list { -O } ]
+ # if [check_effective_target_lto] {
+ # lappend option_list { -g -flto }
+ # lappend option_list { -g -O3 -fwhole-program -flto }
+ # }
}
set nshort [file tail [file dirname $test]]/[file tail $test]
i.e., I add the options ‘-g -flto’ to the list of options used by the gfortran test suite.
>
> I don't have lldb, but I guess I can see roughly the same with gdb..
For what I do, it is close to gdb (I did not succeed to authorize it on recent darwin).
Dominique
>> The affected tests are
>>
>> array_constructor_17.f90
>> auto_char_len_3.f90
>> char_length_14.f90
>> char_length_5.f90
>> char_result_*.f90
>> charlen_03.f90
>> deferred_type_param_4.f90
>> dummy_procedure_3.f90
>> mapping_[12].f90
>> module_read_[12].f90
>> parens_5.f90
>> pr57910.f90
>> proc_ptr_comp_16.f90
>> result_in_spec_2.f90
>> spec_expr_7.f90
>> string_length_1.f90
>> transfer_intrinsic_3.f90
>> widechar_6.f90
>> zero_length_1.f90
>>
>> Note that I did not run lldb on all of them, thus I cannot guarantee that all fail along the same pattern.
>>
>> Cheers,
>>
>> Dominique
>>
>
>
>
> --
> Janne Blomqvist
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2016-12-16 15:54 Dominique d'Humières
@ 2016-12-16 18:07 ` Janne Blomqvist
2016-12-16 18:23 ` Dominique d'Humières
0 siblings, 1 reply; 76+ messages in thread
From: Janne Blomqvist @ 2016-12-16 18:07 UTC (permalink / raw)
To: Dominique d'Humières
Cc: Andre Vehreschild, GCC-Fortran-ML, GCC-Patches-ML
On Fri, Dec 16, 2016 at 5:50 PM, Dominique d'Humières
<dominiq@lps.ens.fr> wrote:
> Hi Janne,
>
> I have applied your two patches and found that I had to skip the patches for resolve.c and match.c due to the errors
>
> ../../p_work/gcc/fortran/resolve.c: In function 'void resolve_select_type(gfc_code*, gfc_namespace*)':
> ../../p_work/gcc/fortran/resolve.c:8731:58: error: format '%lld' expects argument of type 'long long int', but argument 4 has type 'long int' [-Werror=format=]
> gfc_basic_typename (c->ts.type), charlen, c->ts.kind);
>
> and
>
> ../../p_work/gcc/fortran/match.c: In function 'gfc_symtree* select_intrinsic_set_tmp(gfc_typespec*)':
> ../../p_work/gcc/fortran/match.c:5786:55: error: format '%lld' expects argument of type 'long long int', but argument 4 has type 'long int' [-Werror=format=]
> gfc_basic_typename (ts->type), charlen, ts->kind);
>
Oh, blast. Of course you're right, from the second patch, the part
that touched resolve.c and match.c are incorrect.
> while the patch for dump-parse-tree.c was needed.
>
> With the patches applied I see several failures in the test suite compiled with ‘-m64 -flto’, but not with ‘-m32 -flto’ of the kind
Ok, thanks for the hint. I haven't tested with -flto. Do you just run
it with something like
CFLAGS="-flto" make -j $NCPUS check-fortran
or how do you do it?
I don't have lldb, but I guess I can see roughly the same with gdb..
>
> [Book15] f90/bug% gfc /opt/gcc/work/gcc/testsuite/gfortran.dg/char_result_1.f90 -flto -c
> [Book15] f90/bug% lldb /opt/gcc/gcc7w/libexec/gcc/x86_64-apple-darwin16.1.0/7.0.0/lto1
> (lldb) target create "/opt/gcc/gcc7w/libexec/gcc/x86_64-apple-darwin16.1.0/7.0.0/lto1"
> Current executable set to '/opt/gcc/gcc7w/libexec/gcc/x86_64-apple-darwin16.1.0/7.0.0/lto1' (x86_64).
> (lldb) run char_result_1.o
> Process 1310 launched: '/opt/gcc/gcc7w/libexec/gcc/x86_64-apple-darwin16.1.0/7.0.0/lto1' (x86_64)
> Reading object files: char_result_1.o {GC start 2195k}
> Reading the callgraph
> Merging declarations
> Reading summaries
> Reading function bodies:
> Performing interprocedural optimizations
> <whole-program> <profile_estimate> <icf> <devirt> <cp> <targetclone> <inline> <pure-const> <static-var>Assembling functions:
> <materialize-all-clones> <dispatchercalls> <simdclone> f2 f1 double test MAIN__Process 1310 stopped
> * thread #1: tid = 0x54ac, 0x00000001008f76cf lto1`lto_input_tree_ref(ib=<unavailable>, data_in=0x0000000142621090, fn=0x0000000000000000, tag=<unavailable>) + 127 at lto-streamer-in.c:332, queue = 'com.apple.main-thread', stop reason = EXC_BAD_ACCESS (code=1, address=0x18)
> frame #0: 0x00000001008f76cf lto1`lto_input_tree_ref(ib=<unavailable>, data_in=0x0000000142621090, fn=0x0000000000000000, tag=<unavailable>) + 127 at lto-streamer-in.c:332
> 329
> 330 case LTO_ssa_name_ref:
> 331 ix_u = streamer_read_uhwi (ib);
> -> 332 result = (*SSANAMES (fn))[ix_u];
> 333 break;
> 334
> 335 case LTO_field_decl_ref:
> (lldb) bt
> * thread #1: tid = 0x54ac, 0x00000001008f76cf lto1`lto_input_tree_ref(ib=<unavailable>, data_in=0x0000000142621090, fn=0x0000000000000000, tag=<unavailable>) + 127 at lto-streamer-in.c:332, queue = 'com.apple.main-thread', stop reason = EXC_BAD_ACCESS (code=1, address=0x18)
> * frame #0: 0x00000001008f76cf lto1`lto_input_tree_ref(ib=<unavailable>, data_in=0x0000000142621090, fn=0x0000000000000000, tag=<unavailable>) + 127 at lto-streamer-in.c:332
> frame #1: 0x00000001008f78f1 lto1`lto_input_tree_1(ib=0x00007fff5fbfeeb0, data_in=0x0000000142621090, tag=<unavailable>, hash=<unavailable>) + 177 at lto-streamer-in.c:1446
> frame #2: 0x00000001008f7cb8 lto1`lto_input_tree(ib=0x00007fff5fbfeeb0, data_in=0x0000000142621090) + 88 at lto-streamer-in.c:1492
> frame #3: 0x0000000100ce8b43 lto1`streamer_read_tree_body(lto_input_block*, data_in*, tree_node*) + 51 at tree-streamer-in.c:893
> frame #4: 0x0000000100ce8b10 lto1`streamer_read_tree_body(ib=0x00007fff5fbfeeb0, data_in=0x0000000142621090, expr=0x0000000143944af0) + 2096
> frame #5: 0x00000001008f7110 lto1`::lto_read_tree_1(ib=0x00007fff5fbfeeb0, data_in=0x0000000142621090, expr=0x0000000143944af0) + 32 at lto-streamer-in.c:1333
> frame #6: 0x00000001008f78b9 lto1`lto_input_tree_1(lto_input_block*, data_in*, LTO_tags, unsigned int) + 38 at lto-streamer-in.c:1363
> frame #7: 0x00000001008f7893 lto1`lto_input_tree_1(lto_input_block*, data_in*, LTO_tags, unsigned int) + 20
> frame #8: 0x00000001008f787f lto1`lto_input_tree_1(ib=0x00007fff5fbfeeb0, data_in=0x0000000142621090, tag=<unavailable>, hash=2871463685) + 63
> frame #9: 0x00000001008f7c03 lto1`lto_input_scc(ib=0x00007fff5fbfeeb0, data_in=0x0000000142621090, len=0x00007fff5fbfede8, entry_len=0x00007fff5fbfedec) + 371 at lto-streamer-in.c:1387
> frame #10: 0x00000001008f7c91 lto1`lto_input_tree(ib=0x00007fff5fbfeeb0, data_in=0x0000000142621090) + 49 at lto-streamer-in.c:1490
> frame #11: 0x00000001008f8d93 lto1`::lto_read_body_or_constructor(file_data=0x0000000143721000, data=<unavailable>, node=<unavailable>, section_type=LTO_section_function_body) + 931 at lto-streamer-in.c:1045
> frame #12: 0x000000010051a136 lto1`cgraph_node::get_untransformed_body(this=0x000000014391ee60) + 278 at cgraph.c:3581
> frame #13: 0x0000000100526d9a lto1`cgraph_node::expand(this=0x000000014391ee60) + 74 at cgraphunit.c:1971
> frame #14: 0x0000000100527f00 lto1`::output_in_order(no_reorder=<unavailable>) + 528 at cgraphunit.c:2244
> frame #15: 0x0000000100528528 lto1`symbol_table::compile(this=0x0000000143526100) + 952 at cgraphunit.c:2488
> frame #16: 0x0000000100034c68 lto1`lto_main() + 7112 at lto.c:3330
> frame #17: 0x0000000100a87f1a lto1`::compile_file() + 58 at toplev.c:463
> frame #18: 0x0000000100f97744 lto1`toplev::main(this=0x00007fff5fbff2b0, argc=<unavailable>, argv=<unavailable>) + 3636 at toplev.c:1983
> frame #19: 0x0000000100f98c39 lto1`main(argc=2, argv=0x00007fff5fbff2f8) + 41 at main.c:39
> frame #20: 0x00007fffcfa5a255 libdyld.dylib`start + 1
> frame #21: 0x00007fffcfa5a255 libdyld.dylib`start + 1
>
> The affected tests are
>
> array_constructor_17.f90
> auto_char_len_3.f90
> char_length_14.f90
> char_length_5.f90
> char_result_*.f90
> charlen_03.f90
> deferred_type_param_4.f90
> dummy_procedure_3.f90
> mapping_[12].f90
> module_read_[12].f90
> parens_5.f90
> pr57910.f90
> proc_ptr_comp_16.f90
> result_in_spec_2.f90
> spec_expr_7.f90
> string_length_1.f90
> transfer_intrinsic_3.f90
> widechar_6.f90
> zero_length_1.f90
>
> Note that I did not run lldb on all of them, thus I cannot guarantee that all fail along the same pattern.
>
> Cheers,
>
> Dominique
>
--
Janne Blomqvist
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2016-12-16 15:49 ` Andre Vehreschild
@ 2016-12-16 18:02 ` Janne Blomqvist
2016-12-20 14:10 ` Andre Vehreschild
0 siblings, 1 reply; 76+ messages in thread
From: Janne Blomqvist @ 2016-12-16 18:02 UTC (permalink / raw)
To: Andre Vehreschild; +Cc: Fortran List, GCC Patches
On Fri, Dec 16, 2016 at 5:34 PM, Andre Vehreschild <vehre@gmx.de> wrote:
> Hi Janne, hi all,
>
> as promised please find attached the change from int32 to size_t for the
> caf-libraries. Because the caf-libraries do not require special notions
> indicated by negative values I went for using size_t there. I assume this will
> be easier to keep in sync for all caf-libraries, because the size_t is
> available on all modern platforms. I also took the liberty to fix the
> specifiers in trans-decl for the caf-function-declarations and update the
> documentation on the caf-functions in gfortran.texi where some parameters where
> missing.
>
> These additional changes bootstrap fine and induce no new regressions on
> x86_64-linux/f23.
I think you should use build_zero_cst(size_type_node) instead of
size_zero_node as size_zero_node is of type sizetype which is not the
same as size_type_node. Otherwise looks good.
And yes, I think it makes sense to use size_t directly instead of
introducing the GFortran specific gfc_charlen_type typedef.
> I am still not sure, whether we shouldn't address the regression in
> allocate_deferred_char_scalar_1. I did some research, but could not yet come to
> a practical solution. The backend somehow deduces that the memory pointed to
> has size 5 only. But I haven't found a way to do this in the front end.
>
> Comments on these changes?
>
> - Andre
>
> On Tue, 13 Dec 2016 21:08:51 +0200
> Janne Blomqvist <blomqvist.janne@gmail.com> wrote:
>
>> On Mon, Dec 12, 2016 at 9:39 PM, Janne Blomqvist
>> <blomqvist.janne@gmail.com> wrote:
>> > On Mon, Dec 12, 2016 at 7:39 PM, Andre Vehreschild <vehre@gmx.de> wrote:
>> >> Hi Janne,
>> >>
>> >> I found that you are favoring build_int_cst (size_type_node, 0) over
>> >> size_zero_node. Is there a reason to this?
>> >
>> > Yes. AFAIU size_zero_node is a zero constant for sizetype which is not
>> > the same as size_type_node.
>> >
>> > AFAIK the difference is that size_type_node is the C size_t type,
>> > whereas sizetype is a GCC internal type used for address expressions.
>> > On a "normal" target I understand that they are the same size, but
>> > there are some slight differences in semantics, e.g. size_type_node
>> > like C unsigned integer types is defined to wrap around on overflow
>> > whereas sizetype is undefined on overflow.
>> >
>> > I don't know if GCC supports some strange targets with some kind of
>> > segmented memory where the size of sizetype would be different from
>> > size_type_node, but I guess it's possible in theory at least.
>> >
>> > That being said, now that you mention in I should be using
>> > build_zero_cst (some_type_node) instead of
>> > build_int_cst(some_type_node, 0). There's also build_one_cst that I
>> > should use.
>> >
>> >> Furthermore did I have to patch this:
>> >>
>> >> diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
>> >> index 585f25d..f374558 100644
>> >> --- a/gcc/fortran/dump-parse-tree.c
>> >> +++ b/gcc/fortran/dump-parse-tree.c
>> >> @@ -465,7 +465,7 @@ show_expr (gfc_expr *p)
>> >> break;
>> >>
>> >> case BT_HOLLERITH:
>> >> - fprintf (dumpfile, "%dH", p->representation.length);
>> >> + fprintf (dumpfile, "%zdH", p->representation.length);
>> >> c = p->representation.string;
>> >> for (i = 0; i < p->representation.length; i++, c++)
>> >> {
>> >>
>> >> to bootstrap on x86_64-linux/f23.
>> >
>> > Ah, thanks for the catch. I'll fix it by using HOST_WIDE_INT_PRINT_DEC
>> > since I'll have to change gfc_charlen_t to be a typedef form
>> > HOST_WIDE_INT (see my answer to FX).
>> >
>> >> And I have this regression:
>> >>
>> >> FAIL: gfortran.dg/allocate_deferred_char_scalar_1.f03 -O1 (test for
>> >> excess errors)
>> >>
>> >> allocate_deferred_char_scalar_1.f03:184:0:
>> >>
>> >> p = '12345679'
>> >>
>> >> Warning: '__builtin_memcpy' writing 8 bytes into a region of size 5
>> >> overflows the destination [-Wstringop-overflow=]
>> >> allocate_deferred_char_scalar_1.f03:242:0:
>> >>
>> >> p = 4_'12345679'
>> >>
>> >> Warning: '__builtin_memcpy' writing 32 bytes into a region of size 20
>> >> overflows the destination [-Wstringop-overflow=]
>> >
>> > I'm seeing that too, but I assumed they would be fixed by Paul's
>> > recent patch which I don't yet have in my tree yet due to the git
>> > mirror being stuck..
>> >
>> >> Btw, the patch for changing the ABI of the coarray-libs is already nearly
>> >> done. I just need to figure that what the state of regressions is with and
>> >> without my change.
>> >
>> > Thanks.
>> >
>> > I'll produce an updated patch with the changes discussed so far.
>> >
>> >
>> > --
>> > Janne Blomqvist
>>
>> Hi,
>>
>> attached is the updated patch that applies on top of the original. I
>> didn't do the charlen_zero_node etc, I just fixed the relatively few
>> places in my previous patch rather than everywhere in the entire
>> frontend.
>>
>> Now that the git mirror is working again, I see though those warnings
>> with -O1 from gfortran.dg/allocate_deferred_char_scalar_1.f03 are
>> still there, and Paul's patch didn't get rid of them. :(. I have
>> looked at the tree dumps, however, and AFAICS it's a bogus warning.
>>
>> Ok for trunk?
>>
>
>
> --
> Andre Vehreschild * Email: vehre ad gmx dot de
--
Janne Blomqvist
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
@ 2016-12-16 15:54 Dominique d'Humières
2016-12-16 18:07 ` Janne Blomqvist
0 siblings, 1 reply; 76+ messages in thread
From: Dominique d'Humières @ 2016-12-16 15:54 UTC (permalink / raw)
To: Janne Blomqvist; +Cc: Andre Vehreschild, GCC-Fortran-ML, GCC-Patches-ML
Hi Janne,
I have applied your two patches and found that I had to skip the patches for resolve.c and match.c due to the errors
../../p_work/gcc/fortran/resolve.c: In function 'void resolve_select_type(gfc_code*, gfc_namespace*)':
../../p_work/gcc/fortran/resolve.c:8731:58: error: format '%lld' expects argument of type 'long long int', but argument 4 has type 'long int' [-Werror=format=]
gfc_basic_typename (c->ts.type), charlen, c->ts.kind);
and
../../p_work/gcc/fortran/match.c: In function 'gfc_symtree* select_intrinsic_set_tmp(gfc_typespec*)':
../../p_work/gcc/fortran/match.c:5786:55: error: format '%lld' expects argument of type 'long long int', but argument 4 has type 'long int' [-Werror=format=]
gfc_basic_typename (ts->type), charlen, ts->kind);
while the patch for dump-parse-tree.c was needed.
With the patches applied I see several failures in the test suite compiled with ‘-m64 -flto’, but not with ‘-m32 -flto’ of the kind
[Book15] f90/bug% gfc /opt/gcc/work/gcc/testsuite/gfortran.dg/char_result_1.f90 -flto -c
[Book15] f90/bug% lldb /opt/gcc/gcc7w/libexec/gcc/x86_64-apple-darwin16.1.0/7.0.0/lto1
(lldb) target create "/opt/gcc/gcc7w/libexec/gcc/x86_64-apple-darwin16.1.0/7.0.0/lto1"
Current executable set to '/opt/gcc/gcc7w/libexec/gcc/x86_64-apple-darwin16.1.0/7.0.0/lto1' (x86_64).
(lldb) run char_result_1.o
Process 1310 launched: '/opt/gcc/gcc7w/libexec/gcc/x86_64-apple-darwin16.1.0/7.0.0/lto1' (x86_64)
Reading object files: char_result_1.o {GC start 2195k}
Reading the callgraph
Merging declarations
Reading summaries
Reading function bodies:
Performing interprocedural optimizations
<whole-program> <profile_estimate> <icf> <devirt> <cp> <targetclone> <inline> <pure-const> <static-var>Assembling functions:
<materialize-all-clones> <dispatchercalls> <simdclone> f2 f1 double test MAIN__Process 1310 stopped
* thread #1: tid = 0x54ac, 0x00000001008f76cf lto1`lto_input_tree_ref(ib=<unavailable>, data_in=0x0000000142621090, fn=0x0000000000000000, tag=<unavailable>) + 127 at lto-streamer-in.c:332, queue = 'com.apple.main-thread', stop reason = EXC_BAD_ACCESS (code=1, address=0x18)
frame #0: 0x00000001008f76cf lto1`lto_input_tree_ref(ib=<unavailable>, data_in=0x0000000142621090, fn=0x0000000000000000, tag=<unavailable>) + 127 at lto-streamer-in.c:332
329
330 case LTO_ssa_name_ref:
331 ix_u = streamer_read_uhwi (ib);
-> 332 result = (*SSANAMES (fn))[ix_u];
333 break;
334
335 case LTO_field_decl_ref:
(lldb) bt
* thread #1: tid = 0x54ac, 0x00000001008f76cf lto1`lto_input_tree_ref(ib=<unavailable>, data_in=0x0000000142621090, fn=0x0000000000000000, tag=<unavailable>) + 127 at lto-streamer-in.c:332, queue = 'com.apple.main-thread', stop reason = EXC_BAD_ACCESS (code=1, address=0x18)
* frame #0: 0x00000001008f76cf lto1`lto_input_tree_ref(ib=<unavailable>, data_in=0x0000000142621090, fn=0x0000000000000000, tag=<unavailable>) + 127 at lto-streamer-in.c:332
frame #1: 0x00000001008f78f1 lto1`lto_input_tree_1(ib=0x00007fff5fbfeeb0, data_in=0x0000000142621090, tag=<unavailable>, hash=<unavailable>) + 177 at lto-streamer-in.c:1446
frame #2: 0x00000001008f7cb8 lto1`lto_input_tree(ib=0x00007fff5fbfeeb0, data_in=0x0000000142621090) + 88 at lto-streamer-in.c:1492
frame #3: 0x0000000100ce8b43 lto1`streamer_read_tree_body(lto_input_block*, data_in*, tree_node*) + 51 at tree-streamer-in.c:893
frame #4: 0x0000000100ce8b10 lto1`streamer_read_tree_body(ib=0x00007fff5fbfeeb0, data_in=0x0000000142621090, expr=0x0000000143944af0) + 2096
frame #5: 0x00000001008f7110 lto1`::lto_read_tree_1(ib=0x00007fff5fbfeeb0, data_in=0x0000000142621090, expr=0x0000000143944af0) + 32 at lto-streamer-in.c:1333
frame #6: 0x00000001008f78b9 lto1`lto_input_tree_1(lto_input_block*, data_in*, LTO_tags, unsigned int) + 38 at lto-streamer-in.c:1363
frame #7: 0x00000001008f7893 lto1`lto_input_tree_1(lto_input_block*, data_in*, LTO_tags, unsigned int) + 20
frame #8: 0x00000001008f787f lto1`lto_input_tree_1(ib=0x00007fff5fbfeeb0, data_in=0x0000000142621090, tag=<unavailable>, hash=2871463685) + 63
frame #9: 0x00000001008f7c03 lto1`lto_input_scc(ib=0x00007fff5fbfeeb0, data_in=0x0000000142621090, len=0x00007fff5fbfede8, entry_len=0x00007fff5fbfedec) + 371 at lto-streamer-in.c:1387
frame #10: 0x00000001008f7c91 lto1`lto_input_tree(ib=0x00007fff5fbfeeb0, data_in=0x0000000142621090) + 49 at lto-streamer-in.c:1490
frame #11: 0x00000001008f8d93 lto1`::lto_read_body_or_constructor(file_data=0x0000000143721000, data=<unavailable>, node=<unavailable>, section_type=LTO_section_function_body) + 931 at lto-streamer-in.c:1045
frame #12: 0x000000010051a136 lto1`cgraph_node::get_untransformed_body(this=0x000000014391ee60) + 278 at cgraph.c:3581
frame #13: 0x0000000100526d9a lto1`cgraph_node::expand(this=0x000000014391ee60) + 74 at cgraphunit.c:1971
frame #14: 0x0000000100527f00 lto1`::output_in_order(no_reorder=<unavailable>) + 528 at cgraphunit.c:2244
frame #15: 0x0000000100528528 lto1`symbol_table::compile(this=0x0000000143526100) + 952 at cgraphunit.c:2488
frame #16: 0x0000000100034c68 lto1`lto_main() + 7112 at lto.c:3330
frame #17: 0x0000000100a87f1a lto1`::compile_file() + 58 at toplev.c:463
frame #18: 0x0000000100f97744 lto1`toplev::main(this=0x00007fff5fbff2b0, argc=<unavailable>, argv=<unavailable>) + 3636 at toplev.c:1983
frame #19: 0x0000000100f98c39 lto1`main(argc=2, argv=0x00007fff5fbff2f8) + 41 at main.c:39
frame #20: 0x00007fffcfa5a255 libdyld.dylib`start + 1
frame #21: 0x00007fffcfa5a255 libdyld.dylib`start + 1
The affected tests are
array_constructor_17.f90
auto_char_len_3.f90
char_length_14.f90
char_length_5.f90
char_result_*.f90
charlen_03.f90
deferred_type_param_4.f90
dummy_procedure_3.f90
mapping_[12].f90
module_read_[12].f90
parens_5.f90
pr57910.f90
proc_ptr_comp_16.f90
result_in_spec_2.f90
spec_expr_7.f90
string_length_1.f90
transfer_intrinsic_3.f90
widechar_6.f90
zero_length_1.f90
Note that I did not run lldb on all of them, thus I cannot guarantee that all fail along the same pattern.
Cheers,
Dominique
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2016-12-13 19:09 ` Janne Blomqvist
@ 2016-12-16 15:49 ` Andre Vehreschild
2016-12-16 18:02 ` Janne Blomqvist
0 siblings, 1 reply; 76+ messages in thread
From: Andre Vehreschild @ 2016-12-16 15:49 UTC (permalink / raw)
To: Janne Blomqvist; +Cc: Fortran List, GCC Patches
[-- Attachment #1: Type: text/plain, Size: 4818 bytes --]
Hi Janne, hi all,
as promised please find attached the change from int32 to size_t for the
caf-libraries. Because the caf-libraries do not require special notions
indicated by negative values I went for using size_t there. I assume this will
be easier to keep in sync for all caf-libraries, because the size_t is
available on all modern platforms. I also took the liberty to fix the
specifiers in trans-decl for the caf-function-declarations and update the
documentation on the caf-functions in gfortran.texi where some parameters where
missing.
These additional changes bootstrap fine and induce no new regressions on
x86_64-linux/f23.
I am still not sure, whether we shouldn't address the regression in
allocate_deferred_char_scalar_1. I did some research, but could not yet come to
a practical solution. The backend somehow deduces that the memory pointed to
has size 5 only. But I haven't found a way to do this in the front end.
Comments on these changes?
- Andre
On Tue, 13 Dec 2016 21:08:51 +0200
Janne Blomqvist <blomqvist.janne@gmail.com> wrote:
> On Mon, Dec 12, 2016 at 9:39 PM, Janne Blomqvist
> <blomqvist.janne@gmail.com> wrote:
> > On Mon, Dec 12, 2016 at 7:39 PM, Andre Vehreschild <vehre@gmx.de> wrote:
> >> Hi Janne,
> >>
> >> I found that you are favoring build_int_cst (size_type_node, 0) over
> >> size_zero_node. Is there a reason to this?
> >
> > Yes. AFAIU size_zero_node is a zero constant for sizetype which is not
> > the same as size_type_node.
> >
> > AFAIK the difference is that size_type_node is the C size_t type,
> > whereas sizetype is a GCC internal type used for address expressions.
> > On a "normal" target I understand that they are the same size, but
> > there are some slight differences in semantics, e.g. size_type_node
> > like C unsigned integer types is defined to wrap around on overflow
> > whereas sizetype is undefined on overflow.
> >
> > I don't know if GCC supports some strange targets with some kind of
> > segmented memory where the size of sizetype would be different from
> > size_type_node, but I guess it's possible in theory at least.
> >
> > That being said, now that you mention in I should be using
> > build_zero_cst (some_type_node) instead of
> > build_int_cst(some_type_node, 0). There's also build_one_cst that I
> > should use.
> >
> >> Furthermore did I have to patch this:
> >>
> >> diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
> >> index 585f25d..f374558 100644
> >> --- a/gcc/fortran/dump-parse-tree.c
> >> +++ b/gcc/fortran/dump-parse-tree.c
> >> @@ -465,7 +465,7 @@ show_expr (gfc_expr *p)
> >> break;
> >>
> >> case BT_HOLLERITH:
> >> - fprintf (dumpfile, "%dH", p->representation.length);
> >> + fprintf (dumpfile, "%zdH", p->representation.length);
> >> c = p->representation.string;
> >> for (i = 0; i < p->representation.length; i++, c++)
> >> {
> >>
> >> to bootstrap on x86_64-linux/f23.
> >
> > Ah, thanks for the catch. I'll fix it by using HOST_WIDE_INT_PRINT_DEC
> > since I'll have to change gfc_charlen_t to be a typedef form
> > HOST_WIDE_INT (see my answer to FX).
> >
> >> And I have this regression:
> >>
> >> FAIL: gfortran.dg/allocate_deferred_char_scalar_1.f03 -O1 (test for
> >> excess errors)
> >>
> >> allocate_deferred_char_scalar_1.f03:184:0:
> >>
> >> p = '12345679'
> >>
> >> Warning: '__builtin_memcpy' writing 8 bytes into a region of size 5
> >> overflows the destination [-Wstringop-overflow=]
> >> allocate_deferred_char_scalar_1.f03:242:0:
> >>
> >> p = 4_'12345679'
> >>
> >> Warning: '__builtin_memcpy' writing 32 bytes into a region of size 20
> >> overflows the destination [-Wstringop-overflow=]
> >
> > I'm seeing that too, but I assumed they would be fixed by Paul's
> > recent patch which I don't yet have in my tree yet due to the git
> > mirror being stuck..
> >
> >> Btw, the patch for changing the ABI of the coarray-libs is already nearly
> >> done. I just need to figure that what the state of regressions is with and
> >> without my change.
> >
> > Thanks.
> >
> > I'll produce an updated patch with the changes discussed so far.
> >
> >
> > --
> > Janne Blomqvist
>
> Hi,
>
> attached is the updated patch that applies on top of the original. I
> didn't do the charlen_zero_node etc, I just fixed the relatively few
> places in my previous patch rather than everywhere in the entire
> frontend.
>
> Now that the git mirror is working again, I see though those warnings
> with -O1 from gfortran.dg/allocate_deferred_char_scalar_1.f03 are
> still there, and Paul's patch didn't get rid of them. :(. I have
> looked at the tree dumps, however, and AFAICS it's a bogus warning.
>
> Ok for trunk?
>
--
Andre Vehreschild * Email: vehre ad gmx dot de
[-- Attachment #2: pr78534_caf_v1.clog --]
[-- Type: text/plain, Size: 1191 bytes --]
gcc/fortran/ChangeLog:
2016-12-16 Andre Vehreschild <vehre@gcc.gnu.org>
* gfortran.texi: Changed string length to size_t and added missing
documenation of parameters.
* trans-array.c (gfc_alloc_allocatable_for_assignment): Adapted to
string length being of size_t.
* trans-decl.c (gfc_build_builtin_function_decls): Likewise.
(generate_coarray_sym_init): Likewise.
* trans-expr.c (gfc_trans_structure_assign): Likewise.
* trans-intrinsic.c (conv_co_collective): Likewise.
(conv_intrinsic_move_alloc): Likewise.
* trans-stmt.c (gfc_trans_stop): Likewise.
(gfc_trans_lock_unlock): Likewise.
(gfc_trans_event_post_wait): Likewise.
(gfc_trans_sync): Likewise.
(gfc_trans_critical): Likewise.
(gfc_trans_allocate): Likewise.
* trans.c (gfc_allocate_using_caf_lib): Likewise.
(gfc_deallocate_with_status): Likewise.
(gfc_deallocate_scalar_with_status): Likewise.
libgfortran/ChangeLog:
2016-12-16 Andre Vehreschild <vehre@gcc.gnu.org>
* caf/libcaf.h: Fixed prototypes to use size_t for string lengths.
* caf/single.c (_gfortran_caf_sync_images): Adapted string length
parameter to use size_t now.
(_gfortran_caf_lock): Likewise.
(_gfortran_caf_unlock): Likewise.
[-- Attachment #3: pr78534_caf_v1.patch --]
[-- Type: text/x-patch, Size: 35010 bytes --]
diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index 5b05a3d..1604bc8 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -4211,7 +4211,7 @@ size or one for a scalar.
@item @emph{Syntax}:
@code{void caf_register (size_t size, caf_register_t type, caf_token_t *token,
-gfc_descriptor_t *desc, int *stat, char *errmsg, int errmsg_len)}
+gfc_descriptor_t *desc, int *stat, char *errmsg, size_t errmsg_len)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@@ -4263,7 +4263,7 @@ library is only expected to free memory it allocated itself during a call to
@item @emph{Syntax}:
@code{void caf_deregister (caf_token_t *token, caf_deregister_t type,
-int *stat, char *errmsg, int errmsg_len)}
+int *stat, char *errmsg, size_t errmsg_len)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@@ -4322,7 +4322,8 @@ to a remote image identified by the image_index.
@item @emph{Syntax}:
@code{void _gfortran_caf_send (caf_token_t token, size_t offset,
int image_index, gfc_descriptor_t *dest, caf_vector_t *dst_vector,
-gfc_descriptor_t *src, int dst_kind, int src_kind, bool may_require_tmp)}
+gfc_descriptor_t *src, int dst_kind, int src_kind, bool may_require_tmp,
+int *stat)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@@ -4345,6 +4346,9 @@ time that the @var{dest} and @var{src} either cannot overlap or overlap (fully
or partially) such that walking @var{src} and @var{dest} in element wise
element order (honoring the stride value) will not lead to wrong results.
Otherwise, the value is true.
+@item @var{stat} @tab intent(out) when non-NULL give the result of the
+operation, i.e., zero on success and non-zero on error. When NULL and error
+occurs, then an error message is printed and the program is terminated.
@end multitable
@item @emph{NOTES}
@@ -4375,7 +4379,8 @@ image identified by the image_index.
@item @emph{Syntax}:
@code{void _gfortran_caf_get (caf_token_t token, size_t offset,
int image_index, gfc_descriptor_t *src, caf_vector_t *src_vector,
-gfc_descriptor_t *dest, int src_kind, int dst_kind, bool may_require_tmp)}
+gfc_descriptor_t *dest, int src_kind, int dst_kind, bool may_require_tmp,
+int *stat)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@@ -4398,6 +4403,9 @@ time that the @var{dest} and @var{src} either cannot overlap or overlap (fully
or partially) such that walking @var{src} and @var{dest} in element wise
element order (honoring the stride value) will not lead to wrong results.
Otherwise, the value is true.
+@item @var{stat} @tab intent(out) when non-NULL give the result of the
+operation, i.e., zero on success and non-zero on error. When NULL and error
+occurs, then an error message is printed and the program is terminated.
@end multitable
@item @emph{NOTES}
@@ -4430,7 +4438,7 @@ dst_image_index.
int dst_image_index, gfc_descriptor_t *dest, caf_vector_t *dst_vector,
caf_token_t src_token, size_t src_offset, int src_image_index,
gfc_descriptor_t *src, caf_vector_t *src_vector, int dst_kind, int src_kind,
-bool may_require_tmp)}
+bool may_require_tmp, int *stat)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@@ -4461,6 +4469,9 @@ time that the @var{dest} and @var{src} either cannot overlap or overlap (fully
or partially) such that walking @var{src} and @var{dest} in element wise
element order (honoring the stride value) will not lead to wrong results.
Otherwise, the value is true.
+@item @var{stat} @tab intent(out) when non-NULL give the result of the
+operation, i.e., zero on success and non-zero on error. When NULL and error
+occurs, then an error message is printed and the program is terminated.
@end multitable
@item @emph{NOTES}
@@ -4673,7 +4684,7 @@ been locked by the same image is an error.
@item @emph{Syntax}:
@code{void _gfortran_caf_lock (caf_token_t token, size_t index, int image_index,
-int *aquired_lock, int *stat, char *errmsg, int errmsg_len)}
+int *aquired_lock, int *stat, char *errmsg, size_t errmsg_len)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@@ -4708,7 +4719,7 @@ which is unlocked or has been locked by a different image is an error.
@item @emph{Syntax}:
@code{void _gfortran_caf_unlock (caf_token_t token, size_t index, int image_index,
-int *stat, char *errmsg, int errmsg_len)}
+int *stat, char *errmsg, size_t errmsg_len)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@@ -4740,7 +4751,7 @@ Increment the event count of the specified event variable.
@item @emph{Syntax}:
@code{void _gfortran_caf_event_post (caf_token_t token, size_t index,
-int image_index, int *stat, char *errmsg, int errmsg_len)}
+int image_index, int *stat, char *errmsg, size_t errmsg_len)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@@ -4777,7 +4788,7 @@ amount and return.
@item @emph{Syntax}:
@code{void _gfortran_caf_event_wait (caf_token_t token, size_t index,
-int until_count, int *stat, char *errmsg, int errmsg_len)}
+int until_count, int *stat, char *errmsg, size_t errmsg_len)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@@ -4880,7 +4891,7 @@ transfers of previous segment have completed.
@item @emph{Syntax}:
@code{void _gfortran_caf_sync_images (int count, int images[], int *stat,
-char *errmsg, int errmsg_len)}
+char *errmsg, size_t errmsg_len)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@@ -4908,7 +4919,8 @@ Acts as optimization barrier between different segments. It also ensures that
all pending memory operations of this image have been completed.
@item @emph{Syntax}:
-@code{void _gfortran_caf_sync_memory (int *stat, char *errmsg, int errmsg_len)}
+@code{void _gfortran_caf_sync_memory (int *stat, char *errmsg,
+size_t errmsg_len)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@@ -4955,7 +4967,7 @@ Invoked for an @code{ERROR STOP} statement which has a string as argument. The
function should terminate the program with a nonzero-exit code.
@item @emph{Syntax}:
-@code{void _gfortran_caf_error_stop (const char *string, int32_t len)}
+@code{void _gfortran_caf_error_stop (const char *string, size_t len)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@@ -5116,7 +5128,7 @@ be called collectively.
@item @emph{Syntax}:
@code{void _gfortran_caf_co_broadcast (gfc_descriptor_t *a,
-int source_image, int *stat, char *errmsg, int errmsg_len)}
+int source_image, int *stat, char *errmsg, size_t errmsg_len)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@@ -5147,7 +5159,7 @@ strings.
@item @emph{Syntax}:
@code{void _gfortran_caf_co_max (gfc_descriptor_t *a, int result_image,
-int *stat, char *errmsg, int a_len, int errmsg_len)}
+int *stat, char *errmsg, int a_len, size_t errmsg_len)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@@ -5183,7 +5195,7 @@ strings.
@item @emph{Syntax}:
@code{void _gfortran_caf_co_min (gfc_descriptor_t *a, int result_image,
-int *stat, char *errmsg, int a_len, int errmsg_len)}
+int *stat, char *errmsg, int a_len, size_t errmsg_len)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@@ -5218,7 +5230,7 @@ specified image. This function operates on numeric values.
@item @emph{Syntax}:
@code{void _gfortran_caf_co_sum (gfc_descriptor_t *a, int result_image,
-int *stat, char *errmsg, int errmsg_len)}
+int *stat, char *errmsg, size_t errmsg_len)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
@@ -5262,7 +5274,7 @@ string lengths shall be specified as hidden argument;
@item @emph{Syntax}:
@code{void _gfortran_caf_co_reduce (gfc_descriptor_t *a,
void * (*opr) (void *, void *), int opr_flags, int result_image,
-int *stat, char *errmsg, int a_len, int errmsg_len)}
+int *stat, char *errmsg, int a_len, size_t errmsg_len)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 48d5a79..22e3b7f 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -9369,7 +9369,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
build_int_cst (integer_type_node,
GFC_CAF_COARRAY_DEALLOCATE_ONLY),
null_pointer_node, null_pointer_node,
- integer_zero_node);
+ size_zero_node);
gfc_add_expr_to_block (&realloc_block, tmp);
tmp = build_call_expr_loc (input_location,
gfor_fndecl_caf_register,
@@ -9378,7 +9378,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
GFC_CAF_COARRAY_ALLOC_ALLOCATE_ONLY),
token, gfc_build_addr_expr (NULL_TREE, desc),
null_pointer_node, null_pointer_node,
- integer_zero_node);
+ size_zero_node);
gfc_add_expr_to_block (&realloc_block, tmp);
}
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index b2786de..161e282 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -3606,12 +3606,12 @@ gfc_build_builtin_function_decls (void)
gfor_fndecl_caf_register = gfc_build_library_function_decl_with_spec (
get_identifier (PREFIX("caf_register")), "RRWWWWR", void_type_node, 7,
size_type_node, integer_type_node, ppvoid_type_node, pvoid_type_node,
- pint_type, pchar_type_node, integer_type_node);
+ pint_type, pchar_type_node, size_type_node);
gfor_fndecl_caf_deregister = gfc_build_library_function_decl_with_spec (
get_identifier (PREFIX("caf_deregister")), "WRWWR", void_type_node, 5,
ppvoid_type_node, integer_type_node, pint_type, pchar_type_node,
- integer_type_node);
+ size_type_node);
gfor_fndecl_caf_get = gfc_build_library_function_decl_with_spec (
get_identifier (PREFIX("caf_get")), ".R.RRWRRRW", void_type_node, 10,
@@ -3653,17 +3653,17 @@ gfc_build_builtin_function_decls (void)
boolean_type_node, pint_type, pint_type);
gfor_fndecl_caf_sync_all = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_sync_all")), ".WW", void_type_node,
- 3, pint_type, pchar_type_node, integer_type_node);
+ get_identifier (PREFIX("caf_sync_all")), ".WR", void_type_node,
+ 3, pint_type, pchar_type_node, size_type_node);
gfor_fndecl_caf_sync_memory = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_sync_memory")), ".WW", void_type_node,
- 3, pint_type, pchar_type_node, integer_type_node);
+ get_identifier (PREFIX("caf_sync_memory")), ".WR", void_type_node,
+ 3, pint_type, pchar_type_node, size_type_node);
gfor_fndecl_caf_sync_images = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_sync_images")), ".RRWW", void_type_node,
+ get_identifier (PREFIX("caf_sync_images")), ".RRWR", void_type_node,
5, integer_type_node, pint_type, pint_type,
- pchar_type_node, integer_type_node);
+ pchar_type_node, size_type_node);
gfor_fndecl_caf_error_stop = gfc_build_library_function_decl (
get_identifier (PREFIX("caf_error_stop")),
@@ -3672,97 +3672,99 @@ gfc_build_builtin_function_decls (void)
TREE_THIS_VOLATILE (gfor_fndecl_caf_error_stop) = 1;
gfor_fndecl_caf_error_stop_str = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_error_stop_str")), ".R.",
- void_type_node, 2, pchar_type_node, gfc_int4_type_node);
+ get_identifier (PREFIX("caf_error_stop_str")), "RR",
+ void_type_node, 2, pchar_type_node, size_type_node);
/* CAF's ERROR STOP doesn't return. */
TREE_THIS_VOLATILE (gfor_fndecl_caf_error_stop_str) = 1;
gfor_fndecl_caf_stop_numeric = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_stop_numeric")), ".R.",
+ get_identifier (PREFIX("caf_stop_numeric")), "R",
void_type_node, 1, gfc_int4_type_node);
/* CAF's STOP doesn't return. */
TREE_THIS_VOLATILE (gfor_fndecl_caf_stop_numeric) = 1;
gfor_fndecl_caf_stop_str = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_stop_str")), ".R.",
- void_type_node, 2, pchar_type_node, gfc_int4_type_node);
+ get_identifier (PREFIX("caf_stop_str")), "RR",
+ void_type_node, 2, pchar_type_node, size_type_node);
/* CAF's STOP doesn't return. */
TREE_THIS_VOLATILE (gfor_fndecl_caf_stop_str) = 1;
gfor_fndecl_caf_atomic_def = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_atomic_define")), "R..RW",
+ get_identifier (PREFIX("caf_atomic_define")), "WRRRWRR",
void_type_node, 7, pvoid_type_node, size_type_node, integer_type_node,
pvoid_type_node, pint_type, integer_type_node, integer_type_node);
gfor_fndecl_caf_atomic_ref = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_atomic_ref")), "R..WW",
+ get_identifier (PREFIX("caf_atomic_ref")), "RRRWWRR",
void_type_node, 7, pvoid_type_node, size_type_node, integer_type_node,
pvoid_type_node, pint_type, integer_type_node, integer_type_node);
gfor_fndecl_caf_atomic_cas = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_atomic_cas")), "R..WRRW",
+ get_identifier (PREFIX("caf_atomic_cas")), "RRRWRRWRR",
void_type_node, 9, pvoid_type_node, size_type_node, integer_type_node,
pvoid_type_node, pvoid_type_node, pvoid_type_node, pint_type,
integer_type_node, integer_type_node);
gfor_fndecl_caf_atomic_op = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_atomic_op")), ".R..RWW",
+ get_identifier (PREFIX("caf_atomic_op")), "RRRRWRWRR",
void_type_node, 9, integer_type_node, pvoid_type_node, size_type_node,
integer_type_node, pvoid_type_node, pvoid_type_node, pint_type,
integer_type_node, integer_type_node);
gfor_fndecl_caf_lock = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_lock")), "R..WWW",
+ get_identifier (PREFIX("caf_lock")), "RRRWWWR",
void_type_node, 7, pvoid_type_node, size_type_node, integer_type_node,
- pint_type, pint_type, pchar_type_node, integer_type_node);
+ pint_type, pint_type, pchar_type_node, size_type_node);
gfor_fndecl_caf_unlock = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_unlock")), "R..WW",
+ get_identifier (PREFIX("caf_unlock")), "RRRWWR",
void_type_node, 6, pvoid_type_node, size_type_node, integer_type_node,
- pint_type, pchar_type_node, integer_type_node);
+ pint_type, pchar_type_node, size_type_node);
gfor_fndecl_caf_event_post = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_event_post")), "R..WW",
+ get_identifier (PREFIX("caf_event_post")), "RRRWWR",
void_type_node, 6, pvoid_type_node, size_type_node, integer_type_node,
- pint_type, pchar_type_node, integer_type_node);
+ pint_type, pchar_type_node, size_type_node);
gfor_fndecl_caf_event_wait = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_event_wait")), "R..WW",
+ get_identifier (PREFIX("caf_event_wait")), "RRRWWR",
void_type_node, 6, pvoid_type_node, size_type_node, integer_type_node,
- pint_type, pchar_type_node, integer_type_node);
+ pint_type, pchar_type_node, size_type_node);
gfor_fndecl_caf_event_query = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_event_query")), "R..WW",
+ get_identifier (PREFIX("caf_event_query")), "RRRWW",
void_type_node, 5, pvoid_type_node, size_type_node, integer_type_node,
pint_type, pint_type);
gfor_fndecl_co_broadcast = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_co_broadcast")), "W.WW",
+ get_identifier (PREFIX("caf_co_broadcast")), "WRWWR",
void_type_node, 5, pvoid_type_node, integer_type_node,
- pint_type, pchar_type_node, integer_type_node);
+ pint_type, pchar_type_node, size_type_node);
gfor_fndecl_co_max = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_co_max")), "W.WW",
+ get_identifier (PREFIX("caf_co_max")), "WRWWRR",
void_type_node, 6, pvoid_type_node, integer_type_node,
- pint_type, pchar_type_node, integer_type_node, integer_type_node);
+ pint_type, pchar_type_node, size_type_node,
+ size_type_node);
gfor_fndecl_co_min = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_co_min")), "W.WW",
+ get_identifier (PREFIX("caf_co_min")), "WRWWRR",
void_type_node, 6, pvoid_type_node, integer_type_node,
- pint_type, pchar_type_node, integer_type_node, integer_type_node);
+ pint_type, pchar_type_node, size_type_node,
+ size_type_node);
gfor_fndecl_co_reduce = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_co_reduce")), "W.R.WW",
+ get_identifier (PREFIX("caf_co_reduce")), "WRRRWWRR",
void_type_node, 8, pvoid_type_node,
build_pointer_type (build_varargs_function_type_list (void_type_node,
NULL_TREE)),
integer_type_node, integer_type_node, pint_type, pchar_type_node,
- integer_type_node, integer_type_node);
+ size_type_node, size_type_node);
gfor_fndecl_co_sum = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_co_sum")), "W.WW",
+ get_identifier (PREFIX("caf_co_sum")), "WRWWR",
void_type_node, 5, pvoid_type_node, integer_type_node,
- pint_type, pchar_type_node, integer_type_node);
+ pint_type, pchar_type_node, size_type_node);
gfor_fndecl_caf_is_present = gfc_build_library_function_decl_with_spec (
get_identifier (PREFIX("caf_is_present")), "RRR",
@@ -5141,7 +5143,7 @@ generate_coarray_sym_init (gfc_symbol *sym)
token, gfc_build_addr_expr (pvoid_type_node, desc),
null_pointer_node, /* stat. */
null_pointer_node, /* errgmsg. */
- integer_zero_node); /* errmsg_len. */
+ size_zero_node); /* errmsg_len. */
gfc_add_expr_to_block (&caf_init_block, tmp);
gfc_add_modify (&caf_init_block, decl, fold_convert (TREE_TYPE (decl),
gfc_conv_descriptor_data_get (desc)));
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 86c49cf..aef3199 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -7560,7 +7560,7 @@ gfc_trans_structure_assign (tree dest, gfc_expr * expr, bool init, bool coarray)
token),
gfc_build_addr_expr (NULL_TREE, desc),
null_pointer_node, null_pointer_node,
- integer_zero_node);
+ size_zero_node);
gfc_add_expr_to_block (&block, tmp);
}
field = cm->backend_decl;
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 5461666..1db08fa 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -9605,12 +9605,12 @@ conv_co_collective (gfc_code *code)
gfc_add_block_to_block (&block, &argse.pre);
gfc_add_block_to_block (&post_block, &argse.post);
errmsg = argse.expr;
- errmsg_len = fold_convert (integer_type_node, argse.string_length);
+ errmsg_len = fold_convert (size_type_node, argse.string_length);
}
else
{
errmsg = null_pointer_node;
- errmsg_len = integer_zero_node;
+ errmsg_len = size_zero_node;
}
/* Generate the function call. */
@@ -10493,7 +10493,7 @@ conv_intrinsic_move_alloc (gfc_code *code)
null_pointer_node));
tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_sync_all,
3, null_pointer_node, null_pointer_node,
- build_int_cst (integer_type_node, 0));
+ size_zero_node);
tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
tmp, build_empty_stmt (input_location));
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 465338a..1d834aa 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -629,7 +629,6 @@ gfc_trans_stop (gfc_code *code, bool error_stop)
if (code->expr1 == NULL)
{
- tmp = build_int_cst (gfc_int4_type_node, 0);
tmp = build_call_expr_loc (input_location,
error_stop
? (flag_coarray == GFC_FCOARRAY_LIB
@@ -638,7 +637,7 @@ gfc_trans_stop (gfc_code *code, bool error_stop)
: (flag_coarray == GFC_FCOARRAY_LIB
? gfor_fndecl_caf_stop_str
: gfor_fndecl_stop_string),
- 2, build_int_cst (pchar_type_node, 0), tmp);
+ 2, null_pointer_node, size_zero_node);
}
else if (code->expr1->ts.type == BT_INTEGER)
{
@@ -787,12 +786,12 @@ gfc_trans_lock_unlock (gfc_code *code, gfc_exec_op op)
gfc_conv_expr (&argse, code->expr3);
gfc_add_block_to_block (&se.pre, &argse.pre);
errmsg = argse.expr;
- errmsg_len = fold_convert (integer_type_node, argse.string_length);
+ errmsg_len = fold_convert (size_type_node, argse.string_length);
}
else
{
errmsg = null_pointer_node;
- errmsg_len = integer_zero_node;
+ errmsg_len = size_zero_node;
}
if (stat != null_pointer_node && TREE_TYPE (stat) != integer_type_node)
@@ -986,12 +985,12 @@ gfc_trans_event_post_wait (gfc_code *code, gfc_exec_op op)
gfc_conv_expr (&argse, code->expr3);
gfc_add_block_to_block (&se.pre, &argse.pre);
errmsg = argse.expr;
- errmsg_len = fold_convert (integer_type_node, argse.string_length);
+ errmsg_len = fold_convert (size_type_node, argse.string_length);
}
else
{
errmsg = null_pointer_node;
- errmsg_len = integer_zero_node;
+ errmsg_len = size_zero_node;
}
if (stat != null_pointer_node && TREE_TYPE (stat) != integer_type_node)
@@ -1075,7 +1074,7 @@ gfc_trans_sync (gfc_code *code, gfc_exec_op type)
else if (flag_coarray == GFC_FCOARRAY_LIB)
{
errmsg = null_pointer_node;
- errmsglen = build_int_cst (integer_type_node, 0);
+ errmsglen = size_zero_node;
}
/* Check SYNC IMAGES(imageset) for valid image index.
@@ -1436,7 +1435,7 @@ gfc_trans_critical (gfc_code *code)
tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_lock, 7,
token, integer_zero_node, integer_one_node,
null_pointer_node, null_pointer_node,
- null_pointer_node, integer_zero_node);
+ null_pointer_node, size_zero_node);
gfc_add_expr_to_block (&block, tmp);
/* It guarantees memory consistency within the same segment */
@@ -1459,7 +1458,7 @@ gfc_trans_critical (gfc_code *code)
tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_unlock, 6,
token, integer_zero_node, integer_one_node,
null_pointer_node, null_pointer_node,
- integer_zero_node);
+ size_zero_node);
gfc_add_expr_to_block (&block, tmp);
/* It guarantees memory consistency within the same segment */
@@ -5540,7 +5539,7 @@ gfc_trans_allocate (gfc_code * code)
else
{
errmsg = null_pointer_node;
- errlen = build_int_cst (gfc_charlen_type_node, 0);
+ errlen = size_zero_node;
}
/* GOTO destinations. */
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index e5dd986..fd3cc12 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -728,8 +728,10 @@ gfc_allocate_using_caf_lib (stmtblock_t * block, tree pointer, tree size,
{
gcc_assert(errlen == NULL_TREE);
errmsg = null_pointer_node;
- errlen = build_int_cst (integer_type_node, 0);
+ errlen = size_zero_node;
}
+ else
+ errlen = fold_convert (size_type_node, errlen);
size = fold_convert (size_type_node, size);
tmp = build_call_expr_loc (input_location,
@@ -1415,7 +1417,7 @@ gfc_deallocate_with_status (tree pointer, tree status, tree errmsg,
{
gcc_assert (errlen == NULL_TREE);
errmsg = null_pointer_node;
- errlen = build_zero_cst (integer_type_node);
+ errlen = size_zero_node;
}
else
{
@@ -1597,7 +1599,7 @@ gfc_deallocate_scalar_with_status (tree pointer, tree status, tree label_finish,
gfor_fndecl_caf_deregister, 5,
token, build_int_cst (integer_type_node,
caf_dereg_type),
- pstat, null_pointer_node, integer_zero_node);
+ pstat, null_pointer_node, size_zero_node);
gfc_add_expr_to_block (&non_null, tmp);
/* It guarantees memory consistency within the same segment. */
diff --git a/libgfortran/caf/libcaf.h b/libgfortran/caf/libcaf.h
index 1bb5176..af45356 100644
--- a/libgfortran/caf/libcaf.h
+++ b/libgfortran/caf/libcaf.h
@@ -183,28 +183,31 @@ int _gfortran_caf_this_image (int);
int _gfortran_caf_num_images (int, int);
void _gfortran_caf_register (size_t, caf_register_t, caf_token_t *,
- gfc_descriptor_t *, int *, char *, int);
+ gfc_descriptor_t *, int *, char *, size_t);
void _gfortran_caf_deregister (caf_token_t *, caf_deregister_t, int *, char *,
- int);
+ size_t);
-void _gfortran_caf_sync_all (int *, char *, int);
-void _gfortran_caf_sync_memory (int *, char *, int);
-void _gfortran_caf_sync_images (int, int[], int *, char *, int);
+void _gfortran_caf_sync_all (int *, char *, size_t);
+void _gfortran_caf_sync_memory (int *, char *, size_t);
+void _gfortran_caf_sync_images (int, int[], int *, char *, size_t);
void _gfortran_caf_stop_numeric (int32_t)
__attribute__ ((noreturn));
-void _gfortran_caf_stop_str (const char *, int32_t)
+void _gfortran_caf_stop_str (const char *, size_t)
__attribute__ ((noreturn));
-void _gfortran_caf_error_stop_str (const char *, int32_t)
+void _gfortran_caf_error_stop_str (const char *, size_t)
__attribute__ ((noreturn));
void _gfortran_caf_error_stop (int32_t) __attribute__ ((noreturn));
-void _gfortran_caf_co_broadcast (gfc_descriptor_t *, int, int *, char *, int);
-void _gfortran_caf_co_sum (gfc_descriptor_t *, int, int *, char *, int);
-void _gfortran_caf_co_min (gfc_descriptor_t *, int, int *, char *, int, int);
-void _gfortran_caf_co_max (gfc_descriptor_t *, int, int *, char *, int, int);
+void _gfortran_caf_co_broadcast (gfc_descriptor_t *, int, int *, char *,
+ size_t);
+void _gfortran_caf_co_sum (gfc_descriptor_t *, int, int *, char *, size_t);
+void _gfortran_caf_co_min (gfc_descriptor_t *, int, int *, char *, size_t,
+ size_t);
+void _gfortran_caf_co_max (gfc_descriptor_t *, int, int *, char *, size_t,
+ size_t);
void _gfortran_caf_co_reduce (gfc_descriptor_t *, void* (*) (void *, void*),
- int, int, int *, char *, int, int);
+ int, int, int *, char *, size_t, size_t);
void _gfortran_caf_get (caf_token_t, size_t, int, gfc_descriptor_t *,
caf_vector_t *, gfc_descriptor_t *, int, int, bool,
@@ -237,10 +240,11 @@ void _gfortran_caf_atomic_cas (caf_token_t, size_t, int, void *, void *,
void _gfortran_caf_atomic_op (int, caf_token_t, size_t, int, void *, void *,
int *, int, int);
-void _gfortran_caf_lock (caf_token_t, size_t, int, int *, int *, char *, int);
-void _gfortran_caf_unlock (caf_token_t, size_t, int, int *, char *, int);
-void _gfortran_caf_event_post (caf_token_t, size_t, int, int *, char *, int);
-void _gfortran_caf_event_wait (caf_token_t, size_t, int, int *, char *, int);
+void _gfortran_caf_lock (caf_token_t, size_t, int, int *, int *, char *,
+ size_t);
+void _gfortran_caf_unlock (caf_token_t, size_t, int, int *, char *, size_t);
+void _gfortran_caf_event_post (caf_token_t, size_t, int, int *, char *, size_t);
+void _gfortran_caf_event_wait (caf_token_t, size_t, int, int *, char *, size_t);
void _gfortran_caf_event_query (caf_token_t, size_t, int, int *, int *);
int _gfortran_caf_is_present (caf_token_t, int, caf_reference_t *);
diff --git a/libgfortran/caf/single.c b/libgfortran/caf/single.c
index d1b3359..6d37965 100644
--- a/libgfortran/caf/single.c
+++ b/libgfortran/caf/single.c
@@ -134,7 +134,7 @@ _gfortran_caf_num_images (int distance __attribute__ ((unused)),
void
_gfortran_caf_register (size_t size, caf_register_t type, caf_token_t *token,
gfc_descriptor_t *data, int *stat, char *errmsg,
- int errmsg_len)
+ size_t errmsg_len)
{
const char alloc_fail_msg[] = "Failed to allocate coarray";
void *local;
@@ -192,7 +192,7 @@ _gfortran_caf_register (size_t size, caf_register_t type, caf_token_t *token,
void
_gfortran_caf_deregister (caf_token_t *token, caf_deregister_t type, int *stat,
char *errmsg __attribute__ ((unused)),
- int errmsg_len __attribute__ ((unused)))
+ size_t errmsg_len __attribute__ ((unused)))
{
caf_single_token_t single_token = TOKEN (*token);
@@ -218,7 +218,7 @@ _gfortran_caf_deregister (caf_token_t *token, caf_deregister_t type, int *stat,
void
_gfortran_caf_sync_all (int *stat,
char *errmsg __attribute__ ((unused)),
- int errmsg_len __attribute__ ((unused)))
+ size_t errmsg_len __attribute__ ((unused)))
{
__asm__ __volatile__ ("":::"memory");
if (stat)
@@ -229,7 +229,7 @@ _gfortran_caf_sync_all (int *stat,
void
_gfortran_caf_sync_memory (int *stat,
char *errmsg __attribute__ ((unused)),
- int errmsg_len __attribute__ ((unused)))
+ size_t errmsg_len __attribute__ ((unused)))
{
__asm__ __volatile__ ("":::"memory");
if (stat)
@@ -242,7 +242,7 @@ _gfortran_caf_sync_images (int count __attribute__ ((unused)),
int images[] __attribute__ ((unused)),
int *stat,
char *errmsg __attribute__ ((unused)),
- int errmsg_len __attribute__ ((unused)))
+ size_t errmsg_len __attribute__ ((unused)))
{
#ifdef GFC_CAF_CHECK
int i;
@@ -262,14 +262,14 @@ _gfortran_caf_sync_images (int count __attribute__ ((unused)),
}
void
-_gfortran_caf_stop_numeric(int32_t stop_code)
+_gfortran_caf_stop_numeric (int32_t stop_code)
{
fprintf (stderr, "STOP %d\n", stop_code);
exit (0);
}
void
-_gfortran_caf_stop_str(const char *string, int32_t len)
+_gfortran_caf_stop_str (const char *string, size_t len)
{
fputs ("STOP ", stderr);
while (len--)
@@ -280,7 +280,7 @@ _gfortran_caf_stop_str(const char *string, int32_t len)
}
void
-_gfortran_caf_error_stop_str (const char *string, int32_t len)
+_gfortran_caf_error_stop_str (const char *string, size_t len)
{
fputs ("ERROR STOP ", stderr);
while (len--)
@@ -303,7 +303,7 @@ void
_gfortran_caf_co_broadcast (gfc_descriptor_t *a __attribute__ ((unused)),
int source_image __attribute__ ((unused)),
int *stat, char *errmsg __attribute__ ((unused)),
- int errmsg_len __attribute__ ((unused)))
+ size_t errmsg_len __attribute__ ((unused)))
{
if (stat)
*stat = 0;
@@ -313,7 +313,7 @@ void
_gfortran_caf_co_sum (gfc_descriptor_t *a __attribute__ ((unused)),
int result_image __attribute__ ((unused)),
int *stat, char *errmsg __attribute__ ((unused)),
- int errmsg_len __attribute__ ((unused)))
+ size_t errmsg_len __attribute__ ((unused)))
{
if (stat)
*stat = 0;
@@ -323,8 +323,8 @@ void
_gfortran_caf_co_min (gfc_descriptor_t *a __attribute__ ((unused)),
int result_image __attribute__ ((unused)),
int *stat, char *errmsg __attribute__ ((unused)),
- int a_len __attribute__ ((unused)),
- int errmsg_len __attribute__ ((unused)))
+ size_t a_len __attribute__ ((unused)),
+ size_t errmsg_len __attribute__ ((unused)))
{
if (stat)
*stat = 0;
@@ -334,8 +334,8 @@ void
_gfortran_caf_co_max (gfc_descriptor_t *a __attribute__ ((unused)),
int result_image __attribute__ ((unused)),
int *stat, char *errmsg __attribute__ ((unused)),
- int a_len __attribute__ ((unused)),
- int errmsg_len __attribute__ ((unused)))
+ size_t a_len __attribute__ ((unused)),
+ size_t errmsg_len __attribute__ ((unused)))
{
if (stat)
*stat = 0;
@@ -344,13 +344,13 @@ _gfortran_caf_co_max (gfc_descriptor_t *a __attribute__ ((unused)),
void
_gfortran_caf_co_reduce (gfc_descriptor_t *a __attribute__ ((unused)),
- void * (*opr) (void *, void *)
- __attribute__ ((unused)),
- int opr_flags __attribute__ ((unused)),
- int result_image __attribute__ ((unused)),
- int *stat, char *errmsg __attribute__ ((unused)),
- int a_len __attribute__ ((unused)),
- int errmsg_len __attribute__ ((unused)))
+ void * (*opr) (void *, void *)
+ __attribute__ ((unused)),
+ int opr_flags __attribute__ ((unused)),
+ int result_image __attribute__ ((unused)),
+ int *stat, char *errmsg __attribute__ ((unused)),
+ size_t a_len __attribute__ ((unused)),
+ size_t errmsg_len __attribute__ ((unused)))
{
if (stat)
*stat = 0;
@@ -2783,7 +2783,7 @@ void
_gfortran_caf_event_post (caf_token_t token, size_t index,
int image_index __attribute__ ((unused)),
int *stat, char *errmsg __attribute__ ((unused)),
- int errmsg_len __attribute__ ((unused)))
+ size_t errmsg_len __attribute__ ((unused)))
{
uint32_t value = 1;
uint32_t *event = (uint32_t *) ((char *) MEMTOK (token) + index
@@ -2798,7 +2798,7 @@ void
_gfortran_caf_event_wait (caf_token_t token, size_t index,
int until_count, int *stat,
char *errmsg __attribute__ ((unused)),
- int errmsg_len __attribute__ ((unused)))
+ size_t errmsg_len __attribute__ ((unused)))
{
uint32_t *event = (uint32_t *) ((char *) MEMTOK (token) + index
* sizeof (uint32_t));
@@ -2825,7 +2825,8 @@ _gfortran_caf_event_query (caf_token_t token, size_t index,
void
_gfortran_caf_lock (caf_token_t token, size_t index,
int image_index __attribute__ ((unused)),
- int *aquired_lock, int *stat, char *errmsg, int errmsg_len)
+ int *aquired_lock, int *stat, char *errmsg,
+ size_t errmsg_len)
{
const char *msg = "Already locked";
bool *lock = &((bool *) MEMTOK (token))[index];
@@ -2854,22 +2855,21 @@ _gfortran_caf_lock (caf_token_t token, size_t index,
*stat = 1;
if (errmsg_len > 0)
{
- int len = ((int) sizeof (msg) > errmsg_len) ? errmsg_len
- : (int) sizeof (msg);
+ size_t len = (sizeof (msg) > errmsg_len) ? errmsg_len : sizeof (msg);
memcpy (errmsg, msg, len);
if (errmsg_len > len)
memset (&errmsg[len], ' ', errmsg_len-len);
}
return;
}
- _gfortran_caf_error_stop_str (msg, (int32_t) strlen (msg));
+ _gfortran_caf_error_stop_str (msg, strlen (msg));
}
void
_gfortran_caf_unlock (caf_token_t token, size_t index,
int image_index __attribute__ ((unused)),
- int *stat, char *errmsg, int errmsg_len)
+ int *stat, char *errmsg, size_t errmsg_len)
{
const char *msg = "Variable is not locked";
bool *lock = &((bool *) MEMTOK (token))[index];
@@ -2887,15 +2887,14 @@ _gfortran_caf_unlock (caf_token_t token, size_t index,
*stat = 1;
if (errmsg_len > 0)
{
- int len = ((int) sizeof (msg) > errmsg_len) ? errmsg_len
- : (int) sizeof (msg);
+ size_t len = (sizeof (msg) > errmsg_len) ? errmsg_len : sizeof (msg);
memcpy (errmsg, msg, len);
if (errmsg_len > len)
memset (&errmsg[len], ' ', errmsg_len-len);
}
return;
}
- _gfortran_caf_error_stop_str (msg, (int32_t) strlen (msg));
+ _gfortran_caf_error_stop_str (msg, strlen (msg));
}
int
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2016-12-12 19:39 ` Janne Blomqvist
2016-12-12 20:19 ` Andre Vehreschild
@ 2016-12-13 19:09 ` Janne Blomqvist
2016-12-16 15:49 ` Andre Vehreschild
1 sibling, 1 reply; 76+ messages in thread
From: Janne Blomqvist @ 2016-12-13 19:09 UTC (permalink / raw)
To: Andre Vehreschild; +Cc: Fortran List, GCC Patches
[-- Attachment #1: Type: text/plain, Size: 3515 bytes --]
On Mon, Dec 12, 2016 at 9:39 PM, Janne Blomqvist
<blomqvist.janne@gmail.com> wrote:
> On Mon, Dec 12, 2016 at 7:39 PM, Andre Vehreschild <vehre@gmx.de> wrote:
>> Hi Janne,
>>
>> I found that you are favoring build_int_cst (size_type_node, 0) over
>> size_zero_node. Is there a reason to this?
>
> Yes. AFAIU size_zero_node is a zero constant for sizetype which is not
> the same as size_type_node.
>
> AFAIK the difference is that size_type_node is the C size_t type,
> whereas sizetype is a GCC internal type used for address expressions.
> On a "normal" target I understand that they are the same size, but
> there are some slight differences in semantics, e.g. size_type_node
> like C unsigned integer types is defined to wrap around on overflow
> whereas sizetype is undefined on overflow.
>
> I don't know if GCC supports some strange targets with some kind of
> segmented memory where the size of sizetype would be different from
> size_type_node, but I guess it's possible in theory at least.
>
> That being said, now that you mention in I should be using
> build_zero_cst (some_type_node) instead of
> build_int_cst(some_type_node, 0). There's also build_one_cst that I
> should use.
>
>> Furthermore did I have to patch this:
>>
>> diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
>> index 585f25d..f374558 100644
>> --- a/gcc/fortran/dump-parse-tree.c
>> +++ b/gcc/fortran/dump-parse-tree.c
>> @@ -465,7 +465,7 @@ show_expr (gfc_expr *p)
>> break;
>>
>> case BT_HOLLERITH:
>> - fprintf (dumpfile, "%dH", p->representation.length);
>> + fprintf (dumpfile, "%zdH", p->representation.length);
>> c = p->representation.string;
>> for (i = 0; i < p->representation.length; i++, c++)
>> {
>>
>> to bootstrap on x86_64-linux/f23.
>
> Ah, thanks for the catch. I'll fix it by using HOST_WIDE_INT_PRINT_DEC
> since I'll have to change gfc_charlen_t to be a typedef form
> HOST_WIDE_INT (see my answer to FX).
>
>> And I have this regression:
>>
>> FAIL: gfortran.dg/allocate_deferred_char_scalar_1.f03 -O1 (test for excess
>> errors)
>>
>> allocate_deferred_char_scalar_1.f03:184:0:
>>
>> p = '12345679'
>>
>> Warning: '__builtin_memcpy' writing 8 bytes into a region of size 5 overflows
>> the destination [-Wstringop-overflow=]
>> allocate_deferred_char_scalar_1.f03:242:0:
>>
>> p = 4_'12345679'
>>
>> Warning: '__builtin_memcpy' writing 32 bytes into a region of size 20 overflows
>> the destination [-Wstringop-overflow=]
>
> I'm seeing that too, but I assumed they would be fixed by Paul's
> recent patch which I don't yet have in my tree yet due to the git
> mirror being stuck..
>
>> Btw, the patch for changing the ABI of the coarray-libs is already nearly done.
>> I just need to figure that what the state of regressions is with and without my
>> change.
>
> Thanks.
>
> I'll produce an updated patch with the changes discussed so far.
>
>
> --
> Janne Blomqvist
Hi,
attached is the updated patch that applies on top of the original. I
didn't do the charlen_zero_node etc, I just fixed the relatively few
places in my previous patch rather than everywhere in the entire
frontend.
Now that the git mirror is working again, I see though those warnings
with -O1 from gfortran.dg/allocate_deferred_char_scalar_1.f03 are
still there, and Paul's patch didn't get rid of them. :(. I have
looked at the tree dumps, however, and AFAICS it's a bogus warning.
Ok for trunk?
--
Janne Blomqvist
[-- Attachment #2: charlen-2.diff --]
[-- Type: text/plain, Size: 11107 bytes --]
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 585f25d..7aafe54 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -348,12 +348,10 @@ show_constructor (gfc_constructor_base base)
static void
-show_char_const (const gfc_char_t *c, int length)
+show_char_const (const gfc_char_t *c, gfc_charlen_t length)
{
- int i;
-
fputc ('\'', dumpfile);
- for (i = 0; i < length; i++)
+ for (gfc_charlen_t i = 0; i < length; i++)
{
if (c[i] == '\'')
fputs ("''", dumpfile);
@@ -465,7 +463,8 @@ show_expr (gfc_expr *p)
break;
case BT_HOLLERITH:
- fprintf (dumpfile, "%dH", p->representation.length);
+ fprintf (dumpfile, HOST_WIDE_INT_PRINT_DEC "H",
+ p->representation.length);
c = p->representation.string;
for (i = 0; i < p->representation.length; i++, c++)
{
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 6a05e9e..e82c320 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2067,10 +2067,12 @@ gfc_intrinsic_sym;
typedef splay_tree gfc_constructor_base;
-/* This should be a size_t. But occasionally the string length field
- is used as a flag with values -1 and -2, see
- e.g. gfc_add_assign_aux_vars. */
-typedef ptrdiff_t gfc_charlen_t;
+/* 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
{
diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index 5e2a750..5b05a3d 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -3812,10 +3812,10 @@ or GCC's Ada compiler for @code{Boolean}.)
For arguments of @code{CHARACTER} type, the character length is passed
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.
+@code{INTEGER(kind=C_SIZE_T)}. 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/match.c b/gcc/fortran/match.c
index 6184289..aaeb4a7 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -5782,8 +5782,8 @@ select_intrinsic_set_tmp (gfc_typespec *ts)
sprintf (name, "__tmp_%s_%d", gfc_basic_typename (ts->type),
ts->kind);
else
- sprintf (name, "__tmp_%s_%ld_%d", gfc_basic_typename (ts->type),
- charlen, ts->kind);
+ sprintf (name, "__tmp_%s_" HOST_WIDE_INT_PRINT_DEC "_%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/resolve.c b/gcc/fortran/resolve.c
index 150f0c6..fac531f 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -8727,8 +8727,8 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns)
if (c->ts.u.cl && c->ts.u.cl->length
&& c->ts.u.cl->length->expr_type == EXPR_CONSTANT)
charlen = mpz_get_si (c->ts.u.cl->length->value.integer);
- sprintf (name, "__tmp_%s_%ld_%d", gfc_basic_typename (c->ts.type),
- charlen, c->ts.kind);
+ sprintf (name, "__tmp_%s_" HOST_WIDE_INT_PRINT_DEC "_%d",
+ gfc_basic_typename (c->ts.type), charlen, c->ts.kind);
}
else
sprintf (name, "__tmp_%s_%d", gfc_basic_typename (c->ts.type),
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 5b4bb2e..179e136 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_int_cst (gfc_charlen_type_node, 0);
+ : build_zero_cst (gfc_charlen_type_node);
}
@@ -1042,7 +1042,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_int_cst (size_type_node, 0);
+ slen = build_zero_cst (size_type_node);
}
else
{
@@ -1089,7 +1089,7 @@ gfc_conv_class_to_class (gfc_se *parmse, gfc_expr *e, gfc_typespec class_ts,
tmp = slen;
}
else
- tmp = build_int_cst (size_type_node, 0);
+ tmp = build_zero_cst (size_type_node);
gfc_add_modify (&parmse->pre, ctree,
fold_convert (TREE_TYPE (ctree), tmp));
@@ -1228,7 +1228,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_int_cst (size_type_node, 0);
+ from_len = build_zero_cst (size_type_node);
}
if (GFC_CLASS_TYPE_P (TREE_TYPE (to)))
@@ -1340,7 +1340,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_int_cst (TREE_TYPE (from_len), 0));
+ build_zero_cst (TREE_TYPE (from_len)));
tmp = fold_build3_loc (input_location, COND_EXPR,
void_type_node, tmp, extcopy, stdcopy);
gfc_add_expr_to_block (&body, tmp);
@@ -1368,7 +1368,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_int_cst (TREE_TYPE (from_len), 0));
+ build_zero_cst (TREE_TYPE (from_len)));
tmp = fold_build3_loc (input_location, COND_EXPR,
void_type_node, tmp, extcopy, stdcopy);
}
@@ -2196,7 +2196,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_int_cst (TREE_TYPE (se.expr), 0));
+ se.expr, build_zero_cst (TREE_TYPE (se.expr)));
gfc_add_block_to_block (pblock, &se.pre);
if (cl->backend_decl)
@@ -2268,7 +2268,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_int_cst (TREE_TYPE (start.expr), 1));
+ build_one_cst (TREE_TYPE (start.expr)));
fault = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
boolean_type_node, nonempty, fault);
if (name)
@@ -5877,7 +5877,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_int_cst (TREE_TYPE (tmp), 0));
+ build_zero_cst (TREE_TYPE (tmp)));
cl.backend_decl = tmp;
}
@@ -8111,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_int_cst (gfc_charlen_type_node, 0);
+ from_len = build_zero_cst (gfc_charlen_type_node);
}
gfc_add_modify (pre, to_len, fold_convert (TREE_TYPE (to_len),
from_len));
@@ -8240,7 +8240,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_int_cst (TREE_TYPE (lse.string_length), 0));
+ build_zero_cst (TREE_TYPE (lse.string_length)));
}
gfc_add_modify (&block, lse.expr,
@@ -9676,7 +9676,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_int_cst (TREE_TYPE (from_len), 0));
+ build_zero_cst (TREE_TYPE (from_len)));
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 df414ee..5461666 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -7495,9 +7495,8 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr)
= fold_build2_loc (input_location, NE_EXPR,
boolean_type_node,
arg1->expr->ts.u.cl->backend_decl,
- build_int_cst
- (TREE_TYPE (arg1->expr->ts.u.cl->backend_decl),
- 0));
+ build_zero_cst
+ (TREE_TYPE (arg1->expr->ts.u.cl->backend_decl)));
if (scalar)
{
/* A pointer to a scalar. */
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 3285ee0..663bb42 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -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_int_cst (gfc_charlen_type_node, 0));
+ CONSTRUCTOR_APPEND_ELT (node, ss_string1_len[k], build_zero_cst (gfc_charlen_type_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_int_cst (gfc_charlen_type_node, 0));
+ CONSTRUCTOR_APPEND_ELT (node, ss_string2_len[k], build_zero_cst (gfc_charlen_type_node));
}
else
{
@@ -5640,7 +5640,7 @@ gfc_trans_allocate (gfc_code * code)
{
gfc_init_se (&se, NULL);
temp_var_needed = false;
- expr3_len = build_int_cst (gfc_charlen_type_node, 0);
+ expr3_len = build_zero_cst (gfc_charlen_type_node);
e3_is = E3_MOLD;
}
/* Prevent aliasing, i.e., se.expr may be already a
@@ -6036,8 +6036,8 @@ gfc_trans_allocate (gfc_code * code)
e.g., a string. */
memsz = fold_build2_loc (input_location, GT_EXPR,
boolean_type_node, expr3_len,
- build_int_cst
- (TREE_TYPE (expr3_len), 0));
+ build_zero_cst
+ (TREE_TYPE (expr3_len)));
memsz = fold_build3_loc (input_location, COND_EXPR,
TREE_TYPE (expr3_esize),
memsz, tmp, expr3_esize);
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2016-12-12 19:39 ` Janne Blomqvist
@ 2016-12-12 20:19 ` Andre Vehreschild
2016-12-13 19:09 ` Janne Blomqvist
1 sibling, 0 replies; 76+ messages in thread
From: Andre Vehreschild @ 2016-12-12 20:19 UTC (permalink / raw)
To: Janne Blomqvist; +Cc: Fortran List, GCC Patches
Hi Janne,
How about adding charlen_zero_node and one_node like the others have it to prevent repeating ourselves?
- Andre
Am 12. Dezember 2016 20:39:38 MEZ, schrieb Janne Blomqvist <blomqvist.janne@gmail.com>:
>On Mon, Dec 12, 2016 at 7:39 PM, Andre Vehreschild <vehre@gmx.de>
>wrote:
>> Hi Janne,
>>
>> I found that you are favoring build_int_cst (size_type_node, 0) over
>> size_zero_node. Is there a reason to this?
>
>Yes. AFAIU size_zero_node is a zero constant for sizetype which is not
>the same as size_type_node.
>
>AFAIK the difference is that size_type_node is the C size_t type,
>whereas sizetype is a GCC internal type used for address expressions.
>On a "normal" target I understand that they are the same size, but
>there are some slight differences in semantics, e.g. size_type_node
>like C unsigned integer types is defined to wrap around on overflow
>whereas sizetype is undefined on overflow.
>
>I don't know if GCC supports some strange targets with some kind of
>segmented memory where the size of sizetype would be different from
>size_type_node, but I guess it's possible in theory at least.
>
>That being said, now that you mention in I should be using
>build_zero_cst (some_type_node) instead of
>build_int_cst(some_type_node, 0). There's also build_one_cst that I
>should use.
>
>> Furthermore did I have to patch this:
>>
>> diff --git a/gcc/fortran/dump-parse-tree.c
>b/gcc/fortran/dump-parse-tree.c
>> index 585f25d..f374558 100644
>> --- a/gcc/fortran/dump-parse-tree.c
>> +++ b/gcc/fortran/dump-parse-tree.c
>> @@ -465,7 +465,7 @@ show_expr (gfc_expr *p)
>> break;
>>
>> case BT_HOLLERITH:
>> - fprintf (dumpfile, "%dH", p->representation.length);
>> + fprintf (dumpfile, "%zdH", p->representation.length);
>> c = p->representation.string;
>> for (i = 0; i < p->representation.length; i++, c++)
>> {
>>
>> to bootstrap on x86_64-linux/f23.
>
>Ah, thanks for the catch. I'll fix it by using HOST_WIDE_INT_PRINT_DEC
>since I'll have to change gfc_charlen_t to be a typedef form
>HOST_WIDE_INT (see my answer to FX).
>
>> And I have this regression:
>>
>> FAIL: gfortran.dg/allocate_deferred_char_scalar_1.f03 -O1 (test
>for excess
>> errors)
>>
>> allocate_deferred_char_scalar_1.f03:184:0:
>>
>> p = '12345679'
>>
>> Warning: '__builtin_memcpy' writing 8 bytes into a region of size 5
>overflows
>> the destination [-Wstringop-overflow=]
>> allocate_deferred_char_scalar_1.f03:242:0:
>>
>> p = 4_'12345679'
>>
>> Warning: '__builtin_memcpy' writing 32 bytes into a region of size 20
>overflows
>> the destination [-Wstringop-overflow=]
>
>I'm seeing that too, but I assumed they would be fixed by Paul's
>recent patch which I don't yet have in my tree yet due to the git
>mirror being stuck..
>
>> Btw, the patch for changing the ABI of the coarray-libs is already
>nearly done.
>> I just need to figure that what the state of regressions is with and
>without my
>> change.
>
>Thanks.
>
>I'll produce an updated patch with the changes discussed so far.
--
Andre Vehreschild * Kreuzherrenstr. 8 * 52062 Aachen
Tel.: +49 241 929 10 18 * vehre@gmx.de
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2016-12-12 17:39 ` Andre Vehreschild
@ 2016-12-12 19:39 ` Janne Blomqvist
2016-12-12 20:19 ` Andre Vehreschild
2016-12-13 19:09 ` Janne Blomqvist
0 siblings, 2 replies; 76+ messages in thread
From: Janne Blomqvist @ 2016-12-12 19:39 UTC (permalink / raw)
To: Andre Vehreschild; +Cc: Fortran List, GCC Patches
On Mon, Dec 12, 2016 at 7:39 PM, Andre Vehreschild <vehre@gmx.de> wrote:
> Hi Janne,
>
> I found that you are favoring build_int_cst (size_type_node, 0) over
> size_zero_node. Is there a reason to this?
Yes. AFAIU size_zero_node is a zero constant for sizetype which is not
the same as size_type_node.
AFAIK the difference is that size_type_node is the C size_t type,
whereas sizetype is a GCC internal type used for address expressions.
On a "normal" target I understand that they are the same size, but
there are some slight differences in semantics, e.g. size_type_node
like C unsigned integer types is defined to wrap around on overflow
whereas sizetype is undefined on overflow.
I don't know if GCC supports some strange targets with some kind of
segmented memory where the size of sizetype would be different from
size_type_node, but I guess it's possible in theory at least.
That being said, now that you mention in I should be using
build_zero_cst (some_type_node) instead of
build_int_cst(some_type_node, 0). There's also build_one_cst that I
should use.
> Furthermore did I have to patch this:
>
> diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
> index 585f25d..f374558 100644
> --- a/gcc/fortran/dump-parse-tree.c
> +++ b/gcc/fortran/dump-parse-tree.c
> @@ -465,7 +465,7 @@ show_expr (gfc_expr *p)
> break;
>
> case BT_HOLLERITH:
> - fprintf (dumpfile, "%dH", p->representation.length);
> + fprintf (dumpfile, "%zdH", p->representation.length);
> c = p->representation.string;
> for (i = 0; i < p->representation.length; i++, c++)
> {
>
> to bootstrap on x86_64-linux/f23.
Ah, thanks for the catch. I'll fix it by using HOST_WIDE_INT_PRINT_DEC
since I'll have to change gfc_charlen_t to be a typedef form
HOST_WIDE_INT (see my answer to FX).
> And I have this regression:
>
> FAIL: gfortran.dg/allocate_deferred_char_scalar_1.f03 -O1 (test for excess
> errors)
>
> allocate_deferred_char_scalar_1.f03:184:0:
>
> p = '12345679'
>
> Warning: '__builtin_memcpy' writing 8 bytes into a region of size 5 overflows
> the destination [-Wstringop-overflow=]
> allocate_deferred_char_scalar_1.f03:242:0:
>
> p = 4_'12345679'
>
> Warning: '__builtin_memcpy' writing 32 bytes into a region of size 20 overflows
> the destination [-Wstringop-overflow=]
I'm seeing that too, but I assumed they would be fixed by Paul's
recent patch which I don't yet have in my tree yet due to the git
mirror being stuck..
> Btw, the patch for changing the ABI of the coarray-libs is already nearly done.
> I just need to figure that what the state of regressions is with and without my
> change.
Thanks.
I'll produce an updated patch with the changes discussed so far.
--
Janne Blomqvist
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2016-12-12 13:07 ` Janne Blomqvist
@ 2016-12-12 18:26 ` Bob Deen
2016-12-19 16:43 ` Bob Deen
0 siblings, 1 reply; 76+ messages in thread
From: Bob Deen @ 2016-12-12 18:26 UTC (permalink / raw)
To: Janne Blomqvist; +Cc: FX, Fortran List, GCC Patches
> However, this will also affect people doing C->Fortran calls the
> old-fashioned way without ISO_C_BINDING, as they will have to change
> the string length argument from int to size_t in their prototypes.
> Then again, Intel Fortran did this some years ago so I guess at least
> people who care about portability to several compilers are aware.
We do a ton of this (old fashioned c-fortran binding) and changing the string length argument size will have a big impact on us. We don't use the Intel compiler so we never noticed a change there.
Is there really a use case for strings > 2 GB that justifies the breakage? I certainly understand wanting to do it "right" but I'm probably not the only one with practical considerations that argue against it if there are no compelling use cases.
Thanks...
-Bob
Bob Deen @ NASA-JPL Multimission Image Processing Lab
Bob.Deen@jpl.nasa.gov
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2016-12-12 9:53 Janne Blomqvist
2016-12-12 10:20 ` FX
@ 2016-12-12 17:39 ` Andre Vehreschild
2016-12-12 19:39 ` Janne Blomqvist
2016-12-23 15:09 ` Janne Blomqvist
2 siblings, 1 reply; 76+ messages in thread
From: Andre Vehreschild @ 2016-12-12 17:39 UTC (permalink / raw)
To: Janne Blomqvist; +Cc: fortran, gcc-patches
Hi Janne,
I found that you are favoring build_int_cst (size_type_node, 0) over
size_zero_node. Is there a reason to this?
Furthermore did I have to patch this:
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 585f25d..f374558 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -465,7 +465,7 @@ show_expr (gfc_expr *p)
break;
case BT_HOLLERITH:
- fprintf (dumpfile, "%dH", p->representation.length);
+ fprintf (dumpfile, "%zdH", p->representation.length);
c = p->representation.string;
for (i = 0; i < p->representation.length; i++, c++)
{
to bootstrap on x86_64-linux/f23.
And I have this regression:
FAIL: gfortran.dg/allocate_deferred_char_scalar_1.f03 -O1 (test for excess
errors)
allocate_deferred_char_scalar_1.f03:184:0:
p = '12345679'
Warning: '__builtin_memcpy' writing 8 bytes into a region of size 5 overflows
the destination [-Wstringop-overflow=]
allocate_deferred_char_scalar_1.f03:242:0:
p = 4_'12345679'
Warning: '__builtin_memcpy' writing 32 bytes into a region of size 20 overflows
the destination [-Wstringop-overflow=]
I also tried with a sanitized gfortran and am seeing some issues there. I have
to sort through these, but thought to let you know about the above already.
Btw, the patch for changing the ABI of the coarray-libs is already nearly done.
I just need to figure that what the state of regressions is with and without my
change.
- Andre
--
Andre Vehreschild * Email: vehre ad gmx dot de
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2016-12-12 13:35 ` Janus Weil
@ 2016-12-12 13:43 ` Janne Blomqvist
0 siblings, 0 replies; 76+ messages in thread
From: Janne Blomqvist @ 2016-12-12 13:43 UTC (permalink / raw)
To: Janus Weil; +Cc: Andre Vehreschild, FX, gfortran, gcc-patches
On Mon, Dec 12, 2016 at 3:35 PM, Janus Weil <janus@gcc.gnu.org> wrote:
> Hi guys,
>
>> there is already an ABI change. DTIO needed it.
>
> maybe it would be a good idea to document this in places like:
> * https://gcc.gnu.org/wiki/GFortran/News
> * https://gcc.gnu.org/gcc-7/changes.html
>
> On the first page there are "Compatibility notices" for several
> earlier versions which mention stuff like this ...
Yes, absolutely. I was planning to do it when/if the patch is accepted
and merged.
--
Janne Blomqvist
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2016-12-12 10:29 ` Andre Vehreschild
2016-12-12 13:11 ` Janne Blomqvist
@ 2016-12-12 13:35 ` Janus Weil
2016-12-12 13:43 ` Janne Blomqvist
1 sibling, 1 reply; 76+ messages in thread
From: Janus Weil @ 2016-12-12 13:35 UTC (permalink / raw)
To: Andre Vehreschild; +Cc: FX, Janne Blomqvist, gfortran, gcc-patches
Hi guys,
> there is already an ABI change. DTIO needed it.
maybe it would be a good idea to document this in places like:
* https://gcc.gnu.org/wiki/GFortran/News
* https://gcc.gnu.org/gcc-7/changes.html
On the first page there are "Compatibility notices" for several
earlier versions which mention stuff like this ...
Cheers,
Janus
> On Mon, 12 Dec 2016 11:20:06 +0100
> FX <fxcoudert@gmail.com> wrote:
>
>> Hi Janne,
>>
>> This is an ABI change, so it is serious… it will require people to recompile
>> older code and libraries with the new compiler. Do we already plan to break
>> the ABI in this cycle, or is this the first ABI-breaking patch of the cycle?
>> And do we have real-life examples of character strings larger than 2 GB?
>>
>> > Also, as there are some places in the frontend were negative character
>> > lengths are used as special flag values, in the frontend the character
>> > length is handled as a signed variable of the same size as a size_t,
>> > although in the runtime library it really is size_t.
>>
>> First, I thought: we should really make it size_t, and have the negative
>> values be well-defined constants, e.g. (size_t) -1
>>
>> On the other hand, there is the problem of the case where the front-end has
>> different size_t than the target: think 32-bit on 64-bit i386 (front-end
>> size_t larger than target size_t), or cross-compiling for 64-bit on a 32-bit
>> machine (front-end size_t smaller than target size_t). So the charlen type
>> bounds need to be determined when the front-end runs, not when it is compiled
>> (i.e. it is not a fixed type).
>>
>> In iresolve.c, the "Why is this fixup needed?” comment is kinda scary.
>>
>>
>> > I haven't changed the character length variables for the co-array
>> > intrinsics, as this is something that may need to be synchronized with
>> > OpenCoarrays.
>>
>> Won’t that mean that coarray programs will fail due to ABI mismatch?
>>
>>
>> FX
>
> --
> Andre Vehreschild * Email: vehre ad gmx dot de
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2016-12-12 10:29 ` Andre Vehreschild
@ 2016-12-12 13:11 ` Janne Blomqvist
2016-12-12 13:35 ` Janus Weil
1 sibling, 0 replies; 76+ messages in thread
From: Janne Blomqvist @ 2016-12-12 13:11 UTC (permalink / raw)
To: Andre Vehreschild; +Cc: FX, Fortran List, GCC Patches
On Mon, Dec 12, 2016 at 12:29 PM, Andre Vehreschild <vehre@gmx.de> wrote:
> I will take on the coarray ABI changes in the next days and also emit a
> pull-request to the opencoarrays to get them to sync. Janne, please wait until
> I have added those changes to prevent people from having to re-compile multiple
> times.
Ok, thanks for taking care of this!
--
Janne Blomqvist
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2016-12-12 10:20 ` FX
2016-12-12 10:29 ` Andre Vehreschild
@ 2016-12-12 13:07 ` Janne Blomqvist
2016-12-12 18:26 ` Bob Deen
1 sibling, 1 reply; 76+ messages in thread
From: Janne Blomqvist @ 2016-12-12 13:07 UTC (permalink / raw)
To: FX; +Cc: Fortran List, GCC Patches
On Mon, Dec 12, 2016 at 12:20 PM, FX <fxcoudert@gmail.com> wrote:
> Hi Janne,
>
> This is an ABI change, so it is serious… it will require people to recompile older code and libraries with the new compiler. Do we already plan to break the ABI in this cycle, or is this the first ABI-breaking patch of the cycle?
As Andre mentioned, the ABI has already been broken, Gfortran 7 will
have libgfortran.so.4.
However, this will also affect people doing C->Fortran calls the
old-fashioned way without ISO_C_BINDING, as they will have to change
the string length argument from int to size_t in their prototypes.
Then again, Intel Fortran did this some years ago so I guess at least
people who care about portability to several compilers are aware.
> And do we have real-life examples of character strings larger than 2 GB?
Well, people who have needed such will have figured out some
work-around since we haven't supported it, so how would we know? :) It
could be splitting the data into several strings, or switching to
ifort, using C instead of Fortran, or something else.
In any case, I don't expect characters larger than 2 GB to be common
(particularly with the Fortran standard-mandated behaviour of
space-padding to the end in many cases), but as the ABI has been
broken anyways, we might as well fix it.
IIRC at some point there was some discussion of this on
comp.lang.fortran, and somebody mentioned analysis of genomic data as
a use case where large characters can be useful. I don't have any
personal usecase though, at least at the moment.
>> Also, as there are some places in the frontend were negative character
>> lengths are used as special flag values, in the frontend the character
>> length is handled as a signed variable of the same size as a size_t,
>> although in the runtime library it really is size_t.
>
> First, I thought: we should really make it size_t, and have the negative values be well-defined constants, e.g. (size_t) -1
I tried it, but in addition to the issue with negative characters used
as flag values, there's issues like we have stuff such as
gfc_get_int_expr() that take a kind value, and an integer constant,
and produces a gfc_expr. But that doesn't understand stuff like
unsigned types. So in the end I decided it's better to get this patch
in working shape and merged with the ABI changes, then one can fix the
unsigned-ness later (in the end it's just a factor of two in sizes we
can handle, so not a huge deal).
> On the other hand, there is the problem of the case where the front-end has different size_t than the target: think 32-bit on 64-bit i386 (front-end size_t larger than target size_t), or cross-compiling for 64-bit on a 32-bit machine (front-end size_t smaller than target size_t). So the charlen type bounds need to be determined when the front-end runs, not when it is compiled (i.e. it is not a fixed type).
True. Although things like gfc_charlen_type_node should be correct for
the target, the type gfc_charlen_t that I introduced in the frontend
might be too small if one is doing a 32->64 bit cross-compile. So that
should be changed from a typedef of ptrdiff_t to a typedef of
HOST_WIDE_INT which AFAIK is guaranteed to be 64-bit everywhere.
> In iresolve.c, the "Why is this fixup needed?” comment is kinda scary.
Hmm, I think it's a leftover from some earlier experimentation, should
be removed.
>> I haven't changed the character length variables for the co-array
>> intrinsics, as this is something that may need to be synchronized with
>> OpenCoarrays.
>
> Won’t that mean that coarray programs will fail due to ABI mismatch?
No, the co-array intrinsics are, well, intrinsics, so they're handled
specially in the frontend and don't need to follow the normal
argument-passing conventions. But I think it'd be easier if they did,
and might prevent some obscure corner-case bugs. Say, create a
character variable with length 2**31+9, then typecasting to plain int
when calling the intrinsic would wrap around and the library would see
a negative length.
--
Janne Blomqvist
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2016-12-12 10:20 ` FX
@ 2016-12-12 10:29 ` Andre Vehreschild
2016-12-12 13:11 ` Janne Blomqvist
2016-12-12 13:35 ` Janus Weil
2016-12-12 13:07 ` Janne Blomqvist
1 sibling, 2 replies; 76+ messages in thread
From: Andre Vehreschild @ 2016-12-12 10:29 UTC (permalink / raw)
To: FX; +Cc: Janne Blomqvist, fortran, gcc-patches
Hi FX,
there is already an ABI change. DTIO needed it.
I will take on the coarray ABI changes in the next days and also emit a
pull-request to the opencoarrays to get them to sync. Janne, please wait until
I have added those changes to prevent people from having to re-compile multiple
times.
- Andre
On Mon, 12 Dec 2016 11:20:06 +0100
FX <fxcoudert@gmail.com> wrote:
> Hi Janne,
>
> This is an ABI change, so it is serious… it will require people to recompile
> older code and libraries with the new compiler. Do we already plan to break
> the ABI in this cycle, or is this the first ABI-breaking patch of the cycle?
> And do we have real-life examples of character strings larger than 2 GB?
>
> > Also, as there are some places in the frontend were negative character
> > lengths are used as special flag values, in the frontend the character
> > length is handled as a signed variable of the same size as a size_t,
> > although in the runtime library it really is size_t.
>
> First, I thought: we should really make it size_t, and have the negative
> values be well-defined constants, e.g. (size_t) -1
>
> On the other hand, there is the problem of the case where the front-end has
> different size_t than the target: think 32-bit on 64-bit i386 (front-end
> size_t larger than target size_t), or cross-compiling for 64-bit on a 32-bit
> machine (front-end size_t smaller than target size_t). So the charlen type
> bounds need to be determined when the front-end runs, not when it is compiled
> (i.e. it is not a fixed type).
>
> In iresolve.c, the "Why is this fixup needed?” comment is kinda scary.
>
>
> > I haven't changed the character length variables for the co-array
> > intrinsics, as this is something that may need to be synchronized with
> > OpenCoarrays.
>
> Won’t that mean that coarray programs will fail due to ABI mismatch?
>
>
> FX
--
Andre Vehreschild * Email: vehre ad gmx dot de
^ permalink raw reply [flat|nested] 76+ messages in thread
* Re: [PATCH] PR 78534 Change character length from int to size_t
2016-12-12 9:53 Janne Blomqvist
@ 2016-12-12 10:20 ` FX
2016-12-12 10:29 ` Andre Vehreschild
2016-12-12 13:07 ` Janne Blomqvist
2016-12-12 17:39 ` Andre Vehreschild
2016-12-23 15:09 ` Janne Blomqvist
2 siblings, 2 replies; 76+ messages in thread
From: FX @ 2016-12-12 10:20 UTC (permalink / raw)
To: Janne Blomqvist; +Cc: fortran, gcc-patches
Hi Janne,
This is an ABI change, so it is serious… it will require people to recompile older code and libraries with the new compiler. Do we already plan to break the ABI in this cycle, or is this the first ABI-breaking patch of the cycle? And do we have real-life examples of character strings larger than 2 GB?
> Also, as there are some places in the frontend were negative character
> lengths are used as special flag values, in the frontend the character
> length is handled as a signed variable of the same size as a size_t,
> although in the runtime library it really is size_t.
First, I thought: we should really make it size_t, and have the negative values be well-defined constants, e.g. (size_t) -1
On the other hand, there is the problem of the case where the front-end has different size_t than the target: think 32-bit on 64-bit i386 (front-end size_t larger than target size_t), or cross-compiling for 64-bit on a 32-bit machine (front-end size_t smaller than target size_t). So the charlen type bounds need to be determined when the front-end runs, not when it is compiled (i.e. it is not a fixed type).
In iresolve.c, the "Why is this fixup needed?” comment is kinda scary.
> I haven't changed the character length variables for the co-array
> intrinsics, as this is something that may need to be synchronized with
> OpenCoarrays.
Won’t that mean that coarray programs will fail due to ABI mismatch?
FX
^ permalink raw reply [flat|nested] 76+ messages in thread
* [PATCH] PR 78534 Change character length from int to size_t
@ 2016-12-12 9:53 Janne Blomqvist
2016-12-12 10:20 ` FX
` (2 more replies)
0 siblings, 3 replies; 76+ messages in thread
From: Janne Blomqvist @ 2016-12-12 9:53 UTC (permalink / raw)
To: fortran, gcc-patches; +Cc: Janne Blomqvist
In order to handle large character lengths on (L)LP64 targets, switch
the GFortran character length from an int to a size_t.
This is an ABI change, as procedures with character arguments take
hidden arguments with the character length.
I also changed the _size member in vtables from int to size_t, as
there were some cases where character lengths and sizes were
apparently mixed up and caused regressions otherwise. Although I
haven't tested, this might enable very large derived types as well.
Also, as there are some places in the frontend were negative character
lengths are used as special flag values, in the frontend the character
length is handled as a signed variable of the same size as a size_t,
although in the runtime library it really is size_t.
I haven't changed the character length variables for the co-array
intrinsics, as this is something that may need to be synchronized with
OpenCoarrays.
A caveat here is the testcase char_result_8.f90, which I changed
slightly to work around PR 78757. It's a somewhat obscure corner case,
and while this patch admittedly makes it more likely to trigger this
bug, it's, well, still a corner case.
Regtested on x86_64-pc-linux-gnu, Ok for trunk?
frontend:
2016-12-12 Janne Blomqvist <jb@gcc.gnu.org>
PR fortran/78534
PR fortran/66310
* arith.c (gfc_check_charlen_range): New function.
(gfc_range_check): Use gfc_check_charlen_range.
* 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 long.
(gfc_extract_long): New function.
* gfortran.h (gfc_typespec): New member is_charlen.
(gfc_charlen_t): New typedef.
(gfc_expr): Use gfc_charlen_t for character lengths.
(gfc_size_kind): New extern variable.
(gfc_extract_long): New prototype.
(gfc_get_character_expr): Use gfc_charlen_t for character length.
(gfc_get_int_expr): Use long type for value argument.
* iresolve.c (gfc_resolve_repeat): Use gfc_charlen_t,
gfc_charlen_int_kind, set is_charlen.
* match.c (select_intrinsic_set_tmp): Use long for charlen.
* 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_substring): Use get_type_static_bounds.
(resolve_select_type): Use long for charlen.
(resolve_charlen): Use long for charlen, get_type_static_bounds.
* simplify.c (gfc_simplify_repeat): Likewise.
* target-memory.c (gfc_interpret_character): Use gfc_charlen_t.
* 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-decl.c (create_function_arglist): Assert that length is
not NULL_TREE.
* 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 long 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.
* trans-types.h: Include trans.h, tidying.
testsuite:
2016-12-12 Janne Blomqvist <jb@gcc.gnu.org>
PR fortran/78534
PR fortran/66310
* gfortran.dg/char_result_8.f90: Work around PR 78757 by using an
integer of kind C_SIZE_T.
* 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.
libgfortran:
2016-12-12 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.
* 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.
---
gcc/fortran/arith.c | 28 +++++++++++++
gcc/fortran/class.c | 12 +++---
gcc/fortran/expr.c | 30 +++++++++++++-
gcc/fortran/gfortran.h | 18 +++++++--
gcc/fortran/iresolve.c | 10 +++--
gcc/fortran/match.c | 4 +-
gcc/fortran/module.c | 43 +++++++++++++-------
gcc/fortran/resolve.c | 31 +++++++++-----
gcc/fortran/simplify.c | 33 ++++++++++-----
gcc/fortran/target-memory.c | 8 ++--
gcc/fortran/trans-array.c | 3 +-
gcc/fortran/trans-const.c | 12 ++++++
gcc/fortran/trans-const.h | 1 +
gcc/fortran/trans-decl.c | 3 +-
gcc/fortran/trans-expr.c | 56 +++++++++++++++-----------
gcc/fortran/trans-intrinsic.c | 54 ++++++++++++-------------
gcc/fortran/trans-io.c | 4 +-
gcc/fortran/trans-stmt.c | 19 ++++-----
gcc/fortran/trans-types.c | 12 +++++-
gcc/fortran/trans-types.h | 5 ++-
gcc/testsuite/gfortran.dg/char_result_8.f90 | 8 ++--
gcc/testsuite/gfortran.dg/repeat_4.f90 | 23 ++++++-----
gcc/testsuite/gfortran.dg/repeat_7.f90 | 8 ++++
gcc/testsuite/gfortran.dg/scan_2.f90 | 4 +-
gcc/testsuite/gfortran.dg/string_1.f90 | 1 +
gcc/testsuite/gfortran.dg/string_1_lp64.f90 | 15 +++++++
gcc/testsuite/gfortran.dg/string_3.f90 | 1 +
gcc/testsuite/gfortran.dg/string_3_lp64.f90 | 20 +++++++++
libgfortran/intrinsics/args.c | 10 ++---
libgfortran/intrinsics/chmod.c | 3 +-
libgfortran/intrinsics/env.c | 3 +-
libgfortran/intrinsics/extends_type_of.c | 2 +-
libgfortran/intrinsics/gerror.c | 2 +-
libgfortran/intrinsics/getlog.c | 3 +-
libgfortran/intrinsics/hostnm.c | 5 +--
libgfortran/intrinsics/string_intrinsics_inc.c | 17 ++++----
libgfortran/io/transfer.c | 16 ++++----
libgfortran/io/unit.c | 3 +-
libgfortran/io/write.c | 3 +-
libgfortran/libgfortran.h | 2 +-
40 files changed, 359 insertions(+), 176 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/repeat_7.f90
create mode 100644 gcc/testsuite/gfortran.dg/string_1_lp64.f90
create mode 100644 gcc/testsuite/gfortran.dg/string_3_lp64.f90
diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c
index 2781f10..ef4b884 100644
--- a/gcc/fortran/arith.c
+++ b/gcc/fortran/arith.c
@@ -31,6 +31,8 @@ along with GCC; see the file COPYING3. If not see
#include "arith.h"
#include "target-memory.h"
#include "constructor.h"
+#include "tree.h"
+#include "trans-types.h"
/* MPFR does not have a direct replacement for mpz_set_f() from GMP.
It's easily implemented with a few calls though. */
@@ -281,6 +283,27 @@ gfc_check_character_range (gfc_char_t c, int kind)
}
+/* Check whether a character length is within the range
+ [0, TYPE_MAX_VALUE(gfc_charlen_type_node)]. */
+
+arith
+gfc_check_charlen_range (mpz_t p)
+{
+ mpz_t min, max;
+ arith result = ARITH_OK;
+
+ mpz_init (min);
+ mpz_init (max);
+ get_type_static_bounds (gfc_charlen_type_node, min, max);
+ mpz_clear (min);
+ if ((mpz_sgn (p) < 0) || (mpz_cmp (p, max) > 0))
+ result = ARITH_OVERFLOW;
+
+ mpz_clear (max);
+ return result;
+}
+
+
/* Given an integer and a kind, make sure that the integer lies within
the range of the kind. Returns ARITH_OK, ARITH_ASYMMETRIC or
ARITH_OVERFLOW. */
@@ -487,6 +510,9 @@ gfc_range_check (gfc_expr *e)
arith rc;
arith rc2;
+ if (e->ts.is_charlen)
+ return gfc_check_charlen_range (e->value.integer);
+
switch (e->ts.type)
{
case BT_INTEGER:
@@ -689,6 +715,8 @@ gfc_arith_times (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
{
case BT_INTEGER:
mpz_mul (result->value.integer, op1->value.integer, op2->value.integer);
+ if (op1->ts.is_charlen || op2->ts.is_charlen)
+ result->ts.is_charlen = true;
break;
case BT_REAL:
diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index 1fba6c9..62c751e 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(4) to store the string length when the unlimited
+ * _len: An integer(C_SIZE_T) 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 = 4;
+ c->ts.kind = gfc_size_kind;
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_default_integer_kind,
+ c->initializer = gfc_get_int_expr (gfc_size_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 = 4;
+ c->ts.kind = gfc_size_kind;
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_default_integer_kind,
+ c->initializer = gfc_get_int_expr (gfc_size_kind,
NULL,
ts->type == BT_CHARACTER
? ts->kind
- : (int)gfc_element_size (e));
+ : (long)gfc_element_size (e));
gfc_free_expr (e);
/* Add component _extends. */
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 3464a20..1c7c036 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -184,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, int len)
+gfc_get_character_expr (int kind, locus *where, const char *src, gfc_charlen_t len)
{
gfc_expr *e;
gfc_char_t *dest;
@@ -210,7 +210,7 @@ gfc_get_character_expr (int kind, locus *where, const char *src, int len)
/* Get a new expression node that is an integer constant. */
gfc_expr *
-gfc_get_int_expr (int kind, locus *where, int value)
+gfc_get_int_expr (int kind, locus *where, long value)
{
gfc_expr *p;
p = gfc_get_constant_expr (BT_INTEGER, kind,
@@ -636,6 +636,32 @@ gfc_extract_int (gfc_expr *expr, int *result)
}
+/* Same as gfc_extract_int, but use a long. long isn't optimal either,
+ since it won't help on LLP64 targets like win64, but it's the best
+ we can do due to the mpz_*_si functions that take arguments of type
+ long. */
+
+const char *
+gfc_extract_long (gfc_expr *expr, long *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");
+
+ if ((mpz_cmp_si (expr->value.integer, LONG_MAX) > 0)
+ || (mpz_cmp_si (expr->value.integer, LONG_MIN) < 0))
+ {
+ return _("Integer value too large in expression at %C");
+ }
+
+ *result = mpz_get_si (expr->value.integer);
+
+ return NULL;
+}
+
+
/* Recursively copy a list of reference structures. */
gfc_ref *
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 670c13a..4f30ba3 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1009,6 +1009,8 @@ typedef struct
int is_iso_c;
bt f90_type;
bool deferred;
+ bool is_charlen; /* If the expression is a character length, ignore
+ type and kind. */
}
gfc_typespec;
@@ -2058,6 +2060,12 @@ gfc_intrinsic_sym;
typedef splay_tree gfc_constructor_base;
+
+/* This should be a size_t. But occasionally the string length field
+ is used as a flag with values -1 and -2, see
+ e.g. gfc_add_assign_aux_vars. */
+typedef ptrdiff_t gfc_charlen_t;
+
typedef struct gfc_expr
{
expr_t expr_type;
@@ -2103,7 +2111,7 @@ typedef struct gfc_expr
the value. */
struct
{
- int length;
+ gfc_charlen_t length;
char *string;
}
representation;
@@ -2159,7 +2167,7 @@ typedef struct gfc_expr
struct
{
- int length;
+ gfc_charlen_t length;
gfc_char_t *string;
}
character;
@@ -2843,6 +2851,7 @@ 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;
@@ -3074,6 +3083,7 @@ 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_long (gfc_expr *, long *);
bool is_subref_array (gfc_expr *);
bool gfc_is_simply_contiguous (gfc_expr *, bool, bool);
bool gfc_check_init_expr (gfc_expr *);
@@ -3091,8 +3101,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 *, int len);
-gfc_expr *gfc_get_int_expr (int, locus *, int);
+gfc_expr *gfc_get_character_expr (int, locus *, const char *, gfc_charlen_t len);
+gfc_expr *gfc_get_int_expr (int, locus *, long);
gfc_expr *gfc_get_logical_expr (int, locus *, bool);
gfc_expr *gfc_get_iokind_expr (locus *, io_kind);
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index b289c9f..39b1984 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -2147,7 +2147,7 @@ void
gfc_resolve_repeat (gfc_expr *f, gfc_expr *string,
gfc_expr *ncopies)
{
- int len;
+ gfc_charlen_t len;
gfc_expr *tmp;
f->ts.type = BT_CHARACTER;
f->ts.kind = string->ts.kind;
@@ -2161,7 +2161,7 @@ gfc_resolve_repeat (gfc_expr *f, gfc_expr *string,
if (string->expr_type == EXPR_CONSTANT)
{
len = string->value.character.length;
- tmp = gfc_get_int_expr (gfc_default_integer_kind, NULL , len);
+ tmp = gfc_get_int_expr (gfc_charlen_int_kind, NULL , len);
}
else if (string->ts.u.cl && string->ts.u.cl->length)
{
@@ -2169,7 +2169,11 @@ gfc_resolve_repeat (gfc_expr *f, gfc_expr *string,
}
if (tmp)
- f->ts.u.cl->length = gfc_multiply (tmp, gfc_copy_expr (ncopies));
+ {
+ tmp->ts.kind = gfc_charlen_int_kind; /* Why is this fixup needed? */
+ tmp->ts.is_charlen = true;
+ f->ts.u.cl->length = gfc_multiply (tmp, gfc_copy_expr (ncopies));
+ }
}
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 523cba4..6184289 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;
- int charlen = 0;
+ long charlen = 0;
if (ts->type == BT_CLASS || ts->type == BT_DERIVED)
return NULL;
@@ -5782,7 +5782,7 @@ select_intrinsic_set_tmp (gfc_typespec *ts)
sprintf (name, "__tmp_%s_%d", gfc_basic_typename (ts->type),
ts->kind);
else
- sprintf (name, "__tmp_%s_%d_%d", gfc_basic_typename (ts->type),
+ sprintf (name, "__tmp_%s_%ld_%d", gfc_basic_typename (ts->type),
charlen, ts->kind);
gfc_get_sym_tree (name, gfc_current_ns, &tmp, false);
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index e727ade..9324a37 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 int atom_int;
+static HOST_WIDE_INT atom_int;
static char *atom_string, atom_name[MAX_ATOM_SIZE];
@@ -1271,7 +1271,7 @@ parse_string (void)
}
-/* Parse a small integer. */
+/* Parse an integer. Should fit in a HOST_WIDE_INT. */
static void
parse_integer (int c)
@@ -1288,8 +1288,6 @@ parse_integer (int c)
}
atom_int = 10 * atom_int + c - '0';
- if (atom_int > 99999999)
- bad_module ("Integer overflow");
}
}
@@ -1631,11 +1629,12 @@ write_char (char out)
static void
write_atom (atom_type atom, const void *v)
{
- char buffer[20];
+ char buffer[32];
/* Workaround -Wmaybe-uninitialized false positive during
profiledbootstrap by initializing them. */
- int i = 0, len;
+ int len;
+ HOST_WIDE_INT i = 0;
const char *p;
switch (atom)
@@ -1654,11 +1653,9 @@ write_atom (atom_type atom, const void *v)
break;
case ATOM_INTEGER:
- i = *((const int *) v);
- if (i < 0)
- gfc_internal_error ("write_atom(): Writing negative integer");
+ i = *((const HOST_WIDE_INT *) v);
- sprintf (buffer, "%d", i);
+ snprintf (buffer, sizeof (buffer), HOST_WIDE_INT_PRINT_DEC, i);
p = buffer;
break;
@@ -1766,7 +1763,10 @@ static void
mio_integer (int *ip)
{
if (iomode == IO_OUTPUT)
- write_atom (ATOM_INTEGER, ip);
+ {
+ HOST_WIDE_INT hwi = *ip;
+ write_atom (ATOM_INTEGER, &hwi);
+ }
else
{
require_atom (ATOM_INTEGER);
@@ -1774,6 +1774,18 @@ 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. */
@@ -1783,7 +1795,7 @@ mio_intrinsic_op (gfc_intrinsic_op* op)
/* FIXME: Would be nicer to do this via the operators symbolic name. */
if (iomode == IO_OUTPUT)
{
- int converted = (int) *op;
+ HOST_WIDE_INT converted = (HOST_WIDE_INT) *op;
write_atom (ATOM_INTEGER, &converted);
}
else
@@ -2680,7 +2692,7 @@ mio_array_ref (gfc_array_ref *ar)
{
for (i = 0; i < ar->dimen; i++)
{
- int tmp = (int)ar->dimen_type[i];
+ HOST_WIDE_INT tmp = (HOST_WIDE_INT)ar->dimen_type[i];
write_atom (ATOM_INTEGER, &tmp);
}
}
@@ -3382,6 +3394,7 @@ 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;
@@ -3596,7 +3609,9 @@ mio_expr (gfc_expr **ep)
break;
case BT_CHARACTER:
- mio_integer (&e->value.character.length);
+ hwi = e->value.character.length;
+ mio_hwi (&hwi);
+ e->value.character.length = hwi;
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 2093de91..dbe6666 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -29,6 +29,8 @@ along with GCC; see the file COPYING3. If not see
#include "data.h"
#include "target-memory.h" /* for gfc_simplify_transfer */
#include "constructor.h"
+#include "tree.h"
+#include "trans-types.h" /* For gfc_charlen_type_node */
/* Types used in equivalence statements. */
@@ -4608,7 +4610,7 @@ resolve_array_ref (gfc_array_ref *ar)
static bool
resolve_substring (gfc_ref *ref)
{
- int k = gfc_validate_kind (BT_INTEGER, gfc_charlen_int_kind, false);
+ mpz_t min, max;
if (ref->u.ss.start != NULL)
{
@@ -4668,15 +4670,20 @@ resolve_substring (gfc_ref *ref)
return false;
}
- if (compare_bound_mpz_t (ref->u.ss.end,
- gfc_integer_kinds[k].huge) == CMP_GT
+ mpz_init (min);
+ mpz_init (max);
+ get_type_static_bounds (gfc_charlen_type_node, min, max);
+ mpz_clear (min);
+ if (compare_bound_mpz_t (ref->u.ss.end, max) == CMP_GT
&& (compare_bound (ref->u.ss.end, ref->u.ss.start) == CMP_EQ
|| compare_bound (ref->u.ss.end, ref->u.ss.start) == CMP_GT))
{
+ mpz_clear (max);
gfc_error ("Substring end index at %L is too large",
&ref->u.ss.end->where);
return false;
}
+ mpz_clear (max);
}
return true;
@@ -8488,7 +8495,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;
+ long charlen = 0;
int rank = 0;
gfc_ref* ref = NULL;
gfc_expr *selector_expr = NULL;
@@ -8739,7 +8746,7 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns)
if (c->ts.u.cl && c->ts.u.cl->length
&& c->ts.u.cl->length->expr_type == EXPR_CONSTANT)
charlen = mpz_get_si (c->ts.u.cl->length->value.integer);
- sprintf (name, "__tmp_%s_%d_%d", gfc_basic_typename (c->ts.type),
+ sprintf (name, "__tmp_%s_%ld_%d", gfc_basic_typename (c->ts.type),
charlen, c->ts.kind);
}
else
@@ -11402,7 +11409,8 @@ resolve_index_expr (gfc_expr *e)
static bool
resolve_charlen (gfc_charlen *cl)
{
- int i, k;
+ long i;
+ mpz_t min, max;
bool saved_specification_expr;
if (cl->resolved)
@@ -11438,22 +11446,27 @@ 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 && !gfc_extract_int (cl->length, &i) && i < 0)
+ if (cl->length && !gfc_extract_long (cl->length, &i) && i < 0)
gfc_replace_expr (cl->length,
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);
+ mpz_init (min);
+ mpz_init (max);
+ get_type_static_bounds (gfc_charlen_type_node, min, max);
+ mpz_clear (min);
if (cl->length && cl->length->expr_type == EXPR_CONSTANT
&& cl->length->ts.type == BT_INTEGER
- && mpz_cmp (cl->length->value.integer, gfc_integer_kinds[k].huge) > 0)
+ && mpz_cmp (cl->length->value.integer, max) > 0)
{
gfc_error ("String length at %L is too large", &cl->length->where);
specification_expr = saved_specification_expr;
+ mpz_clear (max);
return false;
}
specification_expr = saved_specification_expr;
+ mpz_clear (max);
return true;
}
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index a46fbc5..ea835f4 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -28,6 +28,8 @@ along with GCC; see the file COPYING3. If not see
#include "target-memory.h"
#include "constructor.h"
#include "version.h" /* For version_string. */
+#include "tree.h"
+#include "trans-types.h"
gfc_expr gfc_bad_expr;
@@ -5190,7 +5192,7 @@ gfc_expr *
gfc_simplify_repeat (gfc_expr *e, gfc_expr *n)
{
gfc_expr *result;
- int i, j, len, ncop, nlen;
+ long len, ncop;
mpz_t ncopies;
bool have_length = false;
@@ -5232,24 +5234,26 @@ gfc_simplify_repeat (gfc_expr *e, gfc_expr *n)
/* Check that NCOPIES isn't too large. */
if (len)
{
- mpz_t max, mlen;
- int i;
+ mpz_t min, max, mlen, maxb;
/* Compute the maximum value allowed for NCOPIES: huge(cl) / len. */
+ mpz_init (min);
+ mpz_init (maxb);
mpz_init (max);
- i = gfc_validate_kind (BT_INTEGER, gfc_charlen_int_kind, false);
+ get_type_static_bounds (gfc_charlen_type_node, min, maxb);
+ mpz_clear (min);
if (have_length)
{
- mpz_tdiv_q (max, gfc_integer_kinds[i].huge,
- e->ts.u.cl->length->value.integer);
+ mpz_tdiv_q (max, maxb, e->ts.u.cl->length->value.integer);
}
else
{
mpz_init_set_si (mlen, len);
- mpz_tdiv_q (max, gfc_integer_kinds[i].huge, mlen);
+ mpz_tdiv_q (max, maxb, mlen);
mpz_clear (mlen);
}
+ mpz_clear (maxb);
/* The check itself. */
if (mpz_cmp (ncopies, max) > 0)
@@ -5274,7 +5278,7 @@ gfc_simplify_repeat (gfc_expr *e, gfc_expr *n)
(e->ts.u.cl->length &&
mpz_sgn (e->ts.u.cl->length->value.integer) != 0))
{
- const char *res = gfc_extract_int (n, &ncop);
+ const char *res = gfc_extract_long (n, &ncop);
gcc_assert (res == NULL);
}
else
@@ -5284,11 +5288,18 @@ 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;
- nlen = ncop * len;
+ size_t nlen = ncop * len;
+
+ /* Here's a semi-arbitrary limit. If the string is longer than 4 MB
+ (2**20 elements * 4 bytes (wide chars) per element) defer to
+ runtime instead of consuming (unbounded) memory and CPU at
+ compile time. */
+ if (nlen > 1048576)
+ return NULL;
result = gfc_get_character_expr (e->ts.kind, &e->where, NULL, nlen);
- for (i = 0; i < ncop; i++)
- for (j = 0; j < len; j++)
+ for (size_t i = 0; i < (size_t) ncop; i++)
+ for (size_t j = 0; j < (size_t) 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 ac9cce2..a62d4c2 100644
--- a/gcc/fortran/target-memory.c
+++ b/gcc/fortran/target-memory.c
@@ -438,11 +438,9 @@ 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 =
- (int) mpz_get_ui (result->ts.u.cl->length->value.integer);
+ (gfc_charlen_t) mpz_get_ui (result->ts.u.cl->length->value.integer);
gcc_assert (buffer_size >= size_character (result->value.character.length,
result->ts.kind));
@@ -450,7 +448,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 (i = 0; i < result->value.character.length; i++)
+ for (gfc_charlen_t i = 0; i < result->value.character.length; i++)
result->value.character.string[i] = (gfc_char_t) buffer[i];
else
{
@@ -459,7 +457,7 @@ gfc_interpret_character (unsigned char *buffer, size_t buffer_size,
mpz_init (integer);
gcc_assert (bytes <= sizeof (unsigned long));
- for (i = 0; i < result->value.character.length; i++)
+ for (gfc_charlen_t 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/trans-array.c b/gcc/fortran/trans-array.c
index 8753cbf..f08a614 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -1909,8 +1909,7 @@ 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 (char_len, gfc_default_integer_kind);
- *len = convert (gfc_charlen_type_node, *len);
+ *len = gfc_conv_mpz_to_tree_type (char_len, gfc_charlen_type_node);
mpz_clear (char_len);
return;
diff --git a/gcc/fortran/trans-const.c b/gcc/fortran/trans-const.c
index 812dcc6..3438979 100644
--- a/gcc/fortran/trans-const.c
+++ b/gcc/fortran/trans-const.c
@@ -206,6 +206,18 @@ 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 14b0f79..072de47 100644
--- a/gcc/fortran/trans-const.h
+++ b/gcc/fortran/trans-const.h
@@ -20,6 +20,7 @@ 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-decl.c b/gcc/fortran/trans-decl.c
index f659a48..9536a24 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -2334,7 +2334,7 @@ create_function_arglist (gfc_symbol * sym)
if (gfc_return_by_reference (sym))
{
- tree type = TREE_VALUE (typelist), length = NULL;
+ tree type = TREE_VALUE (typelist), length = NULL_TREE;
if (sym->ts.type == BT_CHARACTER)
{
@@ -2405,6 +2405,7 @@ create_function_arglist (gfc_symbol * sym)
if (sym->ts.type == BT_CHARACTER)
{
gfc_allocate_lang_decl (parm);
+ gcc_assert (length != NULL_TREE);
arglist = chainon (arglist, length);
typelist = TREE_CHAIN (typelist);
}
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index cbfad0b..5b4bb2e 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)
- : integer_zero_node;
+ : build_int_cst (gfc_charlen_type_node, 0);
}
@@ -884,7 +884,8 @@ 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, 4,
+ e->ts.u.cl->length = gfc_get_constant_expr (BT_INTEGER,
+ gfc_charlen_int_kind,
&e->where);
mpz_set_ui (e->ts.u.cl->length->value.integer,
e->value.character.length);
@@ -902,7 +903,7 @@ gfc_conv_intrinsic_to_class (gfc_se *parmse, gfc_expr *e,
else
tmp = integer_zero_node;
- gfc_add_modify (&parmse->pre, ctree, tmp);
+ gfc_add_modify (&parmse->pre, ctree, fold_convert (TREE_TYPE (ctree), tmp));
}
else if (class_ts.type == BT_CLASS
&& class_ts.u.derived->components
@@ -1041,7 +1042,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 = integer_zero_node;
+ slen = build_int_cst (size_type_node, 0);
}
else
{
@@ -1088,7 +1089,7 @@ gfc_conv_class_to_class (gfc_se *parmse, gfc_expr *e, gfc_typespec class_ts,
tmp = slen;
}
else
- tmp = integer_zero_node;
+ tmp = build_int_cst (size_type_node, 0);
gfc_add_modify (&parmse->pre, ctree,
fold_convert (TREE_TYPE (ctree), tmp));
@@ -1227,7 +1228,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 = integer_zero_node;
+ from_len = build_int_cst (size_type_node, 0);
}
if (GFC_CLASS_TYPE_P (TREE_TYPE (to)))
@@ -1339,7 +1340,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,
- integer_zero_node);
+ build_int_cst (TREE_TYPE (from_len), 0));
tmp = fold_build3_loc (input_location, COND_EXPR,
void_type_node, tmp, extcopy, stdcopy);
gfc_add_expr_to_block (&body, tmp);
@@ -1367,7 +1368,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,
- integer_zero_node);
+ build_int_cst (TREE_TYPE (from_len), 0));
tmp = fold_build3_loc (input_location, COND_EXPR,
void_type_node, tmp, extcopy, stdcopy);
}
@@ -2195,7 +2196,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_int_cst (gfc_charlen_type_node, 0));
+ se.expr, build_int_cst (TREE_TYPE (se.expr), 0));
gfc_add_block_to_block (pblock, &se.pre);
if (cl->backend_decl)
@@ -2267,7 +2268,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_int_cst (gfc_charlen_type_node, 1));
+ build_int_cst (TREE_TYPE (start.expr), 1));
fault = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
boolean_type_node, nonempty, fault);
if (name)
@@ -2303,7 +2304,7 @@ 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))
{
- int i_len;
+ long i_len;
i_len = mpz_get_si (length) + 1;
if (i_len < 0)
@@ -2315,7 +2316,8 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind,
else
{
tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_charlen_type_node,
- end.expr, start.expr);
+ fold_convert (gfc_charlen_type_node, end.expr),
+ fold_convert (gfc_charlen_type_node, 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,
@@ -3115,9 +3117,10 @@ 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, len,
+ gfc_charlen_type_node,
+ fold_convert (gfc_charlen_type_node, len),
build_int_cst (gfc_charlen_type_node, 1));
- tmp = build_range_type (gfc_array_index_type, gfc_index_zero_node, tmp);
+ tmp = build_range_type (gfc_charlen_type_node, gfc_index_zero_node, tmp);
if (TREE_CODE (TREE_TYPE (type)) == ARRAY_TYPE)
tmp = build_array_type (TREE_TYPE (TREE_TYPE (type)), tmp);
@@ -3180,7 +3183,9 @@ 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, rse.string_length);
+ lse.string_length,
+ fold_convert (TREE_TYPE (lse.string_length),
+ rse.string_length));
}
type = build_pointer_type (type);
@@ -5872,7 +5877,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_int_cst (gfc_charlen_type_node, 0));
+ build_int_cst (TREE_TYPE (tmp), 0));
cl.backend_decl = tmp;
}
@@ -7199,7 +7204,8 @@ 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, size);
+ gfc_add_modify (block, lhs_cl_size,
+ fold_convert (TREE_TYPE (lhs_cl_size), size));
}
@@ -7438,7 +7444,8 @@ 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, se.string_length);
+ gfc_add_modify (&block, strlen,
+ fold_convert (TREE_TYPE (strlen), se.string_length));
tmp = gfc_build_memcpy_call (dest, se.expr, size);
gfc_add_expr_to_block (&block, tmp);
}
@@ -8104,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 = integer_zero_node;
+ from_len = build_int_cst (gfc_charlen_type_node, 0);
}
gfc_add_modify (pre, to_len, fold_convert (TREE_TYPE (to_len),
from_len));
@@ -8233,7 +8240,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_int_cst (gfc_charlen_type_node, 0));
+ build_int_cst (TREE_TYPE (lse.string_length), 0));
}
gfc_add_modify (&block, lse.expr,
@@ -9488,7 +9495,9 @@ 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, size);
+ lse.string_length,
+ fold_convert (TREE_TYPE (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),
@@ -9505,7 +9514,8 @@ alloc_scalar_allocatable_for_assignment (stmtblock_t *block,
/* Update the lhs character length. */
size = string_length;
- gfc_add_modify (block, lse.string_length, size);
+ gfc_add_modify (block, lse.string_length,
+ fold_convert (TREE_TYPE (lse.string_length), size));
}
}
@@ -9666,7 +9676,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,
- integer_zero_node);
+ build_int_cst (TREE_TYPE (from_len), 0));
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 d7612f6..df414ee 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -7491,10 +7491,13 @@ 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,
- integer_zero_node);
+ nonzero_charlen
+ = fold_build2_loc (input_location, NE_EXPR,
+ boolean_type_node,
+ arg1->expr->ts.u.cl->backend_decl,
+ build_int_cst
+ (TREE_TYPE (arg1->expr->ts.u.cl->backend_decl),
+ 0));
if (scalar)
{
/* A pointer to a scalar. */
@@ -7784,11 +7787,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 (size_type_node, gfc_character_kinds[i].bit_size / 8);
+ size = build_int_cst (sizetype, gfc_character_kinds[i].bit_size / 8);
/* Get the arguments. */
gfc_conv_intrinsic_function_args (se, expr, args, 3);
- slen = fold_convert (size_type_node, gfc_evaluate_now (args[0], &se->pre));
+ slen = fold_convert (sizetype, gfc_evaluate_now (args[0], &se->pre));
src = args[1];
ncopies = gfc_evaluate_now (args[2], &se->pre);
ncopies_type = TREE_TYPE (ncopies);
@@ -7805,7 +7808,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,
- build_int_cst (size_type_node, 0));
+ size_zero_node);
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);
@@ -7815,17 +7818,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. */
- 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;
+ 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;
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,
- build_int_cst (size_type_node, 0));
+ size_zero_node);
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,
@@ -7842,8 +7845,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 (ncopies_type, "count");
- gfc_add_modify (&block, count, build_int_cst (ncopies_type, 0));
+ count = gfc_create_var (sizetype, "count");
+ gfc_add_modify (&block, count, size_zero_node);
exit_label = gfc_build_label_decl (NULL_TREE);
/* Start the loop body. */
@@ -7851,7 +7854,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,
- ncopies);
+ fold_convert (sizetype, 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,
@@ -7859,25 +7862,22 @@ 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, 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_build2_loc (input_location, MULT_EXPR, sizetype, slen,
+ count);
+ tmp = fold_build2_loc (input_location, MULT_EXPR, sizetype, tmp,
+ 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,
- fold_convert (size_type_node,
- size)));
+ size_type_node, slen, size));
gfc_add_expr_to_block (&body, tmp);
/* Increment count. */
- tmp = fold_build2_loc (input_location, PLUS_EXPR, ncopies_type,
- count, build_int_cst (TREE_TYPE (count), 1));
+ tmp = fold_build2_loc (input_location, PLUS_EXPR, sizetype,
+ count, size_one_node);
gfc_add_modify (&body, count, tmp);
/* Build the loop. */
diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c
index 253a5ac..a2992d8 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_int4_type_node);
+ void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_charlen_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_int4_type_node);
+ void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_charlen_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 d34bdba..3285ee0 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 = integer_minus_one_node;
+ len_tree = build_int_cst (gfc_charlen_type_node, -1);
}
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, len_tree);
+ gfc_add_modify (&se.pre, len, fold_convert (TREE_TYPE (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)
{
- int i;
+ gfc_charlen_t 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], integer_zero_node);
+ CONSTRUCTOR_APPEND_ELT (node, ss_string1_len[k], build_int_cst (gfc_charlen_type_node, 0));
}
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], integer_zero_node);
+ CONSTRUCTOR_APPEND_ELT (node, ss_string2_len[k], build_int_cst (gfc_charlen_type_node, 0));
}
else
{
@@ -5640,7 +5640,7 @@ gfc_trans_allocate (gfc_code * code)
{
gfc_init_se (&se, NULL);
temp_var_needed = false;
- expr3_len = integer_zero_node;
+ expr3_len = build_int_cst (gfc_charlen_type_node, 0);
e3_is = E3_MOLD;
}
/* Prevent aliasing, i.e., se.expr may be already a
@@ -6036,7 +6036,8 @@ gfc_trans_allocate (gfc_code * code)
e.g., a string. */
memsz = fold_build2_loc (input_location, GT_EXPR,
boolean_type_node, expr3_len,
- integer_zero_node);
+ build_int_cst
+ (TREE_TYPE (expr3_len), 0));
memsz = fold_build3_loc (input_location, COND_EXPR,
TREE_TYPE (expr3_esize),
memsz, tmp, expr3_esize);
@@ -6332,7 +6333,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, ((int) strlen (msg)));
+ slen = build_int_cst (gfc_charlen_type_node, strlen (msg));
dlen = gfc_get_expr_charlen (code->expr2);
slen = fold_build2_loc (input_location, MIN_EXPR,
TREE_TYPE (slen), dlen, slen);
@@ -6612,7 +6613,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, ((int) strlen (msg)));
+ slen = build_int_cst (gfc_charlen_type_node, 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 354308f..3a9c39d 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -118,6 +118,9 @@ 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;
@@ -965,9 +968,14 @@ gfc_init_types (void)
boolean_true_node = build_int_cst (boolean_type_node, 1);
boolean_false_node = build_int_cst (boolean_type_node, 0);
- /* ??? Shouldn't this be based on gfc_index_integer_kind or so? */
- gfc_charlen_int_kind = 4;
+
+ /* Character lengths are of type size_t, except signed. */
+ gfc_charlen_int_kind = get_int_kind_from_node (size_type_node);
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 e8e92bf..6328125 100644
--- a/gcc/fortran/trans-types.h
+++ b/gcc/fortran/trans-types.h
@@ -23,6 +23,8 @@ along with GCC; see the file COPYING3. If not see
#ifndef GFC_BACKEND_H
#define GFC_BACKEND_H
+#include "trans.h"
+
extern GTY(()) tree gfc_array_index_type;
extern GTY(()) tree gfc_array_range_type;
extern GTY(()) tree gfc_character1_type_node;
@@ -35,10 +37,9 @@ 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/gfortran.dg/char_result_8.f90 b/gcc/testsuite/gfortran.dg/char_result_8.f90
index 69b1196..e265060 100644
--- a/gcc/testsuite/gfortran.dg/char_result_8.f90
+++ b/gcc/testsuite/gfortran.dg/char_result_8.f90
@@ -2,6 +2,7 @@
! functions that return strings.
! { dg-do run }
program main
+ use iso_c_binding, only : c_size_t
implicit none
character (len = 30), target :: string
@@ -9,7 +10,7 @@ program main
call test (f1 (), 30)
call test (f2 (50), 50)
call test (f3 (), 30)
- call test (f4 (70), 70)
+ call test (f4 (70_c_size_t), 70)
call indirect (100)
contains
@@ -30,7 +31,8 @@ contains
end function f3
function f4 (i)
- integer :: i
+ ! Use kind=c_size_t to work around PR 78757
+ integer(c_size_t) :: i
character (len = i), pointer :: f4
f4 => string
end function f4
@@ -40,7 +42,7 @@ contains
call test (f1 (), 30)
call test (f2 (i), i)
call test (f3 (), 30)
- call test (f4 (i), i)
+ call test (f4 (int(i, c_size_t)), i)
end subroutine indirect
subroutine test (string, length)
diff --git a/gcc/testsuite/gfortran.dg/repeat_4.f90 b/gcc/testsuite/gfortran.dg/repeat_4.f90
index e5b5acc..99e7aee 100644
--- a/gcc/testsuite/gfortran.dg/repeat_4.f90
+++ b/gcc/testsuite/gfortran.dg/repeat_4.f90
@@ -2,6 +2,7 @@
!
! { 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"
@@ -21,18 +22,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))
- 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))
+ 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)/2)
- print *, repeat(t1, huge(0)/2)
- print *, repeat(t2, huge(0)/2)
+ 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+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 " }
+ 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 " }
end program test
diff --git a/gcc/testsuite/gfortran.dg/repeat_7.f90 b/gcc/testsuite/gfortran.dg/repeat_7.f90
new file mode 100644
index 0000000..82f8dbf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/repeat_7.f90
@@ -0,0 +1,8 @@
+! { 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 c58a3a2..5ef0230 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 "iscan = _gfortran_string_scan \\(2," 1 "original" } }
-! { dg-final { scan-tree-dump-times "iverify = _gfortran_string_verify \\(2," 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_string_scan \\(2," 1 "original" } }
+! { dg-final { scan-tree-dump-times "_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 11dc5b7..6a6151e 100644
--- a/gcc/testsuite/gfortran.dg/string_1.f90
+++ b/gcc/testsuite/gfortran.dg/string_1.f90
@@ -1,4 +1,5 @@
! { 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
new file mode 100644
index 0000000..a0edbef
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/string_1_lp64.f90
@@ -0,0 +1,15 @@
+! { 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 7daf8d3..4a88b06 100644
--- a/gcc/testsuite/gfortran.dg/string_3.f90
+++ b/gcc/testsuite/gfortran.dg/string_3.f90
@@ -1,4 +1,5 @@
! { 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
new file mode 100644
index 0000000..162561f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/string_3_lp64.f90
@@ -0,0 +1,20 @@
+! { 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/intrinsics/args.c b/libgfortran/intrinsics/args.c
index 517ebc9..0a5923e 100644
--- a/libgfortran/intrinsics/args.c
+++ b/libgfortran/intrinsics/args.c
@@ -37,7 +37,6 @@ void
getarg_i4 (GFC_INTEGER_4 *pos, char *val, gfc_charlen_type val_len)
{
int argc;
- int arglen;
char **argv;
get_args (&argc, &argv);
@@ -49,7 +48,7 @@ getarg_i4 (GFC_INTEGER_4 *pos, char *val, gfc_charlen_type val_len)
if ((*pos) + 1 <= argc && *pos >=0 )
{
- arglen = strlen (argv[*pos]);
+ gfc_charlen_type arglen = strlen (argv[*pos]);
if (arglen > val_len)
arglen = val_len;
memcpy (val, argv[*pos], arglen);
@@ -119,7 +118,8 @@ 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, arglen = 0, stat_flag = GFC_GC_SUCCESS;
+ int argc, stat_flag = GFC_GC_SUCCESS;
+ gfc_charlen_type arglen = 0;
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, arglen, thisarg;
+ int i, argc, 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 5aae77b..bbca4dc 100644
--- a/libgfortran/intrinsics/chmod.c
+++ b/libgfortran/intrinsics/chmod.c
@@ -66,7 +66,6 @@ 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;
@@ -112,7 +111,7 @@ chmod_internal (char *file, char *mode, gfc_charlen_type mode_len)
honor_umask = false;
#endif
- for (i = 0; i < mode_len; i++)
+ for (gfc_charlen_type i = 0; i < mode_len; i++)
{
if (!continue_clause)
{
diff --git a/libgfortran/intrinsics/env.c b/libgfortran/intrinsics/env.c
index fe94f9e..26ad7fe 100644
--- a/libgfortran/intrinsics/env.c
+++ b/libgfortran/intrinsics/env.c
@@ -94,7 +94,8 @@ 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, res_len = 0;
+ int stat = GFC_SUCCESS;
+ gfc_charlen_type 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 595dc6a..8c1e4db 100644
--- a/libgfortran/intrinsics/extends_type_of.c
+++ b/libgfortran/intrinsics/extends_type_of.c
@@ -31,7 +31,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
typedef struct vtype
{
GFC_INTEGER_4 hash;
- GFC_INTEGER_4 size;
+ size_t size;
struct vtype *extends;
}
vtype;
diff --git a/libgfortran/intrinsics/gerror.c b/libgfortran/intrinsics/gerror.c
index d3b28da..ff05737 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)
{
- int p_len;
+ gfc_charlen_type p_len;
char *p;
p = gf_strerror (errno, msg, msg_len);
diff --git a/libgfortran/intrinsics/getlog.c b/libgfortran/intrinsics/getlog.c
index 2d3c74c..89b2c88 100644
--- a/libgfortran/intrinsics/getlog.c
+++ b/libgfortran/intrinsics/getlog.c
@@ -71,7 +71,6 @@ 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. */
@@ -108,7 +107,7 @@ PREFIX(getlog) (char * login, gfc_charlen_type login_len)
if (p == NULL)
goto cleanup;
- p_len = strlen (p);
+ gfc_charlen_type 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 221852b..aff4d26 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,8 +99,7 @@ hostnm_0 (char *name, gfc_charlen_type name_len)
if (val == 0)
{
- i = -1;
- while (i < name_len && p[++i] != '\0')
+ for (gfc_charlen_type i = 0; i < name_len && p[i] != '\0'; i++)
name[i] = p[i];
}
diff --git a/libgfortran/intrinsics/string_intrinsics_inc.c b/libgfortran/intrinsics/string_intrinsics_inc.c
index aa132ce..4131377 100644
--- a/libgfortran/intrinsics/string_intrinsics_inc.c
+++ b/libgfortran/intrinsics/string_intrinsics_inc.c
@@ -224,14 +224,15 @@ 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 (i >= 0 && s[i] == ' ')
- --i;
+ while (s[i] == ' ')
+ {
+ if (i == 0)
+ return 0;
+ --i;
+ }
return i + 1;
}
@@ -327,12 +328,12 @@ string_scan (gfc_charlen_type slen, const CHARTYPE *str,
if (back)
{
- for (i = slen - 1; i >= 0; i--)
+ for (i = slen; i != 0; i--)
{
for (j = 0; j < setlen; j++)
{
- if (str[i] == set[j])
- return (i + 1);
+ if (str[i - 1] == set[j])
+ return i;
}
}
}
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index 5830362..4287668 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -95,17 +95,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 *, int);
+extern void transfer_character (st_parameter_dt *, void *, gfc_charlen_type);
export_proto(transfer_character);
-extern void transfer_character_write (st_parameter_dt *, void *, int);
+extern void transfer_character_write (st_parameter_dt *, void *, gfc_charlen_type);
export_proto(transfer_character_write);
-extern void transfer_character_wide (st_parameter_dt *, void *, int, int);
+extern void transfer_character_wide (st_parameter_dt *, void *, gfc_charlen_type, int);
export_proto(transfer_character_wide);
extern void transfer_character_wide_write (st_parameter_dt *,
- void *, int, int);
+ void *, gfc_charlen_type, int);
export_proto(transfer_character_wide_write);
extern void transfer_complex (st_parameter_dt *, void *, int);
@@ -2259,7 +2259,7 @@ transfer_logical_write (st_parameter_dt *dtp, void *p, int kind)
}
void
-transfer_character (st_parameter_dt *dtp, void *p, int len)
+transfer_character (st_parameter_dt *dtp, void *p, gfc_charlen_type len)
{
static char *empty_string[0];
@@ -2277,13 +2277,13 @@ transfer_character (st_parameter_dt *dtp, void *p, int len)
}
void
-transfer_character_write (st_parameter_dt *dtp, void *p, int len)
+transfer_character_write (st_parameter_dt *dtp, void *p, gfc_charlen_type len)
{
transfer_character (dtp, p, len);
}
void
-transfer_character_wide (st_parameter_dt *dtp, void *p, int len, int kind)
+transfer_character_wide (st_parameter_dt *dtp, void *p, gfc_charlen_type len, int kind)
{
static char *empty_string[0];
@@ -2301,7 +2301,7 @@ transfer_character_wide (st_parameter_dt *dtp, void *p, int len, int kind)
}
void
-transfer_character_wide_write (st_parameter_dt *dtp, void *p, int len, int kind)
+transfer_character_wide_write (st_parameter_dt *dtp, void *p, gfc_charlen_type len, int kind)
{
transfer_character_wide (dtp, p, len, kind);
}
diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c
index 6fa264c..e27f70d 100644
--- a/libgfortran/io/unit.c
+++ b/libgfortran/io/unit.c
@@ -440,10 +440,9 @@ 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 (i = 0; i < dtp->format_len; i++)
+ for (gfc_charlen_type 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 c8bba3c..607e0aa 100644
--- a/libgfortran/io/write.c
+++ b/libgfortran/io/write.c
@@ -2381,7 +2381,6 @@ 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;
@@ -2403,7 +2402,7 @@ namelist_write (st_parameter_dt *dtp)
write_character (dtp, "&", 1, 1, NODELIM);
/* Write namelist name in upper case - f95 std. */
- for (i = 0 ;i < dtp->namelist_name_len ;i++ )
+ for (gfc_charlen_type 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 b9f2471..847ab63 100644
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -249,7 +249,7 @@ typedef GFC_INTEGER_4 GFC_IO_INT;
typedef ptrdiff_t index_type;
/* The type used for the lengths of character variables. */
-typedef GFC_INTEGER_4 gfc_charlen_type;
+typedef size_t gfc_charlen_type;
/* Definitions of CHARACTER data types:
- CHARACTER(KIND=1) corresponds to the C char type,
--
2.7.4
^ permalink raw reply [flat|nested] 76+ messages in thread
end of thread, other threads:[~2018-01-08 19:05 UTC | newest]
Thread overview: 76+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2017-12-29 13:32 [PATCH] PR 78534 Change character length from int to size_t Janne Blomqvist
2017-12-30 14:59 ` Thomas Koenig
2017-12-30 15:25 ` Janne Blomqvist
2017-12-30 17:16 ` Thomas Koenig
2017-12-30 20:35 ` Janne Blomqvist
2017-12-30 20:58 ` Jerry DeLisle
2018-01-03 11:37 ` Janne Blomqvist
2018-01-03 12:10 ` Thomas Koenig
2018-01-03 12:22 ` Janne Blomqvist
2018-01-04 2:21 ` Jerry DeLisle
2018-01-04 7:20 ` Janne Blomqvist
2017-12-31 16:42 ` Thomas Koenig
2018-01-03 18:34 ` Bob Deen
2018-01-03 19:43 ` Janne Blomqvist
2018-01-08 19:08 ` Bob Deen
-- strict thread matches above, loose matches on Subject: below --
2017-01-08 14:29 Dominique d'Humières
2017-01-11 22:17 ` Janne Blomqvist
2017-01-12 8:46 ` FX
2017-01-13 17:09 ` Janne Blomqvist
2017-01-13 19:46 ` David Edelsohn
2017-01-13 23:13 ` Jerry DeLisle
2017-01-14 8:46 ` Janne Blomqvist
2017-01-14 20:30 ` Janne Blomqvist
2017-01-14 21:29 ` Jerry DeLisle
2017-01-14 8:39 ` Janne Blomqvist
2017-01-14 17:01 ` Dominique d'Humières
2017-01-03 14:07 David Edelsohn
2017-01-03 18:04 ` Janne Blomqvist
2017-01-03 19:21 ` FX
2017-01-03 19:32 ` Janne Blomqvist
2016-12-16 15:54 Dominique d'Humières
2016-12-16 18:07 ` Janne Blomqvist
2016-12-16 18:23 ` Dominique d'Humières
2016-12-12 9:53 Janne Blomqvist
2016-12-12 10:20 ` FX
2016-12-12 10:29 ` Andre Vehreschild
2016-12-12 13:11 ` Janne Blomqvist
2016-12-12 13:35 ` Janus Weil
2016-12-12 13:43 ` Janne Blomqvist
2016-12-12 13:07 ` Janne Blomqvist
2016-12-12 18:26 ` Bob Deen
2016-12-19 16:43 ` Bob Deen
2016-12-19 18:30 ` Steve Kargl
2016-12-19 19:49 ` Janne Blomqvist
2016-12-20 3:02 ` Bob Deen
2016-12-20 9:24 ` FX
2016-12-29 21:54 ` Gerald Pfeifer
2016-12-12 17:39 ` Andre Vehreschild
2016-12-12 19:39 ` Janne Blomqvist
2016-12-12 20:19 ` Andre Vehreschild
2016-12-13 19:09 ` Janne Blomqvist
2016-12-16 15:49 ` Andre Vehreschild
2016-12-16 18:02 ` Janne Blomqvist
2016-12-20 14:10 ` Andre Vehreschild
2016-12-20 14:56 ` Janne Blomqvist
2016-12-20 15:09 ` Jakub Jelinek
2016-12-20 15:40 ` Andre Vehreschild
2016-12-20 15:50 ` Jakub Jelinek
2016-12-20 16:05 ` Andre Vehreschild
2016-12-20 16:25 ` Jakub Jelinek
2016-12-21 10:06 ` Andre Vehreschild
2016-12-21 10:28 ` Janne Blomqvist
2016-12-21 10:40 ` Andre Vehreschild
2016-12-21 11:18 ` Janne Blomqvist
2016-12-21 12:06 ` Andre Vehreschild
2016-12-21 12:58 ` Janne Blomqvist
2016-12-21 13:36 ` Andre Vehreschild
2016-12-23 9:57 ` Janne Blomqvist
2016-12-27 10:56 ` Andre Vehreschild
2016-12-27 11:37 ` Janne Blomqvist
2016-12-23 15:09 ` Janne Blomqvist
2016-12-26 11:25 ` FX
2016-12-27 11:03 ` Janne Blomqvist
2016-12-27 18:18 ` FX
2016-12-29 11:50 ` Andre Vehreschild
2017-01-01 11:26 ` Janne Blomqvist
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).