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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index b6dd48089e93c9a35159f82b8c5113fc94ebb536..d80c59bab292bc4653f35e61c25c58eb5d968f72 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+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

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index d6f84ff04def738e255edcb52cc3bc4c8c7f0052..db04b30671d96a3420d100110f4c781fa81b6939 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/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);

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 5ef35b9292dad4055cdf4feeaf7f6a36e94b0d22..77c891f60c95cd5eaa7b379ff8f3b6f6b798a67a 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+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.

diff --git a/gcc/testsuite/gfortran.dg/pr61960.f90 b/gcc/testsuite/gfortran.dg/pr61960.f90
new file mode 100644 (file)
index 0000000..000ff93
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr61960.f90
@@ -0,0 +1,29 @@
+! { 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

diff --git a/gcc/testsuite/gfortran.dg/pr64230.f90 b/gcc/testsuite/gfortran.dg/pr64230.f90
new file mode 100644 (file)
index 0000000..afa44e8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr64230.f90
@@ -0,0 +1,42 @@
+! { 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

diff --git a/gcc/testsuite/gfortran.dg/pr64980.f03 b/gcc/testsuite/gfortran.dg/pr64980.f03
new file mode 100644 (file)
index 0000000..85e6128
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr64980.f03
@@ -0,0 +1,22 @@
+! { 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