procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source 
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.
This commit is contained in:
Harald Anlauf 2024-11-20 21:59:22 +01:00
parent d5cebf7e44
commit 3c130e410a
2 changed files with 110 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

40
gcc/fortran/expr.cc
View file

@ -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;
}

75
gcc/testsuite/gfortran.dg/protected_10.f90 Normal file
View file

@ -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