diff options
| author | Paul Thomas <pault@pc30.home> | 2020-02-23 10:27:37 +0000 |
|---|---|---|
| committer | Paul Thomas <pault@pc30.home> | 2020-02-23 15:26:59 +0000 |
| commit | 61c8d9e4e5f540501eaa98aae1d6c74bde7d4299 (patch) | |
| tree | 2423e0ab193d90c86395ac2a852c7bb931153fbf /gcc | |
| parent | cd6016713aaae242660afb8ec69e17f61b2c2ad0 (diff) | |
| download | gcc-61c8d9e4e5f540501eaa98aae1d6c74bde7d4299.zip gcc-61c8d9e4e5f540501eaa98aae1d6c74bde7d4299.tar.gz gcc-61c8d9e4e5f540501eaa98aae1d6c74bde7d4299.tar.bz2 | |
Patch for PR57710
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/trans-array.c | 26 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/same_type_as_3.f03 | 27 |
2 files changed, 51 insertions, 2 deletions
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 6659816..0449d28 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -8827,7 +8827,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, cdesc = gfc_create_var (cdesc, "cdesc"); DECL_ARTIFICIAL (cdesc) = 1; - + gfc_add_modify (&tmpblock, gfc_conv_descriptor_dtype (cdesc), gfc_get_dtype_rank_type (1, tmp)); gfc_conv_descriptor_lbound_set (&tmpblock, cdesc, @@ -8838,7 +8838,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, gfc_index_one_node); gfc_conv_descriptor_ubound_set (&tmpblock, cdesc, gfc_index_zero_node, ubound); - + if (attr->dimension) comp = gfc_conv_descriptor_data_get (comp); else @@ -9116,10 +9116,14 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, && (CLASS_DATA (c)->attr.allocatable || CLASS_DATA (c)->attr.class_pointer)) { + tree vptr_decl; + /* Allocatable CLASS components. */ comp = fold_build3_loc (input_location, COMPONENT_REF, ctype, decl, cdecl, NULL_TREE); + vptr_decl = gfc_class_vptr_get (comp); + comp = gfc_class_data_get (comp); if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (comp))) gfc_conv_descriptor_data_set (&fnblock, comp, @@ -9131,6 +9135,24 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, build_int_cst (TREE_TYPE (comp), 0)); gfc_add_expr_to_block (&fnblock, tmp); } + + /* The dynamic type of a disassociated pointer or unallocated + allocatable variable is its declared type. An unlimited + polymorphic entity has no declared type. */ + if (!UNLIMITED_POLY (c)) + { + vtab = gfc_find_derived_vtab (c->ts.u.derived); + if (!vtab->backend_decl) + gfc_get_symbol_decl (vtab); + tmp = gfc_build_addr_expr (NULL_TREE, vtab->backend_decl); + } + else + tmp = build_int_cst (TREE_TYPE (vptr_decl), 0); + + tmp = fold_build2_loc (input_location, MODIFY_EXPR, + void_type_node, vptr_decl, tmp); + gfc_add_expr_to_block (&fnblock, tmp); + cmp_has_alloc_comps = false; } /* Coarrays need the component to be nulled before the api-call diff --git a/gcc/testsuite/gfortran.dg/same_type_as_3.f03 b/gcc/testsuite/gfortran.dg/same_type_as_3.f03 new file mode 100644 index 0000000..3a81e74 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/same_type_as_3.f03 @@ -0,0 +1,27 @@ +! { dg-do run } +! +! Test the fix for PR57710. +! +! Contributed by Tobias Burnus <burnus@gcc.gnu.org> +! +module m + type t + end type t + type t2 + integer :: ii + class(t), allocatable :: x + end type t2 +contains + subroutine fini(x) + type(t) :: x + end subroutine fini +end module m + +use m +block + type(t) :: z + type(t2) :: y + y%ii = 123 + if (.not. same_type_as(y%x, z)) call abort () +end block +end |