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:
parent
9aad845a63
commit
cdd244b832
|
@ -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
|
||||
|
|
|
@ -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. */
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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
|
|
@ -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
|
Loading…
Reference in New Issue