Commit 5cf8132a by Tobias Burnus Committed by Tobias Burnus

re PR fortran/54884 (Externally used PRIVATE module procedure wrongly marked as TREE_PUBLIC()=0)

2012-12-23  Tobias Burnus  <burnus@net-b.de>

        PR fortran/54884
        * module.c (write_symbol1_recursion): Set attr.public_use.
        * interface.c (check_sym_interfaces, check_uop_interfaces,
        gfc_check_interfaces): Remove attr.public_use code.
        * resolve.c (resolve_function, resolve_variable,
        resolve_typebound_procedure): Ditto.

2012-12-23  Tobias Burnus  <burnus@net-b.de>

        PR fortran/54884
        * gfortran.dg/public_private_module_8.f90: New.

From-SVN: r194706
parent 5f842aa5
2012-12-23 Tobias Burnus <burnus@net-b.de>
PR fortran/54884
* module.c (write_symbol1_recursion): Set attr.public_use.
* interface.c (check_sym_interfaces, check_uop_interfaces,
gfc_check_interfaces): Remove attr.public_use code.
* resolve.c (resolve_function, resolve_variable,
resolve_typebound_procedure): Ditto.
2012-12-22 Tobias Burnus <burnus@net-b.de>
PR fortran/55763
......
......@@ -1582,9 +1582,6 @@ 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))
......@@ -1610,16 +1607,11 @@ 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);
......@@ -1689,7 +1681,6 @@ void
gfc_check_interfaces (gfc_namespace *ns)
{
gfc_namespace *old_ns, *ns2;
gfc_interface *p;
char interface_name[100];
int i;
......@@ -1714,10 +1705,6 @@ 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);
......
......@@ -5238,6 +5238,7 @@ write_symbol1_recursion (sorted_pointer_info *sp)
p1->u.wsym.state = WRITTEN;
write_symbol (p1->integer, p1->u.wsym.sym);
p1->u.wsym.sym->attr.public_used = 1;
write_symbol1_recursion (sp->right);
}
......
......@@ -3129,12 +3129,6 @@ resolve_function (gfc_expr *expr)
return FAILURE;
}
if (sym && specification_expr && sym->attr.function
&& gfc_current_ns->proc_name
&& gfc_current_ns->proc_name->attr.flavor == FL_MODULE)
sym->attr.public_used = 1;
/* Switch off assumed size checking and do this again for certain kinds
of procedure, once the procedure itself is resolved. */
need_full_assumed_size++;
......@@ -5360,19 +5354,6 @@ resolve_variable (gfc_expr *e)
if (check_assumed_size_reference (sym, e))
return FAILURE;
/* If a PRIVATE variable is used in the specification expression of the
result variable, it might be accessed from outside the module and can
thus not be TREE_PUBLIC() = 0.
TODO: sym->attr.public_used only has to be set for the result variable's
type-parameter expression and not for dummies or automatic variables.
Additionally, it only has to be set if the function is either PUBLIC or
used in a generic interface or TBP; unfortunately,
proc_name->attr.public_used can get set at a later stage. */
if (specification_expr && sym->attr.access == ACCESS_PRIVATE
&& !sym->attr.function && !sym->attr.use_assoc
&& gfc_current_ns->proc_name && gfc_current_ns->proc_name->attr.function)
sym->attr.public_used = 1;
/* Deal with forward references to entries during resolve_code, to
satisfy, at least partially, 12.5.2.5. */
if (gfc_current_ns->entries
......@@ -12146,7 +12127,6 @@ 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);
......
2012-12-23 Tobias Burnus <burnus@net-b.de>
PR fortran/54884
* gfortran.dg/public_private_module_8.f90: New.
2012-12-23 Richard Sandiford <rdsandiford@googlemail.com>
* gcc.target/mips/r10k-cache-barrier-10.c: Make a branch-likely
......
! { dg-do compile }
! { dg-options "-O2" }
!
! PR fortran/54884
!
! Check that get_key_len is not optimized away as it
! is used in a publicly visible specification expression.
!
module m
private
public :: foo
interface foo
module procedure bar
end interface foo
contains
pure function mylen()
integer :: mylen
mylen = 42
end function mylen
pure function myotherlen()
integer :: myotherlen
myotherlen = 99
end function myotherlen
subroutine bar(x)
character(len=mylen()) :: x
character :: z2(myotherlen())
call internal(x)
block
character(len=myotherlen()) :: z
z = "abc"
x(1:5) = z
end block
x(6:10) = intern_func()
contains
function intern_func()
character(len=myotherlen()) :: intern_func
intern_func = "zuzu"
end function intern_func
subroutine internal(y)
character(len=myotherlen()) :: y
y = "abc"
end subroutine internal
end subroutine bar
end module m
! { dg-final { scan-assembler-not "__m_MOD_myotherlen" } }
! { dg-final { scan-assembler "__m_MOD_bar" } }
! { dg-final { scan-assembler "__m_MOD_mylen" } }
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