From 394acee4f98219ad0165794573c44967b12ca05c Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Wed, 4 Dec 2019 12:19:55 +0000 Subject: [PATCH] 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 --- gcc/fortran/ChangeLog | 7 ++++++ gcc/fortran/intrinsic.c | 27 ++++++++++++++--------- gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gfortran.dg/intrinsic_9.f90 | 15 +++++++++++++ 4 files changed, 44 insertions(+), 10 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/intrinsic_9.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 3a188bac265..faac8fa02f5 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2019-12-12 Tobias Burnus + + PR fortran/92754 + * intrinsic.c (gfc_intrinsic_func_interface): Set + sym's flavor, intrinsic and function attribute if + unset. + 2019-12-04 Jakub Jelinek PR fortran/92756 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/ChangeLog b/gcc/testsuite/ChangeLog index 1d6541a9097..e012bddef8c 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2019-12-12 Tobias Burnus + + PR fortran/92754 + gfortran.dg/intrinsic_9.f90: New. + 2019-12-04 Jakub Jelinek PR tree-optimization/92734 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 -- 2.30.2