diff options
| author | Tobias Burnus <burnus@net-b.de> | 2018-10-17 21:58:58 +0200 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2018-10-17 21:58:58 +0200 |
| commit | 91f9b2e0f7054c64e56053993de41b14c5e02226 (patch) | |
| tree | 1b775bb502ec341d64250fa025d0c96f01492905 /gcc | |
| parent | 4026227f21e6c06cbadfa3ac3ab8699719b2bc65 (diff) | |
| download | gcc-91f9b2e0f7054c64e56053993de41b14c5e02226.zip gcc-91f9b2e0f7054c64e56053993de41b14c5e02226.tar.gz gcc-91f9b2e0f7054c64e56053993de41b14c5e02226.tar.bz2 | |
Fix select-type regression
PR fortran/87632
* resolve.c (resolve_select_type): Use correct variable.
PR fortran/87632
* gfortran.dg/select_type_47.f90: New.
From-SVN: r265248
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/fortran/resolve.c | 2 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/select_type_47.f90 | 59 |
4 files changed, 70 insertions, 1 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 962f7fb..4f216d9 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2018-10-17 Tobias Burnus <burnus@net-b.de> + + PR fortran/87632 + * resolve.c (resolve_select_type): Use correct variable. + 2018-10-17 David Malcolm <dmalcolm@redhat.com> * Make-lang.in (selftest-fortran): New. diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 7c03816..7ec9e96 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -8914,7 +8914,7 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns) if (ref2) { if (code->expr1->symtree->n.sym->attr.untyped) - code->expr1->symtree->n.sym->ts = ref->u.c.component->ts; + code->expr1->symtree->n.sym->ts = ref2->u.c.component->ts; selector_type = CLASS_DATA (ref2->u.c.component)->ts.u.derived; } else diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 1e62206..9cb109e 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2018-10-17 Tobias Burnus <burnus@net-b.de> + + PR fortran/87632 + * gfortran.dg/select_type_47.f90: New. + 2018-10-17 Eric Botcazou <ebotcazou@adacore.com> * gcc.c-torture/execute/pr87623.c: New test. diff --git a/gcc/testsuite/gfortran.dg/select_type_47.f90 b/gcc/testsuite/gfortran.dg/select_type_47.f90 new file mode 100644 index 0000000..c7a750e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/select_type_47.f90 @@ -0,0 +1,59 @@ +! { dg-do compile } +! +! PR fortran/87632 +! +! Contributed by Jürgen Reuter +! +module m +type t + integer :: i +end type t +type t2 + type(t) :: phs_config +end type t2 +end module m + +module m2 +use m +implicit none +type t3 +end type t3 + +type process_t + private + type(t2), allocatable :: component(:) +contains + procedure :: get_phs_config => process_get_phs_config +end type process_t + +contains + subroutine process_extract_resonance_history_set & + (process, include_trivial, i_component) + class(process_t), intent(in), target :: process + logical, intent(in), optional :: include_trivial + integer, intent(in), optional :: i_component + integer :: i + i = 1; if (present (i_component)) i = i_component + select type (phs_config => process%get_phs_config (i)) + class is (t) + call foo() + class default + call bar() + end select + end subroutine process_extract_resonance_history_set + + function process_get_phs_config (process, i_component) result (phs_config) + class(t), pointer :: phs_config + class(process_t), intent(in), target :: process + integer, intent(in) :: i_component + if (allocated (process%component)) then + phs_config => process%component(i_component)%phs_config + else + phs_config => null () + end if + end function process_get_phs_config +end module m2 + +program main + use m2 +end program main |