re PR fortran/52916 (481.wrf in SPEC CPU 2006 failed to build)
authorTobias Burnus <burnus@net-b.de>
Sun, 15 Apr 2012 05:52:51 +0000 (07:52 +0200)
committerTobias Burnus <burnus@gcc.gnu.org>
Sun, 15 Apr 2012 05:52:51 +0000 (07:52 +0200)
2012-04-14  Tobias Burnus  <burnus@net-b.de>

        PR fortran/52916
        PR fortran/40973
        * gfortran.h (symbol_attribute): Add public_used.
        * interface.c (check_sym_interfaces, check_uop_interfaces,
        gfc_check_interfaces): Set it.
        * resolve.c (resolve_typebound_procedure): Ditto.
        * trans-decl.c (build_function_decl): Use it.

2012-04-14  Tobias Burnus  <burnus@net-b.de>

        PR fortran/52916
        PR fortran/40973
        * gfortran.dg/public_private_module_3.f90: New.
        * gfortran.dg/public_private_module_4.f90: New.

From-SVN: r186464

gcc/fortran/ChangeLog
gcc/fortran/gfortran.h
gcc/fortran/interface.c
gcc/fortran/resolve.c
gcc/fortran/trans-decl.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/public_private_module_3.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/public_private_module_4.f90 [new file with mode: 0644]

index 99063d30ec564978cadd697c331167af176429a8..9bb46acb427caa193e772465e761f17ccd508eed 100644 (file)
@@ -1,3 +1,13 @@
+2012-04-15  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/52916
+       PR fortran/40973
+       * gfortran.h (symbol_attribute): Add public_used.
+       * interface.c (check_sym_interfaces, check_uop_interfaces,
+       gfc_check_interfaces): Set it.
+       * resolve.c (resolve_typebound_procedure): Ditto.
+       * trans-decl.c (build_function_decl): Use it.
+
 2012-04-11  Tobias Burnus  <burnus@net-b.de>
 
        PR fortran/52729
index 8e83cb4cbd50a60cc6ac80f0cf5a68e8f6e903e4..25bdfa5ca3c82dbf69c29697493523f190e55abe 100644 (file)
@@ -726,6 +726,10 @@ typedef struct
   unsigned sequence:1, elemental:1, pure:1, recursive:1;
   unsigned unmaskable:1, masked:1, contained:1, mod_proc:1, abstract:1;
 
+  /* Set if a (public) symbol [e.g. generic name] exposes this symbol,
+     which is relevant for private module procedures.  */
+  unsigned public_used:1;
+
   /* This is set if a contained procedure could be declared pure.  This is
      used for certain optimizations that require the result or arguments
      cannot alias.  Note that this is zero for PURE procedures.  */
index 298ae23d2608df6909be1b2cfa6eeb00e3b9db54..2f1d24e6e3375fade69278855ca7f2abeb6b7aea 100644 (file)
@@ -1390,6 +1390,9 @@ 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))
@@ -1415,11 +1418,16 @@ 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);
@@ -1489,6 +1497,7 @@ void
 gfc_check_interfaces (gfc_namespace *ns)
 {
   gfc_namespace *old_ns, *ns2;
+  gfc_interface *p;
   char interface_name[100];
   int i;
 
@@ -1513,6 +1522,10 @@ 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 34b3e9e23726304c93c6f8408d8f82cdf6c5180b..57da577dfaaa587d340a2c70b5e9dc63f73f5935 100644 (file)
@@ -11304,6 +11304,7 @@ 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 aec96aa75a258efff33babe96532365ce8317fa1..129010e4cf857afde26cd95c794f138262f4f62b 100644 (file)
@@ -1844,7 +1844,8 @@ build_function_decl (gfc_symbol * sym, bool global)
 
   if (!current_function_decl
       && !sym->attr.entry_master && !sym->attr.is_main_program
-      && (sym->attr.access != ACCESS_PRIVATE || sym->binding_label))
+      && (sym->attr.access != ACCESS_PRIVATE || sym->binding_label
+         || sym->attr.public_used))
     TREE_PUBLIC (fndecl) = 1;
 
   attributes = add_attributes_to_decl (attr, NULL_TREE);
index 2b3395ee917d50253df7a6d7a5edaab5cc4d528c..16d632858904a48408d05977cceb1ba39377c030 100644 (file)
@@ -1,3 +1,10 @@
+2012-04-14  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/52916
+       PR fortran/40973
+       * gfortran.dg/public_private_module_3.f90: New.
+       * gfortran.dg/public_private_module_4.f90: New.
+
 2012-04-14  Tom de Vries  <tom@codesourcery.com>
 
        * gcc.dg/superblock.c: New test.
diff --git a/gcc/testsuite/gfortran.dg/public_private_module_3.f90 b/gcc/testsuite/gfortran.dg/public_private_module_3.f90
new file mode 100644 (file)
index 0000000..f003225
--- /dev/null
@@ -0,0 +1,60 @@
+! { dg-do compile }
+!
+! To be used by public_private_module_4.f90
+!
+! PR fortran/52916
+! Cf. PR fortran/40973
+!
+! Ensure that PRIVATE specific functions do not get
+! marked as TREE_PUBLIC() = 0, if the generic name is
+! PUBLIC.
+!
+module m
+  interface gen
+    module procedure bar
+  end interface gen
+
+  type t
+  end type t
+
+  interface operator(.myop.)
+    module procedure my_op
+  end interface
+
+  interface operator(+)
+    module procedure my_plus
+  end interface
+
+  interface assignment(=)
+    module procedure my_assign
+  end interface
+
+  private :: bar, my_op, my_plus, my_assign
+contains
+  subroutine bar()
+    print *, "bar"
+  end subroutine bar
+  function my_op(op1, op2) result(res)
+    type(t) :: res
+    type(t), intent(in) :: op1, op2
+  end function my_op
+  function my_plus(op1, op2) result(res)
+    type(t) :: res
+    type(t), intent(in) :: op1, op2
+  end function my_plus
+  subroutine my_assign(lhs, rhs)
+    type(t), intent(out) :: lhs
+    type(t), intent(in) :: rhs
+  end subroutine my_assign
+end module m
+
+module m2
+  type t2
+  contains
+    procedure, nopass :: func => foo
+  end type t2
+  private :: foo
+contains
+  subroutine foo()
+  end subroutine foo
+end module m2
diff --git a/gcc/testsuite/gfortran.dg/public_private_module_4.f90 b/gcc/testsuite/gfortran.dg/public_private_module_4.f90
new file mode 100644 (file)
index 0000000..6b5519c
--- /dev/null
@@ -0,0 +1,22 @@
+! { dg-do link }
+! { dg-additional-sources public_private_module_3.f90 }
+!
+! PR fortran/52916
+! Cf. PR fortran/40973
+!
+! Ensure that PRIVATE specific functions do not get
+! marked as TREE_PUBLIC() = 0, if the generic name is
+! PUBLIC.
+!
+use m
+use m2
+implicit none
+
+type(t) :: a, b, c
+type(t2) :: x
+
+call gen()
+a = b + (c .myop. a)
+
+call x%func()
+end