gfortran.h (gfc_check_access): Add prototype.
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. From-SVN: r94073
This commit is contained in:
parent
d7f3fc1990
commit
af30f793c9
|
@ -1,3 +1,12 @@
|
|||
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.
|
||||
|
||||
2005-01-22 Paul Brook <paul@codesourcery.com>
|
||||
|
||||
* primary.c (gfc_match_rvalue): Only apply implicit type if variable
|
||||
|
|
|
@ -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 *);
|
||||
|
|
|
@ -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;
|
||||
|
||||
|
|
|
@ -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);
|
||||
}
|
||||
|
||||
|
|
|
@ -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;
|
||||
}
|
||||
|
||||
|
||||
|
|
|
@ -1,3 +1,7 @@
|
|||
2005-01-22 Paul Brook <paul@codesourcery.com>
|
||||
|
||||
* namelist_1.f90: New test.
|
||||
|
||||
2005-01-22 Richard Sandiford <rsandifo@redhat.com>
|
||||
|
||||
PR tree-optimization/19484
|
||||
|
|
|
@ -0,0 +1,8 @@
|
|||
! { 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
|
||||
|
Loading…
Reference in New Issue