[prev in list] [next in list] [prev in thread] [next in thread]
List: gcc-patches
Subject: [patch, fortran] more about namelists
From: Daniel Franke <franke.daniel () gmail ! com>
Date: 2007-07-31 9:43:18
Message-ID: 200707311143.18265.franke.daniel () gmail ! com
[Download RAW message or body]
A recent patch of mine [1] introduced attribute bits for pointer and private
components of derived types respectively. It was only shortly after I
committed this patch, that I found the functions derived_pointer() and
derived_inaccessable() in resolve.c, obviously meant for the same purpose as
the attributes just introduced ...
Further, while checking the usage of the functions mentioned to see whether
they could be savely removed, I learned that the changes I made to fix the
known problems with namelists introduced new ones (see the changed testcases
for examples).
As a sidenote: with this patch, gfortran will be the only compiler I tested
(intel, sun, lahey) that detects the nested private components in
namelist_33.f90 correctly - for a given value of correct. I would be grateful
if someone could please double-check this, thanks :)
:ADDPATCH fortran:
2007-07-29 Daniel Franke <franke.daniel@gmail.com>
* resolve.c (derived_pointer): Removed, replaced callers by access
to appropiate attribute bit.
(derived_inaccessable): Shortcut recursion depth.
(resolve_fl_namelist): Fixed checks for private components in namelists.
Bootstrapped and regression tested on i686-pc-linux-gnu.
Ok for trunk?
Regards
Daniel
[1] http://gcc.gnu.org/ml/gcc-patches/2007-07/msg02016.html
["namelist-2.patch" (text/x-diff)]
Index: fortran/resolve.c
===================================================================
--- fortran/resolve.c (revision 127062)
+++ fortran/resolve.c (working copy)
@@ -4124,28 +4124,6 @@
}
-/* Given a pointer to a symbol that is a derived type, see if any components
- have the POINTER attribute. The search is recursive if necessary.
- Returns zero if no pointer components are found, nonzero otherwise. */
-
-static int
-derived_pointer (gfc_symbol *sym)
-{
- gfc_component *c;
-
- for (c = sym->components; c; c = c->next)
- {
- if (c->pointer)
- return 1;
-
- if (c->ts.type == BT_DERIVED && derived_pointer (c->ts.derived))
- return 1;
- }
-
- return 0;
-}
-
-
/* Given a pointer to a symbol that is a derived type, see if it's
inaccessible, i.e. if it's defined in another module and the components are
PRIVATE. The search is recursive if necessary. Returns zero if no
@@ -4156,7 +4134,7 @@
{
gfc_component *c;
- if (sym->attr.use_assoc && sym->component_access == ACCESS_PRIVATE)
+ if (sym->attr.use_assoc && sym->attr.private_comp)
return 1;
for (c = sym->components; c; c = c->next)
@@ -5072,7 +5050,7 @@
{
/* Check that transferred derived type doesn't contain POINTER
components. */
- if (derived_pointer (ts->derived))
+ if (ts->derived->attr.pointer_comp)
{
gfc_error ("Data transfer element at %L cannot have "
"POINTER components", &code->loc);
@@ -5921,7 +5899,7 @@
if (code->expr->ts.type == BT_DERIVED
&& code->expr->expr_type == EXPR_VARIABLE
- && derived_pointer (code->expr->ts.derived)
+ && code->expr->ts.derived->attr.pointer_comp
&& gfc_impure_variable (code->expr2->symtree->n.sym))
{
gfc_error ("The impure variable at %L is assigned to "
@@ -7035,13 +7013,11 @@
{
for (nl = sym->namelist; nl; nl = nl->next)
{
- if (nl->sym->attr.use_assoc
- || (sym->ns->parent == nl->sym->ns)
- || (sym->ns->parent
- && sym->ns->parent->parent == nl->sym->ns))
- continue;
-
- if (!gfc_check_access(nl->sym->attr.access,
+ if (!nl->sym->attr.use_assoc
+ && !(sym->ns->parent == nl->sym->ns)
+ && !(sym->ns->parent
+ && sym->ns->parent->parent == nl->sym->ns)
+ && !gfc_check_access(nl->sym->attr.access,
nl->sym->ns->default_access))
{
gfc_error ("NAMELIST object '%s' was declared PRIVATE and "
@@ -7050,10 +7026,22 @@
return FAILURE;
}
+ /* Types with private components that came here by USE-association. */
if (nl->sym->ts.type == BT_DERIVED
+ && derived_inaccessible (nl->sym->ts.derived))
+ {
+ gfc_error ("NAMELIST object '%s' has use-associated PRIVATE "
+ "components and cannot be member of namelist '%s' at %L",
+ nl->sym->name, sym->name, &sym->declared_at);
+ return FAILURE;
+ }
+
+ /* Types with private components that are defined in the same module. */
+ if (nl->sym->ts.type == BT_DERIVED
+ && !(sym->ns->parent == nl->sym->ts.derived->ns)
&& !gfc_check_access (nl->sym->ts.derived->attr.private_comp
- ? ACCESS_PRIVATE : ACCESS_UNKNOWN,
- nl->sym->ns->default_access))
+ ? ACCESS_PRIVATE : ACCESS_UNKNOWN,
+ nl->sym->ns->default_access))
{
gfc_error ("NAMELIST object '%s' has PRIVATE components and "
"cannot be a member of PUBLIC namelist '%s' at %L",
Index: testsuite/gfortran.dg/namelist_33.f90
===================================================================
--- testsuite/gfortran.dg/namelist_33.f90 (revision 127062)
+++ testsuite/gfortran.dg/namelist_33.f90 (working copy)
@@ -2,6 +2,9 @@
!
! PR fortran/32876 - accepts private items in public NAMELISTs
!
+! USE-associated types with private components may
+! not be used in namelists -- anywhere.
+!
MODULE types
type :: tp4
PRIVATE
@@ -26,15 +29,42 @@
END MODULE
MODULE nml
-USE types
- type(tp1) :: t1
- type(tp4) :: t4
+ USE types
- namelist /a/ t1 ! { dg-error "has PRIVATE components and cannot be a member of PUBLIC namelist" }
- namelist /b/ t4 ! { dg-error "has PRIVATE components and cannot be a member of PUBLIC namelist" }
+ type(tp1) :: t1
+ type(tp4) :: t4
+ namelist /a/ t1 ! { dg-error "use-associated PRIVATE components" }
+ namelist /b/ t4 ! { dg-error "use-associated PRIVATE components" }
+
integer, private :: i
- namelist /c/ i ! { dg-error "was declared PRIVATE and cannot be member of PUBLIC namelist" }
+ namelist /c/ i ! { dg-error "was declared PRIVATE and cannot be member of PUBLIC namelist" }
+
+contains
+ subroutine y()
+ type(tp2) :: y2
+ type(tp3) :: y3
+
+ namelist /nml2/ y2 ! { dg-error "has use-associated PRIVATE components " }
+ namelist /nml3/ y3 ! { dg-error "has use-associated PRIVATE components " }
+ end subroutine
END MODULE
+
+program xxx
+ use types
+
+ type :: tp5
+ TYPE(tp4) :: t ! nested private components
+ end type
+ type(tp5) :: t5
+
+ namelist /nml/ t5 ! { dg-error "has use-associated PRIVATE components" }
+
+contains
+ subroutine z()
+ namelist /nml2/ t5 ! { dg-error "has use-associated PRIVATE components" }
+ end subroutine
+end program
+
! { dg-final { cleanup-modules "types nml" } }
Index: testsuite/gfortran.dg/namelist_36.f90
===================================================================
--- testsuite/gfortran.dg/namelist_36.f90 (revision 0)
+++ testsuite/gfortran.dg/namelist_36.f90 (revision 0)
@@ -0,0 +1,29 @@
+! { dg-compile }
+!
+! Private types and types with private components
+! are acceptable in local namelists.
+!
+
+MODULE nml
+ type :: tp1
+ integer :: i
+ end type
+
+ type :: tp2
+ private
+ integer :: i
+ end type
+
+ private :: tp1
+contains
+ subroutine x()
+ type(tp1) :: t1
+ type(tp2) :: t2
+
+ namelist /nml1/ i ! ok, private variable
+ namelist /nml2/ t1 ! ok, private type
+ namelist /nml3/ t2 ! ok, private components
+ end subroutine
+END MODULE
+
+! { dg-final { cleanup-modules "nml" } }
[prev in list] [next in list] [prev in thread] [next in thread]
Configure |
About |
News |
Add a list |
Sponsored by KoreLogic