Hi all,
attached patch fixes the ICE and the wrong char array length mentioned
in comment #3 of the PR. The issue was that getting the _len component
is valid online for unlimited polymorphic pointers. But here this was
tried for polymorphic entity, which had to fail.
Bootstrapped and regtests ok on trunk, gcc-6-branch, gcc-5-branch,
gcc-4_9-branch. Ok for trunk and one week later for the other branches?
Regards,
Andre
--
Andre Vehreschild * Email: vehre ad gmx dot de
gcc/testsuite/ChangeLog:
2016-07-14 Andre Vehreschild <[email protected]>
PR fortran/70842
* gfortran.dg/select_type_35.f03: New test.
gcc/fortran/ChangeLog:
2016-07-14 Andre Vehreschild <[email protected]>
PR fortran/70842
* simplify.c (gfc_simplify_len): Only for unlimited polymorphic
types replace the expression's _data ref with a _len ref.
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 95a8d10..e3f4d50 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -3816,8 +3816,11 @@ gfc_simplify_len (gfc_expr *e, gfc_expr *kind)
}
else if (e->expr_type == EXPR_VARIABLE && e->ts.type == BT_CHARACTER
&& e->symtree->n.sym
+ && e->symtree->n.sym->ts.type != BT_DERIVED
&& e->symtree->n.sym->assoc && e->symtree->n.sym->assoc->target
- && e->symtree->n.sym->assoc->target->ts.type == BT_DERIVED)
+ && e->symtree->n.sym->assoc->target->ts.type == BT_DERIVED
+ && e->symtree->n.sym->assoc->target->symtree->n.sym
+ && UNLIMITED_POLY (e->symtree->n.sym->assoc->target->symtree->n.sym))
/* The expression in assoc->target points to a ref to the _data component
of the unlimited polymorphic entity. To get the _len component the last
_data ref needs to be stripped and a ref to the _len component added. */
diff --git a/gcc/testsuite/gfortran.dg/select_type_35.f03 b/gcc/testsuite/gfortran.dg/select_type_35.f03
new file mode 100644
index 0000000..92d2f27
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/select_type_35.f03
@@ -0,0 +1,41 @@
+! { dg-do run }
+!
+! Contributed by Nathanael Huebbe
+! Check fix for PR/70842
+
+program foo
+
+ TYPE, ABSTRACT :: t_Intermediate
+ END TYPE t_Intermediate
+
+ type, extends(t_Intermediate) :: t_Foo
+ character(:), allocatable :: string
+ end type t_Foo
+
+ class(t_Foo), allocatable :: obj
+
+ allocate(obj)
+ obj%string = "blabarfoo"
+
+ call bar(obj)
+
+ deallocate(obj)
+contains
+ subroutine bar(me)
+ class(t_Intermediate), target :: me
+
+ class(*), pointer :: alias
+
+ select type(me)
+ type is(t_Foo)
+ if (len(me%string) /= 9) call abort()
+ end select
+
+ alias => me
+ select type(alias)
+ type is(t_Foo)
+ if (len(alias%string) /= 9) call abort()
+ end select
+ end subroutine bar
+end program foo
+
