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.

4 files changed, 33 insertions, 5 deletions

diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 6b3e5ba..4368627 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 3a3b6de..8f7deac 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 e160c5c9..301439b 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 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