2011-02-18 Janus Weil <janus@gcc.gnu.org>

	PR fortran/47767
	* gfortran.h (gfc_check_access): Removed prototype.
	(gfc_check_symbol_access): Added prototype.
	* module.c (gfc_check_access): Renamed to 'check_access', made static.
	(gfc_check_symbol_access): New function, basically a shortcut for
	'check_access'.
	(write_dt_extensions,write_symbol0,write_generic,write_symtree): Use
	'gfc_check_symbol_access'.
	(write_operator,write_module): Renamed 'gfc_check_access'.
	* resolve.c (resolve_fl_procedure,resolve_fl_derived,
	resolve_fl_namelist,resolve_symbol,resolve_fntype): Use
	'gfc_check_symbol_access'.

2011-02-18  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/47767
	* gfortran.dg/class_40.f03: New.


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

1 files changed, 19 insertions, 12 deletions

diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 267809c4d77..6f1520c0205 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -4592,8 +4592,8 @@ read_module (void)
    PRIVATE, then private, and otherwise it is public unless the default
    access in this context has been declared PRIVATE.  */
 
-bool
-gfc_check_access (gfc_access specific_access, gfc_access default_access)
+static bool
+check_access (gfc_access specific_access, gfc_access default_access)
 {
   if (specific_access == ACCESS_PUBLIC)
     return TRUE;
@@ -4607,6 +4607,16 @@ gfc_check_access (gfc_access specific_access, gfc_access default_access)
 }
 
 
+bool
+gfc_check_symbol_access (gfc_symbol *sym)
+{
+  if (sym->attr.vtab || sym->attr.vtype)
+    return true;
+  else
+    return check_access (sym->attr.access, sym->ns->default_access);
+}
+
+
 /* A structure to remember which commons we've already written.  */
 
 struct written_common
@@ -4792,8 +4802,7 @@ write_equiv (void)
 static void
 write_dt_extensions (gfc_symtree *st)
 {
-  if (!gfc_check_access (st->n.sym->attr.access,
-			 st->n.sym->ns->default_access))
+  if (!gfc_check_symbol_access (st->n.sym))
     return;
 
   mio_lparen ();
@@ -4874,7 +4883,7 @@ write_symbol0 (gfc_symtree *st)
       && !sym->attr.subroutine && !sym->attr.function)
     dont_write = true;
 
-  if (!gfc_check_access (sym->attr.access, sym->ns->default_access))
+  if (!gfc_check_symbol_access (sym))
     dont_write = true;
 
   if (!dont_write)
@@ -4931,8 +4940,7 @@ write_operator (gfc_user_op *uop)
   static char nullstring[] = "";
   const char *p = nullstring;
 
-  if (uop->op == NULL
-      || !gfc_check_access (uop->access, uop->ns->default_access))
+  if (uop->op == NULL || !check_access (uop->access, uop->ns->default_access))
     return;
 
   mio_symbol_interface (&uop->name, &p, &uop->op);
@@ -4956,8 +4964,7 @@ write_generic (gfc_symtree *st)
   if (!sym || check_unique_name (st->name))
     return;
 
-  if (sym->generic == NULL
-      || !gfc_check_access (sym->attr.access, sym->ns->default_access))
+  if (sym->generic == NULL || !gfc_check_symbol_access (sym))
     return;
 
   if (sym->module == NULL)
@@ -4982,7 +4989,7 @@ write_symtree (gfc_symtree *st)
 	&& sym->ns->proc_name->attr.if_source == IFSRC_IFBODY)
     return;
 
-  if (!gfc_check_access (sym->attr.access, sym->ns->default_access)
+  if (!gfc_check_symbol_access (sym)
       || (sym->attr.flavor == FL_PROCEDURE && sym->attr.generic
 	  && !sym->attr.subroutine && !sym->attr.function))
     return;
@@ -5013,8 +5020,8 @@ write_module (void)
       if (i == INTRINSIC_USER)
 	continue;
 
-      mio_interface (gfc_check_access (gfc_current_ns->operator_access[i],
-				       gfc_current_ns->default_access)
+      mio_interface (check_access (gfc_current_ns->operator_access[i],
+				   gfc_current_ns->default_access)
 		     ? &gfc_current_ns->op[i] : NULL);
     }