Commit cdd244b8 by Tobias Burnus Committed by Tobias Burnus

re PR fortran/52916 (481.wrf in SPEC CPU 2006 failed to build)

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
parent 9aad845a
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> 2012-04-11 Tobias Burnus <burnus@net-b.de>
PR fortran/52729 PR fortran/52729
......
...@@ -726,6 +726,10 @@ typedef struct ...@@ -726,6 +726,10 @@ typedef struct
unsigned sequence:1, elemental:1, pure:1, recursive:1; unsigned sequence:1, elemental:1, pure:1, recursive:1;
unsigned unmaskable:1, masked:1, contained:1, mod_proc:1, abstract: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 /* This is set if a contained procedure could be declared pure. This is
used for certain optimizations that require the result or arguments used for certain optimizations that require the result or arguments
cannot alias. Note that this is zero for PURE procedures. */ cannot alias. Note that this is zero for PURE procedures. */
......
...@@ -1390,6 +1390,9 @@ check_sym_interfaces (gfc_symbol *sym) ...@@ -1390,6 +1390,9 @@ check_sym_interfaces (gfc_symbol *sym)
for (p = sym->generic; p; p = p->next) 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 if (p->sym->attr.mod_proc
&& (p->sym->attr.if_source != IFSRC_DECL && (p->sym->attr.if_source != IFSRC_DECL
|| p->sym->attr.procedure)) || p->sym->attr.procedure))
...@@ -1415,11 +1418,16 @@ check_uop_interfaces (gfc_user_op *uop) ...@@ -1415,11 +1418,16 @@ check_uop_interfaces (gfc_user_op *uop)
char interface_name[100]; char interface_name[100];
gfc_user_op *uop2; gfc_user_op *uop2;
gfc_namespace *ns; gfc_namespace *ns;
gfc_interface *p;
sprintf (interface_name, "operator interface '%s'", uop->name); sprintf (interface_name, "operator interface '%s'", uop->name);
if (check_interface0 (uop->op, interface_name)) if (check_interface0 (uop->op, interface_name))
return; 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) for (ns = gfc_current_ns; ns; ns = ns->parent)
{ {
uop2 = gfc_find_uop (uop->name, ns); uop2 = gfc_find_uop (uop->name, ns);
...@@ -1489,6 +1497,7 @@ void ...@@ -1489,6 +1497,7 @@ void
gfc_check_interfaces (gfc_namespace *ns) gfc_check_interfaces (gfc_namespace *ns)
{ {
gfc_namespace *old_ns, *ns2; gfc_namespace *old_ns, *ns2;
gfc_interface *p;
char interface_name[100]; char interface_name[100];
int i; int i;
...@@ -1513,6 +1522,10 @@ gfc_check_interfaces (gfc_namespace *ns) ...@@ -1513,6 +1522,10 @@ gfc_check_interfaces (gfc_namespace *ns)
if (check_interface0 (ns->op[i], interface_name)) if (check_interface0 (ns->op[i], interface_name))
continue; continue;
for (p = ns->op[i]; p; p = p->next)
p->sym->attr.public_used = 1;
if (ns->op[i]) if (ns->op[i])
gfc_check_operator_interface (ns->op[i]->sym, (gfc_intrinsic_op) i, gfc_check_operator_interface (ns->op[i]->sym, (gfc_intrinsic_op) i,
ns->op[i]->where); ns->op[i]->where);
......
...@@ -11304,6 +11304,7 @@ resolve_typebound_procedure (gfc_symtree* stree) ...@@ -11304,6 +11304,7 @@ resolve_typebound_procedure (gfc_symtree* stree)
gcc_assert (stree->n.tb->u.specific); gcc_assert (stree->n.tb->u.specific);
proc = stree->n.tb->u.specific->n.sym; proc = stree->n.tb->u.specific->n.sym;
where = stree->n.tb->where; where = stree->n.tb->where;
proc->attr.public_used = 1;
/* Default access should already be resolved from the parser. */ /* Default access should already be resolved from the parser. */
gcc_assert (stree->n.tb->access != ACCESS_UNKNOWN); gcc_assert (stree->n.tb->access != ACCESS_UNKNOWN);
......
...@@ -1844,7 +1844,8 @@ build_function_decl (gfc_symbol * sym, bool global) ...@@ -1844,7 +1844,8 @@ build_function_decl (gfc_symbol * sym, bool global)
if (!current_function_decl if (!current_function_decl
&& !sym->attr.entry_master && !sym->attr.is_main_program && !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; TREE_PUBLIC (fndecl) = 1;
attributes = add_attributes_to_decl (attr, NULL_TREE); attributes = add_attributes_to_decl (attr, NULL_TREE);
......
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> 2012-04-14 Tom de Vries <tom@codesourcery.com>
* gcc.dg/superblock.c: New test. * gcc.dg/superblock.c: New test.
......
! { 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
! { 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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment