When passing a CLASS to a TYPE, the "_data" component wasn't added for
scalar variables. (Polymorphic arrays are/were handled correctly.)
This patch adds the _data, fixing this wrong-code issue.
Build and regtested on x86-64-linux.
OK for the trunk?
Tobias
2012-02-06 Tobias Burnus <bur...@net-b.de>
PR fortran/51514
* trans-expr.c (gfc_conv_procedure_call): Add _data component
for calls of scalar CLASS actuals to TYPE dummies.
2012-02-06 Tobias Burnus <bur...@net-b.de>
PR fortran/51514
* gfortran.dg/class_to_type_2.f90: New.
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c (Revision 183942)
+++ gcc/fortran/trans-expr.c (Arbeitskopie)
@@ -3619,6 +3619,12 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol *
&& CLASS_DATA (e)->attr.dimension)
gfc_conv_class_to_class (&parmse, e, fsym->ts, false);
+ if (fsym && fsym->ts.type == BT_DERIVED
+ && e->ts.type == BT_CLASS
+ && !CLASS_DATA (e)->attr.dimension
+ && !CLASS_DATA (e)->attr.codimension)
+ parmse.expr = gfc_class_data_get (parmse.expr);
+
/* If an ALLOCATABLE dummy argument has INTENT(OUT) and is
allocated on entry, it must be deallocated. */
if (fsym && fsym->attr.allocatable
Index: gcc/testsuite/gfortran.dg/class_to_type_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/class_to_type_2.f90 (Revision 0)
+++ gcc/testsuite/gfortran.dg/class_to_type_2.f90 (Arbeitskopie)
@@ -0,0 +1,97 @@
+! { dg-do run }
+!
+! PR fortran/51514
+!
+! Check that passing a CLASS to a TYPE works
+!
+! Based on a test case of Reinhold Bader.
+!
+
+module mod_subpr
+ implicit none
+
+ type :: foo
+ integer :: i = 2
+ end type
+
+ type, extends(foo) :: foo_1
+ real :: r(2)
+ end type
+
+contains
+
+ subroutine subpr (x)
+ type(foo) :: x
+ x%i = 3
+ end subroutine
+
+ elemental subroutine subpr_elem (x)
+ type(foo), intent(inout):: x
+ x%i = 3
+ end subroutine
+
+ subroutine subpr_array (x)
+ type(foo), intent(inout):: x(:)
+ x(:)%i = 3
+ end subroutine
+
+ subroutine subpr2 (x)
+ type(foo) :: x
+ if (x%i /= 55) call abort ()
+ end subroutine
+
+ subroutine subpr2_array (x)
+ type(foo) :: x(:)
+ if (any(x(:)%i /= 55)) call abort ()
+ end subroutine
+
+ function f ()
+ class(foo), allocatable :: f
+ allocate (f)
+ f%i = 55
+ end function f
+
+ function g () result(res)
+ class(foo), allocatable :: res(:)
+ allocate (res(3))
+ res(:)%i = 55
+ end function g
+end module
+
+program prog
+ use mod_subpr
+ implicit none
+ class(foo), allocatable :: xx, yy(:)
+
+ allocate (foo_1 :: xx)
+ xx%i = 33
+ call subpr (xx)
+ if (xx%i /= 3) call abort ()
+
+ xx%i = 33
+ call subpr_elem (xx)
+ if (xx%i /= 3) call abort ()
+
+ call subpr (f ())
+
+ allocate (foo_1 :: yy(2))
+ yy(:)%i = 33
+ call subpr_elem (yy)
+ if (any (yy%i /= 3)) call abort ()
+
+ yy(:)%i = 33
+ call subpr_elem (yy(1))
+ if (yy(1)%i /= 3) call abort ()
+
+ yy(:)%i = 33
+ call subpr_array (yy)
+ if (any (yy%i /= 3)) call abort ()
+
+ yy(:)%i = 33
+ call subpr_array (yy(1:2))
+ if (any (yy(1:2)%i /= 3)) call abort ()
+
+ call subpr2_array (g ())
+end program
+
+! { dg-final { cleanup-modules "mod_subpr" } }
