https://gcc.gnu.org/bugzilla/show_bug.cgi?id=71544
--- Comment #11 from kargl at gcc dot gnu.org ---
(In reply to Richard Biener from comment #9)
> Confirmed as fortran FE bug. The FE manages to set ".r" as fn spec attribute
> on save_cptr which specifies that its first argument does not escape.
>
> It's trans-types.c:create_fn_spec that does this by doing
>
> for (f = gfc_sym_get_dummy_args (sym); f; f = f->next)
> if (spec_len < sizeof (spec))
> {
> if (!f->sym || f->sym->attr.pointer || f->sym->attr.target
> || f->sym->attr.external || f->sym->attr.cray_pointer
> || (f->sym->ts.type == BT_DERIVED
> && (f->sym->ts.u.derived->attr.proc_pointer_comp
> || f->sym->ts.u.derived->attr.pointer_comp))
> || (f->sym->ts.type == BT_CLASS
> && (CLASS_DATA (f->sym)->ts.u.derived->attr.proc_pointer_comp
> || CLASS_DATA
> (f->sym)->ts.u.derived->attr.pointer_comp)))
> spec[spec_len++] = '.';
> else if (f->sym->attr.intent == INTENT_IN)
> spec[spec_len++] = 'r';
> else if (f->sym)
> spec[spec_len++] = 'w';
> }
>
> and it looks like the side-effect of marking arguments as not escaping as
> soon
> as you specify anything else than . was overlooked.
>
> Or Fortran really doesn't allow args to be stored away but has an exception
> for
> C binding types which needs handling above.
This patch works around the inability of a programmer
to type SAVE in the line 'integer(c_int), pointer :: a'.
I'm not convinced that gfortran cannot optimize away the
assignment 'a = 100' as 'a' is a local variable in
subroutine init(). I can find nothing in the standard that
requires a compiler to assume that the return result from
c_loc() is cached somewhere.
I have no intentions to commit this patch. It is recorded
here so that I can clean up my development tree. If one thinks
about its ramifications, one should arrive at the conclusion
that the patch will cause a leak of memory.
Index: match.c
===================================================================
--- match.c (revision 237481)
+++ match.c (working copy)
@@ -1349,6 +1349,11 @@ gfc_match_assignment (void)
gfc_set_sym_referenced (lvalue->symtree->n.sym);
+ if (lvalue->symtree->n.sym->attr.pointer == 1
+ && lvalue->symtree->n.sym->attr.referenced == 1
+ && lvalue->symtree->n.sym->attr.save == SAVE_NONE)
+ lvalue->symtree->n.sym->attr.save = SAVE_IMPLICIT;
+
new_st.op = EXEC_ASSIGN;
new_st.expr1 = lvalue;
new_st.expr2 = rvalue;
