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>
PR fortran/52729

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

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

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

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

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