diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index 6b3e5ba4fcb9e8b12e336cf46944342bc9a8c87a..4368627041edde93d35dc5f2e0e158d2c9f569d3 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -2189,6 +2189,14 @@ resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype, ? CLASS_DATA (sym)->as : sym->as; } + /* These symbols are set untyped by calls to gfc_set_default_type + with 'error_flag' = false. Reset the untyped attribute so that + the error will be generated in gfc_resolve_expr. */ + if (e->expr_type == EXPR_VARIABLE + && sym->ts.type == BT_UNKNOWN + && sym->attr.untyped) + sym->attr.untyped = 0; + /* Expressions are assigned a default ts.type of BT_PROCEDURE in primary.cc (match_actual_arg). If above code determines that it is a variable instead, it needs to be resolved as it was not @@ -5001,7 +5009,8 @@ gfc_resolve_index_1 (gfc_expr *index, int check_scalar, if ((index->ts.kind != gfc_index_integer_kind && force_index_integer_kind) - || index->ts.type != BT_INTEGER) + || (index->ts.type != BT_INTEGER + && index->ts.type != BT_UNKNOWN)) { gfc_clear_ts (&ts); ts.type = BT_INTEGER; diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc index 3a3b6de5cece25979bcffb9986725388765f94d6..8f7deac1d1eed609a3164dd59f44fa5f3a58f79f 100644 --- a/gcc/fortran/symbol.cc +++ b/gcc/fortran/symbol.cc @@ -320,7 +320,7 @@ gfc_set_default_type (gfc_symbol *sym, int error_flag, gfc_namespace *ns) "; did you mean %qs?", sym->name, &sym->declared_at, guessed); else - gfc_error ("Symbol %qs at %L has no IMPLICIT type(symbol)", + gfc_error ("Symbol %qs at %L has no IMPLICIT type", sym->name, &sym->declared_at); sym->attr.untyped = 1; /* Ensure we only give an error once. */ } diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc index e160c5c98c1ba4c97084f2f876f97291fc0995b4..301439baaf5581daf6c83c5f3161a9fbde7f8f99 100644 --- a/gcc/fortran/trans-decl.cc +++ b/gcc/fortran/trans-decl.cc @@ -1797,7 +1797,8 @@ gfc_get_symbol_decl (gfc_symbol * sym) } if (sym->ts.type == BT_UNKNOWN) - gfc_fatal_error ("%s at %C has no default type", sym->name); + gfc_fatal_error ("%s at %L has no default type", sym->name, + &sym->declared_at); if (sym->attr.intrinsic) gfc_internal_error ("intrinsic variable which isn't a procedure"); @@ -5214,8 +5215,8 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) tree tmp = lookup_attribute ("omp allocate", DECL_ATTRIBUTES (n->sym->backend_decl)); tmp = TREE_VALUE (tmp); - TREE_PURPOSE (tmp) = se.expr; - TREE_VALUE (tmp) = align; + TREE_PURPOSE (tmp) = se.expr; + TREE_VALUE (tmp) = align; TREE_PURPOSE (TREE_CHAIN (tmp)) = init_stmtlist; TREE_VALUE (TREE_CHAIN (tmp)) = cleanup_stmtlist; } diff --git a/gcc/testsuite/gfortran.dg/pr103471.f90 b/gcc/testsuite/gfortran.dg/pr103471.f90 new file mode 100644 index 0000000000000000000000000000000000000000..695446e034e67ad3e9ece3562635d68e31dd385a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr103471.f90 @@ -0,0 +1,18 @@ +! { dg-do compile } +! Test the fix for PR103471 in which, rather than giving a "no IMPLICIT type" +! message, gfortran took to ICEing. The fuzzy symbol check for 'kk' demonstrates +! that the error is being detected at the right place. +! +! Contributed by Gerhard Steinmetz <gscfq@t-online.de> +! +program p + implicit none + integer, parameter :: x(4) = [1,2,3,4] + real, external :: y + integer :: kk + print *, [real(y(l))] ! { dg-error "has no IMPLICIT type" } + print *, [real(x(k))] ! { dg-error "has no IMPLICIT type; did you mean .kk.\\?" } +! This silently suppresses the error in the previous line. With the line before +! commented out, the error occurs in trans-decl.cc. +! print *, [real(y(k))] +end