2012-12-23 Tobias Burnus <burnus@net-b.de>
authorburnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4>
Sun, 23 Dec 2012 18:43:32 +0000 (18:43 +0000)
committerburnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4>
Sun, 23 Dec 2012 18:43:32 +0000 (18:43 +0000)
        PR fortran/54884
        * module.c (write_symbol1_recursion): Set attr.public_use.
        * interface.c (check_sym_interfaces, check_uop_interfaces,
        gfc_check_interfaces): Remove attr.public_use code.
        * resolve.c (resolve_function, resolve_variable,
        resolve_typebound_procedure): Ditto.

2012-12-23  Tobias Burnus  <burnus@net-b.de>

        PR fortran/54884
        * gfortran.dg/public_private_module_8.f90: New.

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

gcc/fortran/ChangeLog
gcc/fortran/interface.c
gcc/fortran/module.c
gcc/fortran/resolve.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/public_private_module_8.f90 [new file with mode: 0644]

index 4a84e1d..b3dab05 100644 (file)
@@ -1,3 +1,12 @@
+2012-12-23  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/54884
+       * module.c (write_symbol1_recursion): Set attr.public_use.
+       * interface.c (check_sym_interfaces, check_uop_interfaces,
+       gfc_check_interfaces): Remove attr.public_use code.
+       * resolve.c (resolve_function, resolve_variable,
+       resolve_typebound_procedure): Ditto.
+
 2012-12-22  Tobias Burnus  <burnus@net-b.de>
 
        PR fortran/55763
