re PR fortran/64980 (ICE in trans-expr.c)

2015-02-22  Bernd Edlinger  <bernd.edlinger@hotmail.de>

        PR fortran/64980
        PR fortran/61960
        * trans-expr.c (gfc_apply_interface_mapping_to_expr): Remove mapping
        for component references to class objects.
        (gfc_conv_procedure_call): Compare the class by name.

testsuite:
2015-02-22  Bernd Edlinger  <bernd.edlinger@hotmail.de>

        PR fortran/64980
        PR fortran/61960
        * gfortran.dg/pr61960.f90: New.
        * gfortran.dg/pr64230.f90: New.
        * gfortran.dg/pr64980.f03: New.

From-SVN: r220899

gcc/fortran/ChangeLog

+2015-02-22  Bernd Edlinger  <bernd.edlinger@hotmail.de>
+
+	PR fortran/64980
+	PR fortran/61960
+	* trans-expr.c (gfc_apply_interface_mapping_to_expr): Remove mapping
+	for component references to class objects.
+	(gfc_conv_procedure_call): Compare the class by name.
+
 2015-02-13  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
 	PR fortran/64506

gcc/fortran/trans-expr.c

@@ -3783,10 +3783,6 @@ gfc_apply_interface_mapping_to_expr (gfc_interface_mapping * mapping,
 	  expr->symtree = sym->new_sym;
 	else if (sym->expr)
 	  gfc_replace_expr (expr, gfc_copy_expr (sym->expr));
-	/* Replace base type for polymorphic arguments.  */
-	if (expr->ref && expr->ref->type == REF_COMPONENT
-	    && sym->expr && sym->expr->ts.type == BT_CLASS)
-	  expr->ref->u.c.sym = sym->expr->ts.u.derived;
       }
 
       /* ...and to subexpressions in expr->value.  */
@@ -4541,10 +4537,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 			   && fsym->ts.type == BT_CLASS
 			   && !CLASS_DATA (fsym)->as
 			   && !CLASS_DATA (e)->as
-			   && (CLASS_DATA (fsym)->attr.class_pointer
-			       != CLASS_DATA (e)->attr.class_pointer
-			       || CLASS_DATA (fsym)->attr.allocatable
-				  != CLASS_DATA (e)->attr.allocatable))
+			   && strcmp (fsym->ts.u.derived->name,
+				      e->ts.u.derived->name))
 		    {
 		      type = gfc_typenode_for_spec (&fsym->ts);
 		      var = gfc_create_var (type, fsym->name);

gcc/testsuite/ChangeLog

+2015-02-22  Bernd Edlinger  <bernd.edlinger@hotmail.de>
+
+	PR fortran/64980
+	PR fortran/61960
+	* gfortran.dg/pr61960.f90: New.
+	* gfortran.dg/pr64230.f90: New.
+	* gfortran.dg/pr64980.f03: New.
+
 2015-02-22  Tom de Vries  <tom@codesourcery.com>
 
 	* gcc.dg/pr30957-1.c: Make pr30957-1.c pass rather xfail.

gcc/testsuite/gfortran.dg/pr61960.f90

+! { dg-do compile }
+
+module data_func_mod
+    implicit none
+    integer, parameter :: sp = 4
+    type :: data_type
+        real(kind=sp), pointer, dimension(:, :) :: data => null()
+        integer :: nr_rows = 0, nr_cols = 0
+    end type data_type
+
+contains
+
+    function get_row(this, i) result(row)
+        implicit none
+        type(data_type), intent(in) :: this
+        integer, intent(in) :: i
+        real(kind=sp), dimension(this%nr_cols) :: row
+        row = this%data(:, i)
+    end function get_row
+
+    subroutine print_matrix(m, i, fmt_str)
+        implicit none
+        class(data_type), intent(in) :: m
+        integer, intent(in) :: i
+        character(len=20), intent(in) :: fmt_str
+        write (unit=6, fmt=fmt_str) get_row(m, i)
+    end subroutine print_matrix
+
+end module data_func_mod

gcc/testsuite/gfortran.dg/pr64230.f90

+! { dg-do run }
+Module m
+  Implicit None
+  Type, Public :: t1
+    Integer, Allocatable :: i(:)
+  End Type
+  Type, Public :: t2
+    Integer, Allocatable :: i(:)
+  End Type
+  Type, Public :: t3
+    Type (t2) :: t
+  End Type
+  Type, Public :: t4
+  End Type
+  Type, Public, Extends (t4) :: t5
+    Type (t1) :: t_c1
+  End Type
+  Type, Public, Extends (t4) :: t6
+    Type (t5) :: t_c2
+  End Type
+  Type, Public, Extends (t6) :: t7
+    Type (t3) :: t_c3
+  End Type
+End Module
+Program main
+  Use m
+  Implicit None
+  Interface
+    Subroutine s(t)
+      Use m
+      Class (t4), Allocatable, Intent (Out) :: t
+    End Subroutine
+  End Interface
+  Class (t4), Allocatable :: t
+  Call s(t)
+  Deallocate (t)
+End Program
+Subroutine s(t)
+  Use m
+  Class (t4), Allocatable, Intent (Out) :: t
+  Allocate (t7 :: t)
+End Subroutine

gcc/testsuite/gfortran.dg/pr64980.f03

+! { dg-do compile }
+
+  implicit none
+
+  type :: muli_trapezium_t
+     integer::dim=0
+  end type
+
+  type, extends (muli_trapezium_t) :: muli_trapezium_node_class_t
+  end type
+
+  class(muli_trapezium_node_class_t), pointer :: node
+  print *,get_d_value_array(node)
+
+contains
+
+  function get_d_value_array (this) result (subarray)
+    class(muli_trapezium_t), intent(in) :: this
+    real, dimension(this%dim) :: subarray
+  end function
+
+end