diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index e8742902d12aee30a80b4352daa88ace1a725f67..315a29bd05fc24120aa4e172af1b49ad5756b4fa 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,7 +1,12 @@
+2020-04-19  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/57129
+	* gfortran.dg/subroutine_as_type.f90: New test.
+
 2020-04-19  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
 	PR fortran/93500
-	* arith_divide_3.f90: New test.
+	* gfortran.dg/arith_divide_3.f90: New test.
 
 2020-04-19  Jakub Jelinek  <jakub@redhat.com>
 
diff --git a/gcc/testsuite/gfortran.dg/subroutine_as_type.f90 b/gcc/testsuite/gfortran.dg/subroutine_as_type.f90
new file mode 100644
index 0000000000000000000000000000000000000000..eb8240fbb7bc7e1565ed023f0a37ad4f42ecf936
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/subroutine_as_type.f90
@@ -0,0 +1,7 @@
+
+subroutine t()
+  type t  ! { dg-error "FUNCTION attribute conflicts with SUBROUTINE attribute" }
+  end type t ! { dg-error "Expecting END SUBROUTINE statement" }
+  type, extends(t) :: t2   ! { dg-error "has not been previously defined" }
+  end type t2 ! { dg-error "Expecting END SUBROUTINE statement" }
+end