Fortran: fix checking of protected variables in submodules [PR83135]

When a symbol was use-associated in the ancestor of a submodule, a
PROTECTED attribute was ignored in the submodule or its descendants.
Find the real ancestor of symbols when used in a variable definition
context in a submodule.

	PR fortran/83135

gcc/fortran/ChangeLog:

	* expr.cc (sym_is_from_ancestor): New helper function.
	(gfc_check_vardef_context): Refine checking of PROTECTED attribute
	of symbols that are indirectly use-associated in a submodule.

gcc/testsuite/ChangeLog:

	* gfortran.dg/protected_10.f90: New test.

diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index 01fbc442546d39ed8b3f90f01b55534cba221140..fdbf991664043a271e5ce04320ac11ffb0ed2016 100644 (file)
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -6272,6 +6272,33 @@ gfc_build_intrinsic_call (gfc_namespace *ns, gfc_isym_id id, const char* name,
 }
 
 
+/* Check if a symbol referenced in a submodule is declared in the ancestor
+   module and not accessed by use-association, and that the submodule is a
+   descendant.  */
+
+static bool
+sym_is_from_ancestor (gfc_symbol *sym)
+{
+  const char dot[2] = ".";
+  /* Symbols take the form module.submodule_ or module.name_. */
+  char ancestor_module[2 * GFC_MAX_SYMBOL_LEN + 2];
+  char *ancestor;
+
+  if (sym == NULL
+      || sym->attr.use_assoc
+      || !sym->attr.used_in_submodule
+      || !sym->module
+      || !sym->ns->proc_name
+      || !sym->ns->proc_name->name)
+    return false;
+
+  memset (ancestor_module, '\0', sizeof (ancestor_module));
+  strcpy (ancestor_module, sym->ns->proc_name->name);
+  ancestor = strtok (ancestor_module, dot);
+  return strcmp (ancestor, sym->module) == 0;
+}
+
+
 /* Check if an expression may appear in a variable definition context
    (F2008, 16.6.7) or pointer association context (F2008, 16.6.8).
    This is called from the various places when resolving
@@ -6450,21 +6477,24 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj,
     }
 
   /* PROTECTED and use-associated.  */
-  if (sym->attr.is_protected && sym->attr.use_assoc && check_intentin)
+  if (sym->attr.is_protected
+      && (sym->attr.use_assoc
+         || (sym->attr.used_in_submodule && !sym_is_from_ancestor (sym)))
+      && check_intentin)
     {
       if (pointer && is_pointer)
        {
          if (context)
-           gfc_error ("Variable %qs is PROTECTED and cannot appear in a"
-                      " pointer association context (%s) at %L",
+           gfc_error ("Variable %qs is PROTECTED and cannot appear in a "
+                      "pointer association context (%s) at %L",
                       sym->name, context, &e->where);
          return false;
        }
       if (!pointer && !is_pointer)
        {
          if (context)
-           gfc_error ("Variable %qs is PROTECTED and cannot appear in a"
-                      " variable definition context (%s) at %L",
+           gfc_error ("Variable %qs is PROTECTED and cannot appear in a "
+                      "variable definition context (%s) at %L",
                       sym->name, context, &e->where);
          return false;
        }

diff --git a/gcc/testsuite/gfortran.dg/protected_10.f90 b/gcc/testsuite/gfortran.dg/protected_10.f90
new file mode 100644 (file)
index 0000000..1bb2098
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/protected_10.f90
@@ -0,0 +1,75 @@
+! { dg-do compile }
+! PR fortran/83135 - fix checking of protected variables in submodules
+
+module mod1
+  implicit none
+  private
+  integer, protected, public :: xx = 42
+  public :: set_xx
+  public :: echo1_xx, echo2_xx
+  interface
+     module subroutine echo1_xx()
+     end subroutine echo1_xx
+     module subroutine echo2_xx()
+     end subroutine echo2_xx
+  end interface
+contains
+  subroutine set_xx(arg)
+    integer, intent(in) :: arg
+    xx = arg    ! valid (it is host_associated)
+  end
+end module
+!
+submodule (mod1) s1mod1
+  implicit none
+contains
+  module subroutine echo1_xx()
+    xx = 11     ! valid (it is from the ancestor)
+    write(*,*) "xx=", xx
+  end subroutine echo1_xx
+end submodule
+!
+submodule (mod1:s1mod1) s2mod1
+  implicit none
+contains
+  module subroutine echo2_xx()
+    xx = 12     ! valid (it is from the ancestor)
+    write(*,*) "xx=", xx
+  end subroutine echo2_xx
+end submodule
+!
+module mod2
+  use mod1
+  implicit none
+  integer, protected, public :: yy = 43
+  interface
+     module subroutine echo_xx()
+     end subroutine echo_xx
+  end interface
+contains
+  subroutine bla
+!   xx = 999    ! detected, leads to fatal error
+  end
+end module
+!
+submodule (mod2) smod2
+  implicit none
+contains
+  module subroutine echo_xx ()
+    xx = 10     ! { dg-error "is PROTECTED" }
+    write(*,*) "xx=", xx
+    yy = 22     ! valid (it is from the ancestor)
+  end
+end submodule
+!
+program test_protected
+  use mod1
+  use mod2
+  implicit none
+  write(*,*) "xx=", xx
+  call set_xx(88)
+  write(*,*) "xx=", xx
+  call echo_xx
+  call echo1_xx
+  call echo2_xx
+end program