View | Details | Return to bug 57117 | Differences between
and this patch

Collapse All | Expand All

(-)a/gcc/fortran/primary.c (+4 lines)
Lines 2359-2364 gfc_expr_attr (gfc_expr *e) Link Here
2359
	      attr.allocatable = CLASS_DATA (sym)->attr.allocatable;
2359
	      attr.allocatable = CLASS_DATA (sym)->attr.allocatable;
2360
	    }
2360
	    }
2361
	}
2361
	}
2362
      else if (e->value.function.isym
2363
	       && e->value.function.isym->transformational
2364
	       && e->ts.type == BT_CLASS)
2365
	attr = CLASS_DATA (e)->attr;
2362
      else
2366
      else
2363
	attr = gfc_variable_attr (e, NULL);
2367
	attr = gfc_variable_attr (e, NULL);
2364
2368
(-)a/gcc/fortran/trans-intrinsic.c (+17 lines)
Lines 5279-5284 conv_generic_with_optional_char_arg (gfc_se* se, gfc_expr* expr, Link Here
5279
  gfc_conv_procedure_call (se, sym, expr->value.function.actual, expr,
5279
  gfc_conv_procedure_call (se, sym, expr->value.function.actual, expr,
5280
			  append_args);
5280
			  append_args);
5281
  gfc_free_symbol (sym);
5281
  gfc_free_symbol (sym);
5282
5283
  /* Retrieve the correct vptr for class objects.  */
5284
  if (prim_arg->expr->ts.type == BT_CLASS)
5285
    {
5286
      gfc_se parmse;
5287
      gfc_expr *class_expr
5288
			  = gfc_find_and_cut_at_last_class_ref (prim_arg->expr);
5289
5290
      gfc_init_se (&parmse, NULL);
5291
      parmse.data_not_needed = 1;
5292
      parmse.want_pointer = 1;
5293
      gfc_conv_expr (&parmse, class_expr);
5294
      if (!DECL_LANG_SPECIFIC (se->expr))
5295
	gfc_allocate_lang_decl (se->expr);
5296
      GFC_DECL_SAVED_DESCRIPTOR (se->expr) = parmse.expr;
5297
      gfc_free_expr (class_expr);
5298
    }
5282
}
5299
}
5283
5300
5284
5301
(-)a/gcc/fortran/trans-stmt.c (-1 / +5 lines)
Lines 5435-5441 gfc_trans_allocate (gfc_code * code) Link Here
5435
	  if (code->expr3->rank != 0
5435
	  if (code->expr3->rank != 0
5436
	      && ((!attr.allocatable && !attr.pointer)
5436
	      && ((!attr.allocatable && !attr.pointer)
5437
		  || (code->expr3->expr_type == EXPR_FUNCTION
5437
		  || (code->expr3->expr_type == EXPR_FUNCTION
5438
		      && code->expr3->ts.type != BT_CLASS)))
5438
		      && (code->expr3->ts.type != BT_CLASS
5439
			  || (code->expr3->value.function.isym
5440
			      && code->expr3->value.function.isym
5441
							 ->transformational)))))
5439
	    gfc_conv_expr_descriptor (&se, code->expr3);
5442
	    gfc_conv_expr_descriptor (&se, code->expr3);
5440
	  else
5443
	  else
5441
	    gfc_conv_expr_reference (&se, code->expr3);
5444
	    gfc_conv_expr_reference (&se, code->expr3);
Lines 5551-5556 gfc_trans_allocate (gfc_code * code) Link Here
5551
	  else
5554
	  else
5552
	    {
5555
	    {
5553
	      rhs = gfc_find_and_cut_at_last_class_ref (code->expr3);
5556
	      rhs = gfc_find_and_cut_at_last_class_ref (code->expr3);
5557
5554
	      gfc_add_vptr_component (rhs);
5558
	      gfc_add_vptr_component (rhs);
5555
	      gfc_init_se (&se, NULL);
5559
	      gfc_init_se (&se, NULL);
5556
	      se.want_pointer = 1;
5560
	      se.want_pointer = 1;
(-)a/gcc/testsuite/gfortran.dg/class_allocate_21.f90 (+21 lines)
Line 0 Link Here
1
! { dg-do run }
2
!
3
! Testcase for pr57117
4
5
implicit none
6
7
  type :: ti
8
    integer :: i
9
  end type
10
11
  class(ti), allocatable :: x(:,:), z(:)
12
  integer :: i
13
14
  allocate(x(3,3))
15
  x%i = reshape([( i, i = 1, 9 )], [3, 3])
16
  allocate(z(9), source=reshape(x, (/ 9 /)))
17
18
  if (any( z%i /= [( i, i = 1, 9 )])) call abort()
19
  deallocate (x, z)
20
end
21
(-)a/gcc/testsuite/gfortran.dg/class_allocate_22.f90 (+19 lines)
Line 0 Link Here
1
! { dg-do run }
2
!
3
! Check pr57117 is fixed.
4
5
program pr57117
6
  implicit none
7
8
  type :: ti
9
  end type
10
11
  class(ti), allocatable :: x(:,:), y(:,:)
12
13
  allocate(x(2,6))
14
  allocate(y, source=transpose(x))
15
16
  if (any( ubound(y) /= [6,2])) call abort()
17
  deallocate (x,y)
18
end
19

Return to bug 57117