Fortran: Allow declaration of finalizable DT in a submodule [PR97122]

2023-05-23  Paul Thomas  <pault@gcc.gnu.org>
	    Steven G. Kargl  <kargl@gcc.gnu.org>

gcc/fortran
	PR fortran/97122
	* decl.cc (variable_decl): Clean up white space issues.
	(gfc_match_final_decl): Declaration of finalizable derived type
	is allowed in a submodule.

gcc/testsuite/
	PR fortran/97122
	* gfortran.dg/finalize_8.f03 : Replace testcase that checks
	declaration of finalizable derived types in submodules works.

diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index 4c578d01ad47e092f2aa1b1266c6834a4ddebba8..1de2b23124214a8ee58decb7f81381623b626a12 100644 (file)
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -2697,7 +2697,7 @@ variable_decl (int elem)
        }
 
       gfc_seen_div0 = false;
-      
+
       /* F2018:C830 (R816) An explicit-shape-spec whose bounds are not
         constant expressions shall appear only in a subprogram, derived
         type definition, BLOCK construct, or interface body.  */
@@ -2768,7 +2768,7 @@ variable_decl (int elem)
              if (e->expr_type != EXPR_CONSTANT)
                {
                  n = gfc_copy_expr (e);
-                 if (!gfc_simplify_expr (n, 1)  && gfc_seen_div0) 
+                 if (!gfc_simplify_expr (n, 1)  && gfc_seen_div0)
                    {
                      m = MATCH_ERROR;
                      goto cleanup;
@@ -2783,12 +2783,12 @@ variable_decl (int elem)
              if (e->expr_type != EXPR_CONSTANT)
                {
                  n = gfc_copy_expr (e);
-                 if (!gfc_simplify_expr (n, 1)  && gfc_seen_div0) 
+                 if (!gfc_simplify_expr (n, 1)  && gfc_seen_div0)
                    {
                      m = MATCH_ERROR;
                      goto cleanup;
                    }
-                 
+
                  if (n->expr_type == EXPR_CONSTANT)
                    gfc_replace_expr (e, n);
                  else
@@ -11636,8 +11636,9 @@ gfc_match_final_decl (void)
   block = gfc_state_stack->previous->sym;
   gcc_assert (block);
 
-  if (!gfc_state_stack->previous || !gfc_state_stack->previous->previous
-      || gfc_state_stack->previous->previous->state != COMP_MODULE)
+  if (gfc_state_stack->previous->previous
+      && gfc_state_stack->previous->previous->state != COMP_MODULE
+      && gfc_state_stack->previous->previous->state != COMP_SUBMODULE)
     {
       gfc_error ("Derived type declaration with FINAL at %C must be in the"
                 " specification part of a MODULE");

diff --git a/gcc/testsuite/gfortran.dg/finalize_8.f03 b/gcc/testsuite/gfortran.dg/finalize_8.f03
index b2027a0ba6dd12e978267f4a4b121771af0aee18..b7fa10dda3135b374118255f1c76514601090e20 100644 (file)
--- a/gcc/testsuite/gfortran.dg/finalize_8.f03
+++ b/gcc/testsuite/gfortran.dg/finalize_8.f03
@@ -1,35 +1,49 @@
-! { dg-do compile }
-
-! Parsing of finalizer procedure definitions.
-! Check that FINAL-declarations are only allowed on types defined in the
-! specification part of a module.
-
-MODULE final_type
+! { dg-do run }
+!
+! PR97122: Declaration of a finalizable derived type in a submodule
+! IS allowed.
+!
+! Contributed by Ian Harvey  <ian_harvey@bigpond.com>
+!
+MODULE m
   IMPLICIT NONE
 
-CONTAINS
+  INTERFACE
+    MODULE SUBROUTINE other(i)
+      IMPLICIT NONE
+      integer, intent(inout) :: i
+    END SUBROUTINE other
+  END INTERFACE
 
-  SUBROUTINE bar
-    IMPLICIT NONE
+  integer :: mi
 
-    TYPE :: mytype
-      INTEGER, ALLOCATABLE :: fooarr(:)
-      REAL :: foobar
-    CONTAINS
-      FINAL :: myfinal ! { dg-error "in the specification part of a MODULE" }
-    END TYPE mytype
-
-  CONTAINS
+END MODULE m
 
-    SUBROUTINE myfinal (el)
-      TYPE(mytype) :: el
-    END SUBROUTINE myfinal
+SUBMODULE (m) s
+  IMPLICIT NONE
 
-  END SUBROUTINE bar
+  TYPE :: t
+    integer :: i
+  CONTAINS
+    FINAL :: final_t  ! Used to be an error here
+  END TYPE t
 
-END MODULE final_type
+CONTAINS
 
-PROGRAM finalizer
-  IMPLICIT NONE
-  ! Do nothing here
-END PROGRAM finalizer
+  SUBROUTINE final_t(arg)
+    TYPE(t), INTENT(INOUT) :: arg
+    mi = -arg%i
+  END SUBROUTINE final_t
+
+  module subroutine other(i)  ! 'ti' is finalized
+    integer, intent(inout) :: i
+    type(t) :: ti
+    ti%i = i
+  END subroutine other
+END SUBMODULE s
+
+  use m
+  integer :: i = 42
+  call other(i)
+  if (mi .ne. -i) stop 1
+end