Attachment 39581 Details for Bug 57117 – Shorter version to fix the issue.

[patch] Shorter version to fix the issue.

pr57117_v1.patch (text/plain), 3.38 KB, created by vehre on 2016-09-07 13:40:55 UTC

(hide)

Description:

Filename:

MIME Type:

Creator: vehre

Created: 2016-09-07 13:40:55 UTC

Size: 3.38 KB

patch

obsolete

>diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
>index 396edf2..da92a5d 100644
>--- a/gcc/fortran/primary.c
>+++ b/gcc/fortran/primary.c
>@@ -2359,6 +2359,10 @@ gfc_expr_attr (gfc_expr *e)
> 	      attr.allocatable = CLASS_DATA (sym)->attr.allocatable;
> 	    }
> 	}
>+      else if (e->value.function.isym
>+	       && e->value.function.isym->transformational
>+	       && e->ts.type == BT_CLASS)
>+	attr = CLASS_DATA (e)->attr;
>       else
> 	attr = gfc_variable_attr (e, NULL);
> 
>diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
>index d4ff85c..12db8de 100644
>--- a/gcc/fortran/trans-intrinsic.c
>+++ b/gcc/fortran/trans-intrinsic.c
>@@ -5279,6 +5279,23 @@ conv_generic_with_optional_char_arg (gfc_se* se, gfc_expr* expr,
>   gfc_conv_procedure_call (se, sym, expr->value.function.actual, expr,
> 			  append_args);
>   gfc_free_symbol (sym);
>+
>+  /* Retrieve the correct vptr for class objects.  */
>+  if (prim_arg->expr->ts.type == BT_CLASS)
>+    {
>+      gfc_se parmse;
>+      gfc_expr *class_expr
>+			  = gfc_find_and_cut_at_last_class_ref (prim_arg->expr);
>+
>+      gfc_init_se (&parmse, NULL);
>+      parmse.data_not_needed = 1;
>+      parmse.want_pointer = 1;
>+      gfc_conv_expr (&parmse, class_expr);
>+      if (!DECL_LANG_SPECIFIC (se->expr))
>+	gfc_allocate_lang_decl (se->expr);
>+      GFC_DECL_SAVED_DESCRIPTOR (se->expr) = parmse.expr;
>+      gfc_free_expr (class_expr);
>+    }
> }
> 
> 
>diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
>index 8e5428a..3eef54d 100644
>--- a/gcc/fortran/trans-stmt.c
>+++ b/gcc/fortran/trans-stmt.c
>@@ -5435,7 +5435,10 @@ gfc_trans_allocate (gfc_code * code)
> 	  if (code->expr3->rank != 0
> 	      && ((!attr.allocatable && !attr.pointer)
> 		  || (code->expr3->expr_type == EXPR_FUNCTION
>-		      && code->expr3->ts.type != BT_CLASS)))
>+		      && (code->expr3->ts.type != BT_CLASS
>+			  || (code->expr3->value.function.isym
>+			      && code->expr3->value.function.isym
>+							 ->transformational)))))
> 	    gfc_conv_expr_descriptor (&se, code->expr3);
> 	  else
> 	    gfc_conv_expr_reference (&se, code->expr3);
>@@ -5551,6 +5554,7 @@ gfc_trans_allocate (gfc_code * code)
> 	  else
> 	    {
> 	      rhs = gfc_find_and_cut_at_last_class_ref (code->expr3);
>+
> 	      gfc_add_vptr_component (rhs);
> 	      gfc_init_se (&se, NULL);
> 	      se.want_pointer = 1;
>diff --git a/gcc/testsuite/gfortran.dg/class_allocate_21.f90 b/gcc/testsuite/gfortran.dg/class_allocate_21.f90
>new file mode 100644
>index 0000000..a8ed291
>--- /dev/null
>+++ b/gcc/testsuite/gfortran.dg/class_allocate_21.f90
>@@ -0,0 +1,21 @@
>+! { dg-do run }
>+!
>+! Testcase for pr57117
>+
>+implicit none
>+
>+  type :: ti
>+    integer :: i
>+  end type
>+
>+  class(ti), allocatable :: x(:,:), z(:)
>+  integer :: i
>+
>+  allocate(x(3,3))
>+  x%i = reshape([( i, i = 1, 9 )], [3, 3])
>+  allocate(z(9), source=reshape(x, (/ 9 /)))
>+
>+  if (any( z%i /= [( i, i = 1, 9 )])) call abort()
>+  deallocate (x, z)
>+end
>+
>diff --git a/gcc/testsuite/gfortran.dg/class_allocate_22.f90 b/gcc/testsuite/gfortran.dg/class_allocate_22.f90
>new file mode 100644
>index 0000000..0aa2395
>--- /dev/null
>+++ b/gcc/testsuite/gfortran.dg/class_allocate_22.f90
>@@ -0,0 +1,19 @@
>+! { dg-do run }
>+!
>+! Check pr57117 is fixed.
>+
>+program pr57117
>+  implicit none
>+
>+  type :: ti
>+  end type
>+
>+  class(ti), allocatable :: x(:,:), y(:,:)
>+
>+  allocate(x(2,6))
>+  allocate(y, source=transpose(x))
>+
>+  if (any( ubound(y) /= [6,2])) call abort()
>+  deallocate (x,y)
>+end
>+

Actions: View | Diff

Attachments on bug 57117: 29977 | 36609 | 36618 | 39581