Dear all,
my recent patch for setting PRIVATE module variables and procedures to
TREE_PUBLIC()=0 had a flaw: I completely forgot about generic
interfaces. Even if the specific name is PRIVATE, the specific function
is still callable through the a (public) generic name.
Thanks to HJ for the report. (The bug causes a failures of SPEC CPU 2006.)
I think the handling of type-bound procedures is correct. However, I
wouldn't mind if someone could confirm it. I only check for the specific
entries as GENERIC, OPERATOR and ASSIGNMENT use a type-bound-proc name,
which is already handled. I also didn't try to optimize for private DT,
private generics etc. First, I think it is not needed. And secondly,
through inheritance, it can get extremely complicated.
Build and regtested on x86-64-linux.
OK for the trunk?
Tobias
2012-04-11 Tobias Burnus <bur...@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 <bur...@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.
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 8e83cb4..5480663 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -726,6 +728,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. */
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 298ae23..c04a4d0 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -1390,6 +1392,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 +1420,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 +1499,7 @@ void
gfc_check_interfaces (gfc_namespace *ns)
{
gfc_namespace *old_ns, *ns2;
+ gfc_interface *p;
char interface_name[100];
int i;
@@ -1513,6 +1524,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);
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index b63a0c6..bd94605 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -11304,6 +11335,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);
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index aec96aa..46378b6 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -1844,7 +1858,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);
--- /dev/null 2012-04-10 19:58:22.131728097 +0200
+++ gcc/gcc/testsuite/gfortran.dg/public_private_module_3.f90 2012-04-11 14:15:53.000000000 +0200
@@ -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
--- /dev/null 2012-04-10 19:58:22.131728097 +0200
+++ gcc/gcc/testsuite/gfortran.dg/public_private_module_4.f90 2012-04-11 14:15:43.000000000 +0200
@@ -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
