gcc/testsuite/gfortran.dg/select_type_20.f90

   1 ! { dg-do compile }
   2 ! PR fortran/45848
   3 ! PR fortran/47204
   4 !
   5 ! Contributed by Harald Anlauf and Zdenek Sojka
   6 !
   7 module gfcbug111
   8   implicit none
   9
  10   type, abstract :: inner_product_class
  11   end type inner_product_class
  12
  13   type, extends(inner_product_class) :: trivial_inner_product_type
  14   end type trivial_inner_product_type
  15
  16 contains
  17
  18   function my_dot_v_v (this,a,b)       ! { dg-error "has no IMPLICIT type" }
  19     class(trivial_inner_product_type), intent(in) :: this
  20     class(vector_class),               intent(in) :: a,b ! { dg-error "Derived type" }
  21     real :: my_dot_v_v
  22
  23     select type (a)                    ! { dg-error "Selector shall be polymorphic" }
  24     class is (trivial_vector_type)     ! { dg-error "Syntax error in CLASS IS" }
  25        select type (b)                 ! { dg-error "Expected TYPE IS" }
  26        class is (trivial_vector_type)  ! { dg-error "Syntax error in CLASS IS" }
  27        class default
  28        end select
  29     class default
  30     end select ! { dg-error "Expecting END FUNCTION" }
  31   end function my_dot_v_v
  32 end module gfcbug111
  33
  34 select type (a)
  35 ! { dg-prune-output "Unexpected end of file" }