[gcc r17-3180] fortran: Diagnose allocatable PROCEDURE results early [PR102333]

https://gcc.gnu.org/g:2a4f36222246480d3b66957be3582db084698a32

commit r17-3180-g2a4f36222246480d3b66957be3582db084698a32
Author: Christopher Albert <[email protected]>
Date:   Mon Aug 10 03:10:52 2026 +0200

    fortran: Diagnose allocatable PROCEDURE results early [PR102333]
    
    A function result declared by a PROCEDURE statement can be redirected
    to a hidden procedure pointer result before attribute conflicts are
    checked.  Check the PROCEDURE and ALLOCATABLE conflict before this
    redirection so the original attributes produce the correct diagnostic.
    
    Fixes #7
    
    Assisted-by: GPT-5.6-sol (OpenAI)
    
            PR fortran/102333
    
    gcc/fortran/ChangeLog:
    
            * decl.cc (match_procedure_decl): Diagnose the PROCEDURE and
            ALLOCATABLE conflict before creating a hidden result.
    
    gcc/testsuite/ChangeLog:
    
            * gfortran.dg/pr102333_2.f90: New test.
    
    Signed-off-by: Christopher Albert <[email protected]>

Diff:
---
 gcc/fortran/decl.cc                      |  7 +++++++
 gcc/testsuite/gfortran.dg/pr102333_2.f90 | 13 +++++++++++++
 2 files changed, 20 insertions(+)

diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index 5bd1e3de2d94..4871737458ef 100644
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -7885,6 +7885,13 @@ match_procedure_decl (void)
   if (m == MATCH_ERROR)
     return MATCH_ERROR;
 
+  if (current_attr.allocatable)
+    {
+      current_attr.procedure = 1;
+      gfc_check_conflict (&current_attr, NULL, &gfc_current_locus);
+      return MATCH_ERROR;
+    }
+
   if (proc_if && proc_if->attr.is_bind_c && !current_attr.is_bind_c)
     {
       current_attr.is_bind_c = 1;
diff --git a/gcc/testsuite/gfortran.dg/pr102333_2.f90 b/gcc/testsuite/gfortran.dg/pr102333_2.f90
new file mode 100644
index 000000000000..3b30d5971d1a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr102333_2.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! PR fortran/102333
+
+function factory() result(payload)
+  class(*), allocatable :: payload
+contains
+  function pointer_callback()
+    procedure(factory), pointer :: pointer_callback
+  end function pointer_callback
+  function allocatable_callback()
+    procedure(factory), allocatable :: allocatable_callback ! { dg-error "PROCEDURE attribute conflicts with ALLOCATABLE" }
+  end function allocatable_callback
+end function factory