[fortran] PR57710 - [OOP] [F08] _vptr not set for allocatable CLASS component inside BLOCK

Message ID CAGkQGiKsz-25Sa7f7YOi10kakcKEiqximUqe5_6-1Tqh8Y4rfw@mail.gmail.com
State New
Headers show
Series
  • [fortran] PR57710 - [OOP] [F08] _vptr not set for allocatable CLASS component inside BLOCK
Related show

Commit Message

Paul Richard Thomas Feb. 23, 2020, 11:35 a.m.
This patch is relatively trivial and represents my first foray into
gitland. Thus far, it has been... well, "interesting" compared with
svn.

Class components of derived types are initialized by calls to
trans-array.c(gfc_trans_deferred_array) from
trans-decl.c(gfc_trans_deferred_vars). The components are nullified in
trans-array.c(structure_alloc_comps). The 'same_type_as' intrinsic
requires that nullified class components either point to the declared
type vtable or, in the case of unlimited polymorphic components, the
vptr should be null. See Note 16.28 in the F2018 standard. The
attached patch implements that requirement.

Regtested on FC31/x86_64 - OK for head?

Paul

2020-02-23  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/57710
    * trans-array.c (structure_alloc_comps): When nullifying class
    components, the vptr must point to the declared type or, in the
    case of unlimited polymorphic components, it should be null.

2020-02-23  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/57710
    * gfortran.dg/same_type_as_3.f03 : New test.

Comments

Thomas Koenig Feb. 23, 2020, 2:25 p.m. | #1
Hi Paul,

> Regtested on FC31/x86_64 - OK for head?


Looks good.

Best of luck committing!

Regards

	Thomas
Paul Richard Thomas Feb. 23, 2020, 3:39 p.m. | #2
Committed as r10-6801-g61c8d9e4e5f540501eaa98aae1d6c74bde7d4299

Thanks

Paul

On Sun, 23 Feb 2020 at 14:25, Thomas Koenig <tkoenig@netcologne.de> wrote:
>

> Hi Paul,

>

> > Regtested on FC31/x86_64 - OK for head?

>

> Looks good.

>

> Best of luck committing!

>

> Regards

>

>         Thomas




-- 
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein

Patch

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