https://gcc.gnu.org/g:b6de3eb243c91b6503d95cc1942f55378ae6cbae
commit r17-2099-gb6de3eb243c91b6503d95cc1942f55378ae6cbae Author: Jerry DeLisle <[email protected]> Date: Wed Jul 1 14:03:23 2026 -0700 fortran: [PR126018] Fix rejects character function invocation as stop code Expressions used in stop codes can be functions as long as they resolve to integer or character. PR fortran/126018 gcc/fortran/ChangeLog: * match.cc (gfc_match_stopcode): Adjust the f2008 error check.If the STOP code expr type is unknown, do not error. It will be checked in gfc_resolve_code. * resolve.cc (gfc_resolve_code): Add checks for EXEC_STOP and EXEC_ERROR_STOP. gcc/testsuite/ChangeLog: * gfortran.dg/stop_function_code_1.f90: New test. Diff: --- gcc/fortran/match.cc | 23 ++++++++++++---------- gcc/fortran/resolve.cc | 19 ++++++++++++++++++ gcc/testsuite/gfortran.dg/stop_function_code_1.f90 | 14 +++++++++++++ 3 files changed, 46 insertions(+), 10 deletions(-) diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc index be376a8c0625..4471c1b13b57 100644 --- a/gcc/fortran/match.cc +++ b/gcc/fortran/match.cc @@ -3960,19 +3960,22 @@ checks: goto cleanup; } - /* Use the machinery for an initialization expression to reduce the - stop-code to a constant. */ - gfc_reduce_init_expr (e); - - /* Test for F2008 style STOP stop-code. */ - if (e->expr_type != EXPR_CONSTANT && f08) + /* If this is F2008, it could be an init expression. */ + if (f08) { - gfc_error ("STOP code at %L must be a scalar default CHARACTER or " - "INTEGER constant expression", &e->where); - goto cleanup; + gfc_reduce_init_expr (e); + if (e->expr_type != EXPR_CONSTANT) + { + gfc_error ("STOP code at %L must be a scalar constant " + "expression", &e->where); + goto cleanup; + } } - if (!(e->ts.type == BT_CHARACTER || e->ts.type == BT_INTEGER)) + /* For types known at parse time, check immediately. For BT_UNKNOWN + (e.g. a forward-referenced contained function) defer to resolve. */ + if (e->ts.type != BT_UNKNOWN + && !(e->ts.type == BT_CHARACTER || e->ts.type == BT_INTEGER)) { gfc_error ("STOP code at %L must be either INTEGER or CHARACTER type", &e->where); diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index 9eb022d608d8..4fc7b5a4d740 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -14376,6 +14376,25 @@ start: case EXEC_STOP: case EXEC_ERROR_STOP: + if (code->expr1 != NULL && t) + { + if (!(code->expr1->ts.type == BT_CHARACTER + || code->expr1->ts.type == BT_INTEGER)) + gfc_error ("STOP code at %L must be either INTEGER or CHARACTER " + "type", &code->expr1->where); + else if (code->expr1->rank != 0) + gfc_error ("STOP code at %L must be scalar", + &code->expr1->where); + else if (code->expr1->ts.type == BT_CHARACTER + && code->expr1->ts.kind != gfc_default_character_kind) + gfc_error ("STOP code at %L must be default character KIND=%d", + &code->expr1->where, (int) gfc_default_character_kind); + else if (code->expr1->ts.type == BT_INTEGER + && code->expr1->ts.kind != gfc_default_integer_kind) + gfc_notify_std (GFC_STD_F2018, "STOP code at %L must be default " + "integer KIND=%d", &code->expr1->where, + (int) gfc_default_integer_kind); + } if (code->expr2 != NULL && (code->expr2->ts.type != BT_LOGICAL || code->expr2->rank != 0)) diff --git a/gcc/testsuite/gfortran.dg/stop_function_code_1.f90 b/gcc/testsuite/gfortran.dg/stop_function_code_1.f90 new file mode 100644 index 000000000000..6f69f54e35a5 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/stop_function_code_1.f90 @@ -0,0 +1,14 @@ +! { dg-do compile } +! PR fortran/126018 - Stop code may be a function call (CHARACTER or INTEGER) +program p + implicit none + error stop character_stop () ! was: "must be either INTEGER or CHARACTER" + stop integer_stop () ! likewise for integer +contains + character (1) function character_stop () + character_stop = "a" + end function character_stop + integer function integer_stop () + integer_stop = 1 + end function integer_stop +end program p
