The attached patch and ChangeLog entries are for the
backporting of 25 patches from trunk to the 6-branch.
The bugzilla PR's contained in the patch are
fortran/41922 fortran/60774 fortran/61318 fortran/68566 fortran/69514
fortran/69867 fortran/69962 fortran/70006 fortran/71067 fortran/71730
fortran/71799 fortran/71859 fortran/71862 fortran/77260 fortran/77351
fortran/77372 fortran/77380 fortran/77391 fortran/77420 fortran/77429
fortran/77460 fortran/77506 fortran/77507 fortran/77612 fortran/77694
The patch has been bootstrapped and regression tested on
x86_64-*-freebsd. Ok to commit?
--
Steve
2016-09-28 Steven G. Kargl <ka...@gcc.gnu.org>
PR fortran/41922
* target-memory.c (expr_to_char): Pass in locus and use it in error
messages.
(gfc_merge_initializers): Ditto.
* target-memory.h: Update prototype for gfc_merge_initializers ().
* trans-common.c (get_init_field): Use the correct locus.
PR fortran/60774
* parse.c (next_free,next_fixed): Issue error for statement label
without a statement.
PR fortran/61318
* interface.c (compare_parameter): Use better locus for error message.
PR fortran/68566
* check.c (gfc_check_reshape): Check for constant expression.
PR fortran/69514
* array.c (gfc_match_array_constructor): If type-spec is present,
walk the array constructor performing possible conversions for
numeric types.
PR fortran/69867
* decl.c (build_struct): Ensure that pointers point to something.
PR fortran/69962
* decl.c (gfc_set_constant_character_len): if expr is not
constant issue an error instead of an ICE.
PR fortran/70006
* io.c (gfc_resolve_dt): Use correct locus.
* resolve.c (resolve_branch): Ditto.
PR fortran/71067
* decl.c (match_data_constant): On error, set 'result' to NULL.
PR fortran/71730
* decl.c (char_len_param_value): Check return value of
gfc_reduce_init_expr().
PR fortran/71799
* resolve.c(gfc_resolve_iterator): Failure of type conversion need
not ICE.
PR fortran/71859
* check.c(numeric_check): Prevent ICE. Issue error for invalid
subroutine as an actual argument when numeric argument is expected.
PR fortran/71862
* class.c: Remove assert. Iterate over component only if non-null.
PR fortran/77260
* gcc/fortran/trans-decl.c (generate_local_decl): Suppress warning
for unused variable if symbol is entry point.
PR fortran/77351
* frontend-passes.c (remove_trim,combine_array_constructor): Check for
NULL pointer.
PR fortran/77372
simplify.c (simplify_ieee_selected_real_kind): Check for NULL pointers.
PR fortran/77380
* dependency.c (gfc_check_dependency): Do not assert with
-fcoarray=lib.
PR fortran/77391
* resolve.c (deferred_requirements): New function to check F2008:C402.
(resolve_fl_variable,resolve_fl_parameter): Use it.
PR fortran/77420
* trans-common.c: Handle array elements in equivalence when
the lower and upper bounds of array spec are NULL.
PR fortran/77429
* dependency.c (gfc_check_dependency): Convert gcc_assert() to
a conditional and possible call to gfc_internal_error().
PR fortran/77460
* simplify.c (simplify_transformation_to_scalar): On error, result
may be NULL, simply return.
PR fortran/77506
* array.c (gfc_match_array_constructor): CHARACTER(len=*) cannot
appear in an array constructor.
PR fortran/77507
* intrinsic.c (add_functions): Use correct keyword.
PR fortran/77612
* decl.c (char_len_param_value): Check parent namespace for
seen_implicit_none.
PR fortran/77694
* frontend-passes.c (optimize_binop_array_assignment): Check pointer
for NULL.
2016-09-28 Steven G. Kargl <ka...@gcc.gnu.org>
PR fortran/77507
* ieee/ieee_arithmetic.F90 (IEEE_VALUE_4,IEEE_VALUE_8,IEEE_VALULE_10,
IEEE_VALUE_16): Use correct keyword.
2016-09-28 Steven G. Kargl <ka...@gcc.gnu.org>
PR fortran/41922
* gfortran.dg/equiv_constraint_5.f90: Adjust the error message.
* gfortran.dg/equiv_constraint_7.f90: Ditto.
* gfortran.dg/pr41922.f90: New test.
PR fortran/60774
* gfortran.dg/empty_label.f: Adjust test for new error message.
* gfortran.dg/empty_label.f90: Ditto.
* gfortran.dg/empty_label_typedecl.f90: Ditto.
* gfortran.dg/label_3.f90: Deleted (redundant with empty_label.f90).
* gfortran.dg/warnings_are_errors_1.f90: Remove invalid statement label.
PR fortran/61318
* gfortran.dg/pr61318.f90: New test.
PR fortran/68566
* gfortran.dg/pr68566.f90: new test.
PR fortran/69514
* gfortran.dg/pr69514_1.f90: New test.
* gfortran.dg/pr69514_2.f90: New test.
PR fortran/69867
* gfortran.dg/pr69867.f90: New test.
PR fortran/69962
* gfortran.dg/pr69962.f90: New test.
PR fortran/70006
* gfortran.dg/pr70006.f90: New test.
PR fortran/71067
* gfortran.dg/pr71067_1.f90: New test.
* gfortran.dg/pr71067_2.f90: Ditto.
PR fortran/71730
* gfortran.dg/pr71730.f90: New test.
* gfortran.dg/bounds_check_strlen_2.f90: Fix invalid code.
* gfortran.dg/array_constructor_27.f03: Update dg-error message.
* gfortran.dg/array_constructor_26.f03: Ditto.
PR fortran/71799
* gfortran.dg/pr71799.f90: New test.
PR fortran/71859
* gfortran.dg/pr71859.f90: New test.
* gfortran.dg/intrinsic_numeric_arg.f: Update error message.
* gfortran.dg/coarray_collectives_1.f90: Ditto.
PR fortran/71862
* gfortran.dg/pr71862.f90: New test.
PR fortran/77260
* gfortran.dg/pr77260_1.f90: New test.
* gfortran.dg/pr77260_2.f90: Ditto.
PR fortran/77351
* gfortran.dg/pr77351.f90: New test.
PR fortran/77372
gfortran.dg/pr77372.f90: New test.
PR fortran/77380
* gfortran.dg/pr77380.f90: New test.
PR fortran/77391
* gfortran.dg/pr77391.f90: New test.
PR fortran/77420
* gfortran.dg/pr77420_1.f90: New test.
* gfortran.dg/pr77420_2.f90: Ditto.
* gfortran.dg/pr77420_3.f90: New test. Requires ...
* gfortran.dg/pr77420_4.f90: this file.
PR fortran/77429
* gfortran.dg/pr77429.f90: New test.
PR fortran/77460
* gfortran.dg/pr77460.f90: New test.
PR fortran/77506
* gfortran.dg/pr77506.f90: New test.
PR fortran/77507
* gfortran.dg/ieee/pr77507.f90: New test.
PR fortran/77612
* gfortran.dg/pr77612.f90: New test.
PR fortran/77694
* gfortran.dg/pr77694.f90: New test.
Index: gcc/fortran/array.c
===================================================================
--- gcc/fortran/array.c (revision 240590)
+++ gcc/fortran/array.c (working copy)
@@ -1072,6 +1072,7 @@ match_array_cons_element (gfc_constructo
match
gfc_match_array_constructor (gfc_expr **result)
{
+ gfc_constructor *c;
gfc_constructor_base head, new_cons;
gfc_undo_change_set changed_syms;
gfc_expr *expr;
@@ -1124,6 +1125,15 @@ gfc_match_array_constructor (gfc_expr **
gfc_restore_last_undo_checkpoint ();
goto cleanup;
}
+
+ if (ts.type == BT_CHARACTER
+ && ts.u.cl && !ts.u.cl->length && !ts.u.cl->length_from_typespec)
+ {
+ gfc_error ("Type-spec at %L cannot contain an asterisk for a "
+ "type parameter", &where);
+ gfc_restore_last_undo_checkpoint ();
+ goto cleanup;
+ }
}
}
else if (m == MATCH_ERROR)
@@ -1177,8 +1187,6 @@ done:
be converted. See PR fortran/67803. */
if (ts.type == BT_CHARACTER)
{
- gfc_constructor *c;
-
c = gfc_constructor_first (head);
for (; c; c = gfc_constructor_next (c))
{
@@ -1201,6 +1209,14 @@ done:
}
}
}
+
+ /* Walk the constructor and ensure type conversion for numeric types. */
+ if (gfc_numeric_ts (&ts))
+ {
+ c = gfc_constructor_first (head);
+ for (; c; c = gfc_constructor_next (c))
+ gfc_convert_type (c->expr, &ts, 1);
+ }
}
else
expr = gfc_get_array_expr (BT_UNKNOWN, 0, &where);
Index: gcc/fortran/check.c
===================================================================
--- gcc/fortran/check.c (revision 240590)
+++ gcc/fortran/check.c (working copy)
@@ -72,6 +72,11 @@ type_check (gfc_expr *e, int n, bt type)
static bool
numeric_check (gfc_expr *e, int n)
{
+ /* Users sometime use a subroutine designator as an actual argument to
+ an intrinsic subprogram that expects an argument with a numeric type. */
+ if (e->symtree && e->symtree->n.sym->attr.subroutine)
+ goto error;
+
if (gfc_numeric_ts (&e->ts))
return true;
@@ -86,7 +91,9 @@ numeric_check (gfc_expr *e, int n)
return true;
}
- gfc_error ("%qs argument of %qs intrinsic at %L must be a numeric type",
+error:
+
+ gfc_error ("%qs argument of %qs intrinsic at %L must have a numeric type",
gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic,
&e->where);
@@ -3820,7 +3827,7 @@ gfc_check_reshape (gfc_expr *source, gfc
if (!type_check (order, 3, BT_INTEGER))
return false;
- if (order->expr_type == EXPR_ARRAY)
+ if (order->expr_type == EXPR_ARRAY && gfc_is_constant_expr (order))
{
int i, order_size, dim, perm[GFC_MAX_DIMENSIONS];
gfc_expr *e;
Index: gcc/fortran/class.c
===================================================================
--- gcc/fortran/class.c (revision 240590)
+++ gcc/fortran/class.c (working copy)
@@ -238,12 +238,14 @@ gfc_add_component_ref (gfc_expr *e, cons
/* Avoid losing memory. */
gfc_free_ref_list (*tail);
c = gfc_find_component (derived, name, true, true, tail);
- gcc_assert (c);
- for (ref = *tail; ref->next; ref = ref->next)
- ;
- ref->next = next;
- if (!next)
- e->ts = c->ts;
+
+ if (c) {
+ for (ref = *tail; ref->next; ref = ref->next)
+ ;
+ ref->next = next;
+ if (!next)
+ e->ts = c->ts;
+ }
}
Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c (revision 240590)
+++ gcc/fortran/decl.c (working copy)
@@ -395,6 +395,7 @@ match_data_constant (gfc_expr **result)
{
gfc_error ("Symbol %qs must be a PARAMETER in DATA statement at %C",
name);
+ *result = NULL;
return MATCH_ERROR;
}
else if (dt_sym && gfc_fl_struct (dt_sym->attr.flavor))
@@ -905,6 +906,7 @@ char_len_param_value (gfc_expr **expr, b
goto syntax;
else if ((*expr)->expr_type == EXPR_VARIABLE)
{
+ bool t;
gfc_expr *e;
e = gfc_copy_expr (*expr);
@@ -916,7 +918,16 @@ char_len_param_value (gfc_expr **expr, b
&& e->ref->u.ar.dimen_type[0] == DIMEN_RANGE)
goto syntax;
- gfc_reduce_init_expr (e);
+ t = gfc_reduce_init_expr (e);
+
+ if (!t && e->ts.type == BT_UNKNOWN
+ && e->symtree->n.sym->attr.untyped == 1
+ && (e->symtree->n.sym->ns->seen_implicit_none == 1
+ || e->symtree->n.sym->ns->parent->seen_implicit_none == 1))
+ {
+ gfc_free_expr (e);
+ goto syntax;
+ }
if ((e->ref && e->ref->type == REF_ARRAY
&& e->ref->u.ar.type != AR_ELEMENT)
@@ -1485,10 +1496,14 @@ gfc_set_constant_character_len (int len,
gfc_char_t *s;
int slen;
- gcc_assert (expr->expr_type == EXPR_CONSTANT);
-
if (expr->ts.type != BT_CHARACTER)
return;
+
+ if (expr->expr_type != EXPR_CONSTANT)
+ {
+ gfc_error_now ("CHARACTER length must be a constant at %L", &expr->where);
+ return;
+ }
slen = expr->value.character.length;
if (len != slen)
@@ -1912,8 +1927,10 @@ build_struct (const char *name, gfc_char
if (c->initializer->expr_type == EXPR_CONSTANT)
gfc_set_constant_character_len (len, c->initializer, -1);
- else if (mpz_cmp (c->ts.u.cl->length->value.integer,
- c->initializer->ts.u.cl->length->value.integer))
+ else if (c->initializer
+ && c->initializer->ts.u.cl
+ && mpz_cmp (c->ts.u.cl->length->value.integer,
+ c->initializer->ts.u.cl->length->value.integer))
{
gfc_constructor *ctor;
ctor = gfc_constructor_first (c->initializer->value.constructor);
Index: gcc/fortran/dependency.c
===================================================================
--- gcc/fortran/dependency.c (revision 240590)
+++ gcc/fortran/dependency.c (working copy)
@@ -1252,7 +1252,14 @@ gfc_check_dependency (gfc_expr *expr1, g
gfc_constructor *c;
int n;
- gcc_assert (expr1->expr_type == EXPR_VARIABLE);
+ /* -fcoarray=lib can end up here with expr1->expr_type set to EXPR_FUNCTION
+ and a reference to _F.caf_get, so skip the assert. */
+ if (expr1->expr_type == EXPR_FUNCTION
+ && strcmp (expr1->value.function.name, "_F.caf_get") == 0)
+ return 0;
+
+ if (expr1->expr_type != EXPR_VARIABLE)
+ gfc_internal_error ("gfc_check_dependency: expecting an EXPR_VARIABLE");
switch (expr2->expr_type)
{
Index: gcc/fortran/frontend-passes.c
===================================================================
--- gcc/fortran/frontend-passes.c (revision 240590)
+++ gcc/fortran/frontend-passes.c (working copy)
@@ -1061,6 +1061,9 @@ optimize_binop_array_assignment (gfc_cod
{
gfc_expr *e;
+ if (!*rhs)
+ return false;
+
e = *rhs;
if (e->expr_type == EXPR_OP)
{
@@ -1137,6 +1140,8 @@ remove_trim (gfc_expr *rhs)
bool ret;
ret = false;
+ if (!rhs)
+ return ret;
/* Check for a // b // trim(c). Looping is probably not
necessary because the parser usually generates
@@ -1274,6 +1279,9 @@ combine_array_constructor (gfc_expr *e)
op1 = e->value.op.op1;
op2 = e->value.op.op2;
+ if (!op1 || !op2)
+ return false;
+
if (op1->expr_type == EXPR_ARRAY && op2->rank == 0)
scalar_first = false;
else if (op2->expr_type == EXPR_ARRAY && op1->rank == 0)
Index: gcc/fortran/interface.c
===================================================================
--- gcc/fortran/interface.c (revision 240590)
+++ gcc/fortran/interface.c (working copy)
@@ -2146,7 +2146,7 @@ compare_parameter (gfc_symbol *formal, g
{
if (where)
gfc_error ("Type mismatch in argument %qs at %L; passed %s to %s",
- formal->name, &actual->where, gfc_typename (&actual->ts),
+ formal->name, where, gfc_typename (&actual->ts),
gfc_typename (&formal->ts));
return 0;
}
Index: gcc/fortran/intrinsic.c
===================================================================
--- gcc/fortran/intrinsic.c (revision 240590)
+++ gcc/fortran/intrinsic.c (working copy)
@@ -1239,7 +1239,8 @@ add_functions (void)
*z = "z", *ln = "len", *ut = "unit", *han = "handler",
*num = "number", *tm = "time", *nm = "name", *md = "mode",
*vl = "values", *p1 = "path1", *p2 = "path2", *com = "command",
- *ca = "coarray", *sub = "sub", *dist = "distance", *failed="failed";
+ *ca = "coarray", *sub = "sub", *dist = "distance", *failed="failed",
+ *c_ptr_1 = "c_ptr_1", *c_ptr_2 = "c_ptr_2";
int di, dr, dd, dl, dc, dz, ii;
@@ -2811,8 +2812,8 @@ add_functions (void)
/* The following functions are part of ISO_C_BINDING. */
add_sym_2 ("c_associated", GFC_ISYM_C_ASSOCIATED, CLASS_INQUIRY, ACTUAL_NO,
BT_LOGICAL, dl, GFC_STD_F2003, gfc_check_c_associated, NULL, NULL,
- "C_PTR_1", BT_VOID, 0, REQUIRED,
- "C_PTR_2", BT_VOID, 0, OPTIONAL);
+ c_ptr_1, BT_VOID, 0, REQUIRED,
+ c_ptr_2, BT_VOID, 0, OPTIONAL);
make_from_module();
add_sym_1 ("c_loc", GFC_ISYM_C_LOC, CLASS_INQUIRY, ACTUAL_NO,
Index: gcc/fortran/io.c
===================================================================
--- gcc/fortran/io.c (revision 240590)
+++ gcc/fortran/io.c (working copy)
@@ -3052,7 +3052,7 @@ gfc_resolve_dt (gfc_dt *dt, locus *loc)
&& dt->format_label->defined == ST_LABEL_UNKNOWN)
{
gfc_error ("FORMAT label %d at %L not defined", dt->format_label->value,
- &dt->format_label->where);
+ loc);
return false;
}
Index: gcc/fortran/parse.c
===================================================================
--- gcc/fortran/parse.c (revision 240590)
+++ gcc/fortran/parse.c (working copy)
@@ -1071,13 +1071,8 @@ next_free (void)
}
if (gfc_match_eos () == MATCH_YES)
- {
- gfc_warning_now (0, "Ignoring statement label in empty statement "
- "at %L", &label_locus);
- gfc_free_st_label (gfc_statement_label);
- gfc_statement_label = NULL;
- return ST_NONE;
- }
+ gfc_error_now ("Statement label without statement at %L",
+ &label_locus);
}
}
else if (c == '!')
@@ -1333,8 +1328,7 @@ next_fixed (void)
blank_line:
if (digit_flag)
- gfc_warning_now (0, "Ignoring statement label in empty statement at %L",
- &label_locus);
+ gfc_error_now ("Statement label without statement at %L", &label_locus);
gfc_current_locus.lb->truncated = 0;
gfc_advance_line ();
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c (revision 240590)
+++ gcc/fortran/resolve.c (working copy)
@@ -6508,15 +6508,15 @@ gfc_resolve_iterator (gfc_iterator *iter
/* Convert start, end, and step to the same type as var. */
if (iter->start->ts.kind != iter->var->ts.kind
|| iter->start->ts.type != iter->var->ts.type)
- gfc_convert_type (iter->start, &iter->var->ts, 2);
+ gfc_convert_type (iter->start, &iter->var->ts, 1);
if (iter->end->ts.kind != iter->var->ts.kind
|| iter->end->ts.type != iter->var->ts.type)
- gfc_convert_type (iter->end, &iter->var->ts, 2);
+ gfc_convert_type (iter->end, &iter->var->ts, 1);
if (iter->step->ts.kind != iter->var->ts.kind
|| iter->step->ts.type != iter->var->ts.type)
- gfc_convert_type (iter->step, &iter->var->ts, 2);
+ gfc_convert_type (iter->step, &iter->var->ts, 1);
if (iter->start->expr_type == EXPR_CONSTANT
&& iter->end->expr_type == EXPR_CONSTANT
@@ -8936,7 +8936,7 @@ resolve_branch (gfc_st_label *label, gfc
if (label->defined == ST_LABEL_UNKNOWN)
{
gfc_error ("Label %d referenced at %L is never defined", label->value,
- &label->where);
+ &code->loc);
return;
}
@@ -11495,6 +11495,27 @@ resolve_fl_variable_derived (gfc_symbol
}
+/* F2008, C402 (R401): A colon shall not be used as a type-param-value
+ except in the declaration of an entity or component that has the POINTER
+ or ALLOCATABLE attribute. */
+
+static bool
+deferred_requirements (gfc_symbol *sym)
+{
+ if (sym->ts.deferred
+ && !(sym->attr.pointer
+ || sym->attr.allocatable
+ || sym->attr.omp_udr_artificial_var))
+ {
+ gfc_error ("Entity %qs at %L has a deferred type parameter and "
+ "requires either the POINTER or ALLOCATABLE attribute",
+ sym->name, &sym->declared_at);
+ return false;
+ }
+ return true;
+}
+
+
/* Resolve symbols with flavor variable. */
static bool
@@ -11534,17 +11555,8 @@ resolve_fl_variable (gfc_symbol *sym, in
}
/* Constraints on deferred type parameter. */
- if (sym->ts.deferred
- && !(sym->attr.pointer
- || sym->attr.allocatable
- || sym->attr.omp_udr_artificial_var))
- {
- gfc_error ("Entity %qs at %L has a deferred type parameter and "
- "requires either the pointer or allocatable attribute",
- sym->name, &sym->declared_at);
- specification_expr = saved_specification_expr;
- return false;
- }
+ if (!deferred_requirements (sym))
+ return false;
if (sym->ts.type == BT_CHARACTER)
{
@@ -13663,6 +13675,10 @@ resolve_fl_parameter (gfc_symbol *sym)
return false;
}
+ /* Constraints on deferred type parameter. */
+ if (!deferred_requirements (sym))
+ return false;
+
/* Make sure a parameter that has been implicitly typed still
matches the implicit type, since PARAMETER statements can precede
IMPLICIT statements. */
Index: gcc/fortran/simplify.c
===================================================================
--- gcc/fortran/simplify.c (revision 240590)
+++ gcc/fortran/simplify.c (working copy)
@@ -489,6 +489,8 @@ simplify_transformation_to_scalar (gfc_e
}
result = op (result, gfc_copy_expr (a));
+ if (!result)
+ return result;
}
return result;
@@ -7043,9 +7045,17 @@ gfc_simplify_compiler_version (void)
gfc_expr *
simplify_ieee_selected_real_kind (gfc_expr *expr)
{
- gfc_actual_arglist *arg = expr->value.function.actual;
- gfc_expr *p = arg->expr, *q = arg->next->expr,
- *rdx = arg->next->next->expr;
+ gfc_actual_arglist *arg;
+ gfc_expr *p = NULL, *q = NULL, *rdx = NULL;
+
+ arg = expr->value.function.actual;
+ p = arg->expr;
+ if (arg->next)
+ {
+ q = arg->next->expr;
+ if (arg->next->next)
+ rdx = arg->next->next->expr;
+ }
/* Currently, if IEEE is supported and this module is built, it means
all our floating-point types conform to IEEE. Hence, we simply handle
Index: gcc/fortran/target-memory.c
===================================================================
--- gcc/fortran/target-memory.c (revision 240590)
+++ gcc/fortran/target-memory.c (working copy)
@@ -639,7 +639,8 @@ gfc_target_interpret_expr (unsigned char
error. */
static size_t
-expr_to_char (gfc_expr *e, unsigned char *data, unsigned char *chk, size_t len)
+expr_to_char (gfc_expr *e, locus *loc,
+ unsigned char *data, unsigned char *chk, size_t len)
{
int i;
int ptr;
@@ -663,7 +664,7 @@ expr_to_char (gfc_expr *e, unsigned char
continue;
ptr = TREE_INT_CST_LOW(DECL_FIELD_OFFSET(cmp->backend_decl))
+ TREE_INT_CST_LOW(DECL_FIELD_BIT_OFFSET(cmp->backend_decl))/8;
- expr_to_char (c->expr, &data[ptr], &chk[ptr], len);
+ expr_to_char (c->expr, loc, &data[ptr], &chk[ptr], len);
}
return len;
}
@@ -674,12 +675,16 @@ expr_to_char (gfc_expr *e, unsigned char
buffer = (unsigned char*)alloca (len);
len = gfc_target_encode_expr (e, buffer, len);
- for (i = 0; i < (int)len; i++)
+ for (i = 0; i < (int)len; i++)
{
if (chk[i] && (buffer[i] != data[i]))
{
- gfc_error ("Overlapping unequal initializers in EQUIVALENCE "
- "at %L", &e->where);
+ if (loc)
+ gfc_error ("Overlapping unequal initializers in EQUIVALENCE "
+ "at %L", loc);
+ else
+ gfc_error ("Overlapping unequal initializers in EQUIVALENCE "
+ "at %C");
return 0;
}
chk[i] = 0xFF;
@@ -695,7 +700,8 @@ expr_to_char (gfc_expr *e, unsigned char
the union declaration. */
size_t
-gfc_merge_initializers (gfc_typespec ts, gfc_expr *e, unsigned char *data,
+gfc_merge_initializers (gfc_typespec ts, gfc_expr *e, locus *loc,
+ unsigned char *data,
unsigned char *chk, size_t length)
{
size_t len = 0;
@@ -705,8 +711,7 @@ gfc_merge_initializers (gfc_typespec ts,
{
case EXPR_CONSTANT:
case EXPR_STRUCTURE:
- len = expr_to_char (e, &data[0], &chk[0], length);
-
+ len = expr_to_char (e, loc, &data[0], &chk[0], length);
break;
case EXPR_ARRAY:
@@ -718,7 +723,7 @@ gfc_merge_initializers (gfc_typespec ts,
if (mpz_cmp_si (c->offset, 0) != 0)
len = elt_size * (size_t)mpz_get_si (c->offset);
- len = len + gfc_merge_initializers (ts, c->expr, &data[len],
+ len = len + gfc_merge_initializers (ts, c->expr, loc, &data[len],
&chk[len], length - len);
}
break;
Index: gcc/fortran/target-memory.h
===================================================================
--- gcc/fortran/target-memory.h (revision 240590)
+++ gcc/fortran/target-memory.h (working copy)
@@ -44,7 +44,7 @@ int gfc_interpret_derived (unsigned char
int gfc_target_interpret_expr (unsigned char *, size_t, gfc_expr *, bool);
/* Merge overlapping equivalence initializers for trans-common.c. */
-size_t gfc_merge_initializers (gfc_typespec, gfc_expr *,
+size_t gfc_merge_initializers (gfc_typespec, gfc_expr *, locus *,
unsigned char *, unsigned char *,
size_t);
Index: gcc/fortran/trans-common.c
===================================================================
--- gcc/fortran/trans-common.c (revision 240590)
+++ gcc/fortran/trans-common.c (working copy)
@@ -532,10 +532,15 @@ get_init_field (segment_info *head, tree
memset (chk, '\0', (size_t)length);
for (s = head; s; s = s->next)
if (s->sym->value)
- gfc_merge_initializers (s->sym->ts, s->sym->value,
+ {
+ locus *loc = NULL;
+ if (s->sym->ns->equiv && s->sym->ns->equiv->eq)
+ loc = &s->sym->ns->equiv->eq->expr->where;
+ gfc_merge_initializers (s->sym->ts, s->sym->value, loc,
&data[s->offset],
&chk[s->offset],
(size_t)s->length);
+ }
for (i = 0; i < length; i++)
CONSTRUCTOR_APPEND_ELT (v, NULL, build_int_cst (type, data[i]));
@@ -800,13 +805,21 @@ element_number (gfc_array_ref *ar)
if (ar->dimen_type[i] != DIMEN_ELEMENT)
gfc_internal_error ("element_number(): Bad dimension type");
- mpz_sub (n, *get_mpz (ar->start[i]), *get_mpz (as->lower[i]));
+ if (as && as->lower[i])
+ mpz_sub (n, *get_mpz (ar->start[i]), *get_mpz (as->lower[i]));
+ else
+ mpz_sub_ui (n, *get_mpz (ar->start[i]), 1);
mpz_mul (n, n, multiplier);
mpz_add (offset, offset, n);
- mpz_sub (extent, *get_mpz (as->upper[i]), *get_mpz (as->lower[i]));
- mpz_add_ui (extent, extent, 1);
+ if (as && as->upper[i] && as->lower[i])
+ {
+ mpz_sub (extent, *get_mpz (as->upper[i]), *get_mpz (as->lower[i]));
+ mpz_add_ui (extent, extent, 1);
+ }
+ else
+ mpz_set_ui (extent, 0);
if (mpz_sgn (extent) < 0)
mpz_set_ui (extent, 0);
Index: gcc/fortran/trans-decl.c
===================================================================
--- gcc/fortran/trans-decl.c (revision 240590)
+++ gcc/fortran/trans-decl.c (working copy)
@@ -5279,9 +5279,19 @@ generate_local_decl (gfc_symbol * sym)
}
else if (!sym->attr.use_assoc)
{
- gfc_warning (OPT_Wunused_variable,
- "Unused variable %qs declared at %L",
- sym->name, &sym->declared_at);
+ /* Corner case: the symbol may be an entry point. At this point,
+ it may appear to be an unused variable. Suppress warning. */
+ bool enter = false;
+ gfc_entry_list *el;
+
+ for (el = sym->ns->entries; el; el=el->next)
+ if (strcmp(sym->name, el->sym->name) == 0)
+ enter = true;
+
+ if (!enter)
+ gfc_warning (OPT_Wunused_variable,
+ "Unused variable %qs declared at %L",
+ sym->name, &sym->declared_at);
if (sym->backend_decl != NULL_TREE)
TREE_NO_WARNING(sym->backend_decl) = 1;
}
Index: gcc/testsuite/gfortran.dg/array_constructor_26.f03
===================================================================
--- gcc/testsuite/gfortran.dg/array_constructor_26.f03 (revision 240590)
+++ gcc/testsuite/gfortran.dg/array_constructor_26.f03 (working copy)
@@ -10,7 +10,6 @@ MODULE WinData
INTEGER (1), PARAMETER :: MAXFLD = 25_1, MAXHED = 5_1, MAXCHR = 80_1
integer :: i
TYPE TWindowData
- CHARACTER (MAX_FLD_HED, 1) :: DWFdHd(MAXFLD) = [(" ", i = 1, MAXFLD)]
- ! { dg-error "specification expression" "" { target *-*-* } 13 }
+ CHARACTER (MAX_FLD_HED, 1) :: DWFdHd(MAXFLD) = [(" ", i = 1, MAXFLD)] ! { dg-error "Scalar INTEGER expression" }
END TYPE TWindowData
END MODULE WinData
Index: gcc/testsuite/gfortran.dg/array_constructor_27.f03
===================================================================
--- gcc/testsuite/gfortran.dg/array_constructor_27.f03 (revision 240590)
+++ gcc/testsuite/gfortran.dg/array_constructor_27.f03 (working copy)
@@ -8,8 +8,7 @@
implicit none
type t
- character (a) :: arr (1) = [ "a" ]
- ! { dg-error "specification expression" "" { target *-*-* } 11 }
+ character (a) :: arr (1) = [ "a" ] ! { dg-error "Scalar INTEGER expression" }
end type t
end
Index: gcc/testsuite/gfortran.dg/bounds_check_strlen_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/bounds_check_strlen_2.f90 (revision 240590)
+++ gcc/testsuite/gfortran.dg/bounds_check_strlen_2.f90 (working copy)
@@ -11,8 +11,8 @@ CONTAINS
SUBROUTINE test (str, n)
IMPLICIT NONE
- CHARACTER(len=n) :: str
INTEGER :: n
+ CHARACTER(len=n) :: str
END SUBROUTINE test
SUBROUTINE test2 (str)
Index: gcc/testsuite/gfortran.dg/c_assoc_2.f03
===================================================================
--- gcc/testsuite/gfortran.dg/c_assoc_2.f03 (revision 240590)
+++ gcc/testsuite/gfortran.dg/c_assoc_2.f03 (working copy)
@@ -20,7 +20,7 @@ contains
call abort()
end if
- if(.not. c_associated()) then ! { dg-error "Missing actual argument 'C_PTR_1' in call to 'c_associated'" }
+ if(.not. c_associated()) then ! { dg-error "Missing actual argument 'c_ptr_1' in call to 'c_associated'" }
call abort()
end if
Index: gcc/testsuite/gfortran.dg/c_assoc_4.f90
===================================================================
--- gcc/testsuite/gfortran.dg/c_assoc_4.f90 (revision 240590)
+++ gcc/testsuite/gfortran.dg/c_assoc_4.f90 (working copy)
@@ -9,6 +9,6 @@ PROGRAM test
TYPE (C_PTR) :: x, y
- PRINT *, C_ASSOCIATED([x,y]) ! { dg-error "'C_PTR_1' argument of 'c_associated' intrinsic at .1. must be a scalar" }
+ PRINT *, C_ASSOCIATED([x,y]) ! { dg-error "'c_ptr_1' argument of 'c_associated' intrinsic at .1. must be a scalar" }
END PROGRAM test
Index: gcc/testsuite/gfortran.dg/coarray_collectives_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/coarray_collectives_1.f90 (revision 240590)
+++ gcc/testsuite/gfortran.dg/coarray_collectives_1.f90 (working copy)
@@ -14,7 +14,7 @@ program test
integer(8) :: i8
character(len=19, kind=4) :: msg4
- call co_sum("abc") ! { dg-error "must be a numeric type" }
+ call co_sum("abc") ! { dg-error "must have a numeric type" }
call co_max(cmplx(1.0,0.0)) ! { dg-error "shall be of type integer, real or character" }
call co_min(cmplx(0.0,1.0)) ! { dg-error "shall be of type integer, real or character" }
Index: gcc/testsuite/gfortran.dg/empty_label.f
===================================================================
--- gcc/testsuite/gfortran.dg/empty_label.f (revision 240590)
+++ gcc/testsuite/gfortran.dg/empty_label.f (working copy)
@@ -1,7 +1,4 @@
C { dg-do compile }
-C { dg-options "-Werror -fmax-errors=1" }
-100 ! { dg-error "empty statement" }
+100 ! { dg-error "Statement label without statement" }
end
-subroutine foo ! Not checked ...
-end function ! ... but an error
-C { dg-excess-errors "warnings being treated as errors" }
+
Index: gcc/testsuite/gfortran.dg/empty_label.f90
===================================================================
--- gcc/testsuite/gfortran.dg/empty_label.f90 (revision 240590)
+++ gcc/testsuite/gfortran.dg/empty_label.f90 (working copy)
@@ -1,7 +1,3 @@
! { dg-do compile }
-! { dg-options "-Werror -fmax-errors=1" }
-100 ! { dg-error "empty statement" }
+100 ! { dg-error "Statement label without statement" }
end
-subroutine foo ! Not checked ...
-end function ! ... but an error
-! { dg-excess-errors "warnings being treated as errors" }
Index: gcc/testsuite/gfortran.dg/empty_label_typedecl.f90
===================================================================
--- gcc/testsuite/gfortran.dg/empty_label_typedecl.f90 (revision 240590)
+++ gcc/testsuite/gfortran.dg/empty_label_typedecl.f90 (working copy)
@@ -1,8 +1,6 @@
! { dg-do compile }
-! { dg-options "-Werror" }
subroutine s
type t
- 1 ! { dg-error "empty statement" }
+ 1 ! { dg-error "Statement label without statement" }
end type
end subroutine
-! { dg-excess-errors "warnings being treated as errors" }
Index: gcc/testsuite/gfortran.dg/equiv_constraint_5.f90
===================================================================
--- gcc/testsuite/gfortran.dg/equiv_constraint_5.f90 (revision 240590)
+++ gcc/testsuite/gfortran.dg/equiv_constraint_5.f90 (working copy)
@@ -19,13 +19,13 @@
END TYPE T2
TYPE T3
sequence
- integer :: i=2 ! { dg-error "Overlapping unequal initializers" }
+ integer :: i=2
END TYPE T3
TYPE(T1) :: a1
TYPE(T2) :: a2
TYPE(T3) :: a3
EQUIVALENCE (a1, a2)
- EQUIVALENCE (a1, a3)
+ EQUIVALENCE (a1, a3) ! { dg-error "Overlapping unequal initializers" }
write(6, *) a1, a2, a3
END
Index: gcc/testsuite/gfortran.dg/equiv_constraint_7.f90
===================================================================
--- gcc/testsuite/gfortran.dg/equiv_constraint_7.f90 (revision 240590)
+++ gcc/testsuite/gfortran.dg/equiv_constraint_7.f90 (working copy)
@@ -5,7 +5,7 @@
! Started out being in BLOCK DATA; however, blockdata variables must be in
! COMMON and therefore cannot have F95 style initializers....
MODULE DATA
- INTEGER :: I=1,J=2 ! { dg-error "Overlapping unequal initializers" }
- EQUIVALENCE(I,J)
+ INTEGER :: I=1,J=2
+ EQUIVALENCE(I,J) ! { dg-error "Overlapping unequal initializers" }
END MODULE DATA
END
Index: gcc/testsuite/gfortran.dg/ieee/pr77372.f90
===================================================================
--- gcc/testsuite/gfortran.dg/ieee/pr77372.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/ieee/pr77372.f90 (working copy)
@@ -0,0 +1,7 @@
+! { dg-do compile }
+program p
+ use ieee_arithmetic
+ real(kind=ieee_selected_real_kind(10_1)) :: z1
+ real(kind=ieee_selected_real_kind(10_2)) :: z2
+ real(kind=ieee_selected_real_kind(10_4)) :: z4
+end
Index: gcc/testsuite/gfortran.dg/ieee/pr77507.f90
===================================================================
--- gcc/testsuite/gfortran.dg/ieee/pr77507.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/ieee/pr77507.f90 (working copy)
@@ -0,0 +1,7 @@
+! { dg-do compile }
+Program p
+ Use ieee_arithmetic
+ Use iso_c_binding
+ Print *, ieee_value(x=1.0, class=ieee_negative_inf)
+ Print *, c_associated(c_ptr_1=c_null_ptr)
+End Program
Index: gcc/testsuite/gfortran.dg/intrinsic_numeric_arg.f
===================================================================
--- gcc/testsuite/gfortran.dg/intrinsic_numeric_arg.f (revision 240590)
+++ gcc/testsuite/gfortran.dg/intrinsic_numeric_arg.f (working copy)
@@ -4,6 +4,6 @@
LOGICAL Z
CHARACTER A
REAL R
- R = ABS(Z) ! { dg-error " must be a numeric type" }
- R = ABS(A) ! { dg-error " must be a numeric type" }
+ R = ABS(Z) ! { dg-error " must have a numeric type" }
+ R = ABS(A) ! { dg-error " must have a numeric type" }
END
Index: gcc/testsuite/gfortran.dg/label_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/label_3.f90 (revision 240590)
+++ gcc/testsuite/gfortran.dg/label_3.f90 (working copy)
@@ -1,5 +1,5 @@
! { dg-do compile }
! PR fortran/25756.
! This used to ICE due to the space after the label.
-1 ! { dg-warning "Ignoring statement label in empty statement" }
+1 ! { dg-error "Statement label without statement" }
end
Index: gcc/testsuite/gfortran.dg/pr41922.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr41922.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr41922.f90 (working copy)
@@ -0,0 +1,11 @@
+! { dg-do compile}
+! { dg-options -std=gnu }
+ Subroutine RestoreR8Run()
+ Implicit NONE
+ Integer ISTORE
+ Real XSTORE
+ character CSTORE(8)
+ data cstore/8*' '/
+ data istore/0/
+ EQUIVALENCE (CSTORE(1),XSTORE,ISTORE) ! { dg-error "Overlapping unequal" }
+ end
Index: gcc/testsuite/gfortran.dg/pr61318.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr61318.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr61318.f90 (working copy)
@@ -0,0 +1,23 @@
+! { dg-do compile }
+!
+module gbl_message
+ type :: mytype
+ integer(kind=4) :: e
+ end type mytype
+ type(mytype), parameter :: seve = mytype(1)
+end module gbl_message
+
+module gbl_interfaces
+ interface
+ subroutine gagout(message)
+ character(len=*), intent(in) :: message
+ end subroutine gagout
+ end interface
+end module gbl_interfaces
+
+program test
+ use gbl_message
+ use gbl_interfaces
+ call gagout(seve%e,'Some string') ! { dg-error "Type mismatch in argument" }
+end program test
+! { dg-final { cleanup-modules "gbl_interfaces gbl_message" } }
Index: gcc/testsuite/gfortran.dg/pr68566.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr68566.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr68566.f90 (working copy)
@@ -0,0 +1,13 @@
+! { dg-do run }
+program p
+ character(len=20) s1, s2
+ integer, allocatable :: n(:)
+ n = [2,1]
+ s1 = '1 5 2 6 3 0 4 0'
+ write(s2,'(8(I0,1x))') reshape ([1,2,3,4,5,6], [2,4], [0,0], [2,1])
+ if (trim(s1) /= trim(s2)) call abort
+ write(s2,'(8(I0,1x))') reshape ([1,2,3,4,5,6], [2,4], [0,0], n)
+ if (trim(s1) /= trim(s2)) call abort
+ write(s2,'(8(I0,1x))') reshape ([1,2,3,4,5,6], [2,4], [0,0], [n])
+ if (trim(s1) /= trim(s2)) call abort
+end
Index: gcc/testsuite/gfortran.dg/pr69514_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr69514_1.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr69514_1.f90 (working copy)
@@ -0,0 +1,5 @@
+! { dg-do run }
+program foo
+ real, parameter :: x(3) = 2.0 * [real :: 1, 2, 3 ]
+ if (any(x /= [2., 4., 6.])) call abort
+end program foo
Index: gcc/testsuite/gfortran.dg/pr69514_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr69514_2.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr69514_2.f90 (working copy)
@@ -0,0 +1,49 @@
+! { dg-do run }
+program p
+ implicit none
+
+ real , parameter :: arr(3) = [ real :: 2, 2.5, (1.5, 2.5) ]
+ real , parameter :: ari(3) = [ integer :: 2, 2.5, (1.5, 2.5) ]
+ real , parameter :: arc(3) = [ complex :: 2, 2.5, (1.5, 2.5) ]
+ integer, parameter :: air(3) = [ real :: 2, 2.5, (1.5, 2.5) ]
+ integer, parameter :: aii(3) = [ integer :: 2, 2.5, (1.5, 2.5) ]
+ integer, parameter :: aic(3) = [ complex :: 2, 2.5, (1.5, 2.5) ]
+ complex, parameter :: acr(3) = [ real :: 2, 2.5, (1.5, 2.5) ]
+ complex, parameter :: aci(3) = [ integer :: 2, 2.5, (1.5, 2.5) ]
+ complex, parameter :: acc(3) = [ complex :: 2, 2.5, (1.5, 2.5) ]
+
+ real , parameter :: mrr(3) = 4.5 * [ real :: 2, 2.5, (3.5, 4.0) ]
+ real , parameter :: mri(3) = 4.5 * [ integer :: 2, 2.5, (3.5, 4.0) ]
+ real , parameter :: mrc(3) = 4.5 * [ complex :: 2, 2.5, (3.5, 4.0) ]
+ integer, parameter :: mir(3) = 4 * [ real :: 2, 2.5, (3.5, 4.0) ]
+ integer, parameter :: mii(3) = 4 * [ integer :: 2, 2.5, (3.5, 4.0) ]
+ integer, parameter :: mic(3) = 4 * [ complex :: 2, 2.5, (3.5, 4.0) ]
+ complex, parameter :: mcr(3) = (4.5, 5.5) * [ real :: 2, 2.5, (3.5, 4.0) ]
+ complex, parameter :: mci(3) = (4.5, 5.5) * [ integer :: 2, 2.5, (3.5, 4.0) ]
+ complex, parameter :: mcc(3) = (4.5, 5.5) * [ complex :: 2, 2.5, (3.5, 4.0) ]
+
+ if (any(arr /= [2.00, 2.50, 1.50])) call abort
+ if (any(ari /= [2.00, 2.00, 1.00])) call abort
+ if (any(arc /= [2.00, 2.50, 1.50])) call abort
+
+ if (any(air /= [2, 2, 1])) call abort
+ if (any(aii /= [2, 2, 1])) call abort
+ if (any(aic /= [2, 2, 1])) call abort
+
+ if (any(acr /= [(2.00, 0.00), (2.50, 0.00), (1.50, 0.00)])) call abort
+ if (any(aci /= [(2.00, 0.00), (2.00, 0.00), (1.00, 0.00)])) call abort
+ if (any(acc /= [(2.00, 0.00), (2.50, 0.00), (1.50, 2.50)])) call abort
+
+ if (any(mrr /= [9.00, 11.25, 15.75])) call abort
+ if (any(mri /= [9.00, 9.00, 13.50])) call abort
+ if (any(mrc /= [9.00, 11.25, 15.75])) call abort
+
+ if (any(mir /= [8, 10, 14])) call abort
+ if (any(mii /= [8, 8, 12])) call abort
+ if (any(mic /= [8, 10, 14])) call abort
+
+ if (any(mcr /= [(9.00, 11.00), (11.25, 13.75), (15.75, 19.25)])) call abort
+ if (any(mci /= [(9.00, 11.00), ( 9.00, 11.00), (13.50, 16.50)])) call abort
+ if (any(mcc /= [(9.00, 11.00), (11.25, 13.75), (-6.25, 37.25)])) call abort
+
+end program p
Index: gcc/testsuite/gfortran.dg/pr69867.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr69867.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr69867.f90 (working copy)
@@ -0,0 +1,6 @@
+! { dg-do compile }
+program p
+ type t
+ character(1) :: c(1)=[1] ! { dg-error "convert INTEGER.4. to CHARACTER.1." }
+ end type
+end
Index: gcc/testsuite/gfortran.dg/pr69962.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr69962.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr69962.f90 (working copy)
@@ -0,0 +1,6 @@
+! { dg-do compile }
+program p
+ integer :: n = 1
+ character(3), parameter :: x(2) = ['abc', 'xyz']
+ character(2), parameter :: y(2) = [x(2)(2:3), x(n)(1:2)] ! { dg-error "CHARACTER length must be a constant" }
+end
Index: gcc/testsuite/gfortran.dg/pr70006.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr70006.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr70006.f90 (working copy)
@@ -0,0 +1,9 @@
+! { dg-do compile}
+program test
+ print 1, 'string 1' ! { dg-error "FORMAT label 1" " " { target *-*-* } 3 }
+ print 1, 'string 2' ! { dg-error "FORMAT label 1" " " { target *-*-* } 4 }
+!1 format(a)
+ goto 2 ! { dg-error "Label 2 referenced" " " { target *-*-* } 6 }
+ goto 2 ! { dg-error "Label 2 referenced" " " { target *-*-* } 7 }
+!2 continue
+end program
Index: gcc/testsuite/gfortran.dg/pr71067_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr71067_1.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr71067_1.f90 (working copy)
@@ -0,0 +1,5 @@
+program p
+ integer :: i = 0
+ integer :: z(2)
+ data z /2*i/ ! { dg-error "must be a PARAMETER in DATA" }
+end
Index: gcc/testsuite/gfortran.dg/pr71067_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr71067_2.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr71067_2.f90 (working copy)
@@ -0,0 +1,7 @@
+! { dg-do compile }
+program p
+ integer :: a(2), b(2), c(2)
+ data a /2*b1'/ ! { dg-error "must be a PARAMETER in DATA" }
+ data b /2*o1' ! { dg-error "must be a PARAMETER in DATA" }
+ data c /2*z1 ! { dg-error "must be a PARAMETER in DATA" }
+end
Index: gcc/testsuite/gfortran.dg/pr71730.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr71730.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr71730.f90 (working copy)
@@ -0,0 +1,5 @@
+! { dg-do compile }
+subroutine foo
+ implicit none
+ character(len=bar) :: a ! { dg-error "Scalar INTEGER expression" }
+end subroutine foo
Index: gcc/testsuite/gfortran.dg/pr71799.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr71799.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr71799.f90 (working copy)
@@ -0,0 +1,10 @@
+! { dg-do compile }
+subroutine test2(s)
+integer(1) :: i
+integer (8) :: s
+
+do i = 10, HUGE(i) - 10, 222 ! { dg-error "overflow converting" }
+ s = s + 1
+end do
+
+end subroutine test2
Index: gcc/testsuite/gfortran.dg/pr71859.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr71859.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr71859.f90 (working copy)
@@ -0,0 +1,8 @@
+! { dg-do compile }
+program p
+ call s(1)
+ x = abs(s) ! { dg-error "must have a numeric type" }
+end
+subroutine s(n)
+ print *, n
+end
Index: gcc/testsuite/gfortran.dg/pr71862.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr71862.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr71862.f90 (working copy)
@@ -0,0 +1,16 @@
+! { dg-do compile }
+program p
+ type t
+ integer :: n = 0
+ integer, pointer :: q => null()
+ end type
+ type(t) :: x
+ print *, associated(x%q)
+ x = f()
+ print *, associated(x%q)
+contains
+ function f() result (z) ! { dg-error "must be dummy, allocatable or pointer" }
+ class(t) :: z
+ print *, associated(z%q)
+ end
+end
Index: gcc/testsuite/gfortran.dg/pr77260_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr77260_1.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr77260_1.f90 (working copy)
@@ -0,0 +1,25 @@
+! { dg-do compile }
+! { dg-options "-Wall" }
+module foo
+
+ implicit none
+
+ private
+ public f1,f2
+
+ contains
+
+ integer function f1()
+ integer f2
+ f1=5
+ entry f2
+ f2=8
+ end function
+end module
+
+program test
+ use foo
+ implicit none
+ print *,f2()
+end program
+! { dg-final { cleanup-modules "foo" } }
Index: gcc/testsuite/gfortran.dg/pr77260_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr77260_2.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr77260_2.f90 (working copy)
@@ -0,0 +1,26 @@
+! { dg-do compile }
+! { dg-options "-Wall" }
+module foo
+
+ implicit none
+
+ private
+ public f1,f2
+
+ contains
+
+ integer function f1()
+ integer f2
+ integer f3 ! { dg-warning "Unused variable" }
+ f1=5
+ entry f2
+ f2=8
+ end function
+end module
+
+program test
+ use foo
+ implicit none
+ print *,f2()
+end program
+! { dg-final { cleanup-modules "foo" } }
Index: gcc/testsuite/gfortran.dg/pr77351.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr77351.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr77351.f90 (working copy)
@@ -0,0 +1,6 @@
+! { dg-do compile }
+program p
+ integer :: z(4) = [1, 2, 3, 4]
+ print *, any(shape(z) /= [4,1]) ! { dg-error "shape for elemental binary" }
+end
+! { dg-excess-errors "operands are incommensurate" }
Index: gcc/testsuite/gfortran.dg/pr77380.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr77380.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr77380.f90 (working copy)
@@ -0,0 +1,6 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=lib -O2" }
+program p
+ integer :: z(2)[*] = 1
+ z(:)[1] = z(:)[*] ! { dg-error "must be a scalar at" }
+end
Index: gcc/testsuite/gfortran.dg/pr77391.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr77391.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr77391.f90 (working copy)
@@ -0,0 +1,7 @@
+! { dg-do compile }
+program picky
+character(len=:), parameter :: a="whoops" ! { dg-error "POINTER or ALLOCATABLE" }
+character(len=:) :: b="whoops" ! { dg-error "POINTER or ALLOCATABLE" }
+character(len=:) :: good
+pointer good
+end program picky
Index: gcc/testsuite/gfortran.dg/pr77420_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr77420_1.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr77420_1.f90 (working copy)
@@ -0,0 +1,15 @@
+! { dg-do compile }
+module test_equivalence
+ real, private :: array1(100)
+ real, private :: array2(100)
+ equivalence(array1(3),array2(3))
+end module test_equivalence
+
+module mymodule
+ use test_equivalence
+ real, dimension(:), allocatable :: array1
+end module mymodule
+
+program test
+ use mymodule
+end program test
Index: gcc/testsuite/gfortran.dg/pr77420_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr77420_2.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr77420_2.f90 (working copy)
@@ -0,0 +1,15 @@
+! { dg-do compile }
+module test_equivalence
+ real, private :: array1(100)
+ real, private :: array2(100)
+ equivalence(array1,array2)
+end module test_equivalence
+
+module mymodule
+ use test_equivalence
+ real, dimension(:), allocatable :: array1
+end module mymodule
+
+program test
+ use mymodule
+end program test
Index: gcc/testsuite/gfortran.dg/pr77420_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr77420_3.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr77420_3.f90 (working copy)
@@ -0,0 +1,9 @@
+! { dg-do link }
+! { dg-additional-sources pr77420_4.f90 }
+!
+module h5global
+ implicit none
+ integer :: h5p_default_f, h5p_flags
+ equivalence(h5p_flags, h5p_default_f)
+end module h5global
+! { dg-final { cleanup-modules "h5global" } }
Index: gcc/testsuite/gfortran.dg/pr77420_4.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr77420_4.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr77420_4.f90 (working copy)
@@ -0,0 +1,10 @@
+! { dg-do compile { target { ! *-*-* } } }
+!
+program bug
+ use H5GLOBAL
+ implicit none
+ integer :: i
+ i=H5P_DEFAULT_F
+end program bug
+
+
Index: gcc/testsuite/gfortran.dg/pr77429.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr77429.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr77429.f90 (working copy)
@@ -0,0 +1,7 @@
+! { dg-do compile }
+program p
+ shape(1) = 0 ! { dg-error "expression in variable definition context" }
+ shape(1,2) = 0 ! { dg-error "expression in variable definition context" }
+ shape(1,2,3) = 0 ! { dg-error "Too many arguments in call" }
+ lbound([1]) = 0 ! { dg-error "expression in variable definition context" }
+end
Index: gcc/testsuite/gfortran.dg/pr77460.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr77460.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr77460.f90 (working copy)
@@ -0,0 +1,7 @@
+! { dg-do compile }
+ double precision, parameter :: x = huge(1d0)
+ print*, sum((/x,-x/))
+ print*, sum((/x,x,-x,-x/)) ! { dg-error "overflow" }
+ print*, sum((/x,-x,1d0/))
+ print*, sum((/1d0,x,-x/))
+end
Index: gcc/testsuite/gfortran.dg/pr77506.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr77506.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr77506.f90 (working copy)
@@ -0,0 +1,4 @@
+! { dg-do compile }
+program foo
+ print *, [character(len=*)::'ab','cd'] ! { dg-error "contain an asterisk" }
+end program foo
Index: gcc/testsuite/gfortran.dg/pr77612.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr77612.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr77612.f90 (working copy)
@@ -0,0 +1,13 @@
+! { dg-do compile }
+
+program bad_len
+
+ implicit none
+
+contains
+
+ subroutine sub
+ character(len = ICE) :: line ! { dg-error "INTEGER expression expected" }
+ end subroutine
+
+end program
Index: gcc/testsuite/gfortran.dg/pr77694.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr77694.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr77694.f90 (working copy)
@@ -0,0 +1,7 @@
+! { dg-do compile }
+! { dg-options -O }
+program p
+ logical x(2), y(2)
+ x = .true.
+ y = .nt. x ! { dg-error "Unknown operator" }
+end
Index: gcc/testsuite/gfortran.dg/warnings_are_errors_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/warnings_are_errors_1.f90 (revision 240590)
+++ gcc/testsuite/gfortran.dg/warnings_are_errors_1.f90 (working copy)
@@ -20,8 +20,6 @@
1234 complex :: cplx ! { dg-error "defined but cannot be used" }
cplx = 20.
-! gfc_warning_now:
- 1 ! { dg-error "Ignoring statement label in empty statement" }
end
! { dg-final { output-exists-not } }
! { dg-excess-errors "warnings being treated as errors" }
Index: libgfortran/ieee/ieee_arithmetic.F90
===================================================================
--- libgfortran/ieee/ieee_arithmetic.F90 (revision 240590)
+++ libgfortran/ieee/ieee_arithmetic.F90 (working copy)
@@ -857,12 +857,12 @@ contains
! IEEE_VALUE
- elemental real(kind=4) function IEEE_VALUE_4(X, C) result(res)
- implicit none
+ elemental real(kind=4) function IEEE_VALUE_4(X, CLASS) result(res)
+
real(kind=4), intent(in) :: X
- type(IEEE_CLASS_TYPE), intent(in) :: C
+ type(IEEE_CLASS_TYPE), intent(in) :: CLASS
- select case (C%hidden)
+ select case (CLASS%hidden)
case (1) ! IEEE_SIGNALING_NAN
res = -1
res = sqrt(res)
@@ -895,12 +895,12 @@ contains
end select
end function
- elemental real(kind=8) function IEEE_VALUE_8(X, C) result(res)
- implicit none
+ elemental real(kind=8) function IEEE_VALUE_8(X, CLASS) result(res)
+
real(kind=8), intent(in) :: X
- type(IEEE_CLASS_TYPE), intent(in) :: C
+ type(IEEE_CLASS_TYPE), intent(in) :: CLASS
- select case (C%hidden)
+ select case (CLASS%hidden)
case (1) ! IEEE_SIGNALING_NAN
res = -1
res = sqrt(res)
@@ -934,12 +934,12 @@ contains
end function
#ifdef HAVE_GFC_REAL_10
- elemental real(kind=10) function IEEE_VALUE_10(X, C) result(res)
- implicit none
+ elemental real(kind=10) function IEEE_VALUE_10(X, CLASS) result(res)
+
real(kind=10), intent(in) :: X
- type(IEEE_CLASS_TYPE), intent(in) :: C
+ type(IEEE_CLASS_TYPE), intent(in) :: CLASS
- select case (C%hidden)
+ select case (CLASS%hidden)
case (1) ! IEEE_SIGNALING_NAN
res = -1
res = sqrt(res)
@@ -971,15 +971,16 @@ contains
res = 0
end select
end function
+
#endif
#ifdef HAVE_GFC_REAL_16
- elemental real(kind=16) function IEEE_VALUE_16(X, C) result(res)
- implicit none
+ elemental real(kind=16) function IEEE_VALUE_16(X, CLASS) result(res)
+
real(kind=16), intent(in) :: X
- type(IEEE_CLASS_TYPE), intent(in) :: C
+ type(IEEE_CLASS_TYPE), intent(in) :: CLASS
- select case (C%hidden)
+ select case (CLASS%hidden)
case (1) ! IEEE_SIGNALING_NAN
res = -1
res = sqrt(res)
