This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
Re: [gfortran] private objects in namelists
- From: Paul Brook <paul at codesourcery dot com>
- To: fortran at gcc dot gnu dot org
- Cc: "Paul Thomas" <paulthomas2 at wanadoo dot fr>,gcc-patches at gcc dot gnu dot org
- Date: Sat, 22 Jan 2005 18:20:25 +0000
- Subject: Re: [gfortran] private objects in namelists
- Organization: CodeSourcery
- References: <000c01c4fae6$44df3f40$0400000a@Paul>
On Saturday 15 January 2005 09:40, Paul Thomas wrote:
> This is a micro-buglet... I think. Anyway, it's not important but I would
> like to improve my understanding of the front end or,indeed, fortran.
>
> The fortran standard says (C575) - "A namelist-group-object shall not have
> the private attribute if the namelist-group-name has the PUBLIC attribute."
The attached patch implements this check.
Paul
2005-01-22 Paul Brook <paul@codesourcery.com>
* gfortran.h (gfc_check_access): Add prototype.
* match.c (gfc_match_namelist): Remove TODO.
* module.c (check_access): Rename ...
(gfc_check_access): ... to this. Boolify. Update callers.
* resolve.c (resolve_symbol): Check for private objects in public
namelists.
testsuite/
* namelist_1.f90: New test.
Index: gfortran.h
===================================================================
RCS file: /var/cvsroot/gcc-cvs/gcc/gcc/fortran/gfortran.h,v
retrieving revision 1.50
diff -u -p -r1.50 gfortran.h
--- gfortran.h 18 Jan 2005 12:11:48 -0000 1.50
+++ gfortran.h 22 Jan 2005 16:31:09 -0000
@@ -1802,6 +1802,7 @@ try gfc_resolve_dt (gfc_dt *);
void gfc_module_init_2 (void);
void gfc_module_done_2 (void);
void gfc_dump_module (const char *, int);
+bool gfc_check_access (gfc_access, gfc_access);
/* primary.c */
symbol_attribute gfc_variable_attr (gfc_expr *, gfc_typespec *);
Index: match.c
===================================================================
RCS file: /var/cvsroot/gcc-cvs/gcc/gcc/fortran/match.c,v
retrieving revision 1.29
diff -u -p -r1.29 match.c
--- match.c 18 Jan 2005 12:11:52 -0000 1.29
+++ match.c 22 Jan 2005 15:56:48 -0000
@@ -2418,9 +2418,6 @@ gfc_match_namelist (void)
&& gfc_add_in_namelist (&sym->attr, NULL) == FAILURE)
goto error;
- /* TODO: worry about PRIVATE members of a PUBLIC namelist
- group. */
-
nl = gfc_get_namelist ();
nl->sym = sym;
Index: module.c
===================================================================
RCS file: /var/cvsroot/gcc-cvs/gcc/gcc/fortran/module.c,v
retrieving revision 1.24
diff -u -p -r1.24 module.c
--- module.c 18 Jan 2005 12:11:53 -0000 1.24
+++ module.c 22 Jan 2005 16:31:53 -0000
@@ -3136,29 +3136,23 @@ read_module (void)
/* Given an access type that is specific to an entity and the default
- access, return nonzero if we should write the entity. */
+ access, return nonzero if the entity is publicly accessible. */
-static int
-check_access (gfc_access specific_access, gfc_access default_access)
+bool
+gfc_check_access (gfc_access specific_access, gfc_access default_access)
{
if (specific_access == ACCESS_PUBLIC)
- return 1;
+ return TRUE;
if (specific_access == ACCESS_PRIVATE)
- return 0;
+ return FALSE;
if (gfc_option.flag_module_access_private)
- {
- if (default_access == ACCESS_PUBLIC)
- return 1;
- }
+ return default_access == ACCESS_PUBLIC;
else
- {
- if (default_access != ACCESS_PRIVATE)
- return 1;
- }
+ return default_access != ACCESS_PRIVATE;
- return 0;
+ return FALSE;
}
@@ -3230,7 +3224,7 @@ write_symbol0 (gfc_symtree * st)
&& !sym->attr.subroutine && !sym->attr.function)
return;
- if (!check_access (sym->attr.access, sym->ns->default_access))
+ if (!gfc_check_access (sym->attr.access, sym->ns->default_access))
return;
p = get_pointer (sym);
@@ -3289,7 +3283,7 @@ write_operator (gfc_user_op * uop)
static char nullstring[] = "";
if (uop->operator == NULL
- || !check_access (uop->access, uop->ns->default_access))
+ || !gfc_check_access (uop->access, uop->ns->default_access))
return;
mio_symbol_interface (uop->name, nullstring, &uop->operator);
@@ -3303,7 +3297,7 @@ write_generic (gfc_symbol * sym)
{
if (sym->generic == NULL
- || !check_access (sym->attr.access, sym->ns->default_access))
+ || !gfc_check_access (sym->attr.access, sym->ns->default_access))
return;
mio_symbol_interface (sym->name, sym->module, &sym->generic);
@@ -3317,7 +3311,7 @@ write_symtree (gfc_symtree * st)
pointer_info *p;
sym = st->n.sym;
- if (!check_access (sym->attr.access, sym->ns->default_access)
+ if (!gfc_check_access (sym->attr.access, sym->ns->default_access)
|| (sym->attr.flavor == FL_PROCEDURE && sym->attr.generic
&& !sym->attr.subroutine && !sym->attr.function))
return;
@@ -3348,8 +3342,8 @@ write_module (void)
if (i == INTRINSIC_USER)
continue;
- mio_interface (check_access (gfc_current_ns->operator_access[i],
- gfc_current_ns->default_access)
+ mio_interface (gfc_check_access (gfc_current_ns->operator_access[i],
+ gfc_current_ns->default_access)
? &gfc_current_ns->operator[i] : NULL);
}
Index: resolve.c
===================================================================
RCS file: /var/cvsroot/gcc-cvs/gcc/gcc/fortran/resolve.c,v
retrieving revision 1.30
diff -u -p -r1.30 resolve.c
--- resolve.c 22 Jan 2005 15:24:06 -0000 1.30
+++ resolve.c 22 Jan 2005 18:10:53 -0000
@@ -3881,7 +3881,7 @@ resolve_symbol (gfc_symbol * sym)
int formal_ns_save, check_constant, mp_flag;
int i;
const char *whynot;
-
+ gfc_namelist *nl;
if (sym->attr.flavor == FL_UNKNOWN)
{
@@ -4043,8 +4043,9 @@ resolve_symbol (gfc_symbol * sym)
}
}
- if (sym->attr.flavor == FL_VARIABLE)
+ switch (sym->attr.flavor)
{
+ case FL_VARIABLE:
/* Can the sybol have an initializer? */
whynot = NULL;
if (sym->attr.allocatable)
@@ -4084,6 +4085,25 @@ resolve_symbol (gfc_symbol * sym)
/* Assign default initializer. */
if (sym->ts.type == BT_DERIVED && !(sym->value || whynot))
sym->value = gfc_default_initializer (&sym->ts);
+ break;
+
+ case FL_NAMELIST:
+ /* Reject PRIVATE objects in a PUBLIC namelist. */
+ if (gfc_check_access(sym->attr.access, sym->ns->default_access))
+ {
+ for (nl = sym->namelist; nl; nl = nl->next)
+ {
+ if (!gfc_check_access(nl->sym->attr.access,
+ nl->sym->ns->default_access))
+ gfc_error ("PRIVATE symbol '%s' cannot be member of "
+ "PUBLIC namelist at %L", nl->sym->name,
+ &sym->declared_at);
+ }
+ }
+ break;
+
+ default:
+ break;
}
! { dg-do compile }
! Check that public entities in private namelists are rejected
module namelist_1
public
integer,private :: x
namelist /n/ x ! { dg-error "cannot be member of PUBLIC namelist" "" }
end module