diff options
author | Paul Thomas <pault@gcc.gnu.org> | 2020-03-05 11:01:59 +0100 |
---|---|---|
committer | Thomas König <tkoenig@gcc.gnu.org> | 2020-03-05 11:04:09 +0100 |
commit | 7beafc829c5b122298093ba517023015611aeca8 (patch) | |
tree | e8567a37168d11caeb6a338918d55c9655ac5f15 | |
parent | e19f06538c51fed54240a4e98277e62daa00d9b3 (diff) | |
download | gcc-7beafc829c5b122298093ba517023015611aeca8.zip gcc-7beafc829c5b122298093ba517023015611aeca8.tar.gz gcc-7beafc829c5b122298093ba517023015611aeca8.tar.bz2 |
Fix ICE in trans_associate_var
2020-03-05 Paul Thomas <pault@gcc.gnu.org>
Backport from trunk
PR fortran/92976
* match.c (select_type_set_tmp): Variable 'selector' to replace
select_type_stack->selector. If the selector array spec has
explicit bounds, make the temporary's bounds deferred.
2020-03-05 Paul Thomas <pault@gcc.gnu.org>
Backport from trunk
PR fortran/92976
* gfortran.dg/select_type_48.f90 : New test.
-rw-r--r-- | gcc/fortran/ChangeLog | 8 | ||||
-rw-r--r-- | gcc/fortran/match.c | 26 | ||||
-rw-r--r-- | gcc/testsuite/ChangeLog | 6 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/select_type_48.f90 | 31 |
4 files changed, 61 insertions, 10 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 8fccf0d..b3ccda4 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2020-03-05 Paul Thomas <pault@gcc.gnu.org> + + Backport from trunk + PR fortran/92976 + * match.c (select_type_set_tmp): Variable 'selector' to replace + select_type_stack->selector. If the selector array spec has + explicit bounds, make the temporary's bounds deferred. + 2020-02-19 Mark Eggleston <markeggleston@gcc.gnu.org> Backported from mainline diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index efc0c2d..088b69f 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -6165,6 +6165,7 @@ select_type_set_tmp (gfc_typespec *ts) { char name[GFC_MAX_SYMBOL_LEN]; gfc_symtree *tmp = NULL; + gfc_symbol *selector = select_type_stack->selector; if (!ts) { @@ -6186,22 +6187,27 @@ select_type_set_tmp (gfc_typespec *ts) gfc_get_sym_tree (name, gfc_current_ns, &tmp, false); gfc_add_type (tmp->n.sym, ts, NULL); - if (select_type_stack->selector->ts.type == BT_CLASS - && select_type_stack->selector->attr.class_ok) + if (selector->ts.type == BT_CLASS && selector->attr.class_ok) { - tmp->n.sym->attr.pointer - = CLASS_DATA (select_type_stack->selector)->attr.class_pointer; + tmp->n.sym->attr.pointer = CLASS_DATA (selector)->attr.class_pointer; /* Copy across the array spec to the selector. */ - if (CLASS_DATA (select_type_stack->selector)->attr.dimension - || CLASS_DATA (select_type_stack->selector)->attr.codimension) + if (CLASS_DATA (selector)->attr.dimension + || CLASS_DATA (selector)->attr.codimension) { tmp->n.sym->attr.dimension - = CLASS_DATA (select_type_stack->selector)->attr.dimension; + = CLASS_DATA (selector)->attr.dimension; tmp->n.sym->attr.codimension - = CLASS_DATA (select_type_stack->selector)->attr.codimension; - tmp->n.sym->as - = gfc_copy_array_spec (CLASS_DATA (select_type_stack->selector)->as); + = CLASS_DATA (selector)->attr.codimension; + if (CLASS_DATA (selector)->as->type != AS_EXPLICIT) + tmp->n.sym->as + = gfc_copy_array_spec (CLASS_DATA (selector)->as); + else + { + tmp->n.sym->as = gfc_get_array_spec(); + tmp->n.sym->as->rank = CLASS_DATA (selector)->as->rank; + tmp->n.sym->as->type = AS_DEFERRED; + } } } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index eca8fc0..ec8328c 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2020-03-05 Paul Thomas <pault@gcc.gnu.org> + + Backport from trunk + PR fortran/92976 + * gfortran.dg/select_type_48.f90 : New test. + 2020-03-04 Martin Sebor <msebor@redhat.com> PR c++/90938 diff --git a/gcc/testsuite/gfortran.dg/select_type_48.f90 b/gcc/testsuite/gfortran.dg/select_type_48.f90 new file mode 100644 index 0000000..d9ad01c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/select_type_48.f90 @@ -0,0 +1,31 @@ +! { dg-do run } +! +! Test the fix for PR92976, in which the TYPE IS statement caused an ICE +! because of the explicit bounds of 'x'. +! +! Contributed by Gerhard Steinmetz <gscfq@t-online.de> +! +program p + type t + integer :: i + end type + class(t), allocatable :: c(:) + allocate (c, source = [t(1111),t(2222),t(3333)]) + call s(c) + if (sum (c%i) .ne. 3333) stop 1 +contains + subroutine s(x) + class(t) :: x(2) + select type (x) +! ICE as compiler attempted to assign descriptor to an array + type is (t) + x%i = 0 +! Make sure that bounds are correctly translated. + call counter (x) + end select + end + subroutine counter (arg) + type(t) :: arg(:) + if (size (arg, 1) .ne. 2) stop 2 + end +end |