Hi All,
I have been around several circuits with a patch for this regression. I
posted one in Bugzilla but rejected it because it was not direct enough.
This one, however, is more to my liking and fixes another bug lurking in
the shadows.
The way in which select type has been implemented is a bit weird in that
the select type temporaries don't get their assoc set until resolution.
Therefore, if the selector is of inferred type, the namespace is tagged by
setting 'assoc_name_inferred'. This narrows down the range of select type
temporaries that are picked out by the chunk in primary.cc, thereby fixing
the problem.
The chunks in resolve.cc fix a problem found on the way, where invalid
array references, either cause an ICE or were silently absorbed.
OK for mainline and 14-branch?
Paul
Fortran: Fix select type regression due to r14-9489 [PR114874]
2024-05-15 Paul Thomas
gcc/fortran
PR fortran/114874
* gfortran.h: Add 'assoc_name_inferred' to gfc_namespace.
* match.cc (gfc_match_select_type) : Set 'assoc_name_inferred'
in select type namespace if the selector has inferred type.
* primary.cc (gfc_match_varspec): If a select type temporary
is apparently scalar and '(' has been detected, check to see if
the current name space has 'assoc_name_inferred' set. If so,
set inferred_type.
* resolve.cc (resolve_variable): If the namespace of a select
type temporary is marked with 'assoc_name_inferred' call
gfc_fixup_inferred_type_refs to ensure references are OK.
(gfc_fixup_inferred_type_refs): Catch invalid array refs..
gcc/testsuite/
PR fortran/114874
* gfortran.dg/pr114874_1.f90: New test for valid code.
* gfortran.dg/pr114874_2.f90: New test for invalid code.
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index a7a0fdba3dd..de1a7cd0935 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2242,6 +2242,10 @@ typedef struct gfc_namespace
/* Set when resolve_types has been called for this namespace. */
unsigned types_resolved:1;
+ /* Set if the associate_name in a select type statement is an
+ inferred type. */
+ unsigned assoc_name_inferred:1;
+
/* Set to 1 if code has been generated for this namespace. */
unsigned translated:1;
diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc
index 4539c9bb134..b7441b9b074 100644
--- a/gcc/fortran/match.cc
+++ b/gcc/fortran/match.cc
@@ -6721,6 +6721,20 @@ gfc_match_select_type (void)
goto cleanup;
}
+ if (expr2 && expr2->expr_type == EXPR_VARIABLE
+ && expr2->symtree->n.sym->assoc)
+{
+ if (expr2->symtree->n.sym->assoc->inferred_type)
+ gfc_current_ns->assoc_name_inferred = 1;
+ else if (expr2->symtree->n.sym->assoc->target
+ && expr2->symtree->n.sym->assoc->target->ts.type == BT_UNKNOWN)
+ gfc_current_ns->assoc_name_inferred = 1;
+}
+ else if (!expr2
+ && expr1->symtree->n.sym->assoc
+ && expr1->symtree->n.sym->assoc->inferred_type)
+gfc_current_ns->assoc_name_inferred = 1;
+
new_st.op = EXEC_SELECT_TYPE;
new_st.expr1 = expr1;
new_st.expr2 = expr2;
diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc
index 8e7833769a8..76f6bcb8a78 100644
--- a/gcc/fortran/primary.cc
+++ b/gcc/fortran/primary.cc
@@ -2113,13 +2113,13 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
inferred_type = IS_INFERRED_TYPE (primary);
- /* SELECT TYPE and SELECT RANK temporaries within an ASSOCIATE block, whose
- selector has not been parsed, can generate errors with array and component
- refs.. Use 'inferred_type' as a flag to suppress these errors. */
+ /* SELECT TYPE temporaries within an ASSOCIATE block, whose selector has not
+ been parsed, can generate errors with array refs.. The SELECT TYPE
+ namespace is marked with 'assoc_name_inferred'. During resolution, this is
+ detected and gfc_fixup_inferred_type_refs is called. */
if (!inferred_type
- && (gfc_peek_ascii_char () == '(' && !sym->attr.dimension)
- && !sym->attr.codimension
&& sym->attr.select_type_temporary
+ && sym->ns->assoc_name_inferred
&& !sym->attr.select_rank_temporary)
inferred_type = true;
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 4368627041e..d7a0856fcca 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -5888,6 +5888,9 @@ resolve_variable (gfc_expr *e)
if (e->expr_type == EXPR_CONSTANT)
return true;
}
+ else if (sym->attr.select_type_temporary
+ && sym->ns->assoc_name_inferred)
+gfc_fixup_inferred_type_refs (e);
/* For variables that are used in an associate (target => object) where
the object's basetype is array valued while the target is scalar,
@@ -6231,10 +6234,12 @@ gfc_fixup_inferred_type_refs (gfc_expr *e)
free (new_ref);
}
else
- {
- e->ref = ref->next;
- free (ref);
- }
+ {
+ if (e->ref->u.ar.type == AR_UNKNOWN)
+ gfc_error ("Invalid array reference at %L", >where);
+
