From: Paul Thomas Date: Mon, 1 Jan 2018 17:36:41 +0000 (+0000) Subject: re PR fortran/83076 (ICE in gfc_deallocate_scalar_with_status, at fortran/trans.c... X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=f549bfb3db5524f71d1d29f4a3adc99ffcebfd87;p=gcc.git re PR fortran/83076 (ICE in gfc_deallocate_scalar_with_status, at fortran/trans.c:1598) 2018-01-01 Paul Thomas 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. 2018-01-01 Paul Thomas PR fortran/83076 * gfortran.dg/coarray_45.f90 : New test. PR fortran/83319 * gfortran.dg/coarray_46.f90 : New test. From-SVN: r256065 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 678ffc68469..ad2ff35b610 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,20 @@ +2018-01-01 Paul Thomas + + 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-28 Steven G. Kargl PR Fortran/83548 diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 7b837c9fe50..662d34f7c0a 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -870,7 +870,7 @@ typedef struct 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; + has_dtio_procs:1, caf_token:1; /* This is a temporary selector for SELECT TYPE or an associate variable for SELECT_TYPE or ASSOCIATE. */ diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index cf75a78d7ba..c1d8a426dc9 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -13993,6 +13993,31 @@ resolve_fl_derived0 (gfc_symbol *sym) 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) diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index 6868329575b..73f75ccf58b 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -1837,7 +1837,7 @@ gfc_get_array_descriptor_base (int dimen, int codimen, bool restricted) TREE_NO_WARNING (decl) = 1; } - if (flag_coarray == GFC_FCOARRAY_LIB && codimen) + if (flag_coarray == GFC_FCOARRAY_LIB) { decl = gfc_add_field_to_struct_1 (fat_type, get_identifier ("token"), @@ -2373,6 +2373,7 @@ gfc_copy_dt_decls_ifequal (gfc_symbol *from, gfc_symbol *to, 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 @@ -2483,6 +2484,10 @@ gfc_get_derived_type (gfc_symbol * derived, int codimen) 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); @@ -2677,7 +2682,9 @@ gfc_get_derived_type (gfc_symbol * derived, int codimen) 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; + 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 @@ -2762,19 +2769,6 @@ gfc_get_derived_type (gfc_symbol * derived, int codimen) && !(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. */ @@ -2800,6 +2794,24 @@ gfc_get_derived_type (gfc_symbol * derived, int codimen) 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); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 416bcd592eb..e4dd14f7e15 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2018-01-01 Paul Thomas + + PR fortran/83076 + * gfortran.dg/coarray_45.f90 : New test. + + PR fortran/83319 + * gfortran.dg/coarray_46.f90 : New test. + 2018-01-01 Jakub Jelinek PR tree-optimization/83581 diff --git a/gcc/testsuite/gfortran.dg/coarray_45.f90 b/gcc/testsuite/gfortran.dg/coarray_45.f90 new file mode 100644 index 00000000000..87763563efe --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray_45.f90 @@ -0,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 diff --git a/gcc/testsuite/gfortran.dg/coarray_46.f90 b/gcc/testsuite/gfortran.dg/coarray_46.f90 new file mode 100644 index 00000000000..273c6e86840 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray_46.f90 @@ -0,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