Index: gcc/fortran/resolve.c =================================================================== --- gcc/fortran/resolve.c (revision 164634) +++ gcc/fortran/resolve.c (working copy) @@ -7570,7 +7570,11 @@ resolve_assoc_var (gfc_symbol* sym, bool sym->attr.target = (tsym->attr.target || tsym->attr.pointer); } - sym->ts = target->ts; + /* Get type if this was not already set. Note that it can be + some other type than the target in case this is a SELECT TYPE + selector! So we must not update when the type is already there. */ + if (sym->ts.type == BT_UNKNOWN) + sym->ts = target->ts; gcc_assert (sym->ts.type != BT_UNKNOWN); /* See if this is a valid association-to-variable. */ @@ -7673,8 +7677,8 @@ resolve_select_type (gfc_code *code, gfc error++; continue; } - else - default_case = body; + + default_case = body; } } Index: gcc/testsuite/gfortran.dg/select_type_18.f03 =================================================================== --- gcc/testsuite/gfortran.dg/select_type_18.f03 (revision 0) +++ gcc/testsuite/gfortran.dg/select_type_18.f03 (revision 0) @@ -0,0 +1,90 @@ +! { dg-do compile } + +! PR fortran/45783 +! PR fortran/45795 +! This used to fail because of incorrect compile-time typespec on the +! SELECT TYPE selector. + +! This is the test-case from PR 45795. +! Contributed by Salvatore Filippone, sfilippone@uniroma2.it. + +module base_mod + + type :: base + integer :: m, n + end type base + +end module base_mod + +module s_base_mod + + use base_mod + + type, extends(base) :: s_base + contains + procedure, pass(a) :: cp_to_foo => s_base_cp_to_foo + + end type s_base + + + type, extends(s_base) :: s_foo + + integer :: nnz + integer, allocatable :: ia(:), ja(:) + real, allocatable :: val(:) + + contains + + procedure, pass(a) :: cp_to_foo => s_cp_foo_to_foo + + end type s_foo + + + interface + subroutine s_base_cp_to_foo(a,b,info) + import :: s_base, s_foo + class(s_base), intent(in) :: a + class(s_foo), intent(inout) :: b + integer, intent(out) :: info + end subroutine s_base_cp_to_foo + end interface + + interface + subroutine s_cp_foo_to_foo(a,b,info) + import :: s_foo + class(s_foo), intent(in) :: a + class(s_foo), intent(inout) :: b + integer, intent(out) :: info + end subroutine s_cp_foo_to_foo + end interface + +end module s_base_mod + + +subroutine trans2(a,b) + use s_base_mod + implicit none + + class(s_base), intent(out) :: a + class(base), intent(in) :: b + + type(s_foo) :: tmp + integer err_act, info + + + info = 0 + select type(b) + class is (s_base) + call b%cp_to_foo(tmp,info) + class default + info = -1 + write(*,*) 'Invalid dynamic type' + end select + + if (info /= 0) write(*,*) 'Error code ',info + + return + +end subroutine trans2 + +! { dg-final { cleanup-modules "base_mod s_base_mod" } }