--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gcc/testsuite/gfortran.dg/allocate_with_source_23.f03	Fri Oct 27 22:46:09 2017 +0900
@@ -0,0 +1,67 @@
+! { dg-do run }
+! { dg-options "-fcheck=bounds" }
+! { dg-shouldfail "Array bounds mismatch" }
+!
+! Test that pr72832 is fixed now.
+! Contributed by Daan van Vugt
+
+program allocate_source
+  type :: t
+    integer :: i
+  end type t
+  type, extends(t) :: tt
+  end type tt
+
+  call test_type()
+  call test_class_correct()
+  call test_class_fail()
+
+contains
+
+subroutine test_class_correct()
+  class(t), allocatable, dimension(:) :: a, b
+  allocate(tt::a(1:2))
+  a(:)%i = [ 1,2 ]
+  if (size(a) /= 2) call abort()
+  if (any(a(:)%i /= [ 1,2])) call abort()
+
+  allocate(b(1:4), source=a(1))
+  if (size(b) /= 4) call abort()
+  if (any(b(:)%i /= [ 1,1,1,1])) call abort()
+  select type (b(1))
+    class is (tt)
+      continue
+    class default
+      call abort()
+  end select
+end subroutine
+
+subroutine test_class_fail()
+  class(t), allocatable, dimension(:) :: a, b
+  allocate(tt::a(1:2))
+  a(:)%i = [ 1,2 ]
+  if (size(a) /= 2) call abort()
+  if (any(a(:)%i /= [ 1,2])) call abort()
+
+  allocate(b(1:4), source=a) ! Fail expected: sizes do not conform
+  if (size(b) /= 4) call abort()
+  if (any(b(1:2)%i /= [ 1,2])) call abort()
+  select type (b(1))
+    class is (tt)
+      continue
+    class default
+      call abort()
+  end select
+end subroutine
+
+subroutine test_type()
+  type(t), allocatable, dimension(:) :: a, b
+  allocate(a(1:2))
+  if (size(a) /= 2) call abort()
+
+  allocate(b(1:4), source=a)
+  if (size(b) /= 4) call abort()
+end subroutine
+end program allocate_source
+
+