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
This commit is contained in:
Tobias Burnus 2012-04-15 07:52:51 +02:00 committed by Tobias Burnus
parent 9aad845a63
commit cdd244b832
8 changed files with 119 additions and 1 deletions

View 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> 2012-04-11 Tobias Burnus <burnus@net-b.de>
PR fortran/52729 PR fortran/52729

View File

@ -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. */

View File

@ -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)
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
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)
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);

View File

@ -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);

View File

@ -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);

View 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> 2012-04-14 Tom de Vries <tom@codesourcery.com>
* gcc.dg/superblock.c: New test. * gcc.dg/superblock.c: New test.

View File

@ -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

View File

@ -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