public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc(refs/vendors/ibm/heads/perf)] Patch for PR57710
@ 2020-03-19 5:48 Jiu Fu Guo
0 siblings, 0 replies; only message in thread
From: Jiu Fu Guo @ 2020-03-19 5:48 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:61c8d9e4e5f540501eaa98aae1d6c74bde7d4299
commit 61c8d9e4e5f540501eaa98aae1d6c74bde7d4299
Author: Paul Thomas <pault@pc30.home>
Date: Sun Feb 23 10:27:37 2020 +0000
Patch for PR57710
Diff:
---
gcc/fortran/trans-array.c | 26 ++++++++++++++++++++++++--
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 66598161fd8..0449d281bf7 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 00000000000..3a81e749763
--- /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
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2020-03-19 5:48 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2020-03-19 5:48 [gcc(refs/vendors/ibm/heads/perf)] Patch for PR57710 Jiu Fu Guo
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).