Index: flang/lib/Evaluate/characteristics.cpp
===================================================================
--- flang/lib/Evaluate/characteristics.cpp
+++ flang/lib/Evaluate/characteristics.cpp
@@ -1017,8 +1017,14 @@
     }
   } else {
     for (std::size_t j{0}; j < dummyArguments.size(); ++j) {
-      if (!dummyArguments[j].IsCompatibleWith(
-              actual.dummyArguments[j], whyNot)) {
+      // Subtlety: the dummy/actual distinction must be reversed for this
+      // compatibility test in order to correctly check extended vs.
+      // base types.  Example:
+      //   subroutine s1(base); subroutine s2(extended)
+      //   procedure(s1), pointer :: p
+      //   p => s2 ! an error, s2 is more restricted, can't handle "base"
+      if (!actual.dummyArguments[j].IsCompatibleWith(
+              dummyArguments[j], whyNot)) {
         if (whyNot) {
           *whyNot = "incompatible dummy argument #"s + std::to_string(j + 1) +
               ": "s + *whyNot;
Index: flang/lib/Evaluate/formatting.cpp
===================================================================
--- flang/lib/Evaluate/formatting.cpp
+++ flang/lib/Evaluate/formatting.cpp
@@ -479,7 +479,11 @@
 std::string DynamicType::AsFortran() const {
   if (derived_) {
     CHECK(category_ == TypeCategory::Derived);
-    return DerivedTypeSpecAsFortran(*derived_);
+    std::string result{DerivedTypeSpecAsFortran(*derived_)};
+    if (IsPolymorphic()) {
+      result = "CLASS("s + result + ')';
+    }
+    return result;
   } else if (charLengthParamValue_ || knownLength()) {
     std::string result{"CHARACTER(KIND="s + std::to_string(kind_) + ",LEN="};
     if (knownLength()) {
Index: flang/lib/Evaluate/type.cpp
===================================================================
--- flang/lib/Evaluate/type.cpp
+++ flang/lib/Evaluate/type.cpp
@@ -215,14 +215,7 @@
   }
   if (scope) {
     const auto &dtDetails{typeSymbol.get<semantics::DerivedTypeDetails>()};
-    if (auto extends{dtDetails.GetParentComponentName()}) {
-      if (auto iter{scope->find(*extends)}; iter != scope->cend()) {
-        if (const Symbol & symbol{*iter->second};
-            symbol.test(Symbol::Flag::ParentComp)) {
-          return &symbol;
-        }
-      }
-    }
+    return dtDetails.GetParentComponent(*scope);
   }
   return nullptr;
 }
Index: flang/lib/Semantics/expression.cpp
===================================================================
--- flang/lib/Semantics/expression.cpp
+++ flang/lib/Semantics/expression.cpp
@@ -4068,7 +4068,7 @@
   } else if (std::optional<DynamicType> type{GetType(i)}) {
     return type->IsAssumedType()         ? "TYPE(*)"s
         : type->IsUnlimitedPolymorphic() ? "CLASS(*)"s
-        : type->IsPolymorphic()          ? "CLASS("s + type->AsFortran() + ')'
+        : type->IsPolymorphic()          ? type->AsFortran()
         : type->category() == TypeCategory::Derived
         ? "TYPE("s + type->AsFortran() + ')'
         : type->category() == TypeCategory::Character
Index: flang/test/Semantics/assign09.f90
===================================================================
--- flang/test/Semantics/assign09.f90
+++ flang/test/Semantics/assign09.f90
@@ -34,11 +34,11 @@
 
   noInterfaceProcPtr => sqrt ! ok
   realToRealProcPtr => sqrt ! ok
-  !ERROR: Procedure pointer 'inttorealprocptr' associated with incompatible procedure designator 'sqrt': incompatible dummy argument #1: incompatible dummy data object types: INTEGER(4) vs REAL(4)
+  !ERROR: Procedure pointer 'inttorealprocptr' associated with incompatible procedure designator 'sqrt': incompatible dummy argument #1: incompatible dummy data object types: REAL(4) vs INTEGER(4)
   intToRealProcPtr => sqrt
   call sub1(sqrt) ! ok
   call sub2(sqrt) ! ok
-  !ERROR: Actual procedure argument has interface incompatible with dummy argument 'p=': incompatible dummy argument #1: incompatible dummy data object types: INTEGER(4) vs REAL(4)
+  !ERROR: Actual procedure argument has interface incompatible with dummy argument 'p=': incompatible dummy argument #1: incompatible dummy data object types: REAL(4) vs INTEGER(4)
   call sub3(sqrt)
 
   noInterfaceProcPtr => noInterfaceExternal ! ok
Index: flang/test/Semantics/assign12.f90
===================================================================
--- /dev/null
+++ flang/test/Semantics/assign12.f90
@@ -0,0 +1,32 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+module m
+  type base
+    procedure(baseSub), pointer :: baseComponent
+  end type
+  type, extends(base) :: extended
+  end type
+ contains
+  subroutine baseSub(x)
+    class(base), intent(in) :: x
+  end
+  subroutine extendedSub(x)
+    class(extended), intent(in) :: x
+  end
+  subroutine test
+    procedure(baseSub), pointer :: basePtr
+    procedure(extendedSub), pointer :: extendedPtr
+    type(extended) :: extendedVar
+    extendedPtr => baseSub ! ok
+    extendedPtr => basePtr ! ok
+    extendedVar = extended(baseSub) ! ok
+    extendedVar = extended(basePtr) ! ok
+    !ERROR: Procedure pointer 'baseptr' associated with incompatible procedure designator 'extendedsub': incompatible dummy argument #1: incompatible dummy data object types: CLASS(extended) vs CLASS(base)
+    basePtr => extendedSub
+    !ERROR: Procedure pointer 'baseptr' associated with incompatible procedure designator 'extendedptr': incompatible dummy argument #1: incompatible dummy data object types: CLASS(extended) vs CLASS(base)
+    basePtr => extendedPtr
+    !ERROR: Procedure pointer 'basecomponent' associated with incompatible procedure designator 'extendedsub': incompatible dummy argument #1: incompatible dummy data object types: CLASS(extended) vs CLASS(base)
+    extendedVar = extended(extendedSub)
+    !ERROR: Procedure pointer 'basecomponent' associated with incompatible procedure designator 'extendedptr': incompatible dummy argument #1: incompatible dummy data object types: CLASS(extended) vs CLASS(base)
+    extendedVar = extended(extendedPtr)
+  end
+end
Index: flang/test/Semantics/call05.f90
===================================================================
--- flang/test/Semantics/call05.f90
+++ flang/test/Semantics/call05.f90
@@ -85,9 +85,9 @@
     call sup(pp)
     !ERROR: If a POINTER or ALLOCATABLE dummy or actual argument is unlimited polymorphic, both must be so
     call sua(pa)
-    !ERROR: Actual argument type 'CLASS(*)' is not compatible with dummy argument type 't'
+    !ERROR: Actual argument type 'CLASS(*)' is not compatible with dummy argument type 'CLASS(t)'
     call spp(up)
-    !ERROR: Actual argument type 'CLASS(*)' is not compatible with dummy argument type 't'
+    !ERROR: Actual argument type 'CLASS(*)' is not compatible with dummy argument type 'CLASS(t)'
     call spa(ua)
     !ERROR: POINTER or ALLOCATABLE dummy and actual arguments must have the same declared type and kind
     call spp(pp2)
Index: flang/test/Semantics/global01.f90
===================================================================
--- flang/test/Semantics/global01.f90
+++ flang/test/Semantics/global01.f90
@@ -23,7 +23,7 @@
 
 program test
   interface
-    !WARNING: The global subprogram 'global1' is not compatible with its local procedure declaration (incompatible dummy argument #1: incompatible dummy data object types: REAL(4) vs INTEGER(4))
+    !WARNING: The global subprogram 'global1' is not compatible with its local procedure declaration (incompatible dummy argument #1: incompatible dummy data object types: INTEGER(4) vs REAL(4))
     subroutine global1(x)
       real, intent(in) :: x
     end subroutine