[Patch, Fortran, OOP] PR 57306: ICE on valid with class pointer initialization

[Patch, Fortran, OOP] PR 57306: ICE on valid with class pointer initialization

[Janus Weil]

[-- Attachment #1: Type: text/plain, Size: 661 bytes --]

Hi all,

here is a fix for class pointer initialization. The problem was that
'gfc_get_symbol_decl' did not recognize class pointers properly. The
first version of the patch posted in the PR induced problems with NULL
initialization of class pointers, which are fixed by the attached
second version.

Regtested on x86_64-unknown-linux-gnu. Ok for trunk?

Cheers,
Janus


2013-07-26  Janus Weil  <janus@gcc.gnu.org>

    PR fortran/57306
    * trans-decl.c (gfc_get_symbol_decl): Treat class pointers.
    * trans-expr.c (gfc_conv_initializer): Ditto.

2013-07-26  Janus Weil  <janus@gcc.gnu.org>

    PR fortran/57306
    * gfortran.dg/pointer_init_8.f90: New.

[-- Attachment #2: pr57306_v2.diff --]
[-- Type: application/octet-stream, Size: 1741 bytes --]

Index: gcc/fortran/trans-decl.c
===================================================================
--- gcc/fortran/trans-decl.c	(revision 201253)
+++ gcc/fortran/trans-decl.c	(working copy)
@@ -1491,14 +1491,16 @@ gfc_get_symbol_decl (gfc_symbol * sym)
 	 SAVE is specified otherwise they need to be reinitialized
 	 every time the procedure is entered. The TREE_STATIC is
 	 in this case due to -fmax-stack-var-size=.  */
+      bool ptr = sym->attr.pointer || sym->attr.allocatable
+		 || (sym->ts.type == BT_CLASS
+		     && CLASS_DATA (sym)->attr.class_pointer);
+						  
       DECL_INITIAL (decl) = gfc_conv_initializer (sym->value, &sym->ts,
 						  TREE_TYPE (decl),
 						  sym->attr.dimension
 						  || (sym->attr.codimension
 						      && sym->attr.allocatable),
-						  sym->attr.pointer
-						  || sym->attr.allocatable,
-						  sym->attr.proc_pointer);
+						  ptr, sym->attr.proc_pointer);
     }
 
   if (!TREE_STATIC (decl)
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c	(revision 201253)
+++ gcc/fortran/trans-expr.c	(working copy)
@@ -5664,7 +5664,18 @@ gfc_conv_initializer (gfc_expr * expr, gfc_typespe
   else if (pointer || procptr)
     {
       if (!expr || expr->expr_type == EXPR_NULL)
-	return fold_convert (type, null_pointer_node);
+	{
+	  if (ts->type == BT_CLASS)
+	    {
+	      gfc_init_se (&se, NULL);
+	      gfc_conv_structure (&se, gfc_class_null_initializer(ts, expr), 1);
+	      gcc_assert (TREE_CODE (se.expr) == CONSTRUCTOR);
+	      TREE_STATIC (se.expr) = 1;
+	      return se.expr;
+	    }
+	  else
+	    return fold_convert (type, null_pointer_node);
+	}
       else
 	{
 	  gfc_init_se (&se, NULL);

[-- Attachment #3: pointer_init_8.f90 --]
[-- Type: application/octet-stream, Size: 277 bytes --]

! { dg-do compile }
!
! PR 57306: [OOP] ICE on valid with class pointer initialization
!
! Contributed by Andrew Benson <abensonca@gmail.com>

module t
  type :: c
  end type c
  type(c), target :: cd
  class(c), pointer :: cc => cd
end

! { dg-final { cleanup-modules "t" } }

Re: [Patch, Fortran, OOP] PR 57306: ICE on valid with class pointer initialization

[Tobias Burnus]

Hi Janus,

Janus Weil wrote:
> here is a fix for class pointer initialization.

I think the patch looks reasonable. However, as soon as I try to use the 
variable, I get an ICE in write_global_declarations -> symtab_get_node. 
It works if one moves the targets into a module.

I wonder whether there is an ordering problem of the decl or something 
else. The dump has:

   static struct __class_MAIN___C_p cc = &cd;
   struct c cd;
   static struct __class_MAIN___C_p dc = ⅆ
   struct d dd;

Additionally, the CLASS are wrongly initialized: You only set "_data" 
(indirectly as it is the first field/component of the class) but you do 
not set the _vptr component. Hence, the my example fails at run time

Tobias

PS: The test case. With module - fails at run time for same_type_as. 
Without module - one gets an ICE.

!module m
   type :: c
   end type c
   type, extends(c) :: d
   end type d
   type(c), target :: cd
   type(d), target :: dd
!end module m

!  use m
   class(c), pointer :: cc => cd
   class(c), pointer :: dc => dd

   if(.not. associated(cc, cd)) call abort()   ! OK
   if(.not. same_type_as(cc, cd)) call abort() ! Fails
   if(.not. associated(dc, dd)) call abort()   ! OK
   if(.not. same_type_as(dc, dd)) call abort() ! Fails
end

Re: [Patch, Fortran, OOP] PR 57306: ICE on valid with class pointer initialization

[Janus Weil]

[-- Attachment #1: Type: text/plain, Size: 822 bytes --]

Hi Tobias,

>> here is a fix for class pointer initialization.
>
> I think the patch looks reasonable.

well, it may appear so ...


> Additionally, the CLASS are wrongly initialized: You only set "_data"
> (indirectly as it is the first field/component of the class) but you do not
> set the _vptr component.

... but as you point out, it clearly produces wrong code :(

The attached new version should do the right thing now. At least it
shows the correct dump for the original test case as well as yours. It
is currently being regtested.


> PS: The test case. With module - fails at run time for same_type_as. Without
> module - one gets an ICE.

This now gives the correct run-time behavior with the module, but
still ICEs without. Unfortunately I have no idea why ...

Anyway, thanks for your review.

Cheers,
Janus

[-- Attachment #2: pr57306_v3.diff --]
[-- Type: application/octet-stream, Size: 2676 bytes --]

Index: gcc/fortran/class.c
===================================================================
--- gcc/fortran/class.c	(revision 201283)
+++ gcc/fortran/class.c	(working copy)
@@ -430,6 +430,8 @@ gfc_class_null_initializer (gfc_typespec *ts, gfc_
 
   if (is_unlimited_polymorphic && init_expr)
     vtab = gfc_find_intrinsic_vtab (&ts->u.derived->components->ts);
+  else if (init_expr && init_expr->expr_type != EXPR_NULL)
+    vtab = gfc_find_derived_vtab (init_expr->ts.u.derived);
   else
     vtab = gfc_find_derived_vtab (ts->u.derived);
 
@@ -442,6 +444,8 @@ gfc_class_null_initializer (gfc_typespec *ts, gfc_
       gfc_constructor *ctor = gfc_constructor_get();
       if (strcmp (comp->name, "_vptr") == 0 && vtab)
 	ctor->expr = gfc_lval_expr_from_sym (vtab);
+      else if (init_expr && init_expr->expr_type != EXPR_NULL)
+	  ctor->expr = gfc_copy_expr (init_expr);
       else
 	ctor->expr = gfc_get_null_expr (NULL);
       gfc_constructor_append (&init->value.constructor, ctor);
Index: gcc/fortran/trans-decl.c
===================================================================
--- gcc/fortran/trans-decl.c	(revision 201283)
+++ gcc/fortran/trans-decl.c	(working copy)
@@ -1491,14 +1491,16 @@ gfc_get_symbol_decl (gfc_symbol * sym)
 	 SAVE is specified otherwise they need to be reinitialized
 	 every time the procedure is entered. The TREE_STATIC is
 	 in this case due to -fmax-stack-var-size=.  */
+      bool ptr = sym->attr.pointer || sym->attr.allocatable
+		 || (sym->ts.type == BT_CLASS
+		     && CLASS_DATA (sym)->attr.class_pointer);
+						  
       DECL_INITIAL (decl) = gfc_conv_initializer (sym->value, &sym->ts,
 						  TREE_TYPE (decl),
 						  sym->attr.dimension
 						  || (sym->attr.codimension
 						      && sym->attr.allocatable),
-						  sym->attr.pointer
-						  || sym->attr.allocatable,
-						  sym->attr.proc_pointer);
+						  ptr, sym->attr.proc_pointer);
     }
 
   if (!TREE_STATIC (decl)
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c	(revision 201283)
+++ gcc/fortran/trans-expr.c	(working copy)
@@ -5663,7 +5663,15 @@ gfc_conv_initializer (gfc_expr * expr, gfc_typespe
     }
   else if (pointer || procptr)
     {
-      if (!expr || expr->expr_type == EXPR_NULL)
+      if (ts->type == BT_CLASS)
+	{
+	  gfc_init_se (&se, NULL);
+	  gfc_conv_structure (&se, gfc_class_null_initializer(ts, expr), 1);
+	  gcc_assert (TREE_CODE (se.expr) == CONSTRUCTOR);
+	  TREE_STATIC (se.expr) = 1;
+	  return se.expr;
+	}
+      else if (!expr || expr->expr_type == EXPR_NULL)
 	return fold_convert (type, null_pointer_node);
       else
 	{

Re: [Patch, Fortran, OOP] PR 57306: ICE on valid with class pointer initialization

[Janus Weil]

2013/7/29 Janus Weil <janus@gcc.gnu.org>:
> Hi Tobias,
>
>>> here is a fix for class pointer initialization.
>>
>> I think the patch looks reasonable.
>
> well, it may appear so ...
>
>
>> Additionally, the CLASS are wrongly initialized: You only set "_data"
>> (indirectly as it is the first field/component of the class) but you do not
>> set the _vptr component.
>
> ... but as you point out, it clearly produces wrong code :(
>
> The attached new version should do the right thing now. At least it
> shows the correct dump for the original test case as well as yours. It
> is currently being regtested.

unfortunately it shows a couple of runtime problems with type-bound operators:

FAIL: gfortran.dg/class_defined_operator_1.f03  -O0  execution test
FAIL: gfortran.dg/typebound_operator_13.f03  -O0  execution test
FAIL: gfortran.dg/typebound_operator_7.f03  -O0  execution test
FAIL: gfortran.dg/typebound_operator_8.f03  -O0  execution test
FAIL: gfortran.dg/typebound_operator_9.f03  -O0  execution test


> gfortran-4.9 class_defined_operator_1.f03
> ./a.out

Program received signal SIGSEGV: Segmentation fault - invalid memory reference.


Will investigate ...

Cheers,
Janus

Re: [Patch, Fortran, OOP] PR 57306: ICE on valid with class pointer initialization

[Janus Weil]

[-- Attachment #1: Type: text/plain, Size: 903 bytes --]

>> The attached new version should do the right thing now. At least it
>> shows the correct dump for the original test case as well as yours. It
>> is currently being regtested.
>
> unfortunately it shows a couple of runtime problems with type-bound operators:
>
> FAIL: gfortran.dg/class_defined_operator_1.f03  -O0  execution test
> FAIL: gfortran.dg/typebound_operator_13.f03  -O0  execution test
> FAIL: gfortran.dg/typebound_operator_7.f03  -O0  execution test
> FAIL: gfortran.dg/typebound_operator_8.f03  -O0  execution test
> FAIL: gfortran.dg/typebound_operator_9.f03  -O0  execution test

The attached update fixes it, and thus should hopefully be
regression-free. It also renames 'gfc_class_null_initializer' to
'gfc_class_initializer', since it now also does other initializations
beside EXPR_NULL.

Will do another regtest to make sure it's clean. Ok for trunk if it passes?

Cheers,
Janus

[-- Attachment #2: pr57306_v4.diff --]
[-- Type: application/octet-stream, Size: 4699 bytes --]

Index: gcc/fortran/class.c
===================================================================
--- gcc/fortran/class.c	(revision 201283)
+++ gcc/fortran/class.c	(working copy)
@@ -412,12 +412,12 @@ gfc_is_class_container_ref (gfc_expr *e)
 }
 
 
-/* Build a NULL initializer for CLASS pointers,
-   initializing the _data component to NULL and
-   the _vptr component to the declared type.  */
+/* Build an initializer for CLASS pointers,
+   initializing the _data component to the init_expr (or NULL) and the _vptr
+   component to the corresponding type (or the declared type, given by ts).  */
 
 gfc_expr *
-gfc_class_null_initializer (gfc_typespec *ts, gfc_expr *init_expr)
+gfc_class_initializer (gfc_typespec *ts, gfc_expr *init_expr)
 {
   gfc_expr *init;
   gfc_component *comp;
@@ -430,6 +430,8 @@ gfc_expr *
 
   if (is_unlimited_polymorphic && init_expr)
     vtab = gfc_find_intrinsic_vtab (&ts->u.derived->components->ts);
+  else if (init_expr && init_expr->expr_type != EXPR_NULL)
+    vtab = gfc_find_derived_vtab (init_expr->ts.u.derived);
   else
     vtab = gfc_find_derived_vtab (ts->u.derived);
 
@@ -442,6 +444,8 @@ gfc_expr *
       gfc_constructor *ctor = gfc_constructor_get();
       if (strcmp (comp->name, "_vptr") == 0 && vtab)
 	ctor->expr = gfc_lval_expr_from_sym (vtab);
+      else if (init_expr && init_expr->expr_type != EXPR_NULL)
+	  ctor->expr = gfc_copy_expr (init_expr);
       else
 	ctor->expr = gfc_get_null_expr (NULL);
       gfc_constructor_append (&init->value.constructor, ctor);
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(revision 201283)
+++ gcc/fortran/gfortran.h	(working copy)
@@ -2983,7 +2983,7 @@ void gfc_add_class_array_ref (gfc_expr *);
 bool gfc_is_class_array_ref (gfc_expr *, bool *);
 bool gfc_is_class_scalar_expr (gfc_expr *);
 bool gfc_is_class_container_ref (gfc_expr *e);
-gfc_expr *gfc_class_null_initializer (gfc_typespec *, gfc_expr *);
+gfc_expr *gfc_class_initializer (gfc_typespec *, gfc_expr *);
 unsigned int gfc_hash_value (gfc_symbol *);
 bool gfc_build_class_symbol (gfc_typespec *, symbol_attribute *,
 				gfc_array_spec **, bool);
Index: gcc/fortran/trans-decl.c
===================================================================
--- gcc/fortran/trans-decl.c	(revision 201283)
+++ gcc/fortran/trans-decl.c	(working copy)
@@ -1491,14 +1491,16 @@ gfc_get_symbol_decl (gfc_symbol * sym)
 	 SAVE is specified otherwise they need to be reinitialized
 	 every time the procedure is entered. The TREE_STATIC is
 	 in this case due to -fmax-stack-var-size=.  */
+      bool ptr = sym->attr.pointer || sym->attr.allocatable
+		 || (sym->ts.type == BT_CLASS
+		     && CLASS_DATA (sym)->attr.class_pointer);
+						  
       DECL_INITIAL (decl) = gfc_conv_initializer (sym->value, &sym->ts,
 						  TREE_TYPE (decl),
 						  sym->attr.dimension
 						  || (sym->attr.codimension
 						      && sym->attr.allocatable),
-						  sym->attr.pointer
-						  || sym->attr.allocatable,
-						  sym->attr.proc_pointer);
+						  ptr, sym->attr.proc_pointer);
     }
 
   if (!TREE_STATIC (decl)
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c	(revision 201283)
+++ gcc/fortran/trans-expr.c	(working copy)
@@ -5663,7 +5663,15 @@ gfc_conv_initializer (gfc_expr * expr, gfc_typespe
     }
   else if (pointer || procptr)
     {
-      if (!expr || expr->expr_type == EXPR_NULL)
+      if (ts->type == BT_CLASS && !procptr)
+	{
+	  gfc_init_se (&se, NULL);
+	  gfc_conv_structure (&se, gfc_class_initializer (ts, expr), 1);
+	  gcc_assert (TREE_CODE (se.expr) == CONSTRUCTOR);
+	  TREE_STATIC (se.expr) = 1;
+	  return se.expr;
+	}
+      else if (!expr || expr->expr_type == EXPR_NULL)
 	return fold_convert (type, null_pointer_node);
       else
 	{
@@ -5682,7 +5690,7 @@ gfc_conv_initializer (gfc_expr * expr, gfc_typespe
 	case BT_CLASS:
 	  gfc_init_se (&se, NULL);
 	  if (ts->type == BT_CLASS && expr->expr_type == EXPR_NULL)
-	    gfc_conv_structure (&se, gfc_class_null_initializer(ts, expr), 1);
+	    gfc_conv_structure (&se, gfc_class_initializer (ts, expr), 1);
 	  else
 	    gfc_conv_structure (&se, expr, 1);
 	  gcc_assert (TREE_CODE (se.expr) == CONSTRUCTOR);
@@ -5992,7 +6000,7 @@ gfc_trans_subcomponent_assign (tree dest, gfc_comp
     {
       /* NULL initialization for CLASS components.  */
       tmp = gfc_trans_structure_assign (dest,
-					gfc_class_null_initializer (&cm->ts, expr));
+					gfc_class_initializer (&cm->ts, expr));
       gfc_add_expr_to_block (&block, tmp);
     }
   else if (cm->attr.dimension && !cm->attr.proc_pointer)

Re: [Patch, Fortran, OOP] PR 57306: ICE on valid with class pointer initialization

[Janus Weil]

[-- Attachment #1: Type: text/plain, Size: 1606 bytes --]

2013/7/30 Janus Weil <janus@gcc.gnu.org>:
>>> The attached new version should do the right thing now. At least it
>>> shows the correct dump for the original test case as well as yours. It
>>> is currently being regtested.
>>
>> unfortunately it shows a couple of runtime problems with type-bound operators:
>>
>> FAIL: gfortran.dg/class_defined_operator_1.f03  -O0  execution test
>> FAIL: gfortran.dg/typebound_operator_13.f03  -O0  execution test
>> FAIL: gfortran.dg/typebound_operator_7.f03  -O0  execution test
>> FAIL: gfortran.dg/typebound_operator_8.f03  -O0  execution test
>> FAIL: gfortran.dg/typebound_operator_9.f03  -O0  execution test
>
> The attached update fixes it, and thus should hopefully be
> regression-free. It also renames 'gfc_class_null_initializer' to
> 'gfc_class_initializer', since it now also does other initializations
> beside EXPR_NULL.
>
> Will do another regtest to make sure it's clean.

No failures observed. As a test case I'm using now Tobias' extended
version (attached). New ChangeLog below.

Ok for trunk?

Cheers,
Janus


2013-07-30  Janus Weil  <janus@gcc.gnu.org>

    PR fortran/57306
    * class.c (gfc_class_null_initializer): Rename to
    'gfc_class_initializer'. Treat non-NULL init-exprs.
    * gfortran.h (gfc_class_null_initializer): Update prototype.
    * trans-decl.c (gfc_get_symbol_decl): Treat class pointers.
    * trans-expr.c (gfc_conv_initializer): Ditto.
    (gfc_trans_subcomponent_assign): Renamed gfc_class_null_initializer.

2013-07-30  Janus Weil  <janus@gcc.gnu.org>

    PR fortran/57306
    * gfortran.dg/pointer_init_8.f90: New.

[-- Attachment #2: pr57306_v4.diff --]
[-- Type: application/octet-stream, Size: 4699 bytes --]

Index: gcc/fortran/class.c
===================================================================
--- gcc/fortran/class.c	(revision 201283)
+++ gcc/fortran/class.c	(working copy)
@@ -412,12 +412,12 @@ gfc_is_class_container_ref (gfc_expr *e)
 }
 
 
-/* Build a NULL initializer for CLASS pointers,
-   initializing the _data component to NULL and
-   the _vptr component to the declared type.  */
+/* Build an initializer for CLASS pointers,
+   initializing the _data component to the init_expr (or NULL) and the _vptr
+   component to the corresponding type (or the declared type, given by ts).  */
 
 gfc_expr *
-gfc_class_null_initializer (gfc_typespec *ts, gfc_expr *init_expr)
+gfc_class_initializer (gfc_typespec *ts, gfc_expr *init_expr)
 {
   gfc_expr *init;
   gfc_component *comp;
@@ -430,6 +430,8 @@ gfc_expr *
 
   if (is_unlimited_polymorphic && init_expr)
     vtab = gfc_find_intrinsic_vtab (&ts->u.derived->components->ts);
+  else if (init_expr && init_expr->expr_type != EXPR_NULL)
+    vtab = gfc_find_derived_vtab (init_expr->ts.u.derived);
   else
     vtab = gfc_find_derived_vtab (ts->u.derived);
 
@@ -442,6 +444,8 @@ gfc_expr *
       gfc_constructor *ctor = gfc_constructor_get();
       if (strcmp (comp->name, "_vptr") == 0 && vtab)
 	ctor->expr = gfc_lval_expr_from_sym (vtab);
+      else if (init_expr && init_expr->expr_type != EXPR_NULL)
+	  ctor->expr = gfc_copy_expr (init_expr);
       else
 	ctor->expr = gfc_get_null_expr (NULL);
       gfc_constructor_append (&init->value.constructor, ctor);
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(revision 201283)
+++ gcc/fortran/gfortran.h	(working copy)
@@ -2983,7 +2983,7 @@ void gfc_add_class_array_ref (gfc_expr *);
 bool gfc_is_class_array_ref (gfc_expr *, bool *);
 bool gfc_is_class_scalar_expr (gfc_expr *);
 bool gfc_is_class_container_ref (gfc_expr *e);
-gfc_expr *gfc_class_null_initializer (gfc_typespec *, gfc_expr *);
+gfc_expr *gfc_class_initializer (gfc_typespec *, gfc_expr *);
 unsigned int gfc_hash_value (gfc_symbol *);
 bool gfc_build_class_symbol (gfc_typespec *, symbol_attribute *,
 				gfc_array_spec **, bool);
Index: gcc/fortran/trans-decl.c
===================================================================
--- gcc/fortran/trans-decl.c	(revision 201283)
+++ gcc/fortran/trans-decl.c	(working copy)
@@ -1491,14 +1491,16 @@ gfc_get_symbol_decl (gfc_symbol * sym)
 	 SAVE is specified otherwise they need to be reinitialized
 	 every time the procedure is entered. The TREE_STATIC is
 	 in this case due to -fmax-stack-var-size=.  */
+      bool ptr = sym->attr.pointer || sym->attr.allocatable
+		 || (sym->ts.type == BT_CLASS
+		     && CLASS_DATA (sym)->attr.class_pointer);
+						  
       DECL_INITIAL (decl) = gfc_conv_initializer (sym->value, &sym->ts,
 						  TREE_TYPE (decl),
 						  sym->attr.dimension
 						  || (sym->attr.codimension
 						      && sym->attr.allocatable),
-						  sym->attr.pointer
-						  || sym->attr.allocatable,
-						  sym->attr.proc_pointer);
+						  ptr, sym->attr.proc_pointer);
     }
 
   if (!TREE_STATIC (decl)
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c	(revision 201283)
+++ gcc/fortran/trans-expr.c	(working copy)
@@ -5663,7 +5663,15 @@ gfc_conv_initializer (gfc_expr * expr, gfc_typespe
     }
   else if (pointer || procptr)
     {
-      if (!expr || expr->expr_type == EXPR_NULL)
+      if (ts->type == BT_CLASS && !procptr)
+	{
+	  gfc_init_se (&se, NULL);
+	  gfc_conv_structure (&se, gfc_class_initializer (ts, expr), 1);
+	  gcc_assert (TREE_CODE (se.expr) == CONSTRUCTOR);
+	  TREE_STATIC (se.expr) = 1;
+	  return se.expr;
+	}
+      else if (!expr || expr->expr_type == EXPR_NULL)
 	return fold_convert (type, null_pointer_node);
       else
 	{
@@ -5682,7 +5690,7 @@ gfc_conv_initializer (gfc_expr * expr, gfc_typespe
 	case BT_CLASS:
 	  gfc_init_se (&se, NULL);
 	  if (ts->type == BT_CLASS && expr->expr_type == EXPR_NULL)
-	    gfc_conv_structure (&se, gfc_class_null_initializer(ts, expr), 1);
+	    gfc_conv_structure (&se, gfc_class_initializer (ts, expr), 1);
 	  else
 	    gfc_conv_structure (&se, expr, 1);
 	  gcc_assert (TREE_CODE (se.expr) == CONSTRUCTOR);
@@ -5992,7 +6000,7 @@ gfc_trans_subcomponent_assign (tree dest, gfc_comp
     {
       /* NULL initialization for CLASS components.  */
       tmp = gfc_trans_structure_assign (dest,
-					gfc_class_null_initializer (&cm->ts, expr));
+					gfc_class_initializer (&cm->ts, expr));
       gfc_add_expr_to_block (&block, tmp);
     }
   else if (cm->attr.dimension && !cm->attr.proc_pointer)

[-- Attachment #3: pointer_init_8.f90 --]
[-- Type: application/octet-stream, Size: 573 bytes --]

! { dg-do compile }
!
! PR 57306: [OOP] ICE on valid with class pointer initialization
!
! Contributed by Andrew Benson <abensonca@gmail.com>

module m
  type :: c
  end type c
  type, extends(c) :: d
  end type d
  type(c), target :: x
  type(d), target :: y
end module m

 use m
  class(c), pointer :: px => x
  class(c), pointer :: py => y

  if (.not. associated(px, x))   call abort()
  if (.not. same_type_as(px, x)) call abort()
  if (.not. associated(py, y))   call abort()
  if (.not. same_type_as(py, y)) call abort()
end 

! { dg-final { cleanup-modules "m" } }

Re: [Patch, Fortran, OOP] PR 57306: ICE on valid with class pointer initialization

[Janus Weil]

ping!


2013/7/30 Janus Weil <janus@gcc.gnu.org>:
>> The attached update fixes it, and thus should hopefully be
>> regression-free. It also renames 'gfc_class_null_initializer' to
>> 'gfc_class_initializer', since it now also does other initializations
>> beside EXPR_NULL.
>>
>> Will do another regtest to make sure it's clean.
>
> No failures observed. As a test case I'm using now Tobias' extended
> version (attached). New ChangeLog below.
>
> Ok for trunk?
>
> Cheers,
> Janus
>
>
> 2013-07-30  Janus Weil  <janus@gcc.gnu.org>
>
>     PR fortran/57306
>     * class.c (gfc_class_null_initializer): Rename to
>     'gfc_class_initializer'. Treat non-NULL init-exprs.
>     * gfortran.h (gfc_class_null_initializer): Update prototype.
>     * trans-decl.c (gfc_get_symbol_decl): Treat class pointers.
>     * trans-expr.c (gfc_conv_initializer): Ditto.
>     (gfc_trans_subcomponent_assign): Renamed gfc_class_null_initializer.
>
> 2013-07-30  Janus Weil  <janus@gcc.gnu.org>
>
>     PR fortran/57306
>     * gfortran.dg/pointer_init_8.f90: New.

Re: [Patch, Fortran, OOP] PR 57306: ICE on valid with class pointer initialization

[Tobias Burnus]

Janus Weil wrote:
> ping!

Sorry, I currently have only a shaky internet connection and also no 
access to my development system.

Looking at gfc_class_initializer, I have the impression that it does not 
handle initialization of unlimited polymorphic variables/components. I 
don't know whether initialization is permitted, but my feeling is that 
the following should work:

type t
   class(*), pointer :: x
end type t
type(t), target :: y
integer,target :: z
type(t) :: x = t(y)
type(t) :: x = t(z)
class(*), pointer :: a => y

And I have the feeling that it is not correctly treated - but I might be 
wrong. (Note to the example above: I believe "t(y)" is a valid structure 
constructor, which is not yet supported. But again, I might be wrong 
about either.)


Regarding the example: Does it now work when the target and the pointer 
are in the same scoping unit? Or does one still need to place the 
targets into the module?

> 2013/7/30 Janus Weil <janus@gcc.gnu.org>:
>>> The attached update fixes it, and thus should hopefully be
>>> regression-free. It also renames 'gfc_class_null_initializer' to
>>> 'gfc_class_initializer', since it now also does other initializations
>>> beside EXPR_NULL.
>>>
>>> Will do another regtest to make sure it's clean.
>> No failures observed. As a test case I'm using now Tobias' extended
>> version (attached). New ChangeLog below.

Well, the test case does not check whether it works. You either need to 
check the dump - or you need to use dg-do run.

Tobias

>>
>> 2013-07-30  Janus Weil  <janus@gcc.gnu.org>
>>
>>      PR fortran/57306
>>      * class.c (gfc_class_null_initializer): Rename to
>>      'gfc_class_initializer'. Treat non-NULL init-exprs.
>>      * gfortran.h (gfc_class_null_initializer): Update prototype.
>>      * trans-decl.c (gfc_get_symbol_decl): Treat class pointers.
>>      * trans-expr.c (gfc_conv_initializer): Ditto.
>>      (gfc_trans_subcomponent_assign): Renamed gfc_class_null_initializer.
>>
>> 2013-07-30  Janus Weil  <janus@gcc.gnu.org>
>>
>>      PR fortran/57306
>>      * gfortran.dg/pointer_init_8.f90: New.

Re: [Patch, Fortran, OOP] PR 57306: ICE on valid with class pointer initialization

[Janus Weil]

Hi Tobias,

> Sorry, I currently have only a shaky internet connection and also no access
> to my development system.

sounds like holidays :)


> Looking at gfc_class_initializer, I have the impression that it does not
> handle initialization of unlimited polymorphic variables/components. I don't
> know whether initialization is permitted, but my feeling is that the
> following should work:
>
> type t
>   class(*), pointer :: x
> end type t
> type(t), target :: y
> integer,target :: z
> type(t) :: x = t(y)
> type(t) :: x = t(z)
> class(*), pointer :: a => y
>
> And I have the feeling that it is not correctly treated - but I might be
> wrong. (Note to the example above: I believe "t(y)" is a valid structure
> constructor, which is not yet supported. But again, I might be wrong about
> either.)

Your example yields (with and without the current patch):

tobias2.f90:7.17:

type(t) :: x = t(y)
                 1
Error: Can't convert TYPE(t) to CLASS(*) at (1)
tobias2.f90:8.17:

type(t) :: x = t(z)
                 1
Error: Can't convert INTEGER(4) to CLASS(*) at (1)


In fact the patch does not really handle unlimited polymorphics. I
suspect several fixes might be needed to get your test case running.
Is it ok to do this in a follow-up patch?


> Regarding the example: Does it now work when the target and the pointer are
> in the same scoping unit? Or does one still need to place the targets into
> the module?

Well, they will work as soon as PR 55207 is fixed (there is a working
patch already, which hopefully can be committed soon).



>>> No failures observed. As a test case I'm using now Tobias' extended
>>> version (attached). New ChangeLog below.
>
> Well, the test case does not check whether it works. You either need to
> check the dump - or you need to use dg-do run.

Good point. The intention was to use dg-do run, of course.


Anyway, thanks for the review. Is it ok to commit the patch as is and
defer the treatment of unlimited polymorphics into a follow-up patch?

Cheers,
Janus



>>> 2013-07-30  Janus Weil  <janus@gcc.gnu.org>
>>>
>>>      PR fortran/57306
>>>      * class.c (gfc_class_null_initializer): Rename to
>>>      'gfc_class_initializer'. Treat non-NULL init-exprs.
>>>      * gfortran.h (gfc_class_null_initializer): Update prototype.
>>>      * trans-decl.c (gfc_get_symbol_decl): Treat class pointers.
>>>      * trans-expr.c (gfc_conv_initializer): Ditto.
>>>      (gfc_trans_subcomponent_assign): Renamed gfc_class_null_initializer.
>>>
>>> 2013-07-30  Janus Weil  <janus@gcc.gnu.org>
>>>
>>>      PR fortran/57306
>>>      * gfortran.dg/pointer_init_8.f90: New.
>
>

Re: [Patch, Fortran, OOP] PR 57306: ICE on valid with class pointer initialization

[Janus Weil]

>> Looking at gfc_class_initializer, I have the impression that it does not
>> handle initialization of unlimited polymorphic variables/components. I don't
>> know whether initialization is permitted, but my feeling is that the
>> following should work:
>>
>> type t
>>   class(*), pointer :: x
>> end type t
>> type(t), target :: y
>> integer,target :: z
>> type(t) :: x = t(y)
>> type(t) :: x = t(z)
>> class(*), pointer :: a => y
>>
>> And I have the feeling that it is not correctly treated - but I might be
>> wrong. (Note to the example above: I believe "t(y)" is a valid structure
>> constructor, which is not yet supported. But again, I might be wrong about
>> either.)
>
> Your example yields (with and without the current patch):
>
> tobias2.f90:7.17:
>
> type(t) :: x = t(y)
>                  1
> Error: Can't convert TYPE(t) to CLASS(*) at (1)
> tobias2.f90:8.17:
>
> type(t) :: x = t(z)
>                  1
> Error: Can't convert INTEGER(4) to CLASS(*) at (1)

In fact this problem is more similar to PR 49213 than the one under
discussion here. I have added the above test case to PR 49213 as
comment 12.

Cheers,
Janus

Re: [Patch, Fortran, OOP] PR 57306: ICE on valid with class pointer initialization

[Tobias Burnus]

Janus Weil wrote:
> Ok for trunk?

Sorry for the belated review.

+      bool ptr = sym->attr.pointer || sym->attr.allocatable
+		 || (sym->ts.type == BT_CLASS
+		     && CLASS_DATA (sym)->attr.class_pointer);


That looks quite imbalanced. Why do you not take care of 
CLASS_DATA(sym)->attr.allocatable? Actually, shouldn't that always be 
true for BT_CLASS in this context? A BT_CLASS should either be a 
pointer/allocatable or a dummy argument - but the latter is never 
initialized (while being a dummy).

Otherwise, it looks OK to me.

(Don't forget the dg-do compile -> run change.)

 From follow-up emails:
>> type t
>>    class(*), pointer :: x
>> end type t
>> type(t), target :: y
>> integer,target :: z
>> type(t) :: x = t(y)
>> type(t) :: x = t(z)
>> class(*), pointer :: a => y
> Your example yields (with and without the current patch):
>
> type(t) :: x = t(y)
>                   1
> Error: Can't convert TYPE(t) to CLASS(*) at (1)
>
> In fact the patch does not really handle unlimited polymorphics. I
> suspect several fixes might be needed to get your test case running.
> Is it ok to do this in a follow-up patch?

Seems as if there is more work required ... Yes, a follow-up patch is 
fine, but somewhere the omission should be recorded. (As you did in 
PR49213.)

Talking about the example above, the following is similar and may or may 
not be handled:

integer, target :: tgt
type t2
end type t2
type(t2), target :: tgt2
type t
   class(*), pointer :: a => tgt
   class(*), pointer :: b => tgt2
end type t
type(t) :: x
type(t), SAVE :: y
end

>> Regarding the example: Does it now work when the target and the pointer are
>> in the same scoping unit? Or does one still need to place the targets into
>> the module?
> Well, they will work as soon as PR 55207 is fixed (there is a working
> patch already, which hopefully can be committed soon).

Good to know that that is already tracked and being fixed.

Tobias

Re: [Patch, Fortran, OOP] PR 57306: ICE on valid with class pointer initialization

[Janus Weil]

[-- Attachment #1: Type: text/plain, Size: 2029 bytes --]

Hi,

> Sorry for the belated review.
>
> +      bool ptr = sym->attr.pointer || sym->attr.allocatable
> +                || (sym->ts.type == BT_CLASS
> +                    && CLASS_DATA (sym)->attr.class_pointer);
>
>
> That looks quite imbalanced. Why do you not take care of
> CLASS_DATA(sym)->attr.allocatable? Actually, shouldn't that always be true
> for BT_CLASS in this context? A BT_CLASS should either be a
> pointer/allocatable or a dummy argument - but the latter is never
> initialized (while being a dummy).

right. Then it should be ok to just check for BT_CLASS. Updated patch attached.


> Otherwise, it looks OK to me.

Thanks. I will commit the attached version after another regtest.


> (Don't forget the dg-do compile -> run change.)

Done.


> From follow-up emails:
>>>
>>> type t
>>>    class(*), pointer :: x
>>> end type t
>>> type(t), target :: y
>>> integer,target :: z
>>> type(t) :: x = t(y)
>>> type(t) :: x = t(z)
>>> class(*), pointer :: a => y
>>
>> Your example yields (with and without the current patch):
>>
>> type(t) :: x = t(y)
>>                   1
>> Error: Can't convert TYPE(t) to CLASS(*) at (1)
>>
>> In fact the patch does not really handle unlimited polymorphics. I
>> suspect several fixes might be needed to get your test case running.
>> Is it ok to do this in a follow-up patch?
>
>
> Seems as if there is more work required ... Yes, a follow-up patch is fine,
> but somewhere the omission should be recorded. (As you did in PR49213.)
>
> Talking about the example above, the following is similar and may or may not
> be handled:
>
> integer, target :: tgt
> type t2
> end type t2
> type(t2), target :: tgt2
> type t
>   class(*), pointer :: a => tgt
>   class(*), pointer :: b => tgt2
> end type t
> type(t) :: x
> type(t), SAVE :: y
> end

In addition to the can't-convert error, this one also gives

integer, target :: tgt
                      1
Internal Error at (1):

but I don't directly see why. I will also add it to the above PR to
keep track of it.

Cheers,
Janus

[-- Attachment #2: pr57306_v5.diff --]
[-- Type: application/octet-stream, Size: 4747 bytes --]

Index: gcc/fortran/class.c
===================================================================
--- gcc/fortran/class.c	(revision 201504)
+++ gcc/fortran/class.c	(working copy)
@@ -412,12 +412,12 @@ gfc_is_class_container_ref (gfc_expr *e)
 }
 
 
-/* Build a NULL initializer for CLASS pointers,
-   initializing the _data component to NULL and
-   the _vptr component to the declared type.  */
+/* Build an initializer for CLASS pointers,
+   initializing the _data component to the init_expr (or NULL) and the _vptr
+   component to the corresponding type (or the declared type, given by ts).  */
 
 gfc_expr *
-gfc_class_null_initializer (gfc_typespec *ts, gfc_expr *init_expr)
+gfc_class_initializer (gfc_typespec *ts, gfc_expr *init_expr)
 {
   gfc_expr *init;
   gfc_component *comp;
@@ -430,6 +430,8 @@ gfc_expr *
 
   if (is_unlimited_polymorphic && init_expr)
     vtab = gfc_find_intrinsic_vtab (&ts->u.derived->components->ts);
+  else if (init_expr && init_expr->expr_type != EXPR_NULL)
+    vtab = gfc_find_derived_vtab (init_expr->ts.u.derived);
   else
     vtab = gfc_find_derived_vtab (ts->u.derived);
 
@@ -442,6 +444,8 @@ gfc_expr *
       gfc_constructor *ctor = gfc_constructor_get();
       if (strcmp (comp->name, "_vptr") == 0 && vtab)
 	ctor->expr = gfc_lval_expr_from_sym (vtab);
+      else if (init_expr && init_expr->expr_type != EXPR_NULL)
+	  ctor->expr = gfc_copy_expr (init_expr);
       else
 	ctor->expr = gfc_get_null_expr (NULL);
       gfc_constructor_append (&init->value.constructor, ctor);
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(revision 201504)
+++ gcc/fortran/gfortran.h	(working copy)
@@ -2983,7 +2983,7 @@ void gfc_add_class_array_ref (gfc_expr *);
 bool gfc_is_class_array_ref (gfc_expr *, bool *);
 bool gfc_is_class_scalar_expr (gfc_expr *);
 bool gfc_is_class_container_ref (gfc_expr *e);
-gfc_expr *gfc_class_null_initializer (gfc_typespec *, gfc_expr *);
+gfc_expr *gfc_class_initializer (gfc_typespec *, gfc_expr *);
 unsigned int gfc_hash_value (gfc_symbol *);
 bool gfc_build_class_symbol (gfc_typespec *, symbol_attribute *,
 				gfc_array_spec **, bool);
Index: gcc/fortran/trans-decl.c
===================================================================
--- gcc/fortran/trans-decl.c	(revision 201504)
+++ gcc/fortran/trans-decl.c	(working copy)
@@ -1491,14 +1491,14 @@ gfc_get_symbol_decl (gfc_symbol * sym)
 	 SAVE is specified otherwise they need to be reinitialized
 	 every time the procedure is entered. The TREE_STATIC is
 	 in this case due to -fmax-stack-var-size=.  */
+
       DECL_INITIAL (decl) = gfc_conv_initializer (sym->value, &sym->ts,
-						  TREE_TYPE (decl),
-						  sym->attr.dimension
-						  || (sym->attr.codimension
-						      && sym->attr.allocatable),
-						  sym->attr.pointer
-						  || sym->attr.allocatable,
-						  sym->attr.proc_pointer);
+				    TREE_TYPE (decl), sym->attr.dimension
+				    || (sym->attr.codimension
+					&& sym->attr.allocatable),
+				    sym->attr.pointer || sym->attr.allocatable
+				    || sym->ts.type == BT_CLASS,
+				    sym->attr.proc_pointer);
     }
 
   if (!TREE_STATIC (decl)
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c	(revision 201504)
+++ gcc/fortran/trans-expr.c	(working copy)
@@ -5664,7 +5664,15 @@ gfc_conv_initializer (gfc_expr * expr, gfc_typespe
     }
   else if (pointer || procptr)
     {
-      if (!expr || expr->expr_type == EXPR_NULL)
+      if (ts->type == BT_CLASS && !procptr)
+	{
+	  gfc_init_se (&se, NULL);
+	  gfc_conv_structure (&se, gfc_class_initializer (ts, expr), 1);
+	  gcc_assert (TREE_CODE (se.expr) == CONSTRUCTOR);
+	  TREE_STATIC (se.expr) = 1;
+	  return se.expr;
+	}
+      else if (!expr || expr->expr_type == EXPR_NULL)
 	return fold_convert (type, null_pointer_node);
       else
 	{
@@ -5683,7 +5691,7 @@ gfc_conv_initializer (gfc_expr * expr, gfc_typespe
 	case BT_CLASS:
 	  gfc_init_se (&se, NULL);
 	  if (ts->type == BT_CLASS && expr->expr_type == EXPR_NULL)
-	    gfc_conv_structure (&se, gfc_class_null_initializer(ts, expr), 1);
+	    gfc_conv_structure (&se, gfc_class_initializer (ts, expr), 1);
 	  else
 	    gfc_conv_structure (&se, expr, 1);
 	  gcc_assert (TREE_CODE (se.expr) == CONSTRUCTOR);
@@ -5993,7 +6001,7 @@ gfc_trans_subcomponent_assign (tree dest, gfc_comp
     {
       /* NULL initialization for CLASS components.  */
       tmp = gfc_trans_structure_assign (dest,
-					gfc_class_null_initializer (&cm->ts, expr));
+					gfc_class_initializer (&cm->ts, expr));
       gfc_add_expr_to_block (&block, tmp);
     }
   else if (cm->attr.dimension && !cm->attr.proc_pointer)

[-- Attachment #3: pointer_init_8.f90 --]
[-- Type: application/octet-stream, Size: 569 bytes --]

! { dg-do run }
!
! PR 57306: [OOP] ICE on valid with class pointer initialization
!
! Contributed by Andrew Benson <abensonca@gmail.com>

module m
  type :: c
  end type c
  type, extends(c) :: d
  end type d
  type(c), target :: x
  type(d), target :: y
end module m

 use m
  class(c), pointer :: px => x
  class(c), pointer :: py => y

  if (.not. associated(px, x))   call abort()
  if (.not. same_type_as(px, x)) call abort()
  if (.not. associated(py, y))   call abort()
  if (.not. same_type_as(py, y)) call abort()
end 

! { dg-final { cleanup-modules "m" } }

Re: [Patch, Fortran, OOP] PR 57306: ICE on valid with class pointer initialization

[Janus Weil]

>> Sorry for the belated review.
>>
>> +      bool ptr = sym->attr.pointer || sym->attr.allocatable
>> +                || (sym->ts.type == BT_CLASS
>> +                    && CLASS_DATA (sym)->attr.class_pointer);
>>
>>
>> That looks quite imbalanced. Why do you not take care of
>> CLASS_DATA(sym)->attr.allocatable? Actually, shouldn't that always be true
>> for BT_CLASS in this context? A BT_CLASS should either be a
>> pointer/allocatable or a dummy argument - but the latter is never
>> initialized (while being a dummy).
>
> right. Then it should be ok to just check for BT_CLASS. Updated patch attached.
>
>
>> Otherwise, it looks OK to me.
>
> Thanks. I will commit the attached version after another regtest.

Committed as r201521.


Cheers,
Janus