[PATCH 15/22] Coarray caf_shmem final patch set

From 9db159f5a09d5beb0d0545e573fcdfaa8938088d Mon Sep 17 00:00:00 2001
From: Andre Vehreschild <[email protected]>
Date: Sat, 14 Feb 2026 11:37:07 -0800
Subject: [PATCH] Fortran: Fix coarray shared mem [PR121429]

	PR fortran/121429

libgfortran/ChangeLog:

	* caf/shmem.c (_gfortran_caf_deregister): Add a call to
	sync_team.

gcc/testsuite/ChangeLog:

	* gfortran.dg/coarray/deallocate_sync.f90: New test.
---
 .../gfortran.dg/coarray/deallocate_sync.f90   | 26 +++++++++++++++++++
 libgfortran/caf/shmem.c                       |  1 +
 2 files changed, 27 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/coarray/deallocate_sync.f90

diff --git a/gcc/testsuite/gfortran.dg/coarray/deallocate_sync.f90 b/gcc/testsuite/gfortran.dg/coarray/deallocate_sync.f90
new file mode 100644
index 00000000000..8c6f2b79fb1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/deallocate_sync.f90
@@ -0,0 +1,26 @@
+! { dg-do run }
+! Test case from pr121429 which failed because the deallocate was not
+! doing an implicit sync all.
+program main
+  implicit none
+  integer, allocatable, codimension[:] :: a(:), b(:)
+  integer :: n, i, left, right
+  integer :: k
+  n = num_images()
+  i = this_image()
+  !   We skip this test for -fcoarray=single
+  if (n .ne. 1) then
+    ! Verify in the testsuite that num_images = 8 as set in caf.exp
+    if (n .ne. 8) error stop "Need at least three images"
+    left = modulo(i+n-2,n)+1
+    right = modulo(i,n)+1
+    do k=1,1000
+       allocate(a(k+5)[*])
+       allocate(b(k)[*])
+       b(:)[right] = right + 1000 * k
+       deallocate (a)  ! This synchronizes automatically
+       if (any(b(:)[left] /= left + 1000 * k)) error stop "Test failed"
+       deallocate (b)
+    end do
+  end if
+end program main
diff --git a/libgfortran/caf/shmem.c b/libgfortran/caf/shmem.c
index 9913db6d709..de6a2b23017 100644
--- a/libgfortran/caf/shmem.c
+++ b/libgfortran/caf/shmem.c
@@ -465,6 +465,7 @@ _gfortran_caf_deregister (caf_token_t *token, caf_deregister_t type, int *stat,
       free (ca);
       free (TOKEN (*token));
       *token = NULL;
+      sync_team (caf_current_team);
     }
   else
     {
-- 
2.53.0