MODULE cast_mini


IMPLICIT NONE

TYPE :: List_T
  INTEGER :: idx
END TYPE List_T

TYPE, EXTENDS(List_T) :: ExtList_T
  REAL :: value
END TYPE ExtList_T

TYPE, EXTENDS(ExtList_T) :: FurList_T
  LOGICAL :: foo
END TYPE FurList_T

! INTERFACE cast_any
!   MODULE PROCEDURE Cast_ListFur
!   MODULE PROCEDURE Cast_ExtFur
! END INTERFACE cast_any

 CONTAINS

FUNCTION Cast_ListExt(in) RESULT(out)
  CLASS(List_T),  INTENT(IN), POINTER :: in
  CLASS(ExtList_T), POINTER :: out
  out => null()
  IF (.NOT. ASSOCIATED(in)) RETURN
  SELECT TYPE(in)
    CLASS IS (ExtList_T)
      out => in
    CLASS DEFAULT
      WRITE(*,*) "Problem while trying to downcast!"
  END SELECT  
END FUNCTION Cast_ListExt

FUNCTION Cast_ListFur(in) RESULT(out)
  CLASS(List_T),  INTENT(IN), POINTER :: in
  CLASS(FurList_T), POINTER :: out
  out => null()
  IF (.NOT. ASSOCIATED(in)) RETURN
  SELECT TYPE(in)
    CLASS IS (FurList_T)
      out => in
    CLASS DEFAULT
      WRITE(*,*) "Problem while trying to downcast!"
  END SELECT  
END FUNCTION Cast_ListFur

FUNCTION Cast_ExtFur(in) RESULT(out)
  CLASS(ExtList_T),  INTENT(IN), POINTER :: in
  CLASS(FurList_T), POINTER :: out
  out => null()
  IF (.NOT. ASSOCIATED(in)) RETURN
  SELECT TYPE(in)
    CLASS IS (FurList_T)
      out => in
    CLASS DEFAULT
      WRITE(*,*) "Problem while trying to downcast!"
  END SELECT  
END FUNCTION Cast_ExtFur


END MODULE
 