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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 962f7fb6028b422d70dcd806f585c360fdafceac..4f216d94cae4c65c2630897e4c6c29ea968c81a8 100644 (file)
--- 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 7c0381698cb5b89250aa141f66d29bf9fdb63413..7ec9e969c71e0f1a38b72d821bc1a3317492c588 100644 (file)
--- 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 1e622066da5c6982ebb4eae81737b7a2ff07d708..9cb109ef0346295138f25efc4f462daf4835f3eb 100644 (file)
--- 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 (file)
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