Commit 394acee4 by Tobias Burnus Committed by Tobias Burnus

Fortran] PR92754 - fix an issue with resolving intrinsic functions

        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.

From-SVN: r278961
parent 8c3785c4
2019-12-12 Tobias Burnus <tobias@codesourcery.com>
PR fortran/92754
* intrinsic.c (gfc_intrinsic_func_interface): Set
sym's flavor, intrinsic and function attribute if
unset.
2019-12-04 Jakub Jelinek <jakub@redhat.com> 2019-12-04 Jakub Jelinek <jakub@redhat.com>
PR fortran/92756 PR fortran/92756
......
...@@ -4839,9 +4839,9 @@ gfc_check_intrinsic_standard (const gfc_intrinsic_sym* isym, ...@@ -4839,9 +4839,9 @@ gfc_check_intrinsic_standard (const gfc_intrinsic_sym* isym,
match match
gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag) gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag)
{ {
gfc_symbol *sym;
gfc_intrinsic_sym *isym, *specific; gfc_intrinsic_sym *isym, *specific;
gfc_actual_arglist *actual; gfc_actual_arglist *actual;
const char *name;
int flag; int flag;
if (expr->value.function.isym != NULL) if (expr->value.function.isym != NULL)
...@@ -4857,15 +4857,15 @@ gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag) ...@@ -4857,15 +4857,15 @@ gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag)
flag |= (actual->expr->ts.type != BT_INTEGER flag |= (actual->expr->ts.type != BT_INTEGER
&& actual->expr->ts.type != BT_CHARACTER); && 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); isym = specific = gfc_intrinsic_function_by_id (id);
} }
else else
isym = specific = gfc_find_function (name); isym = specific = gfc_find_function (sym->name);
if (isym == NULL) if (isym == NULL)
{ {
...@@ -4879,7 +4879,7 @@ gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag) ...@@ -4879,7 +4879,7 @@ gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag)
|| isym->id == GFC_ISYM_SNGL || isym->id == GFC_ISYM_DFLOAT) || isym->id == GFC_ISYM_SNGL || isym->id == GFC_ISYM_DFLOAT)
&& gfc_init_expr_flag && gfc_init_expr_flag
&& !gfc_notify_std (GFC_STD_F2003, "Function %qs as initialization " && !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) if (!error_flag)
gfc_pop_suppress_errors (); gfc_pop_suppress_errors ();
...@@ -4898,7 +4898,7 @@ gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag) ...@@ -4898,7 +4898,7 @@ gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag)
&& id != GFC_ISYM_TRANSFER && id != GFC_ISYM_TRIM && id != GFC_ISYM_TRANSFER && id != GFC_ISYM_TRIM
&& !gfc_notify_std (GFC_STD_F2003, "Transformational function %qs " && !gfc_notify_std (GFC_STD_F2003, "Transformational function %qs "
"at %L is invalid in an initialization " "at %L is invalid in an initialization "
"expression", name, &expr->where)) "expression", sym->name, &expr->where))
{ {
if (!error_flag) if (!error_flag)
gfc_pop_suppress_errors (); gfc_pop_suppress_errors ();
...@@ -4956,9 +4956,6 @@ gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag) ...@@ -4956,9 +4956,6 @@ gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag)
got_specific: got_specific:
expr->value.function.isym = specific; expr->value.function.isym = specific;
if (!expr->symtree->n.sym->module)
gfc_intrinsic_symbol (expr->symtree->n.sym);
if (!error_flag) if (!error_flag)
gfc_pop_suppress_errors (); gfc_pop_suppress_errors ();
...@@ -4980,6 +4977,16 @@ got_specific: ...@@ -4980,6 +4977,16 @@ got_specific:
"character arguments at %L", &expr->where)) "character arguments at %L", &expr->where))
return MATCH_ERROR; 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; return MATCH_YES;
} }
......
2019-12-12 Tobias Burnus <tobias@codesourcery.com>
PR fortran/92754
gfortran.dg/intrinsic_9.f90: New.
2019-12-04 Jakub Jelinek <jakub@redhat.com> 2019-12-04 Jakub Jelinek <jakub@redhat.com>
PR tree-optimization/92734 PR tree-optimization/92734
......
! { 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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment