Index: flang/lib/Semantics/CMakeLists.txt
===================================================================
--- flang/lib/Semantics/CMakeLists.txt
+++ flang/lib/Semantics/CMakeLists.txt
@@ -21,6 +21,7 @@
   check-purity.cpp
   check-return.cpp
   check-select-rank.cpp
+  check-select-type.cpp
   check-stop.cpp
   compute-offsets.cpp
   expression.cpp
Index: flang/lib/Semantics/assignment.cpp
===================================================================
--- flang/lib/Semantics/assignment.cpp
+++ flang/lib/Semantics/assignment.cpp
@@ -75,7 +75,7 @@
       const Scope &scope{context_.FindScope(lhsLoc)};
       if (auto whyNot{WhyNotModifiable(lhsLoc, lhs, scope, true)}) {
         if (auto *msg{Say(lhsLoc,
-                "Left-hand side of assignment is not modifiable"_err_en_US)}) {
+                "Left-hand side of assignment is not modifiable"_err_en_US)}) { // C1158
           msg->Attach(*whyNot);
         }
       }
Index: flang/lib/Semantics/check-call.cpp
===================================================================
--- flang/lib/Semantics/check-call.cpp
+++ flang/lib/Semantics/check-call.cpp
@@ -332,7 +332,7 @@
     if (auto why{WhyNotModifiable(
             messages.at(), actual, *scope, vectorSubscriptIsOk)}) {
       if (auto *msg{messages.Say(
-              "Actual argument associated with %s %s must be definable"_err_en_US,
+              "Actual argument associated with %s %s must be definable"_err_en_US, // C1158
               reason, dummyName)}) {
         msg->Attach(*why);
       }
Index: flang/lib/Semantics/check-select-type.h
===================================================================
--- /dev/null
+++ flang/lib/Semantics/check-select-type.h
@@ -0,0 +1,31 @@
+//===-- lib/Semantics/check-select-type.h -----------------------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_SEMANTICS_CHECK_SELECT_TYPE_H_
+#define FORTRAN_SEMANTICS_CHECK_SELECT_TYPE_H_
+
+#include "flang/Semantics/semantics.h"
+
+namespace Fortran::parser {
+struct SelectTypeConstruct;
+struct Selector;
+} // namespace Fortran::parser
+
+namespace Fortran::semantics {
+
+class SelectTypeChecker : public virtual BaseChecker {
+public:
+  explicit SelectTypeChecker(SemanticsContext &context) : context_{context} {};
+  void Enter(const parser::SelectTypeConstruct &);
+
+private:
+  const SomeExpr *GetExprFromSelector(const parser::Selector &);
+  SemanticsContext &context_;
+};
+} // namespace Fortran::semantics
+#endif // FORTRAN_SEMANTICS_CHECK_SELECT_TYPE_H_
Index: flang/lib/Semantics/check-select-type.cpp
===================================================================
--- /dev/null
+++ flang/lib/Semantics/check-select-type.cpp
@@ -0,0 +1,271 @@
+//===-- lib/Semantics/check-select-type.cpp -------------------------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#include "check-select-type.h"
+#include "flang/Common/idioms.h"
+#include "flang/Common/reference.h"
+#include "flang/Evaluate/fold.h"
+#include "flang/Evaluate/type.h"
+#include "flang/Parser/parse-tree.h"
+#include "flang/Semantics/semantics.h"
+#include "flang/Semantics/tools.h"
+#include <optional>
+
+namespace Fortran::semantics {
+
+class TypeCaseValues {
+public:
+  TypeCaseValues(SemanticsContext &c, const evaluate::DynamicType &t)
+      : context_{c}, selectorType_{t} {}
+  void Check(const std::list<parser::SelectTypeConstruct::TypeCase> &cases) {
+    for (const auto &c : cases) {
+      AddTypeCase(c);
+    }
+    if (!hasErrors_) {
+      ReportConflictingTypeCases();
+    }
+  }
+
+private:
+  void AddTypeCase(const parser::SelectTypeConstruct::TypeCase &c) {
+    const auto &stmt{std::get<parser::Statement<parser::TypeGuardStmt>>(c.t)};
+    const parser::TypeGuardStmt &typeGuardStmt{stmt.statement};
+    const auto &guard{std::get<parser::TypeGuardStmt::Guard>(typeGuardStmt.t)};
+    if (std::holds_alternative<parser::Default>(guard.u)) {
+      typeCases_.emplace_back(stmt, std::nullopt);
+    } else if (std::optional<evaluate::DynamicType> type{GetGuardType(guard)}) {
+      if (PassesChecksOnGuard(guard, *type)) {
+        typeCases_.emplace_back(stmt, *type);
+      } else {
+        hasErrors_ = true;
+      }
+    } else {
+      hasErrors_ = true;
+    }
+  }
+
+  std::optional<evaluate::DynamicType> GetGuardType(
+      const parser::TypeGuardStmt::Guard &guard) {
+    return std::visit(
+        common::visitors{
+            [](const parser::Default &)
+                -> std::optional<evaluate::DynamicType> {
+              return std::nullopt;
+            },
+            [](const parser::TypeSpec &typeSpec) {
+              return evaluate::DynamicType::From(typeSpec.declTypeSpec);
+            },
+            [](const parser::DerivedTypeSpec &spec)
+                -> std::optional<evaluate::DynamicType> {
+              if (const auto *derivedTypeSpec{spec.derivedTypeSpec}) {
+                const semantics::Symbol &typeSymbol{
+                    derivedTypeSpec->typeSymbol()};
+                if (const semantics::Scope * scope{typeSymbol.scope()}) {
+                  auto &mutablederivedTypeSpec{
+                      *const_cast<semantics::DerivedTypeSpec *>(
+                          derivedTypeSpec)};
+                  auto &mutableConstScope{
+                      *const_cast<semantics::Scope *>(scope)};
+                  auto &declTypeSpec{mutableConstScope.MakeDerivedType(
+                      DeclTypeSpec::TypeDerived,
+                      std::move(mutablederivedTypeSpec))};
+                  return evaluate::DynamicType::From(declTypeSpec);
+                }
+              }
+              return std::nullopt;
+            },
+        },
+        guard.u);
+  }
+
+  bool PassesChecksOnGuard(const parser::TypeGuardStmt::Guard &guard,
+      const evaluate::DynamicType &guardDynamicType) {
+    return std::visit(
+        common::visitors{
+            [](const parser::Default &) { return true; },
+            [&](const parser::TypeSpec &typeSpec) {
+              if (const DeclTypeSpec * spec{typeSpec.declTypeSpec}) {
+                if (spec->category() == DeclTypeSpec::Character &&
+                    !guardDynamicType.IsAssumedLengthCharacter()) { // C1160
+                  context_.Say(parser::FindSourceLocation(typeSpec),
+                      "The type specification statement must have "
+                      "LEN type parameter as assumed"_err_en_US);
+                  return false;
+                }
+                if (const DerivedTypeSpec * derived{spec->AsDerived()}) {
+                  return PassesDerivedTypeChecks(
+                      *derived, parser::FindSourceLocation(typeSpec));
+                }
+                return false;
+              }
+              return false;
+            },
+            [&](const parser::DerivedTypeSpec &x) {
+              if (const semantics::DerivedTypeSpec *
+                  derived{x.derivedTypeSpec}) {
+                return PassesDerivedTypeChecks(
+                    *derived, parser::FindSourceLocation(x));
+              }
+              return false;
+            },
+        },
+        guard.u);
+  }
+
+  bool PassesDerivedTypeChecks(const semantics::DerivedTypeSpec &derived,
+      parser::CharBlock sourceLoc) const {
+    for (const auto &pair : derived.parameters()) {
+      if (pair.second.isLen() && pair.second.isAssumed()) { // C1160
+        context_.Say(sourceLoc,
+            "The type specification statement must have "
+            "LEN type parameter as assumed"_err_en_US);
+        return false;
+      }
+    }
+    if (!IsExtensibleType(&derived)) { // C1161
+      context_.Say(sourceLoc,
+          "The type specification statement must not specify "
+          "a type with a SEQUENCE attribute or a BIND attribute"_err_en_US);
+      return false;
+    }
+    if (!selectorType_.IsUnlimitedPolymorphic()) { // C1162
+      if (const semantics::Scope * guardScope{derived.typeSymbol().scope()}) {
+        // From dynamicTypespec  -> derivedtypespec
+        const auto &selDerivedTypeSpec{selectorType_.GetDerivedTypeSpec()};
+        if (!(derived == selDerivedTypeSpec) &&
+            !guardScope->FindComponent(selDerivedTypeSpec.name())) {
+          context_.Say(sourceLoc,
+              "Type specification '%s' must be an extension of TYPE '%s'"_err_en_US,
+              derived.AsFortran(), selDerivedTypeSpec.AsFortran());
+          return false;
+        }
+      }
+    }
+    return true;
+  }
+
+  struct TypeCase {
+    explicit TypeCase(const parser::Statement<parser::TypeGuardStmt> &s,
+        std::optional<evaluate::DynamicType> guardTypeDynamic)
+        : stmt{s} {
+      SetGuardType(guardTypeDynamic);
+    }
+
+    void SetGuardType(std::optional<evaluate::DynamicType> guardTypeDynamic) {
+      const auto &guard{GetGuardFromStmt(stmt)};
+      std::visit(common::visitors{
+                     [&](const parser::Default &) {},
+                     [&](const auto &) { guardType_ = *guardTypeDynamic; },
+                 },
+          guard.u);
+    }
+
+    bool IsDefault() const {
+      const auto &guard{GetGuardFromStmt(stmt)};
+      return std::holds_alternative<parser::Default>(guard.u);
+    }
+
+    bool IsTypeSpec() const {
+      const auto &guard{GetGuardFromStmt(stmt)};
+      return std::holds_alternative<parser::TypeSpec>(guard.u);
+    }
+
+    bool IsDerivedTypeSpec() const {
+      const auto &guard{GetGuardFromStmt(stmt)};
+      return std::holds_alternative<parser::DerivedTypeSpec>(guard.u);
+    }
+
+    const parser::TypeGuardStmt::Guard &GetGuardFromStmt(
+        const parser::Statement<parser::TypeGuardStmt> &stmt) const {
+      const parser::TypeGuardStmt &typeGuardStmt{stmt.statement};
+      return std::get<parser::TypeGuardStmt::Guard>(typeGuardStmt.t);
+    }
+
+    std::optional<evaluate::DynamicType> guardType() const {
+      return guardType_;
+    }
+
+    std::string AsFortran() const { // TODO:needs more type details on output
+      std::string result;
+      if (this->guardType()) {
+        auto type{*this->guardType()};
+        result += type.AsFortran();
+      } else {
+        result += "DEFAULT";
+      }
+      return result;
+    }
+    const parser::Statement<parser::TypeGuardStmt> &stmt;
+    std::optional<evaluate::DynamicType> guardType_; // is this POD?
+  };
+
+  // Returns true if and only if the values are different
+  // Does apple to apple comparision, in case of TypeSpec or DerivedTypeSpec
+  // checks for kinds as well.
+  static bool TypesAreDifferent(const TypeCase &x, const TypeCase &y) {
+    if (x.IsDefault()) { // C1164
+      return !y.IsDefault();
+    } else if (x.IsTypeSpec() && y.IsTypeSpec()) { // C1163
+      return !AreTypeKindCompatible(x, y);
+    } else if (x.IsDerivedTypeSpec() && y.IsDerivedTypeSpec()) { // C1163
+      return !AreTypeKindCompatible(x, y);
+    }
+    return true;
+  }
+
+  static bool AreTypeKindCompatible(const TypeCase &x, const TypeCase &y) {
+    return (*x.guardType()).IsTkCompatibleWith((*y.guardType()));
+  }
+
+  void ReportConflictingTypeCases() {
+    for (auto iter{typeCases_.begin()}; iter != typeCases_.end(); ++iter) {
+      parser::Message *msg{nullptr};
+      for (auto p{typeCases_.begin()}; p != typeCases_.end(); ++p) {
+        if (p->stmt.source.begin() < iter->stmt.source.begin() &&
+            !TypesAreDifferent(*p, *iter)) {
+          if (!msg) {
+            msg = &context_.Say(iter->stmt.source,
+                "Type specification '%s' conflicts with previous type specification"_err_en_US,
+                iter->AsFortran());
+          }
+          msg->Attach(p->stmt.source,
+              "Conflicting type specification '%s'"_en_US, p->AsFortran());
+        }
+      }
+    }
+  }
+
+  SemanticsContext &context_;
+  const evaluate::DynamicType &selectorType_;
+  std::list<TypeCase> typeCases_;
+  bool hasErrors_{false};
+};
+
+void SelectTypeChecker::Enter(const parser::SelectTypeConstruct &construct) {
+  const auto &selectTypeStmt{
+      std::get<parser::Statement<parser::SelectTypeStmt>>(construct.t)};
+  const auto &selectType{selectTypeStmt.statement};
+  const auto &unResolvedSel{std::get<parser::Selector>(selectType.t)};
+  const auto *selector{GetExprFromSelector(unResolvedSel)};
+
+  if (!selector) {
+    return; // expression semantics failed on Selector
+  }
+  if (auto exprType{selector->GetType()}) {
+    const auto &typeCaseList{
+        std::get<std::list<parser::SelectTypeConstruct::TypeCase>>(
+            construct.t)};
+    TypeCaseValues{context_, *exprType}.Check(typeCaseList);
+  }
+}
+
+const SomeExpr *SelectTypeChecker::GetExprFromSelector(
+    const parser::Selector &selector) {
+  return std::visit([](const auto &x) { return GetExpr(x); }, selector.u);
+}
+} // namespace Fortran::semantics
Index: flang/lib/Semantics/resolve-names.cpp
===================================================================
--- flang/lib/Semantics/resolve-names.cpp
+++ flang/lib/Semantics/resolve-names.cpp
@@ -5152,6 +5152,13 @@
             "Selector is not a variable"_err_en_US);
         association = {};
       }
+      if (const DeclTypeSpec * type{whole->GetType()}) {
+        if (!type->IsPolymorphic()) { // C1159
+          Say(association.selector.source,
+              "Selector '%s' in SELECT TYPE statement must be "
+              "polymorphic"_err_en_US);
+        }
+      }
     } else {
       Say(association.selector.source, // C1157
           "Selector is not a named variable: 'associate-name =>' is required"_err_en_US);
Index: flang/lib/Semantics/semantics.cpp
===================================================================
--- flang/lib/Semantics/semantics.cpp
+++ flang/lib/Semantics/semantics.cpp
@@ -26,6 +26,7 @@
 #include "check-purity.h"
 #include "check-return.h"
 #include "check-select-rank.h"
+#include "check-select-type.h"
 #include "check-stop.h"
 #include "compute-offsets.h"
 #include "mod-file.h"
@@ -157,7 +158,8 @@
     ArithmeticIfStmtChecker, AssignmentChecker, CaseChecker, CoarrayChecker,
     DataChecker, DeallocateChecker, DoForallChecker, IfStmtChecker, IoChecker,
     MiscChecker, NamelistChecker, NullifyChecker, OmpStructureChecker,
-    PurityChecker, ReturnStmtChecker, SelectRankConstructChecker, StopChecker>;
+    PurityChecker, ReturnStmtChecker, SelectRankConstructChecker,
+    SelectTypeChecker, StopChecker>;
 
 static bool PerformStatementSemantics(
     SemanticsContext &context, parser::Program &program) {
Index: flang/test/Semantics/selecttype01.f90
===================================================================
--- /dev/null
+++ flang/test/Semantics/selecttype01.f90
@@ -0,0 +1,224 @@
+! RUN: %S/test_errors.sh %s %t %f18
+! Test for checking select type constraints,
+module m1
+  use ISO_C_BINDING
+  type shape
+    integer :: color
+    logical :: filled
+    integer :: x
+    integer :: y
+  end type shape
+
+  type, extends(shape) :: rectangle
+    integer :: length
+    integer :: width
+  end type rectangle
+
+  type, extends(rectangle) :: square
+  end type square
+
+  type, extends(square) :: extsquare
+  end type
+
+  type :: unrelated
+    logical :: some_logical
+  end type
+
+  type withSequence
+    SEQUENCE
+    integer :: x
+  end type
+
+  type, BIND(C) :: withBind
+    INTEGER(c_int) ::int_in_c
+  end type
+
+  TYPE(shape), TARGET :: shape_obj
+  TYPE(rectangle), TARGET :: rect_obj
+  TYPE(square), TARGET :: squr_obj
+ !define polymorphic objects
+  class(*), pointer :: unlim_polymorphic
+  class(shape), pointer :: shape_lim_polymorphic
+end
+module m
+   type :: t(n)
+      integer, len :: n
+   end type
+contains
+    subroutine CheckC1160( a )
+        class(*), intent(in) :: a
+        select type ( a )
+!ERROR: The type specification statement must have LEN type parameter as assumed
+                type is ( character(len=10) ) !<-- assumed length-type
+                ! OK
+                type is ( character(len=*) )
+		! OK
+		type is ( t(n=10) )
+!ERROR: The type specification statement must have LEN type parameter as assumed
+		type is ( t(n=*) )   !<-- assumed length-type
+!ERROR: Derived type 'character' not found
+                class is ( character(len=10) ) !<-- assumed length-type
+        end select
+    end subroutine
+end module
+
+subroutine CheckC1157
+	use m1
+        integer, parameter :: const_var=10
+!ERROR: Selector is not a named variable: 'associate-name =>' is required
+        select type(10)
+        end select
+!ERROR: Selector is not a named variable: 'associate-name =>' is required
+        select type(const_var)
+        end select
+!ERROR: Selector is not a named variable: 'associate-name =>' is required
+        select type (4.999)
+        end select
+!ERROR: Selector is not a named variable: 'associate-name =>' is required
+        select type (shape_obj%x)
+        end select
+end subroutine
+
+!CheckPloymorphicSelectorType
+subroutine CheckC1159
+            integer :: int_variable
+            real :: real_variable
+            complex :: complex_var = cmplx(3.0, 4.0)
+            logical :: log_variable
+            character (len=10) :: char_variable = "OM"
+    !ERROR: Selector 'int_variable' in SELECT TYPE statement must be polymorphic
+            select type (int_variable)
+            end select
+   !ERROR: Selector 'real_variable' in SELECT TYPE statement must be polymorphic
+            select type (real_variable)
+            end select
+    !ERROR: Selector 'complex_var' in SELECT TYPE statement must be polymorphic
+            select type(complex_var)
+            end select
+    !ERROR: Selector 'logical_variable' in SELECT TYPE statement must be polymorphic
+            select type(logical_variable)
+            end select
+            !ERROR: Selector 'char_variable' in SELECT TYPE statement must be polymorphic
+            select type(char_variable)
+            end select
+end
+
+subroutine CheckC1161
+        use m1
+        shape_lim_polymorphic => rect_obj
+        select type(shape_lim_polymorphic)
+        !ERROR: The type specification statement must not specify a type with a SEQUENCE attribute or a BIND attribute
+            type is (withSequence)
+        !ERROR: The type specification statement must not specify a type with a SEQUENCE attribute or a BIND attribute
+            type is (withBind)
+        end select
+end
+
+subroutine CheckC1162
+        use m1
+        class(rectangle), pointer :: rectangle_polymorphic
+        !not unlimited polymorphic objects
+        select type (rectangle_polymorphic)
+        !ERROR: Type specification 'shape' must be an extension of TYPE 'rectangle'
+            type is (shape)
+        !ERROR: Type specification 'unrelated' must be an extension of TYPE 'rectangle'
+            type is (unrelated)
+	!all are ok
+            type is (square)
+            type is (extsquare)
+	!Handle same types 
+            type is (rectangle)
+        end select
+
+        !Unlimited polymorphic objects are allowed.
+        unlim_polymorphic => rect_obj
+        select type (unlim_polymorphic)
+            type is (shape)
+            type is (unrelated)
+        end select
+end
+subroutine CheckC1163
+    use m1
+    !assign dynamically
+    shape_lim_polymorphic => rect_obj
+    unlim_polymorphic => shape_obj
+    select type (shape_lim_polymorphic)
+        type is (shape)
+!ERROR: Type specification 'shape' conflicts with previous type specification
+        type is (shape)
+        class is (square)
+!ERROR: Type specification 'square' conflicts with previous type specification
+        class is (square)
+!        ![FIXME]: figure out whats allowed and not allowed
+!        type is (integer)
+!        class is (integer)
+
+    end select
+
+!    select type (unlim_polymorphic)
+!        ![FIXME] figure out whats allowed and not allowed
+!            class is (integer)
+!            type is (integer)
+!    end select
+end
+subroutine CheckC1164
+    use m1
+    shape_lim_polymorphic => rect_obj
+    unlim_polymorphic => shape_obj
+    select type (shape_lim_polymorphic)
+        CLASS DEFAULT
+!ERROR: Type specification 'DEFAULT' conflicts with previous type specification
+        CLASS DEFAULT
+        TYPE IS (shape)
+        TYPE IS (rectangle)
+!ERROR: Type specification 'DEFAULT' conflicts with previous type specification
+	CLASS DEFAULT
+    end select
+
+    !Saving computation if some error in guard by not computing RepeatingCases
+    select type (shape_lim_polymorphic)
+        CLASS DEFAULT
+        CLASS DEFAULT
+        !ERROR: The type specification statement must not specify a type with a SEQUENCE attribute or a BIND attribute
+        TYPE IS(withSequence)
+    end select
+end subroutine
+subroutine WorkingPolymorphism
+        use m1
+
+        !assign dynamically
+        shape_lim_polymorphic => rect_obj
+        unlim_polymorphic => shape_obj
+        select type (shape_lim_polymorphic)
+            type is  (shape)
+                print *, "hello shape"
+            type is  (rectangle)
+                print *, "hello rect"
+            type is  (square)
+                print *, "hello square"
+            CLASS DEFAULT
+                print *, "default"
+        end select
+
+        print *, "unlim polymorphism"
+
+        select type (unlim_polymorphic)
+            type is  (shape)
+                print *, "hello shape"
+            type is  (rectangle)
+                print *, "hello rect"
+            type is  (square)
+                print *, "hello square"
+            CLASS DEFAULT
+                    print *, "default"
+        end select
+end
+
+program main
+   use m, only : CheckC1160,t
+   type(t(n=3)) :: foo
+   call CheckC1160( "Hello!" )
+   call CheckC1160( foo )
+   call CheckC1160( 1.0 )
+end program
+
Index: flang/test/Semantics/selecttype02.f90
===================================================================
--- /dev/null
+++ flang/test/Semantics/selecttype02.f90
@@ -0,0 +1,58 @@
+! RUN: %S/test_errors.sh %s %t %f18
+module m1
+  use ISO_C_BINDING
+  type shape
+    integer :: color
+    logical :: filled
+    integer :: x
+    integer :: y
+  end type shape
+  type, extends(shape) :: rectangle
+    integer :: length
+    integer :: width
+  end type rectangle
+  type, extends(rectangle) :: square
+  end type square
+
+  TYPE(shape), TARGET :: shape_obj
+  TYPE(rectangle), TARGET :: rect_obj
+ !define polymorphic objects
+  class(shape), pointer :: shape_lim_polymorphic
+end
+subroutine C1165a
+        use m1
+        shape_lim_polymorphic => rect_obj
+        label : select type (shape_lim_polymorphic)
+        end select label
+
+        label1 : select type (shape_lim_polymorphic)
+        !ERROR: SELECT TYPE construct name required but missing
+        end select
+
+        select type (shape_lim_polymorphic)
+        !ERROR: SELECT TYPE construct name unexpected
+        end select label2
+
+        select type (shape_lim_polymorphic)
+        end select
+end subroutine
+subroutine C1165b
+        use m1
+        shape_lim_polymorphic => rect_obj
+!type-guard-stmt realted checks
+	label : select type (shape_lim_polymorphic)
+		type is (shape) label
+        end select label
+
+	 select type (shape_lim_polymorphic)
+        !ERROR: SELECT TYPE name not allowed
+		type is (shape) label
+        end select
+
+	label : select type (shape_lim_polymorphic)
+        !ERROR: SELECT TYPE name mismatch
+		type is (shape) labelll
+        end select label
+end subroutine
+
+
Index: flang/test/Semantics/selecttype03.f90
===================================================================
--- /dev/null
+++ flang/test/Semantics/selecttype03.f90
@@ -0,0 +1,124 @@
+! RUN: %S/test_errors.sh %s %t %f18
+! Test various conditions in C1158.
+implicit none
+
+type :: t1
+  integer :: i
+end type
+
+type, extends(t1) :: t2
+end type
+
+type(t1),target :: x1
+type(t2),target :: x2
+
+class(*), pointer :: ptr
+class(t1), pointer :: p_or_c
+!vector subscript related
+            class(t1),DIMENSION(:,:),allocatable::array1
+            class(t2),DIMENSION(:,:),allocatable::array2
+	    integer, dimension(2) :: V
+	    V = (/ 1,2 /)
+            allocate(array1(3,3))
+            allocate(array2(3,3))
+! A) associate with function, i.e (other than variables)
+select type ( y => fun(1) )
+type is (t1)
+  print *, rank(y%i)
+end select
+
+select type ( y => fun(1) )
+type is (t1)
+!ERROR: Left-hand side of assignment is not modifiable
+  y%i = 1 !VDC
+type is (t2)
+!ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'z=' must be definable
+call sub_with_in_and_inout_param(y,y) !VDC
+end select
+
+! B) associated with a variable:
+p_or_c => x1
+select type ( a => p_or_c )
+type is (t1)
+a%i = 10
+end select
+
+select type ( a => p_or_c )
+type is (t1)
+end select
+!C)Associate with  with vector subscript
+	    select type (b => array1(V,2))
+		type is (t1)
+!ERROR: Left-hand side of assignment is not modifiable
+			b%i  = 1 !VDC
+		type is (t2)
+!ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'z=' must be definable
+			call sub_with_in_and_inout_param_vector(b,b) !VDC
+	    end select
+
+            select type(b =>  foo(1) )
+                    type is (t1)
+!ERROR: Left-hand side of assignment is not modifiable
+                        b%i = 1 !VDC
+                    type is (t2)
+!ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'z=' must be definable
+                        call sub_with_in_and_inout_param_vector(b,b) !VDC
+            end select
+
+!D) Have no association and should be ok.
+!1. points to function
+ptr => fun(1)
+select type ( ptr )
+type is (t1)
+  ptr%i = 1
+end select
+
+!2. points to variable
+ptr=>x1
+select type (ptr)
+type is (t1)
+ptr%i = 10
+end select
+
+contains
+
+  function fun(i)
+    class(t1),pointer :: fun
+    integer :: i
+    if (i>0) then
+      fun => x1
+    else if (i<0) then
+      fun => x2
+    else
+      fun => NULL()
+    end if
+  end function
+
+  function foo(i)
+    integer :: i
+    class(t1),DIMENSION(:),allocatable :: foo
+    integer, dimension(2) :: U
+    U = (/ 1,2 /)
+
+    if (i>0) then
+      foo = array1(2,U)
+    else if (i<0) then
+!ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types TYPE(t1) and TYPE(t2)
+      foo = array2(2,U)
+    end if
+  end function
+
+ subroutine sub_with_in_and_inout_param(y, z)
+    type(t2), INTENT(IN) :: y
+    class(t2), INTENT(INOUT) :: z
+    z%i = 10
+ end subroutine
+
+ subroutine sub_with_in_and_inout_param_vector(y, z)
+    type(t2),DIMENSION(:), INTENT(IN) :: y
+    class(t2),DIMENSION(:), INTENT(INOUT) :: z
+    z%i = 10
+ end subroutine
+
+end
+