Fortran: Detect 'no implicit type' error in right place [PR103471]

2024-04-21  Paul Thomas  <pault@gcc.gnu.org>

gcc/fortran
	PR fortran/103471
	* resolve.cc (resolve_actual_arglist): Catch variables silently
	set as untyped, resetting the flag so that gfc_resolve_expr can
	generate the no implicit type error.
	(gfc_resolve_index_1): Block index expressions of unknown type
	from being converted to default integer, avoiding the fatal
	error in trans-decl.cc.
	* symbol.cc (gfc_set_default_type): Remove '(symbol)' from the
	'no IMPLICIT type' error message.
	* trans-decl.cc (gfc_get_symbol_decl): Change fatal error locus
	to that of the symbol declaration.
	(gfc_trans_deferred_vars): Remove two trailing tabs.

gcc/testsuite/
	PR fortran/103471
	* gfortran.dg/pr103471.f90: New test.

diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 6b3e5ba4fcb9e8b12e336cf46944342bc9a8c87a..4368627041edde93d35dc5f2e0e158d2c9f569d3 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
index 0000000..695446e
--- /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