From: Bernd Edlinger Date: Sun, 22 Feb 2015 19:38:53 +0000 (+0000) Subject: re PR fortran/64980 (ICE in trans-expr.c) X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=62c4c81aec34c3874fd55ecff937c969658dd75d;p=gcc.git re PR fortran/64980 (ICE in trans-expr.c) 2015-02-22 Bernd Edlinger 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 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 b6dd48089e9..d80c59bab29 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2015-02-22 Bernd Edlinger + + 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 PR fortran/64506 diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index d6f84ff04de..db04b30671d 100644 --- 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 5ef35b9292d..77c891f60c9 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2015-02-22 Bernd Edlinger + + 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 * 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 index 00000000000..000ff93ce5a --- /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 index 00000000000..afa44e8642a --- /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 index 00000000000..85e61289557 --- /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