From: Paul Brook Date: Sat, 22 Jan 2005 18:23:43 +0000 (+0000) Subject: gfortran.h (gfc_check_access): Add prototype. X-Git-Tag: releases/gcc-4.0.0~1371 X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=af30f793c95eacd307ed1c52354b64b4f9aa1dc6;p=thirdparty%2Fgcc.git gfortran.h (gfc_check_access): Add prototype. 2005-01-22 Paul Brook * 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 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index fb4af7de454f..434a23ba93dd 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2005-01-22 Paul Brook + + * 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 * primary.c (gfc_match_rvalue): Only apply implicit type if variable diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 6598d1495904..c68f5af5ad52 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -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 *); diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index 743d4b9fd2d6..abd8ef89acb1 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -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; diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index 7c736548d968..3670a3a49adf 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -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); } diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index c3bf35057df9..442b205b7bc4 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -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; } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index c8930cbbf688..7115b358a4bd 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2005-01-22 Paul Brook + + * namelist_1.f90: New test. + 2005-01-22 Richard Sandiford PR tree-optimization/19484 diff --git a/gcc/testsuite/gfortran.dg/namelist_1.f90 b/gcc/testsuite/gfortran.dg/namelist_1.f90 new file mode 100644 index 000000000000..9bebe773b677 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/namelist_1.f90 @@ -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 +