diff mbox series

[Fortan] PR 87632 - fix select type ICE

Message ID 7079a01f-97e3-debc-ad93-441a6348b3c3@net-b.de
State New
Headers show
Series [Fortan] PR 87632 - fix select type ICE | expand

Commit Message

Tobias Burnus Oct. 17, 2018, 7:59 p.m. UTC 
Due to using the wrong variable, gfortran will segfault – as ref is 
always NULL.

Build and regtested on x86-64-gnu-linux.

Committed as obvious in Rev. 265248.

Tobias

Comments

Paul Richard Thomas Oct. 17, 2018, 9:49 p.m. UTC | #1 
Hi Tobias,

Thanks for taking care of that so quickly. Juergen is proving to be a
loyal friend to gfortran by coming back to us so quickly on
regressions and reducing testcases. He deserves a good service.

Cheers

Paul

On Wed, 17 Oct 2018 at 20:59, Tobias Burnus <burnus@net-b.de> wrote:
>
> Due to using the wrong variable, gfortran will segfault – as ref is
> always NULL.
>
> Build and regtested on x86-64-gnu-linux.
>
> Committed as obvious in Rev. 265248.
>
> Tobias
>
diff mbox series

Patch


	PR fortran/87632
	* resolve.c (resolve_select_type): Use correct variable.

	PR fortran/87632
	* gfortran.dg/select_type_47.f90: New.


diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 7c0381698cb..7ec9e969c71 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/gfortran.dg/select_type_47.f90 b/gcc/testsuite/gfortran.dg/select_type_47.f90
new file mode 100644
index 00000000000..c7a750e35ac
--- /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