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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@94073 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index fb4af7d..434a23b 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,14 @@
 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
        does not have an explicit type.
        (gfc_match_variable): Resolve implicit derived types in all cases.

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 6598d14..c68f5af 100644 (file)
--- 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 743d4b9..abd8ef8 100644 (file)
--- 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 7c73654..3670a3a 100644 (file)
--- 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 c3bf350..442b205 100644 (file)
--- 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 c8930cb..7115b35 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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

diff --git a/gcc/testsuite/gfortran.dg/namelist_1.f90 b/gcc/testsuite/gfortran.dg/namelist_1.f90
new file mode 100644 (file)
index 0000000..9bebe77
--- /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
+