Hi All,
This is a complete rework of the patch and of the original mechanism
for adding caf token fields and finding them.
In this patch, the token fields are added to the derived types after
all the components have been resolved. This is done so that all the
tokens appear at the very end of the derived type, including the
hidden string lengths. This avoids the present situation, where the
token appears immediately after its associated component such that the
the derived types are not compatible with modules or libraries
compiled without -fcoarray selected. All trans-types has to do now is
to find the component and have the component token field point to its
backend_decl. PR83319 is fixed by unconditionally adding the token
field to the descriptor, when -fcoarray=lib whatever the value of
codimen.
This is something of a belt-and-braces approach, in that the token
fields will sometimes be added when not needed. However, it is better
that than the ICEs that occur when they are missing.
Bootstrapped and regtested on FC23/x86_64 - OK for trunk and 7-branch?
Paul
2017-12-26 Paul Thomas <pa...@gcc.gnu.org>
PR fortran/83076
* resolve.c (resolve_fl_derived0): Add caf_token fields for
allocatable and pointer scalars, when -fcoarray selected.
* trans-types.c (gfc_copy_dt_decls_ifequal): Copy the token
field as well as the backend_decl.
(gfc_get_derived_type): Flag GFC_FCOARRAY_LIB for module
derived types that are not vtypes. Components with caf_token
attribute are pvoid types. For a component requiring it, find
the caf_token field and have the component token field point to
its backend_decl.
PR fortran/83319
*trans-types.c (gfc_get_array_descriptor_base): Add the token
field to the descriptor even when codimen not set.
2017-12-26 Paul Thomas <pa...@gcc.gnu.org>
PR fortran/83076
* gfortran.dg/coarray_45.f90 : New test.
PR fortran/83319
* gfortran.dg/coarray_46.f90 : New test.
On 3 December 2017 at 23:48, Dominique d'Humières
<domi...@tournesol.lps.ens.fr> wrote:
> Dear Paul,
>
>> Bootstrapped and regtested on FC23/x86_64 - OK for trunk?
>
> See my comment 7 in the PR.
>
> Dominique
>
--
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein
Index: gcc/fortran/gfortran.h
===================================================================
*** gcc/fortran/gfortran.h (revision 256000)
--- gcc/fortran/gfortran.h (working copy)
*************** typedef struct
*** 870,876 ****
unsigned alloc_comp:1, pointer_comp:1, proc_pointer_comp:1,
private_comp:1, zero_comp:1, coarray_comp:1, lock_comp:1,
event_comp:1, defined_assign_comp:1, unlimited_polymorphic:1,
! has_dtio_procs:1;
/* This is a temporary selector for SELECT TYPE or an associate
variable for SELECT_TYPE or ASSOCIATE. */
--- 870,876 ----
unsigned alloc_comp:1, pointer_comp:1, proc_pointer_comp:1,
private_comp:1, zero_comp:1, coarray_comp:1, lock_comp:1,
event_comp:1, defined_assign_comp:1, unlimited_polymorphic:1,
! has_dtio_procs:1, caf_token:1;
/* This is a temporary selector for SELECT TYPE or an associate
variable for SELECT_TYPE or ASSOCIATE. */
Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c (revision 256000)
--- gcc/fortran/resolve.c (working copy)
*************** resolve_fl_derived0 (gfc_symbol *sym)
*** 13992,13997 ****
--- 13992,14022 ----
if (!success)
return false;
+ /* Now add the caf token field, where needed. */
+ if (flag_coarray != GFC_FCOARRAY_NONE
+ && !sym->attr.is_class && !sym->attr.vtype)
+ {
+ for (c = sym->components; c; c = c->next)
+ if (!c->attr.dimension && !c->attr.codimension
+ && (c->attr.allocatable || c->attr.pointer))
+ {
+ char name[GFC_MAX_SYMBOL_LEN+9];
+ gfc_component *token;
+ sprintf (name, "_caf_%s", c->name);
+ token = gfc_find_component (sym, name, true, true, NULL);
+ if (token == NULL)
+ {
+ if (!gfc_add_component (sym, name, &token))
+ return false;
+ token->ts.type = BT_VOID;
+ token->ts.kind = gfc_default_integer_kind;
+ token->attr.access = ACCESS_PRIVATE;
+ token->attr.artificial = 1;
+ token->attr.caf_token = 1;
+ }
+ }
+ }
+
check_defined_assignments (sym);
if (!sym->attr.defined_assign_comp && super_type)
Index: gcc/fortran/trans-types.c
===================================================================
*** gcc/fortran/trans-types.c (revision 256000)
--- gcc/fortran/trans-types.c (working copy)
*************** gfc_get_array_descriptor_base (int dimen
*** 1837,1843 ****
TREE_NO_WARNING (decl) = 1;
}
! if (flag_coarray == GFC_FCOARRAY_LIB && codimen)
{
decl = gfc_add_field_to_struct_1 (fat_type,
get_identifier ("token"),
--- 1837,1843 ----
TREE_NO_WARNING (decl) = 1;
}
! if (flag_coarray == GFC_FCOARRAY_LIB)
{
decl = gfc_add_field_to_struct_1 (fat_type,
get_identifier ("token"),
*************** gfc_copy_dt_decls_ifequal (gfc_symbol *f
*** 2373,2378 ****
--- 2373,2379 ----
for (; to_cm; to_cm = to_cm->next, from_cm = from_cm->next)
{
to_cm->backend_decl = from_cm->backend_decl;
+ to_cm->caf_token = from_cm->caf_token;
if (from_cm->ts.type == BT_UNION)
gfc_get_union_type (to_cm->ts.u.derived);
else if (from_cm->ts.type == BT_DERIVED
*************** gfc_get_derived_type (gfc_symbol * deriv
*** 2483,2488 ****
--- 2484,2493 ----
gfc_dt_list *dt;
gfc_namespace *ns;
tree tmp;
+ bool coarray_flag;
+
+ coarray_flag = flag_coarray == GFC_FCOARRAY_LIB
+ && derived->module && !derived->attr.vtype;
gcc_assert (!derived->attr.pdt_template);
*************** gfc_get_derived_type (gfc_symbol * deriv
*** 2677,2683 ****
field_type = build_pointer_type (tmp);
}
else if (c->ts.type == BT_DERIVED || c->ts.type == BT_CLASS)
! field_type = c->ts.u.derived->backend_decl;
else
{
if (c->ts.type == BT_CHARACTER
--- 2682,2690 ----
field_type = build_pointer_type (tmp);
}
else if (c->ts.type == BT_DERIVED || c->ts.type == BT_CLASS)
! field_type = c->ts.u.derived->backend_decl;
! else if (c->attr.caf_token)
! field_type = pvoid_type_node;
else
{
if (c->ts.type == BT_CHARACTER
*************** gfc_get_derived_type (gfc_symbol * deriv
*** 2762,2780 ****
&& !(c->ts.type == BT_DERIVED
&& strcmp (c->name, "_data") == 0))
GFC_DECL_PTR_ARRAY_P (c->backend_decl) = 1;
-
- /* Do not add a caf_token field for classes' data components. */
- if (codimen && !c->attr.dimension && !c->attr.codimension
- && (c->attr.allocatable || c->attr.pointer)
- && c->caf_token == NULL_TREE && strcmp ("_data", c->name) != 0)
- {
- char caf_name[GFC_MAX_SYMBOL_LEN];
- snprintf (caf_name, GFC_MAX_SYMBOL_LEN, "_caf_%s", c->name);
- c->caf_token = gfc_add_field_to_struct (typenode,
- get_identifier (caf_name),
- pvoid_type_node, &chain);
- TREE_NO_WARNING (c->caf_token) = 1;
- }
}
/* Now lay out the derived type, including the fields. */
--- 2769,2774 ----
*************** gfc_get_derived_type (gfc_symbol * deriv
*** 2800,2805 ****
--- 2794,2817 ----
copy_derived_types:
+ for (c = derived->components; c; c = c->next)
+ {
+ /* Do not add a caf_token field for class container components. */
+ if ((codimen || coarray_flag)
+ && !c->attr.dimension && !c->attr.codimension
+ && (c->attr.allocatable || c->attr.pointer)
+ && !derived->attr.is_class)
+ {
+ char caf_name[GFC_MAX_SYMBOL_LEN];
+ gfc_component *token;
+ snprintf (caf_name, GFC_MAX_SYMBOL_LEN, "_caf_%s", c->name);
+ token = gfc_find_component (derived, caf_name, true, true, NULL);
+ gcc_assert (token);
+ c->caf_token = token->backend_decl;
+ TREE_NO_WARNING (c->caf_token) = 1;
+ }
+ }
+
for (dt = gfc_derived_types; dt; dt = dt->next)
gfc_copy_dt_decls_ifequal (derived, dt->derived, false);
Index: gcc/testsuite/gfortran.dg/coarray_45.f90
===================================================================
*** gcc/testsuite/gfortran.dg/coarray_45.f90 (nonexistent)
--- gcc/testsuite/gfortran.dg/coarray_45.f90 (working copy)
***************
*** 0 ****
--- 1,24 ----
+ ! { dg-do compile }
+ ! { dg-options "-fcoarray=lib -lcaf_single " }
+ !
+ ! Test the fix for PR83076
+ !
+ module m
+ type t
+ integer, pointer :: z
+ end type
+ type(t) :: ptr
+ contains
+ function g(x)
+ type(t) :: x[*]
+ if (associated (x%z, ptr%z)) deallocate (x%z) ! This used to ICE with
-fcoarray=lib
+ end
+ end module
+
+ use m
+ contains
+ function f(x)
+ type(t) :: x[*]
+ if (associated (x%z, ptr%z)) deallocate (x%z)
+ end
+ end
Index: gcc/testsuite/gfortran.dg/coarray_46.f90
===================================================================
*** gcc/testsuite/gfortran.dg/coarray_46.f90 (nonexistent)
--- gcc/testsuite/gfortran.dg/coarray_46.f90 (working copy)
***************
*** 0 ****
--- 1,17 ----
+ ! { dg-do compile }
+ ! { dg-options "-fcoarray=lib -lcaf_single" }
+ !
+ ! Test the fix for PR83319
+ !
+ module foo_module
+ implicit none
+ type foo
+ integer, allocatable :: i(:)
+ end type
+ end module
+
+ use foo_module
+ implicit none
+ type(foo), save :: bar[*]
+ allocate(bar%i(1)) ! Used to ICE here.
+ end
