From 1f462b5072a5e82c35921f7e3bdf3959c4a49dc9 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Thu, 5 Sep 2024 21:30:25 +0200
Subject: [PATCH] Fortran: fix ICE in gfc_create_module_variable [PR100273]

gcc/fortran/ChangeLog:

	PR fortran/100273
	* trans-decl.cc (gfc_create_module_variable): Handle module
	variable also when it is needed for the result specification
	of a contained function.

gcc/testsuite/ChangeLog:

	PR fortran/100273
	* gfortran.dg/pr100273.f90: New test.
---
 gcc/fortran/trans-decl.cc              |  3 ++-
 gcc/testsuite/gfortran.dg/pr100273.f90 | 26 ++++++++++++++++++++++++++
 2 files changed, 28 insertions(+), 1 deletion(-)
 create mode 100644 gcc/testsuite/gfortran.dg/pr100273.f90

diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 6692ac7ef4c..ee41d66e6d2 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -5540,7 +5540,8 @@ gfc_create_module_variable (gfc_symbol * sym)
   /* Create the variable.  */
   pushdecl (decl);
   gcc_assert (sym->ns->proc_name->attr.flavor == FL_MODULE
-	      || (sym->ns->parent->proc_name->attr.flavor == FL_MODULE
+	      || ((sym->ns->parent->proc_name->attr.flavor == FL_MODULE
+		   || sym->ns->parent->proc_name->attr.flavor == FL_PROCEDURE)
 		  && sym->fn_result_spec));
   DECL_CONTEXT (decl) = sym->ns->proc_name->backend_decl;
   rest_of_decl_compilation (decl, 1, 0);
diff --git a/gcc/testsuite/gfortran.dg/pr100273.f90 b/gcc/testsuite/gfortran.dg/pr100273.f90
new file mode 100644
index 00000000000..f71947ad802
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr100273.f90
@@ -0,0 +1,26 @@
+! { dg-do compile }
+! PR fortran/100273 - ICE in gfc_create_module_variable
+!
+! Contributed by G.Steinmetz
+
+module m
+  implicit none
+contains
+  character(4) function g(k)
+    integer :: k
+    g = f(k)
+  contains
+    function f(n)
+      character(3), parameter :: a(2) = ['1  ', '123']
+      integer :: n
+      character(len_trim(a(n))) :: f
+      f = 'abc'
+    end
+  end
+end
+program p
+  use m 
+  implicit none
+  print *, '>>' // g(1) // '<<'
+  print *, '>>' // g(2) // '<<'
+end