Index: gcc/fortran/simplify.c
===================================================================
--- gcc/fortran/simplify.c	(Revision 242447)
+++ gcc/fortran/simplify.c	(Arbeitskopie)
@@ -2517,7 +2517,7 @@ gfc_simplify_extends_type_of (gfc_expr *a, gfc_exp
   if (UNLIMITED_POLY (a) || UNLIMITED_POLY (mold))
     return NULL;
 
-  /* Return .false. if the dynamic type can never be the same.  */
+  /* Return .false. if the dynamic type can never be an extension.  */
   if ((a->ts.type == BT_CLASS && mold->ts.type == BT_CLASS
        && !gfc_type_is_extension_of
 			(mold->ts.u.derived->components->ts.u.derived,
@@ -2535,10 +2535,14 @@ gfc_simplify_extends_type_of (gfc_expr *a, gfc_exp
       || (a->ts.type == BT_CLASS && mold->ts.type == BT_DERIVED
 	  && !gfc_type_is_extension_of
 			(mold->ts.u.derived,
-			 a->ts.u.derived->components->ts.u.derived)))
+			 a->ts.u.derived->components->ts.u.derived)
+	  && !gfc_type_is_extension_of
+			(a->ts.u.derived->components->ts.u.derived,
+			 mold->ts.u.derived)))
     return gfc_get_logical_expr (gfc_default_logical_kind, &a->where, false);
 
-  if (mold->ts.type == BT_DERIVED
+  /* Return .true. if the dynamic type is guaranteed to be an extension.  */
+  if (a->ts.type == BT_CLASS && mold->ts.type == BT_DERIVED
       && gfc_type_is_extension_of (mold->ts.u.derived,
 				   a->ts.u.derived->components->ts.u.derived))
     return gfc_get_logical_expr (gfc_default_logical_kind, &a->where, true);
Index: gcc/testsuite/gfortran.dg/extends_type_of_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/extends_type_of_3.f90	(Revision 242447)
+++ gcc/testsuite/gfortran.dg/extends_type_of_3.f90	(Arbeitskopie)
@@ -3,9 +3,7 @@
 !
 ! PR fortran/41580
 !
-! Compile-time simplification of SAME_TYPE_AS
-! and EXTENDS_TYPE_OF.
-!
+! Compile-time simplification of SAME_TYPE_AS and EXTENDS_TYPE_OF.
 
 implicit none
 type t1
@@ -37,6 +35,8 @@ logical, parameter :: p6 = same_type_as(a1,a1)  !
 
 if (p1 .or. p2 .or. p3 .or. p4 .or. .not. p5 .or. .not. p6) call should_not_exist()
 
+if (same_type_as(b1,b1)   .neqv. .true.) call should_not_exist()
+
 ! Not (trivially) compile-time simplifiable:
 if (same_type_as(b1,a1)  .neqv. .true.) call abort()
 if (same_type_as(b1,a11) .neqv. .false.) call abort()
@@ -49,6 +49,7 @@ if (same_type_as(b1,a1)  .neqv. .false.) call abor
 if (same_type_as(b1,a11) .neqv. .true.) call abort()
 deallocate(b1)
 
+
 ! .true. -> same type
 if (extends_type_of(a1,a1)   .neqv. .true.) call should_not_exist()
 if (extends_type_of(a11,a11) .neqv. .true.) call should_not_exist()
@@ -83,8 +84,8 @@ if (extends_type_of(a1,a11) .neqv. .false.) call s
 if (extends_type_of(b1,a1)   .neqv. .true.) call should_not_exist()
 if (extends_type_of(b11,a1)  .neqv. .true.) call should_not_exist()
 if (extends_type_of(b11,a11) .neqv. .true.) call should_not_exist()
-if (extends_type_of(b1,a11)  .neqv. .false.) call should_not_exist()
 
+
 if (extends_type_of(a1,b11)  .neqv. .false.) call abort()
 
 ! Special case, simplified at tree folding:
@@ -92,19 +93,34 @@ if (extends_type_of(b1,b1)   .neqv. .true.) call a
 
 ! All other possibilities are not compile-time checkable
 if (extends_type_of(b11,b1)  .neqv. .true.) call abort()
-!if (extends_type_of(b1,b11)  .neqv. .false.) call abort() ! FAILS due to PR 47189
+if (extends_type_of(b1,b11)  .neqv. .false.) call abort()
 if (extends_type_of(a11,b11) .neqv. .true.) call abort()
+
 allocate(t11 :: b11)
 if (extends_type_of(a11,b11) .neqv. .true.) call abort()
 deallocate(b11)
+
 allocate(t111 :: b11)
 if (extends_type_of(a11,b11) .neqv. .false.) call abort()
 deallocate(b11)
+
 allocate(t11 :: b1)
 if (extends_type_of(a11,b1) .neqv. .true.) call abort()
 deallocate(b1)
 
+allocate(t11::b1)
+if (extends_type_of(b1,a11) .neqv. .true.) call abort()
+deallocate(b1)
+
+allocate(b1,source=a11)
+if (extends_type_of(b1,a11) .neqv. .true.) call abort()
+deallocate(b1)
+
+allocate( b1,source=a1)
+if (extends_type_of(b1,a11) .neqv. .false.) call abort()
+deallocate(b1)
+
 end
 
-! { dg-final { scan-tree-dump-times "abort" 13 "original" } }
+! { dg-final { scan-tree-dump-times "abort" 17 "original" } }
 ! { dg-final { scan-tree-dump-times "should_not_exist" 0 "original" } }
