Hi Gonzalo,
I've pushed the corrected version now as r16-7653-g82cc94e5fb69d1 .
Let's hope that there is no further fallout, and have an eye on
the test results.
Best,
Harald
On 2/22/26 15:57, Gonzalosilvalde wrote:
From: Gonzalo Silvalde Blanco <[email protected]>
The error message for an ambiguous pointer function assignment contained a
FIXME and an embedded newline that the diagnostics printer does not handle.
Split the single gfc_error call into a gfc_error for the main diagnostic
and an inform note for the F2008 explanation.
PR fortran/80012
gcc/fortran/ChangeLog:
* symbol.cc (gfc_add_procedure): Split error into gfc_error and
inform.
gcc/testsuite/ChangeLog:
* gfortran.dg/pr80012.f90: New test.
Signed-off-by: Gonzalo Silvalde Blanco <[email protected]>
---
Hi Harald,
I investigated the regression caused by my previous commit and I
believe I found the root cause.
The problem was the use of auto_diagnostic_group in gfc_add_procedure.
When that object is created, it increments the diagnostic group nesting
counter. Then, when gfc_error internally calls set_diagnostic_buffer,
it hits this assert in diagnostics/buffering.cc:50:
gcc_assert (m_diagnostic_groups.m_group_nesting_depth == 0);
...which I think causes the ICE, since the nesting depth is no longer
0 at that point.
Looking at other uses of inform() in the Fortran frontend, none of them
wrap the call in an auto_diagnostic_group, and they work fine. So I
simply removed the auto_diagnostic_group wrapper.
I ran make check-fortran on both my patched version and a clean
mainline checkout. Both now give identical results in my PC.
Best regards,
Gonzalo
gcc/fortran/symbol.cc | 22 +++++++++++-----------
gcc/testsuite/gfortran.dg/pr80012.f90 | 14 ++++++++++++++
2 files changed, 25 insertions(+), 11 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/pr80012.f90
diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
index 5ff14e27b94..9edfb8e9eeb 100644
--- a/gcc/fortran/symbol.cc
+++ b/gcc/fortran/symbol.cc
@@ -24,6 +24,7 @@ along with GCC; see the file COPYING3. If not see
#include "coretypes.h"
#include "options.h"
#include "gfortran.h"
+#include "diagnostic-core.h"
#include "parse.h"
#include "match.h"
#include "constructor.h"
@@ -1887,19 +1888,18 @@ gfc_add_procedure (symbol_attribute *attr,
procedure_type t,
if (attr->proc != PROC_UNKNOWN && !attr->module_procedure
&& attr->access == ACCESS_UNKNOWN)
{
- if (attr->proc == PROC_ST_FUNCTION && t == PROC_INTERNAL
- && !gfc_notification_std (GFC_STD_F2008))
- gfc_error ("%s procedure at %L is already declared as %s "
- "procedure. \nF2008: A pointer function assignment "
- "is ambiguous if it is the first executable statement "
- "after the specification block. Please add any other "
- "kind of executable statement before it. FIXME",
+ gfc_error ("%s procedure at %L is already declared as %s procedure",
gfc_code2string (procedures, t), where,
gfc_code2string (procedures, attr->proc));
- else
- gfc_error ("%s procedure at %L is already declared as %s "
- "procedure", gfc_code2string (procedures, t), where,
- gfc_code2string (procedures, attr->proc));
+ if (attr->proc == PROC_ST_FUNCTION && t == PROC_INTERNAL
+ && !gfc_notification_std (GFC_STD_F2008))
+ {
+ inform (gfc_get_location (where),
+ "F2008: A pointer function assignment is ambiguous if it is "
+ "the first executable statement after the specification "
+ "block. Please add any other kind of executable "
+ "statement before it");
+ }
return false;
}
diff --git a/gcc/testsuite/gfortran.dg/pr80012.f90
b/gcc/testsuite/gfortran.dg/pr80012.f90
new file mode 100644
index 00000000000..da626d565d8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr80012.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+! { dg-options "-std=gnu" }
+! PR fortran/80012
+! Test that the error message for ambiguous pointer function assignment
+! is split into an error and an informational note, without FIXME.
+
+two() = 7
+contains
+ function two () ! { dg-error "INTERNAL-PROC procedure at .1. is already declared
as STATEMENT-PROC procedure" }
+! { dg-message "F2008: A pointer function assignment is ambiguous" "" { target
*-*-* } 9 }
+ integer, pointer :: two
+ allocate(two)
+ end function two
+end