index 908db74..b587d4a 100644 (file)
@@ -1582,9 +1582,6 @@ check_sym_interfaces (gfc_symbol *sym)
 
       for (p = sym->generic; p; p = p->next)
        {
-         if (sym->attr.access != ACCESS_PRIVATE)
-           p->sym->attr.public_used = 1;
-
          if (p->sym->attr.mod_proc
              && (p->sym->attr.if_source != IFSRC_DECL
                  || p->sym->attr.procedure))
@@ -1610,16 +1607,11 @@ check_uop_interfaces (gfc_user_op *uop)
   char interface_name[100];
   gfc_user_op *uop2;
   gfc_namespace *ns;
-  gfc_interface *p;
 
   sprintf (interface_name, "operator interface '%s'", uop->name);
   if (check_interface0 (uop->op, interface_name))
     return;
 
-  if (uop->access != ACCESS_PRIVATE)
-    for (p = uop->op; p; p = p->next)
-      p->sym->attr.public_used = 1;
-
   for (ns = gfc_current_ns; ns; ns = ns->parent)
     {
       uop2 = gfc_find_uop (uop->name, ns);
@@ -1689,7 +1681,6 @@ void
 gfc_check_interfaces (gfc_namespace *ns)
 {
   gfc_namespace *old_ns, *ns2;
-  gfc_interface *p;
   char interface_name[100];
   int i;
 
@@ -1714,10 +1705,6 @@ gfc_check_interfaces (gfc_namespace *ns)
       if (check_interface0 (ns->op[i], interface_name))
        continue;
 
-      for (p = ns->op[i]; p; p = p->next)
-       p->sym->attr.public_used = 1;
-
-
       if (ns->op[i])
        gfc_check_operator_interface (ns->op[i]->sym, (gfc_intrinsic_op) i,
                                      ns->op[i]->where);
index a797f24..e19c6d9 100644 (file)
@@ -5238,6 +5238,7 @@ write_symbol1_recursion (sorted_pointer_info *sp)
 
   p1->u.wsym.state = WRITTEN;
   write_symbol (p1->integer, p1->u.wsym.sym);
+  p1->u.wsym.sym->attr.public_used = 1;
  
   write_symbol1_recursion (sp->right);
 }
index 77d3dc5..873400a 100644 (file)
@@ -3129,12 +3129,6 @@ resolve_function (gfc_expr *expr)
       return FAILURE;
     }
 
-  if (sym && specification_expr && sym->attr.function
-      && gfc_current_ns->proc_name
-      && gfc_current_ns->proc_name->attr.flavor == FL_MODULE)
-    sym->attr.public_used = 1;
-
-
   /* Switch off assumed size checking and do this again for certain kinds
      of procedure, once the procedure itself is resolved.  */
   need_full_assumed_size++;
@@ -5360,19 +5354,6 @@ resolve_variable (gfc_expr *e)
   if (check_assumed_size_reference (sym, e))
     return FAILURE;
 
-  /* If a PRIVATE variable is used in the specification expression of the
-     result variable, it might be accessed from outside the module and can
-     thus not be TREE_PUBLIC() = 0.
-     TODO: sym->attr.public_used only has to be set for the result variable's
-     type-parameter expression and not for dummies or automatic variables.
-     Additionally, it only has to be set if the function is either PUBLIC or
-     used in a generic interface or TBP; unfortunately,
-     proc_name->attr.public_used can get set at a later stage.  */
-  if (specification_expr && sym->attr.access == ACCESS_PRIVATE
-      && !sym->attr.function && !sym->attr.use_assoc
-      && gfc_current_ns->proc_name && gfc_current_ns->proc_name->attr.function)
-    sym->attr.public_used = 1;
-
   /* Deal with forward references to entries during resolve_code, to
      satisfy, at least partially, 12.5.2.5.  */
   if (gfc_current_ns->entries
@@ -12146,7 +12127,6 @@ resolve_typebound_procedure (gfc_symtree* stree)
   gcc_assert (stree->n.tb->u.specific);
   proc = stree->n.tb->u.specific->n.sym;
   where = stree->n.tb->where;
-  proc->attr.public_used = 1;
 
   /* Default access should already be resolved from the parser.  */
   gcc_assert (stree->n.tb->access != ACCESS_UNKNOWN);
index 315fb0e..8a99e06 100644 (file)
@@ -1,3 +1,8 @@
+2012-12-23  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/54884
+       * gfortran.dg/public_private_module_8.f90: New.
+
 2012-12-23  Richard Sandiford  <rdsandiford@googlemail.com>
 
        * gcc.target/mips/r10k-cache-barrier-10.c: Make a branch-likely
diff --git a/gcc/testsuite/gfortran.dg/public_private_module_8.f90 b/gcc/testsuite/gfortran.dg/public_private_module_8.f90
new file mode 100644 (file)
index 0000000..bfc1b36
--- /dev/null
@@ -0,0 +1,49 @@
+! { dg-do compile }
+! { dg-options "-O2" }
+!
+! PR fortran/54884
+!
+! Check that get_key_len is not optimized away as it
+! is used in a publicly visible specification expression.
+!
+
+module m
+  private
+  public :: foo
+  interface foo
+    module procedure bar
+  end interface foo
+contains
+  pure function mylen()
+    integer :: mylen
+    mylen = 42
+  end function mylen
+  pure function myotherlen()
+    integer :: myotherlen
+    myotherlen = 99
+  end function myotherlen
+  subroutine bar(x)
+    character(len=mylen()) :: x
+    character :: z2(myotherlen())
+    call internal(x)
+    block
+       character(len=myotherlen()) :: z
+       z = "abc"
+       x(1:5) = z
+    end block
+    x(6:10) = intern_func()
+  contains
+    function intern_func()
+      character(len=myotherlen()) :: intern_func
+      intern_func = "zuzu"
+    end function intern_func
+   subroutine internal(y)
+      character(len=myotherlen()) :: y
+      y = "abc"
+    end subroutine internal
+  end subroutine bar
+end module m
+
+! { dg-final { scan-assembler-not "__m_MOD_myotherlen" } }
+! { dg-final { scan-assembler "__m_MOD_bar" } }
+! { dg-final { scan-assembler "__m_MOD_mylen" } }