See attached patch.
Regression tested on x86_64.
OK for mainline?
Also since this is fixing a rejects valid, I would like to backport.
Regards,
Jerry
---
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.
---From 4263dbe988fea932e4b591c15bccc9ce401d2d3f Mon Sep 17 00:00:00 2001
From: Jerry DeLisle <[email protected]>
Date: Wed, 1 Jul 2026 14:03:23 -0700
Subject: [PATCH] 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.
---
gcc/fortran/match.cc | 23 +++++++++++--------
gcc/fortran/resolve.cc | 19 +++++++++++++++
.../gfortran.dg/stop_function_code_1.f90 | 14 +++++++++++
3 files changed, 46 insertions(+), 10 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/stop_function_code_1.f90
diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc
index be376a8c062..7695f746901 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 default CHARACTER or "
+ "INTEGER 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 9eb022d608d..4fc7b5a4d74 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 00000000000..6f69f54e35a
--- /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
--
2.54.0
