The problem here is that one gets two symbols - one inside the block and
one outside and they do not really agree whether one has a function or a
variable – which later gives an ICE. As sym->module was "(intrinsic)"
and FL_VARIABLE, one was running into an assert.
The problem is that when resolving the expression with "max", gfortran
detects that it got an intrinsic function and resolves the
expression/function call (in this case to a constant). However, the
information that "max" was regarded as intrinsic procedure never ends up
in the symbol itself, only in the expression.
My first idea was to call gfc_resolve_intrinsic, which does a lot of
nice things like setting the attributes, warning that the type is
ignored with intrinsic procedures (-Wsurprsing, only) etc. However, that
gives a bunch of ICE. Even a more Spartan attr setting had similar
issues – hence, I moved it below the simplification, in the hope it
would work there. Well, gfc_resolve_intrinsic still gave tons of errors
and ICEs, but what I now have works. (I think it also works w/o the
FL_UNKNOWN condition, but, in any case, I am not sure which variant is
better)
The settings I use with this patch seem to work and I have the hope that
it covers all valid/invalid code correctly (fingers crossed).
Build and regtested on x86-64-gnu-linux.
OK for the trunk?
Tobias
PS: I added 'sym' as after simplifcation, expr->symtree->n.sym might no
longer exist; getting rid of 'name' was only a cleanup as sym->name is a
tad clearer and avoids another variable.
PPS: I ended up fixing this PR as Martin CC'ed me – after finding that
my commit caused the ICE; well, that one was in 2014 (!), somewhat
unrelated, and before that commit the code was rejected… With a lot of
good (evil?) will, one can still call it a regression ;-)
gcc/fortran/
PR fortran/92754
* intrinsic.c (gfc_intrinsic_func_interface): Set
sym's flavor, intrinsic and function attribute if
unset.
gcc/testsuite/
PR fortran/92754
gfortran.dg/intrinsic_9.f90: New.
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 572967f5d4e..76b53bb7117 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -4839,9 +4839,9 @@ gfc_check_intrinsic_standard (const gfc_intrinsic_sym* isym,
match
gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag)
{
+ gfc_symbol *sym;
gfc_intrinsic_sym *isym, *specific;
gfc_actual_arglist *actual;
- const char *name;
int flag;
if (expr->value.function.isym != NULL)
@@ -4857,15 +4857,15 @@ gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag)
flag |= (actual->expr->ts.type != BT_INTEGER
&& actual->expr->ts.type != BT_CHARACTER);
- name = expr->symtree->n.sym->name;
+ sym = expr->symtree->n.sym;
- if (expr->symtree->n.sym->intmod_sym_id)
+ if (sym->intmod_sym_id)
{
- gfc_isym_id id = gfc_isym_id_by_intmod_sym (expr->symtree->n.sym);
+ gfc_isym_id id = gfc_isym_id_by_intmod_sym (sym);
isym = specific = gfc_intrinsic_function_by_id (id);
}
else
- isym = specific = gfc_find_function (name);
+ isym = specific = gfc_find_function (sym->name);
if (isym == NULL)
{
@@ -4879,7 +4879,7 @@ gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag)
|| isym->id == GFC_ISYM_SNGL || isym->id == GFC_ISYM_DFLOAT)
&& gfc_init_expr_flag
&& !gfc_notify_std (GFC_STD_F2003, "Function %qs as initialization "
- "expression at %L", name, &expr->where))
+ "expression at %L", sym->name, &expr->where))
{
if (!error_flag)
gfc_pop_suppress_errors ();
@@ -4898,7 +4898,7 @@ gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag)
&& id != GFC_ISYM_TRANSFER && id != GFC_ISYM_TRIM
&& !gfc_notify_std (GFC_STD_F2003, "Transformational function %qs "
"at %L is invalid in an initialization "
- "expression", name, &expr->where))
+ "expression", sym->name, &expr->where))
{
if (!error_flag)
gfc_pop_suppress_errors ();
@@ -4956,9 +4956,6 @@ gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag)
got_specific:
expr->value.function.isym = specific;
- if (!expr->symtree->n.sym->module)
- gfc_intrinsic_symbol (expr->symtree->n.sym);
-
if (!error_flag)
gfc_pop_suppress_errors ();
@@ -4980,6 +4977,16 @@ got_specific:
"character arguments at %L", &expr->where))
return MATCH_ERROR;
+ if (sym->attr.flavor == FL_UNKNOWN)
+ {
+ sym->attr.function = 1;
+ sym->attr.intrinsic = 1;
+ sym->attr.flavor = FL_PROCEDURE;
+ }
+
+ if (!sym->module)
+ gfc_intrinsic_symbol (sym);
+
return MATCH_YES;
}
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_9.f90 b/gcc/testsuite/gfortran.dg/intrinsic_9.f90
new file mode 100644
index 00000000000..43959ad85df
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_9.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+!
+! PR fortran/92754
+!
+! Contributed by G. Steinmetz
+!
+
+program p
+ integer :: max
+ block
+ character :: x = max('a','b')
+ !print *, x
+ if (x /= 'b') stop 1
+ end block
+end
