15 files changed, 802 insertions, 11 deletions
diff --git a/gcc/testsuite/gfortran.dg/do_concurrent_11.f90 b/gcc/testsuite/gfortran.dg/do_concurrent_11.f90
new file mode 100644
index 0000000..d4890a3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/do_concurrent_11.f90
@@ -0,0 +1,53 @@
+! { dg-do run }
+! { dg-additional-options "-fdump-tree-original" }
+
+module m
+implicit none
+contains
+subroutine sub(y,str)
+integer :: y, x, i
+character(len=5) :: str
+character(len=5) :: z = "abcde"
+logical :: error = .false.
+
+x = 5
+z = "12345"
+do concurrent (i = 1: 3) local_init(x) local_init(z) shared(error)default(none)
+   if (x /= 5) error = .true.
+   if (z /= "12345") error = .true.
+   x =  99
+   z = "XXXXX"
+end do
+if (x /= 5 .or. z /= "12345") stop 1
+if (error) stop 2
+
+do concurrent (i = 1: 3) local(y) local(str) shared(error) default(none)
+   y =  99
+   str = "XXXXX"
+end do
+if (y /= 42 .or. str /= "ABCDE") stop 3
+end
+end
+
+use m
+implicit none
+character(len=5) :: chars = "ABCDE"
+integer :: fourtytwo = 42
+call sub(fourtytwo, chars)
+end
+
+
+! { dg-final { scan-tree-dump-times "  integer\\(kind=4\\) x;" 2 "original" } }
+! { dg-final { scan-tree-dump-times "  static character\\(kind=1\\) z\\\[1:5\\\] = .abcde.;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "  character\\(kind=1\\) z\\\[1:5\\\];" 1 "original" } }
+! { dg-final { scan-tree-dump-times "  integer\\(kind=4\\) y;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "  character\\(kind=1\\) str\\\[1:5\\\];" 1 "original" } }
+
+! { dg-final { scan-tree-dump-times "  x = 5;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "  __builtin_memmove \\(\\(void \\*\\) &z, \\(void \\*\\) &.12345.\\\[1\\\]\{lb: 1 sz: 1\}, 5\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "  x = x;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "  __builtin_memmove \\(\\(void \\*\\) &z, \\(void \\*\\)\\ &z, 5\\);" 1 "original" } }
+
+! { dg-final { scan-tree-dump-not "  y = y;" "original" } }
+! { dg-final { scan-tree-dump-times "  __builtin_memmove \\(\\(void \\*\\) &str, \\(void \\*\\)\\ &.XXXXX.\\\[1\\\]\{lb: 1 sz: 1\}, 5\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "  __builtin_memmove \\(\\(void \\*\\) &str," 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/do_concurrent_12.f90 b/gcc/testsuite/gfortran.dg/do_concurrent_12.f90
new file mode 100644
index 0000000..8a2acfa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/do_concurrent_12.f90
@@ -0,0 +1,175 @@
+! { dg-do compile }
+
+! Fails to compile because default initializers aren't supported.
+! cf. do_concurrent_14.f90 and PR fortran/101602 (comment 6)
+
+module m
+implicit none
+type t
+  integer :: y = 44
+  integer, pointer :: ptr(:) => null()
+end type t
+
+contains
+
+subroutine sub(x, y)
+  integer :: i
+  type(t) :: x, y(4)
+  type(t) :: a, b(3)
+  logical :: error = .false.
+  integer, target :: tgt(6)
+  integer, target :: tgt2(7)
+
+  x%y = 100
+  x%ptr => tgt
+  y(1)%y = 101
+  y(2)%y = 102
+  y(3)%y = 103
+  y(4)%y = 104
+  y(1)%ptr => tgt
+  y(2)%ptr => tgt
+  y(3)%ptr => tgt
+  y(4)%ptr => tgt
+
+  a%y = 105
+  a%ptr => tgt
+  b(1)%y = 106
+  b(2)%y = 107
+  b(3)%y = 108
+  b(1)%ptr => tgt
+  b(2)%ptr => tgt
+  b(3)%ptr => tgt
+
+  do concurrent (i = 1: 3) local_init(x,y,a,b) shared(error,tgt,tgt2) default(none)
+    if (x%y /= 100 &
+        .or. .not.associated (x%ptr, tgt) &
+        .or. y(1)%y /= 101 &
+        .or. y(2)%y /= 102 &
+        .or. y(3)%y /= 103 &
+        .or. y(4)%y /= 104 &
+        .or. .not.associated (y(1)%ptr, tgt) &
+        .or. .not.associated (y(2)%ptr, tgt) &
+        .or. .not.associated (y(3)%ptr, tgt) &
+        .or. .not.associated (y(4)%ptr, tgt) &
+        .or. a%y /= 105 &
+        .or. .not.associated (a%ptr, tgt) &
+        .or. b(1)%y /= 106 &
+        .or. b(2)%y /= 107 &
+        .or. b(3)%y /= 108 &
+        .or. .not.associated (b(1)%ptr, tgt) &
+        .or. .not.associated (b(2)%ptr, tgt) &
+        .or. .not.associated (b(3)%ptr, tgt)) &
+     error = .true.
+
+    x%y = 900
+    x%ptr => tgt
+    y(1)%y = 901
+    y(2)%y = 902
+    y(3)%y = 903
+    y(4)%y = 904
+    y(1)%ptr => tgt2
+    y(2)%ptr => tgt2
+    y(3)%ptr => tgt2
+    y(4)%ptr => tgt2
+
+    a%y = 905
+    a%ptr => tgt
+    b(1)%y = 906
+    b(2)%y = 907
+    b(3)%y = 908
+    b(1)%ptr => tgt2
+    b(2)%ptr => tgt2
+    b(3)%ptr => tgt2
+  end do
+
+  if (error) stop 1
+  if (x%y /= 100 &
+      .or. .not.associated (x%ptr, tgt) &
+      .or. y(1)%y /= 101 &
+      .or. y(2)%y /= 102 &
+      .or. y(3)%y /= 103 &
+      .or. y(4)%y /= 104 &
+      .or. .not.associated (y(1)%ptr, tgt) &
+      .or. .not.associated (y(2)%ptr, tgt) &
+      .or. .not.associated (y(3)%ptr, tgt) &
+      .or. .not.associated (y(4)%ptr, tgt) &
+      .or. a%y /= 105 &
+      .or. .not.associated (a%ptr, tgt) &
+      .or. b(1)%y /= 106 &
+      .or. b(2)%y /= 107 &
+      .or. b(3)%y /= 108 &
+      .or. .not.associated (b(1)%ptr, tgt) &
+      .or. .not.associated (b(2)%ptr, tgt) &
+      .or. .not.associated (b(3)%ptr, tgt)) &
+   stop 2
+
+  do concurrent (i = 1: 3) local(x,y,a,b) shared(error,tgt,tgt2) default(none)
+! { dg-error "34: Sorry, LOCAL specifier at .1. for 'x' of derived type with default initializer is not yet supported" "" { target *-*-* } .-1 }
+! { dg-error "36: Sorry, LOCAL specifier at .1. for 'y' of derived type with default initializer is not yet supported" "" { target *-*-* } .-2 }
+! { dg-error "38: Sorry, LOCAL specifier at .1. for 'a' of derived type with default initializer is not yet supported" "" { target *-*-* } .-3 }
+! { dg-error "40: Sorry, LOCAL specifier at .1. for 'b' of derived type with default initializer is not yet supported" "" { target *-*-* } .-4 }
+
+    if (x%y /= 44) error = .true.
+    if (any(y(:)%y /= 44)) error = .true.
+    if (a%y /= 44) error = .true.
+    if (any (b(:)%y /= 44)) error = .true.
+
+    if (associated(x%ptr)) error = .true.
+    if (associated(y(1)%ptr)) error = .true.
+    if (associated(y(2)%ptr)) error = .true.
+    if (associated(y(3)%ptr)) error = .true.
+    if (associated(y(4)%ptr)) error = .true.
+    if (associated(a%ptr)) error = .true.
+    if (associated(b(1)%ptr)) error = .true.
+    if (associated(b(2)%ptr)) error = .true.
+    if (associated(b(3)%ptr)) error = .true.
+
+    x%y = 900
+    x%ptr => tgt
+    y(1)%y = 901
+    y(2)%y = 902
+    y(3)%y = 903
+    y(4)%y = 904
+    y(1)%ptr => tgt2
+    y(2)%ptr => tgt2
+    y(3)%ptr => tgt2
+    y(4)%ptr => tgt2
+
+    a%y = 905
+    a%ptr => tgt
+    b(1)%y = 906
+    b(2)%y = 907
+    b(3)%y = 908
+    b(1)%ptr => tgt2
+    b(2)%ptr => tgt2
+    b(3)%ptr => tgt2
+  end do
+
+  if (error) stop 3
+  if (x%y /= 100 &
+      .or. .not.associated (x%ptr, tgt) &
+      .or. y(1)%y /= 101 &
+      .or. y(2)%y /= 102 &
+      .or. y(3)%y /= 103 &
+      .or. y(4)%y /= 104 &
+      .or. .not.associated (y(1)%ptr, tgt) &
+      .or. .not.associated (y(2)%ptr, tgt) &
+      .or. .not.associated (y(3)%ptr, tgt) &
+      .or. .not.associated (y(4)%ptr, tgt) &
+      .or. a%y /= 105 &
+      .or. .not.associated (a%ptr, tgt) &
+      .or. b(1)%y /= 106 &
+      .or. b(2)%y /= 107 &
+      .or. b(3)%y /= 108 &
+      .or. .not.associated (b(1)%ptr, tgt) &
+      .or. .not.associated (b(2)%ptr, tgt) &
+      .or. .not.associated (b(3)%ptr, tgt)) &
+   stop 4
+end
+end
+
+use m
+implicit none
+type(t) :: q, r(4)
+call sub(q,r)
+end
diff --git a/gcc/testsuite/gfortran.dg/do_concurrent_13.f90 b/gcc/testsuite/gfortran.dg/do_concurrent_13.f90
new file mode 100644
index 0000000..6545780
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/do_concurrent_13.f90
@@ -0,0 +1,211 @@
+! { dg-do run }
+! { dg-additional-options "-fdump-tree-original" }
+
+module m
+implicit none
+type t
+  integer :: y = 44
+  integer, pointer :: ptr(:) => null()
+end type t
+
+contains
+
+subroutine sub(x, y)
+  integer :: i
+  type(t), pointer :: x, y(:)
+  type(t), pointer :: a, b(:)
+  logical :: error = .false.
+  integer, target :: tgt(6)
+  integer, target :: tgt2(7)
+
+  type(t), pointer :: x_saved
+  type(t), pointer :: y_saved(:)
+  type(t), pointer :: a_saved
+  type(t), pointer :: b_saved(:)
+
+  allocate(a, b(3))
+
+  x_saved => x
+  y_saved => y
+  a_saved => a
+  b_saved => b
+
+  x%y = 100
+  x%ptr => tgt
+  y(1)%y = 101
+  y(2)%y = 102
+  y(3)%y = 103
+  y(4)%y = 104
+  y(1)%ptr => tgt
+  y(2)%ptr => tgt
+  y(3)%ptr => tgt
+  y(4)%ptr => tgt
+
+  a%y = 105
+  a%ptr => tgt
+  b(1)%y = 106
+  b(2)%y = 107
+  b(3)%y = 108
+  b(1)%ptr => tgt
+  b(2)%ptr => tgt
+  b(3)%ptr => tgt
+
+  do concurrent (i = 1: 3) local_init(x,y,a,b) shared(error,tgt,tgt2,x_saved,y_saved,a_saved,b_saved) default(none)
+    if (.not.associated(x,x_saved)) error = .true.
+    if (.not.associated(y,y_saved)) error = .true.
+    if (.not.associated(a,a_saved)) error = .true.
+    if (.not.associated(b,b_saved)) error = .true.
+    if (x%y /= 100 &
+        .or. .not.associated (x%ptr, tgt) &
+        .or. y(1)%y /= 101 &
+        .or. y(2)%y /= 102 &
+        .or. y(3)%y /= 103 &
+        .or. y(4)%y /= 104 &
+        .or. .not.associated (y(1)%ptr, tgt) &
+        .or. .not.associated (y(2)%ptr, tgt) &
+        .or. .not.associated (y(3)%ptr, tgt) &
+        .or. .not.associated (y(4)%ptr, tgt) &
+        .or. a%y /= 105 &
+        .or. .not.associated (a%ptr, tgt) &
+        .or. b(1)%y /= 106 &
+        .or. b(2)%y /= 107 &
+        .or. b(3)%y /= 108 &
+        .or. .not.associated (b(1)%ptr, tgt) &
+        .or. .not.associated (b(2)%ptr, tgt) &
+        .or. .not.associated (b(3)%ptr, tgt)) &
+     error = .true.
+
+    if (i == 3) then
+      ! This is a hack - assuming no concurrency!
+      x%y = 900
+      y(1)%y = 901
+      a%y = 905
+      b(1)%y = 906
+    endif
+    x => null()
+    y => null()
+    a => null()
+    b => null()
+  end do
+
+  if (error) stop 1
+  if (.not.associated(x,x_saved)) stop 2
+  if (.not.associated(y,y_saved)) stop 3
+  if (.not.associated(a,a_saved)) stop 4
+  if (.not.associated(b,b_saved)) stop 5
+  ! Value a bit changed because of the hack above!
+  if (x%y /= 900 &
+      .or. .not.associated (x%ptr, tgt) &
+      .or. y(1)%y /= 901 &
+      .or. y(2)%y /= 102 &
+      .or. y(3)%y /= 103 &
+      .or. y(4)%y /= 104 &
+      .or. .not.associated (y(1)%ptr, tgt) &
+      .or. .not.associated (y(2)%ptr, tgt) &
+      .or. .not.associated (y(3)%ptr, tgt) &
+      .or. .not.associated (y(4)%ptr, tgt) &
+      .or. a%y /= 905 &
+      .or. .not.associated (a%ptr, tgt) &
+      .or. b(1)%y /= 906 &
+      .or. b(2)%y /= 107 &
+      .or. b(3)%y /= 108 &
+      .or. .not.associated (b(1)%ptr, tgt) &
+      .or. .not.associated (b(2)%ptr, tgt) &
+      .or. .not.associated (b(3)%ptr, tgt)) &
+   stop 6
+
+  ! Reset
+  x%y = 100
+  y(1)%y = 101
+  a%y = 105
+  b(1)%y = 106
+
+  do concurrent (i = 1: 3) local(x,y,a,b) shared(error) default(none)
+    x => null()
+    y => null()
+    a => null()
+    b => null()
+  end do
+
+  if (.not.associated(x,x_saved)) stop 7
+  if (.not.associated(y,y_saved)) stop 8
+  if (.not.associated(a,a_saved)) stop 9
+  if (.not.associated(b,b_saved)) stop 10
+  if (x%y /= 100 &
+      .or. .not.associated (x%ptr, tgt) &
+      .or. y(1)%y /= 101 &
+      .or. y(2)%y /= 102 &
+      .or. y(3)%y /= 103 &
+      .or. y(4)%y /= 104 &
+      .or. .not.associated (y(1)%ptr, tgt) &
+      .or. .not.associated (y(2)%ptr, tgt) &
+      .or. .not.associated (y(3)%ptr, tgt) &
+      .or. .not.associated (y(4)%ptr, tgt) &
+      .or. a%y /= 105 &
+      .or. .not.associated (a%ptr, tgt) &
+      .or. b(1)%y /= 106 &
+      .or. b(2)%y /= 107 &
+      .or. b(3)%y /= 108 &
+      .or. .not.associated (b(1)%ptr, tgt) &
+      .or. .not.associated (b(2)%ptr, tgt) &
+      .or. .not.associated (b(3)%ptr, tgt)) &
+   stop 11
+
+  do concurrent (i = 1: 3) local(x,y,a,b) shared(error,tgt,tgt2,x_saved,y_saved,a_saved,b_saved) default(none)
+    x => a_saved
+    y => b_saved
+    a => x_saved
+    b => y_saved
+    if (a%y /= 100 &
+        .or. .not.associated (a%ptr, tgt) &
+        .or. b(1)%y /= 101 &
+        .or. b(2)%y /= 102 &
+        .or. b(3)%y /= 103 &
+        .or. b(4)%y /= 104 &
+        .or. .not.associated (b(1)%ptr, tgt) &
+        .or. .not.associated (b(2)%ptr, tgt) &
+        .or. .not.associated (b(3)%ptr, tgt) &
+        .or. .not.associated (b(4)%ptr, tgt) &
+        .or. x%y /= 105 &
+        .or. .not.associated (x%ptr, tgt) &
+        .or. y(1)%y /= 106 &
+        .or. y(2)%y /= 107 &
+        .or. y(3)%y /= 108 &
+        .or. .not.associated (y(1)%ptr, tgt) &
+        .or. .not.associated (y(2)%ptr, tgt) &
+        .or. .not.associated (y(3)%ptr, tgt)) &
+     error = .true.
+  end do
+
+  if (.not.associated(x,x_saved)) stop 12
+  if (.not.associated(y,y_saved)) stop 13
+  if (.not.associated(a,a_saved)) stop 14
+  if (.not.associated(b,b_saved)) stop 15
+  if (x%y /= 100 &
+      .or. .not.associated (x%ptr, tgt) &
+      .or. y(1)%y /= 101 &
+      .or. y(2)%y /= 102 &
+      .or. y(3)%y /= 103 &
+      .or. y(4)%y /= 104 &
+      .or. .not.associated (y(1)%ptr, tgt) &
+      .or. .not.associated (y(2)%ptr, tgt) &
+      .or. .not.associated (y(3)%ptr, tgt) &
+      .or. .not.associated (y(4)%ptr, tgt) &
+      .or. a%y /= 105 &
+      .or. .not.associated (a%ptr, tgt) &
+      .or. b(1)%y /= 106 &
+      .or. b(2)%y /= 107 &
+      .or. b(3)%y /= 108 &
+      .or. .not.associated (b(1)%ptr, tgt) &
+      .or. .not.associated (b(2)%ptr, tgt) &
+      .or. .not.associated (b(3)%ptr, tgt)) &
+   stop 16
+end
+end
+
+use m
+implicit none
+type(t), pointer :: q, r(:)
+allocate(q, r(4))
+call sub(q,r)
+end
diff --git a/gcc/testsuite/gfortran.dg/do_concurrent_14.f90 b/gcc/testsuite/gfortran.dg/do_concurrent_14.f90
new file mode 100644
index 0000000..c0a90ff
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/do_concurrent_14.f90
@@ -0,0 +1,176 @@
+! { dg-do run }
+
+module m
+implicit none
+type t
+  integer :: y = 44
+  integer, pointer :: ptr(:) => null()
+end type t
+
+! No default initializers, cf. do_concurrent_12.f90
+! and PR fortran/101602 (comment 6)
+type t2
+  integer :: y
+  integer, pointer :: ptr(:)
+end type t2
+
+contains
+
+subroutine sub(x, y)
+  integer :: i
+  type(t) :: x, y(4)
+  type(t) :: a, b(3)
+  type(t2) :: x2, y2(4)
+  type(t2) :: a2, b2(3)
+  logical :: error = .false.
+  integer, target :: tgt(6)
+  integer, target :: tgt2(7)
+
+  x%y = 100
+  x%ptr => tgt
+  y(1)%y = 101
+  y(2)%y = 102
+  y(3)%y = 103
+  y(4)%y = 104
+  y(1)%ptr => tgt
+  y(2)%ptr => tgt
+  y(3)%ptr => tgt
+  y(4)%ptr => tgt
+
+  a%y = 105
+  a%ptr => tgt
+  b(1)%y = 106
+  b(2)%y = 107
+  b(3)%y = 108
+  b(1)%ptr => tgt
+  b(2)%ptr => tgt
+  b(3)%ptr => tgt
+
+  ! Copy values from 't' to associated 't2' variables
+  x2%y = x%y
+  x2%ptr => x%ptr
+  a2%y = a%y
+  a2%ptr => a%ptr
+  y2(:)%y = y(:)%y
+  do i = 1, size(y)
+    y2(i)%ptr => y(i)%ptr
+  end do
+  b2(:)%y = b(:)%y
+  do i = 1, size(b)
+    b2(i)%ptr => b(i)%ptr
+  end do
+
+  do concurrent (i = 1: 3) local_init(x,y,a,b) shared(error,tgt,tgt2) default(none)
+    if (x%y /= 100 &
+        .or. .not.associated (x%ptr, tgt) &
+        .or. y(1)%y /= 101 &
+        .or. y(2)%y /= 102 &
+        .or. y(3)%y /= 103 &
+        .or. y(4)%y /= 104 &
+        .or. .not.associated (y(1)%ptr, tgt) &
+        .or. .not.associated (y(2)%ptr, tgt) &
+        .or. .not.associated (y(3)%ptr, tgt) &
+        .or. .not.associated (y(4)%ptr, tgt) &
+        .or. a%y /= 105 &
+        .or. .not.associated (a%ptr, tgt) &
+        .or. b(1)%y /= 106 &
+        .or. b(2)%y /= 107 &
+        .or. b(3)%y /= 108 &
+        .or. .not.associated (b(1)%ptr, tgt) &
+        .or. .not.associated (b(2)%ptr, tgt) &
+        .or. .not.associated (b(3)%ptr, tgt)) &
+     error = .true.
+
+    x%y = 900
+    x%ptr => tgt
+    y(1)%y = 901
+    y(2)%y = 902
+    y(3)%y = 903
+    y(4)%y = 904
+    y(1)%ptr => tgt2
+    y(2)%ptr => tgt2
+    y(3)%ptr => tgt2
+    y(4)%ptr => tgt2
+
+    a%y = 905
+    a%ptr => tgt
+    b(1)%y = 906
+    b(2)%y = 907
+    b(3)%y = 908
+    b(1)%ptr => tgt2
+    b(2)%ptr => tgt2
+    b(3)%ptr => tgt2
+  end do
+
+  if (error) stop 1
+  if (x%y /= 100 &
+      .or. .not.associated (x%ptr, tgt) &
+      .or. y(1)%y /= 101 &
+      .or. y(2)%y /= 102 &
+      .or. y(3)%y /= 103 &
+      .or. y(4)%y /= 104 &
+      .or. .not.associated (y(1)%ptr, tgt) &
+      .or. .not.associated (y(2)%ptr, tgt) &
+      .or. .not.associated (y(3)%ptr, tgt) &
+      .or. .not.associated (y(4)%ptr, tgt) &
+      .or. a%y /= 105 &
+      .or. .not.associated (a%ptr, tgt) &
+      .or. b(1)%y /= 106 &
+      .or. b(2)%y /= 107 &
+      .or. b(3)%y /= 108 &
+      .or. .not.associated (b(1)%ptr, tgt) &
+      .or. .not.associated (b(2)%ptr, tgt) &
+      .or. .not.associated (b(3)%ptr, tgt)) &
+   stop 2
+
+  ! Use version without default initializers
+  do concurrent (i = 1: 3) local(x2,y2,a2,b2) shared(error,tgt,tgt2) default(none)
+    x2%y = 900
+    x2%ptr => tgt
+    y2(1)%y = 901
+    y2(2)%y = 902
+    y2(3)%y = 903
+    y2(4)%y = 904
+    y2(1)%ptr => tgt2
+    y2(2)%ptr => tgt2
+    y2(3)%ptr => tgt2
+    y2(4)%ptr => tgt2
+
+    a2%y = 905
+    a2%ptr => tgt
+    b2(1)%y = 906
+    b2(2)%y = 907
+    b2(3)%y = 908
+    b2(1)%ptr => tgt2
+    b2(2)%ptr => tgt2
+    b2(3)%ptr => tgt2
+  end do
+
+  if (error) stop 3
+  if (x2%y /= 100 &
+      .or. .not.associated (x2%ptr, tgt) &
+      .or. y2(1)%y /= 101 &
+      .or. y2(2)%y /= 102 &
+      .or. y2(3)%y /= 103 &
+      .or. y2(4)%y /= 104 &
+      .or. .not.associated (y2(1)%ptr, tgt) &
+      .or. .not.associated (y2(2)%ptr, tgt) &
+      .or. .not.associated (y2(3)%ptr, tgt) &
+      .or. .not.associated (y2(4)%ptr, tgt) &
+      .or. a2%y /= 105 &
+      .or. .not.associated (a2%ptr, tgt) &
+      .or. b2(1)%y /= 106 &
+      .or. b2(2)%y /= 107 &
+      .or. b2(3)%y /= 108 &
+      .or. .not.associated (b2(1)%ptr, tgt) &
+      .or. .not.associated (b2(2)%ptr, tgt) &
+      .or. .not.associated (b2(3)%ptr, tgt)) &
+   stop 4
+end
+end
+
+use m
+implicit none
+type(t) :: q, r(4)
+call sub(q,r)
+end
diff --git a/gcc/testsuite/gfortran.dg/do_concurrent_15.f90 b/gcc/testsuite/gfortran.dg/do_concurrent_15.f90
new file mode 100644
index 0000000..f0003c8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/do_concurrent_15.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+
+! Fails to compile because assumed-size arrays are not yet
+! handled with LOCAL / LOCAL_INIT, cf. PR fortran/101602 (comment 6)
+
+subroutine test_it(xx, yy)
+  implicit none
+  integer :: xx(:), yy(:,:)
+  integer :: i, sz1, sz2
+
+  sz1 = size(xx)
+  do , concurrent (i = 1 : sz1) local(xx)  ! { dg-error "39: Sorry, LOCAL specifier at .1. for assumed-size array 'xx' is not yet supported" }
+    xx(i) = 1
+  end do
+
+  sz2 = size(yy,dim=1)
+  do , concurrent (i=1:sz2) local_init(yy)  ! { dg-error "40: Sorry, LOCAL_INIT specifier at .1. for assumed-size array 'yy' is not yet supported" }
+    yy(i,:) = 1
+  end do
+end
diff --git a/gcc/testsuite/gfortran.dg/do_concurrent_8_f2023.f90 b/gcc/testsuite/gfortran.dg/do_concurrent_8_f2023.f90
index a99d81e..55eb97b 100644
--- a/gcc/testsuite/gfortran.dg/do_concurrent_8_f2023.f90
+++ b/gcc/testsuite/gfortran.dg/do_concurrent_8_f2023.f90
@@ -8,10 +8,8 @@ program do_concurrent_complex
   product = 1
   do concurrent (i = 1:10) local(j) shared(sum) reduce(+:sum)
     ! { dg-error "Variable .sum. at .1. has already been specified in a locality-spec" "" { target *-*-* } .-1 }
-    ! { dg-error "Sorry, LOCAL and LOCAL_INIT are not yet supported for 'do concurrent' constructs" "" { target *-*-* } .-2 }
     do concurrent (j = 1:10) local(k) shared(product) reduce(*:product)
       ! { dg-error "Variable .product. at .1. has already been specified in a locality-spec" "" { target *-*-* } .-1 }
-      ! { dg-error "Sorry, LOCAL and LOCAL_INIT are not yet supported for 'do concurrent' constructs" "" { target *-*-* } .-2 }
       do concurrent (k = 1:10)
         array(i,j,k) = i * j * k
         sum = sum + array(i,j,k)
@@ -20,4 +18,4 @@ program do_concurrent_complex
     end do
   end do
   print *, sum, product
-end program do_concurrent_complex
-\ No newline at end of file
+end program do_concurrent_complex
diff --git a/gcc/testsuite/gfortran.dg/do_concurrent_9.f90 b/gcc/testsuite/gfortran.dg/do_concurrent_9.f90
index 98cef3e..9c1bca6 100644
--- a/gcc/testsuite/gfortran.dg/do_concurrent_9.f90
+++ b/gcc/testsuite/gfortran.dg/do_concurrent_9.f90
@@ -6,7 +6,7 @@ program do_concurrent_default_none
   x = 0
   y = 0
   z = 0
-  do concurrent (i = 1:10) default(none) shared(x) local(y) ! { dg-error "Sorry, LOCAL and LOCAL_INIT are not yet supported" }
+  do concurrent (i = 1:10) default(none) shared(x) local(y)
     ! { dg-error "Variable 'z' .* not specified in a locality spec .* but required due to DEFAULT \\(NONE\\)" "" { target *-*-* } .-1 }
     x = x + i
     y = i * 2
diff --git a/gcc/testsuite/gfortran.dg/do_concurrent_all_clauses.f90 b/gcc/testsuite/gfortran.dg/do_concurrent_all_clauses.f90
index 2e1c18c..0c8a6ad 100644
--- a/gcc/testsuite/gfortran.dg/do_concurrent_all_clauses.f90
+++ b/gcc/testsuite/gfortran.dg/do_concurrent_all_clauses.f90
@@ -11,7 +11,6 @@ program do_concurrent_all_clauses
       shared(arr, squared, sum, max_val) &
       reduce(+:sum) & ! { dg-error "Variable 'sum' at \\(1\\) has already been specified in a locality-spec" }
       reduce(max:max_val) ! { dg-error "Variable 'max_val' at \\(1\\) has already been specified in a locality-spec" }
-    ! { dg-error "Sorry, LOCAL and LOCAL_INIT are not yet supported*" "" { target *-*-* } .-1 }
     block
       integer :: temp2
       temp = i * 2
diff --git a/gcc/testsuite/gfortran.dg/do_concurrent_local_init.f90 b/gcc/testsuite/gfortran.dg/do_concurrent_local_init.f90
index 08e1fb9..6c5e87e 100644
--- a/gcc/testsuite/gfortran.dg/do_concurrent_local_init.f90
+++ b/gcc/testsuite/gfortran.dg/do_concurrent_local_init.f90
@@ -3,9 +3,9 @@
 program do_concurrent_local_init
   implicit none
   integer :: i, arr(10), temp
-  do concurrent (i = 1:10) local_init(temp)  ! { dg-error "LOCAL and LOCAL_INIT are not yet supported for 'do concurrent' constructs" }
+  do concurrent (i = 1:10) local_init(temp)
     temp = i
     arr(i) = temp
   end do
   print *, arr
-end program do_concurrent_local_init
-\ No newline at end of file
+end program do_concurrent_local_init
diff --git a/gcc/testsuite/gfortran.dg/do_concurrent_locality_specs.f90 b/gcc/testsuite/gfortran.dg/do_concurrent_locality_specs.f90
index 0ee7a7e..ed3504e 100644
--- a/gcc/testsuite/gfortran.dg/do_concurrent_locality_specs.f90
+++ b/gcc/testsuite/gfortran.dg/do_concurrent_locality_specs.f90
@@ -6,9 +6,8 @@ do , concurrent (i = 1:5) shared(j,jj) local(k,kk) local_init(ll,lll)
     ! { dg-warning "Variable 'kk' in locality-spec at \\(1\\) is not used \\\[-Wunused-variable\\\]" "" { target *-*-* } .-1 }
     ! { dg-warning "Variable 'll' in locality-spec at \\(1\\) is not used \\\[-Wunused-variable\\\]" "" { target *-*-* } .-2 }
     ! { dg-warning "Variable 'jj' in locality-spec at \\(1\\) is not used \\\[-Wunused-variable\\\]" "" { target *-*-* } .-3 }
-    ! { dg-error "Sorry, LOCAL and LOCAL_INIT are not yet supported for 'do concurrent' constructs" "" { target *-*-* } .-4 }
   j = 5
   k = 7
   lll = 8
 end do
-end
-\ No newline at end of file
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/append-args-interop.f90 b/gcc/testsuite/gfortran.dg/gomp/append-args-interop.f90
index f2c4d97..540079a 100644
--- a/gcc/testsuite/gfortran.dg/gomp/append-args-interop.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/append-args-interop.f90
@@ -23,6 +23,6 @@ use m
   call f()
 end
 
-! { dg-final { scan-tree-dump "__builtin_GOMP_interop \\(99, 3, interopobjs\.\[0-9\]+, tgt_tgtsync\.\[0-9\]+, pref_type\.\[0-9\]+, " "gimple" } }
-! { dg-final { scan-tree-dump "__builtin_GOMP_interop \\(99, 0, 0B, 0B, 0B, 0, 0B, 3, interopobjs\.\[0-9\]+," "gimple" } }
+! { dg-final { scan-tree-dump "__builtin_GOMP_interop \\(99, 3, &interopobjs\.\[0-9\]+, &tgt_tgtsync\.\[0-9\]+, &pref_type\.\[0-9\]+, " "gimple" } }
+! { dg-final { scan-tree-dump "__builtin_GOMP_interop \\(99, 0, 0B, 0B, 0B, 0, 0B, 3, &interopobjs\.\[0-9\]+," "gimple" } }
 ! { dg-final { scan-tree-dump "g \\(&interop\.\[0-9\]+, interop\.\[0-9\]+, &interop\.\[0-9\]+\\)" "gimple" } }
diff --git a/gcc/testsuite/gfortran.dg/optional_absent_13.f90 b/gcc/testsuite/gfortran.dg/optional_absent_13.f90
new file mode 100644
index 0000000..9c2039b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/optional_absent_13.f90
@@ -0,0 +1,48 @@
+! { dg-do run }
+! PR fortran/119656 - wrong code with impure elemental subroutine and interface
+!
+! Derived from testcase at:
+!   https://fortran-lang.discourse.group/t/
+!     problem-with-impure-elemental-subroutine-in-interface-with-gfortran/9545
+
+module m2
+  implicit none
+  interface foo
+     module procedure foo_mat
+     module procedure foo_df
+     module procedure foo_cmat
+  end interface foo
+contains
+
+  subroutine foo_mat(x, nacf, label)
+    real,             intent(in)           :: x(:,:)
+    integer,          intent(in)           :: nacf
+    character(len=*), intent(in), optional :: label
+  end subroutine foo_mat
+
+  impure elemental subroutine foo_df(nacf, outu, xstr)
+    integer         , intent(in)           :: nacf
+    integer         , intent(in), optional :: outu
+    character(len=*), intent(in), optional :: xstr
+    if (present(xstr)) then
+       if (len (xstr) /= 2) then
+          print *,"nacf, len(xstr) =", nacf, len(xstr)
+          stop nacf
+       end if
+    end if
+  end subroutine foo_df
+
+  subroutine foo_cmat(x, nacf, label)
+    complex,          intent(in)           :: x(:,:)
+    integer,          intent(in)           :: nacf
+    character(len=*), intent(in), optional :: label
+  end subroutine foo_cmat
+
+end module m2
+
+program main
+  use m2, only: foo, foo_df
+  implicit none
+  call foo_df(nacf = 1, xstr="ab")
+  call foo   (nacf = 2, xstr="ab")
+end program main
diff --git a/gcc/testsuite/gfortran.dg/reduce_2.f90 b/gcc/testsuite/gfortran.dg/reduce_2.f90
index 52d7c68..cacd54a 100644
--- a/gcc/testsuite/gfortran.dg/reduce_2.f90
+++ b/gcc/testsuite/gfortran.dg/reduce_2.f90
@@ -8,6 +8,10 @@
   integer, allocatable :: i(:,:,:)
   integer :: n(2,2)
   Logical :: l1(4), l2(2,3), l3(2,2)
+  type :: string_t
+    character(:), allocatable :: chr(:)
+  end type
+  type(string_t) :: str
 
 ! The ARRAY argument at (1) of REDUCE shall not be polymorphic
   print *, reduce (cstar, add) ! { dg-error "shall not be polymorphic" }
@@ -54,6 +58,10 @@
 ! (2) shall be the same
   print *, reduce ([character(4) :: 'abcd','efgh'], char_three) ! { dg-error "arguments of the OPERATION" }
 
+! The character length of the ARRAY argument at (1) and of the arguments of the OPERATION at (2)
+! shall be the same
+  str = reduce ([character(4) :: 'abcd','efgh'], char_one) ! { dg-error "character length of the ARRAY" }
+
 ! The DIM argument at (1), if present, must be an integer scalar
   print *, reduce (i, add, dim = 2.0) ! { dg-error "must be an integer scalar" }
 
diff --git a/gcc/testsuite/gfortran.dg/reduce_3.f90 b/gcc/testsuite/gfortran.dg/reduce_3.f90
new file mode 100644
index 0000000..c0ed062
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/reduce_3.f90
@@ -0,0 +1,56 @@
+! { dg-do run }
+!
+! PR119460: Scalar reduce was failing with ARRAY elements larger than
+! an address size.
+!
+! Contributed by Rainer Orth  <ro@gcc.gnu.org>
+!
+program test_reduce
+   implicit none
+   integer :: i
+   integer, parameter :: dp = kind(1.0_8), extent = 4
+
+   real(dp) :: rarray(extent,extent,extent), rmat(extent,extent), &
+               rvec (extent), rscl
+
+   type :: t
+      real(dp) :: field(extent)
+   end type t
+
+   type (t) :: tmat(extent, extent), tarray(extent), tscalar
+
+   rarray = reshape ([(real(i, kind = dp), i = 1, size(rarray))], &
+                     shape (rarray))
+
+   rmat = reduce (rarray, add, dim = 1)
+   if (any (rmat /= sum (rarray, 1))) stop 1
+
+   rmat = reduce (rarray, add, dim = 2)
+   if (any (rmat /= sum (rarray, 2))) stop 2
+
+   rmat = reduce (rarray, add, dim = 3)
+   if (any (rmat /= sum (rarray, 3))) stop 3
+
+   rscl = reduce (rarray, add)
+   if (rscl /= sum (rarray)) stop 4
+
+   tmat%field(1) = rmat
+   tarray = reduce (tmat, t_add, dim =1)
+   rvec = reduce (rmat, add, dim = 1)
+   if (any (tarray%field(1) /= rvec)) stop 5
+
+   tscalar = reduce (tmat, t_add)
+   if (tscalar%field(1) /= sum (tmat%field(1))) stop 6
+contains
+
+   pure real(dp) function add (i, j)
+      real(dp), intent(in) :: i, j
+      add = i + j
+   end function add
+
+   pure type(t) function t_add (i, j)
+      type(t), intent(in) :: i, j
+      t_add%field(1) = i%field(1) + j%field(1)
+   end function t_add
+
+end
diff --git a/gcc/testsuite/gfortran.dg/reduce_4.f90 b/gcc/testsuite/gfortran.dg/reduce_4.f90
new file mode 100644
index 0000000..edea931
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/reduce_4.f90
@@ -0,0 +1,48 @@
+! { dg-do run }
+!
+! PR119540 comment2: REDUCE was getting the shape wrong. This testcase also
+! verifies that the longest possible name for the OPERATION wrapper function
+! is catered for.
+!
+! Contributed by Harald Anlauf  <anlauf@gcc.gnu.org>
+!
+program p2345678901234567890123456789012345678901234567890123456789_123
+  implicit none
+  integer, parameter :: n = 3
+  integer, parameter :: vec(n) = [2, 5, 10]
+  integer, parameter :: mat(n,2) = reshape([vec,2*vec],[n,2])
+  integer :: mat_shape(2), reduce_shape(1), r
+  integer, dimension(:), allocatable :: res1
+
+  mat_shape = shape (mat)
+  reduce_shape = shape (reduce (mat, add, 1), 1)
+  if (reduce_shape(1) /= mat_shape(2)) stop 1
+
+  reduce_shape = shape (reduce (mat, add, 1), 1)
+  if (reduce_shape(1) /= mat_shape(2)) stop 2
+
+  res1 = reduce (mat, add, 1)
+  if (any (res1 /= [17, 34])) stop 3
+
+  res1 = reduce (mat, add, 2)
+  if (any (res1 /= [6, 15, 30])) stop 4
+
+  r = reduce (vec, &
+              o2345678901234567890123456789012345678901234567890123456789_123)
+  if (r /= 17) stop 5
+
+  deallocate (res1)
+contains
+  pure function add(i,j) result(sum_ij)
+    integer, intent(in) :: i, j
+    integer             :: sum_ij
+    sum_ij = i + j
+  end function add
+
+  pure function o2345678901234567890123456789012345678901234567890123456789_123 (i, j) &
+       result (sum)
+    integer, intent(in) :: i, j
+    integer             :: sum
+    sum = i + j
+  end function
+end