https://gcc.gnu.org/g:3c130e410ac45d1bfca0c9d584603b726f58e0ac
commit r15-5533-g3c130e410ac45d1bfca0c9d584603b726f58e0ac
Author: Harald Anlauf <anl...@gmx.de>
Date: Wed Nov 20 21:59:22 2024 +0100
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:
---
gcc/fortran/expr.cc | 40 ++++++++++++++--
gcc/testsuite/gfortran.dg/protected_10.f90 | 75 ++++++++++++++++++++++++++++++
2 files changed, 110 insertions(+), 5 deletions(-)
diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index 01fbc442546d..fdbf99166404 100644
--- 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
index 000000000000..1bb20983e944
--- /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
