Patch Detail
get:
Show a patch.
patch:
Update a patch.
put:
Update a patch.
GET /api/patches/2195310/?format=api
{ "id": 2195310, "url": "http://patchwork.ozlabs.org/api/patches/2195310/?format=api", "web_url": "http://patchwork.ozlabs.org/project/gcc/patch/5ac88929-4f86-4ca4-bce6-4e9a55b2f854@gmail.com/", "project": { "id": 17, "url": "http://patchwork.ozlabs.org/api/projects/17/?format=api", "name": "GNU Compiler Collection", "link_name": "gcc", "list_id": "gcc-patches.gcc.gnu.org", "list_email": "gcc-patches@gcc.gnu.org", "web_url": null, "scm_url": null, "webscm_url": null, "list_archive_url": "", "list_archive_url_format": "", "commit_url_format": "" }, "msgid": "<5ac88929-4f86-4ca4-bce6-4e9a55b2f854@gmail.com>", "list_archive_url": null, "date": "2026-02-10T18:11:13", "name": "[6/13] Coarray shared memory library", "commit_ref": null, "pull_url": null, "state": "new", "archived": false, "hash": "32f5848dc67ab49a0f172e28b09659c5fc7eb910", "submitter": { "id": 78264, "url": "http://patchwork.ozlabs.org/api/people/78264/?format=api", "name": "Jerry D", "email": "jvdelisle2@gmail.com" }, "delegate": null, "mbox": "http://patchwork.ozlabs.org/project/gcc/patch/5ac88929-4f86-4ca4-bce6-4e9a55b2f854@gmail.com/mbox/", "series": [ { "id": 491719, "url": "http://patchwork.ozlabs.org/api/series/491719/?format=api", "web_url": "http://patchwork.ozlabs.org/project/gcc/list/?series=491719", "date": "2026-02-10T17:55:35", "name": "[1/13] Coarray shared memory library", "version": 1, "mbox": "http://patchwork.ozlabs.org/series/491719/mbox/" } ], "comments": "http://patchwork.ozlabs.org/api/patches/2195310/comments/", "check": "pending", "checks": "http://patchwork.ozlabs.org/api/patches/2195310/checks/", "tags": {}, "related": [], "headers": { "Return-Path": "<gcc-patches-bounces~incoming=patchwork.ozlabs.org@gcc.gnu.org>", "X-Original-To": [ "incoming@patchwork.ozlabs.org", "gcc-patches@gcc.gnu.org" ], "Delivered-To": [ "patchwork-incoming@legolas.ozlabs.org", "gcc-patches@gcc.gnu.org" ], "Authentication-Results": [ "legolas.ozlabs.org;\n\tdkim=pass (2048-bit key;\n unprotected) header.d=gmail.com header.i=@gmail.com header.a=rsa-sha256\n header.s=20230601 header.b=Jc/bgtH/;\n\tdkim-atps=neutral", "legolas.ozlabs.org;\n spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org\n (client-ip=2620:52:6:3111::32; helo=vm01.sourceware.org;\n envelope-from=gcc-patches-bounces~incoming=patchwork.ozlabs.org@gcc.gnu.org;\n receiver=patchwork.ozlabs.org)", "sourceware.org;\n\tdkim=pass (2048-bit key,\n unprotected) header.d=gmail.com header.i=@gmail.com header.a=rsa-sha256\n header.s=20230601 header.b=Jc/bgtH/", "sourceware.org;\n dmarc=pass (p=none dis=none) header.from=gmail.com", "sourceware.org; spf=pass smtp.mailfrom=gmail.com", "server2.sourceware.org;\n arc=none smtp.remote-ip=209.85.210.178" ], "Received": [ "from vm01.sourceware.org (vm01.sourceware.org\n [IPv6:2620:52:6:3111::32])\n\t(using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)\n\t key-exchange x25519 server-signature ECDSA (secp384r1) server-digest SHA384)\n\t(No client certificate requested)\n\tby legolas.ozlabs.org (Postfix) with ESMTPS id 4f9V5n2hJkz1xtr\n\tfor <incoming@patchwork.ozlabs.org>; Wed, 11 Feb 2026 05:12:29 +1100 (AEDT)", "from vm01.sourceware.org (localhost [127.0.0.1])\n\tby sourceware.org (Postfix) with ESMTP id 3D2784BA2E11\n\tfor <incoming@patchwork.ozlabs.org>; Tue, 10 Feb 2026 18:12:27 +0000 (GMT)", "from mail-pf1-f178.google.com (mail-pf1-f178.google.com\n [209.85.210.178])\n by sourceware.org (Postfix) with ESMTPS id 493954BA2E19\n for <gcc-patches@gcc.gnu.org>; Tue, 10 Feb 2026 18:11:16 +0000 (GMT)", "by mail-pf1-f178.google.com with SMTP id\n d2e1a72fcca58-82361bcbd8fso2384346b3a.0\n for <gcc-patches@gcc.gnu.org>; Tue, 10 Feb 2026 10:11:16 -0800 (PST)", "from [10.168.168.23] ([50.37.179.80])\n by smtp.gmail.com with ESMTPSA id\n d2e1a72fcca58-824418812d2sm16504120b3a.43.2026.02.10.10.11.14\n (version=TLS1_3 cipher=TLS_AES_128_GCM_SHA256 bits=128/128);\n Tue, 10 Feb 2026 10:11:14 -0800 (PST)" ], "DKIM-Filter": [ "OpenDKIM Filter v2.11.0 sourceware.org 3D2784BA2E11", "OpenDKIM Filter v2.11.0 sourceware.org 493954BA2E19" ], "DMARC-Filter": "OpenDMARC Filter v1.4.2 sourceware.org 493954BA2E19", "ARC-Filter": "OpenARC Filter v1.0.0 sourceware.org 493954BA2E19", "ARC-Seal": "i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1770747076; cv=none;\n b=AQSxVSdD5Jzr8oiaAHdTSVZqW98pkS4ThvyILR//SpZjGNiGXIiiJnjL/JMkBz73BcxyObB+QxU2izbB1ogz6g9uZvaJVM8zMnnHEK8MoadIJObjLOq3K9rKcrtjiBWpDIhWcG4WsNA7vOemAtCoH01WaXTG6QKAmi97z3kKNDs=", "ARC-Message-Signature": "i=1; a=rsa-sha256; d=sourceware.org; s=key;\n t=1770747076; c=relaxed/simple;\n bh=7jPKm6uaU7S7aOUIfmjgqxCUj3MGcZ9mB0xHeXysJ8A=;\n h=DKIM-Signature:Message-ID:Date:MIME-Version:To:From:Subject;\n b=KBzfuSxLRJAUv7fqTUiSIU0ltV+ygxbMgdbQpK5d+otb8+9AaoP7e9VfghqdD5ZIfF7J3Lf3KErHY1M6ZGyvchvhZTl4bWe2vHlbKUtFjcK7855hFbrRi3j41tc7rBFvidkBklM4AOjXlObS1rgGi++Ds8qjnwKyxaQgZ6TbGZo=", "ARC-Authentication-Results": "i=1; server2.sourceware.org", "DKIM-Signature": "v=1; a=rsa-sha256; c=relaxed/relaxed;\n d=gmail.com; s=20230601; t=1770747075; x=1771351875; darn=gcc.gnu.org;\n h=autocrypt:subject:from:cc:to:content-language:user-agent\n :mime-version:date:message-id:from:to:cc:subject:date:message-id\n :reply-to; bh=7jPKm6uaU7S7aOUIfmjgqxCUj3MGcZ9mB0xHeXysJ8A=;\n b=Jc/bgtH/14V6WEEsMOB9Rzbwuq8SsJJ0oy6UdZ6kHSSLOroFhRGnnYv5ItxG9GhIYw\n ghCaVvGS9HeTq7x8QcTYwsVwexZVCgAmzqiTrpBhscmMzE7strO/WKaOWQgpq7M9Vrsn\n kCImBh5Og24b5UbSPV6X8YHCwAy4+kB95sjpYUh2ZngOwNpjGAKYkh7B7Ui92ra9729S\n 4fw0V8uALdCs3XR2gK2Tq9f3sKrahmtRXf0a+/ZUSfBsd/KYoalL9k1VJGEhhTCJqoCg\n 2HOjSFGnER46DSyf5V2Jvoc9RrCCmri+YEoc85T5wMJMCQArWxNj4POMq9d89PFKSNJ9\n 0riw==", "X-Google-DKIM-Signature": "v=1; a=rsa-sha256; c=relaxed/relaxed;\n d=1e100.net; s=20230601; t=1770747075; x=1771351875;\n h=autocrypt:subject:from:cc:to:content-language:user-agent\n :mime-version:date:message-id:x-gm-gg:x-gm-message-state:from:to:cc\n :subject:date:message-id:reply-to;\n bh=7jPKm6uaU7S7aOUIfmjgqxCUj3MGcZ9mB0xHeXysJ8A=;\n b=nvgs9VW9Dqjzv8Op3FPpDnCH34gKtvYOV6j7Wn33udCDXGn/Y/jS8nvhCJEPMIdAxj\n o3A8t+fe2JZ5ExiUpb8DDIfRY1YAjonsqAu9aVlkh7MrwK0PKr8ZCk2SfZ7NyiYnvTOK\n qNgCxaqSf/FGtXjbkMTpETbPQ6/dHWu3pVnOvQVKc7mnJHVeWQ3DxI3XHhbbk6Y6K207\n 8G37ybYrThbnm1YoUnF1Po3H5jfMa7tqtw9/ywKFRqbSgt7dNtkY02iMB5FtBdy78zGb\n ZcrqR33Lgo2a55f/AIzz7gkMNcQi3oDGSNCkJbmP/5P+tyQXnOUFR4OV0yF+B7Q3BKyH\n IpPw==", "X-Forwarded-Encrypted": "i=1;\n AJvYcCXZWabTnDMe8/OAE5cf4G9KvxPr058axpnzgxB8D9UF+SL16RcTAqht2MCHSyFyMEsD216cdHl5nwnQHA==@gcc.gnu.org", "X-Gm-Message-State": "AOJu0YzDM9t25/nqG6ryG5/KEHEKli0K938EAvU78P9j5byqy9zzA0ah\n dlXylqcRm1ioyK0CtiZ0ZwvWDpGP2M9JJVjSI8JbEZ0HNYpIfzhz194L", "X-Gm-Gg": "AZuq6aI6VimJZGmKVfk8cHnOPYdPLz6nI6dzv4ZyH4kyNwmp6SeT3xIFoFqfw/fIdC8\n 9Nq7vAC77OaDkypZNodf4bFnwlRiqWU2OUqMaP6sSUjL8EFKKh2mwRmeK00JGHD0raOob7PtwQ9\n FzBqTMlo1qGHQx9mdld8RIpuDgWny0yoIpe5vSFJQnSlwVKkTlJ12TO0l9eTvGzY5Xz6u86qpng\n 2Vww8OOHM/8so5Jq93JUGLzkG7u9LPjxrGV2dgWZRzbruO1Kj8LOxtizy/jhBiYPCRaO70cKRvQ\n YhoQv4F8MX/plSOw5AVPOMc1mkR/nauvTfJ/VgQJzE84YlSrt17xw5MN1x0XOKv8MN5pvd10klu\n XYgg2DnneqChuI1wG2QdaF8SSPG9CSJruWse86hX2AezTGF7/MOfyje/bU0S3vPwRG6wFKiciBl\n dvNlV3Irgo6kRQ/GFiszkxwQVvh7KWtRC3e9eL/A==", "X-Received": "by 2002:a05:6a00:949e:b0:824:98ef:dc63 with SMTP id\n d2e1a72fcca58-82498efdf02mr134722b3a.51.1770747075174;\n Tue, 10 Feb 2026 10:11:15 -0800 (PST)", "Content-Type": "multipart/mixed; boundary=\"------------6v2R6UtJhm0F8GruGl6zFlt9\"", "Message-ID": "<5ac88929-4f86-4ca4-bce6-4e9a55b2f854@gmail.com>", "Date": "Tue, 10 Feb 2026 10:11:13 -0800", "MIME-Version": "1.0", "User-Agent": "Mozilla Thunderbird", "Content-Language": "en-US", "To": "gfortran <fortran@gcc.gnu.org>, gcc-patches <gcc-patches@gcc.gnu.org>", "Cc": "Tobias Burnus <tburnus@baylibre.com>, Richard Biener <rguenther@suse.de>,\n Andre Vehreschild <vehre@gmx.de>, Jakub Jelinek <jakub@redhat.com>,\n Paul Richard Thomas <paul.richard.thomas@gmail.com>,\n FX Coudert <fxcoudert@gmail.com>, Toon Moene <toon@moene.org>", "From": "Jerry D <jvdelisle2@gmail.com>", "Subject": "[PATCH 6/13] Coarray shared memory library", "Autocrypt": "addr=jvdelisle2@gmail.com; keydata=\n xjMEY5TlkxYJKwYBBAHaRw8BAQdAyrkRDhmJhSTTlV/50gJLlvliU6/Lm5C9ViKV8T9y1GnN\n HkplcnJ5IEQgPGp2ZGVsaXNsZTJAZ21haWwuY29tPsKJBBMWCAAxFiEEOFR0TS0390uh8dRV\n uWXAJaWpwWoFAmOU5ZMCGwMECwkIBwUVCAkKCwUWAgMBAAAKCRC5ZcAlpanBalsJAP4wdCiH\n 2Of9oZv1QWgZ/AVdbWFM3Fv47/WZQHOXfoZ9HgD6AkXrKeJ+6usST7PEaDJjptaViT1fLiYY\n V/6XaOKSsgLOOARjlOWTEgorBgEEAZdVAQUBAQdAdA7PczYnl07vnOT9oP/wvvMDd4HP09Zl\n g3LzwXQJWT8DAQgHwngEGBYIACAWIQQ4VHRNLTf3S6Hx1FW5ZcAlpanBagUCY5TlkwIbDAAK\n CRC5ZcAlpanBasF/AQCa5WjlsVpLsEiggZyT18MOJNAdeRd7wkGDUrwedHrvawD/cE1H+/Ms\n L1ZwvQiLfGdx8crigQqWTQyos4kH8Wx82wc=", "X-BeenThere": "gcc-patches@gcc.gnu.org", "X-Mailman-Version": "2.1.30", "Precedence": "list", "List-Id": "Gcc-patches mailing list <gcc-patches.gcc.gnu.org>", "List-Unsubscribe": "<https://gcc.gnu.org/mailman/options/gcc-patches>,\n <mailto:gcc-patches-request@gcc.gnu.org?subject=unsubscribe>", "List-Archive": "<https://gcc.gnu.org/pipermail/gcc-patches/>", "List-Post": "<mailto:gcc-patches@gcc.gnu.org>", "List-Help": "<mailto:gcc-patches-request@gcc.gnu.org?subject=help>", "List-Subscribe": "<https://gcc.gnu.org/mailman/listinfo/gcc-patches>,\n <mailto:gcc-patches-request@gcc.gnu.org?subject=subscribe>", "Errors-To": "gcc-patches-bounces~incoming=patchwork.ozlabs.org@gcc.gnu.org" }, "content": "Dear all, as requested,\n\nSee attached patch 6 of 13\n\nBest Regards,\n\nJerry", "diff": "commit 9f74ce7aa6b7caadbd760a5920b87ac4016a5b92\nAuthor: Andre Vehreschild <vehre@gcc.gnu.org>\nDate: Wed Jun 18 09:26:22 2025 +0200\n\n Fortran: Enable coarray tests for multi image use [PR88076]\n \n Change some of regression tests to run on single and multiple images.\n Add some new tests.\n \n PR fortran/88076\n \n gcc/testsuite/ChangeLog:\n \n * gfortran.dg/coarray/alloc_comp_4.f90: Make multi image\n compatible.\n * gfortran.dg/coarray/atomic_2.f90: Same.\n * gfortran.dg/coarray/caf.exp: Also test caf_shmem and choose\n eight images as a default.\n * gfortran.dg/coarray/coarray_allocated.f90: Add multi image\n support.\n * gfortran.dg/coarray/coindexed_1.f90: Same.\n * gfortran.dg/coarray/coindexed_3.f08: Same.\n * gfortran.dg/coarray/coindexed_5.f90: Same.\n * gfortran.dg/coarray/dummy_3.f90: Same.\n * gfortran.dg/coarray/event_1.f90: Same.\n * gfortran.dg/coarray/event_3.f08: Same.\n * gfortran.dg/coarray/event_4.f08: Same.\n * gfortran.dg/coarray/failed_images_2.f08: Same.\n * gfortran.dg/coarray/image_status_1.f08: Same.\n * gfortran.dg/coarray/image_status_2.f08: Same.\n * gfortran.dg/coarray/lock_2.f90: Same.\n * gfortran.dg/coarray/poly_run_3.f90: Same.\n * gfortran.dg/coarray/scalar_alloc_1.f90: Same.\n * gfortran.dg/coarray/stopped_images_2.f08: Same.\n * gfortran.dg/coarray/sync_1.f90: Same.\n * gfortran.dg/coarray/sync_3.f90: Same.\n * gfortran.dg/coarray/co_reduce_string.f90: New test.\n * gfortran.dg/coarray/sync_team.f90: New test.\n\ndiff --git a/gcc/testsuite/gfortran.dg/coarray/alloc_comp_4.f90 b/gcc/testsuite/gfortran.dg/coarray/alloc_comp_4.f90\nindex 2ee8ff0253d..50b4bab1603 100644\n--- a/gcc/testsuite/gfortran.dg/coarray/alloc_comp_4.f90\n+++ b/gcc/testsuite/gfortran.dg/coarray/alloc_comp_4.f90\n@@ -11,11 +11,19 @@ program main\n end type\n \n type(mytype), save :: object[*]\n- integer :: me\n+ integer :: me, other\n \n me=this_image()\n- allocate(object%indices(me))\n- object%indices = 42\n+ other = me + 1\n+ if (other .GT. num_images()) other = 1\n+ if (me == num_images()) then\n+ allocate(object%indices(me/2))\n+ else\n+ allocate(object%indices(me))\n+ end if\n+ object%indices = 42 * me\n \n- if ( any( object[me]%indices(:) /= 42 ) ) STOP 1\n+ sync all\n+ if ( any( object[other]%indices(:) /= 42 * other ) ) STOP 1\n+ sync all\n end program\ndiff --git a/gcc/testsuite/gfortran.dg/coarray/atomic_2.f90 b/gcc/testsuite/gfortran.dg/coarray/atomic_2.f90\nindex 5e1c4967248..7eccd7b578c 100644\n--- a/gcc/testsuite/gfortran.dg/coarray/atomic_2.f90\n+++ b/gcc/testsuite/gfortran.dg/coarray/atomic_2.f90\n@@ -61,7 +61,7 @@ end do\n sync all\n \n call atomic_ref(var, caf[num_images()], stat=stat)\n-if (stat /= 0 .or. var /= num_images() + this_image()) STOP 12\n+if (stat /= 0 .or. var /= num_images() * 2) STOP 12\n do i = 1, num_images()\n call atomic_ref(var, caf[i], stat=stat)\n if (stat /= 0 .or. var /= num_images() + i) STOP 13\n@@ -328,7 +328,7 @@ end do\n sync all\n \n call atomic_ref(var, caf[num_images()], stat=stat)\n-if (stat /= 0 .or. var /= num_images() + this_image()) STOP 45\n+if (stat /= 0 .or. var /= num_images() * 2) STOP 45\n do i = 1, num_images()\n call atomic_ref(var, caf[i], stat=stat)\n if (stat /= 0 .or. var /= num_images() + i) STOP 46\n@@ -403,7 +403,7 @@ if (this_image() < storage_size(caf)-2) then\n do i = this_image(), min(num_images(), storage_size(caf)-2)\n var = -99\n call atomic_fetch_and(caf[i], shiftl(1, this_image()), var, stat=stat)\n- if (stat /= 0 .or. var <= 0) STOP 53\n+ if (stat /= 0) STOP 53\n end do\n end if\n sync all\n@@ -544,7 +544,7 @@ if (this_image() < storage_size(caf)-2) then\n do i = this_image(), min(num_images(), storage_size(caf)-2)\n var = -99\n call atomic_fetch_xor(caf[i], shiftl(1, this_image()), var, stat=stat)\n- if (stat /= 0 .or. (var < 0 .and. var /= -1)) STOP 68\n+ if (stat /= 0) STOP 68\n end do\n end if\n sync all\n@@ -628,26 +628,27 @@ sync all\n \n if (this_image() == 1) then\n call atomic_cas(caf_log[num_images()], compare=.false., new=.false., old=var2, stat=stat)\n- if (stat /= 0 .or. var2 .neqv. .true.) STOP 82\n+ if (stat /= 0 .or. (var2 .neqv. .true.)) STOP 82\n call atomic_ref(var2, caf_log[num_images()], stat=stat)\n- if (stat /= 0 .or. var2 .neqv. .true.) STOP 83\n+ if (stat /= 0 .or. (var2 .neqv. .true.)) STOP 83\n end if\n sync all\n \n-if (this_image() == num_images() .and. caf_log .neqv. .true.) STOP 84\n+if (this_image() == num_images() .and. (caf_log .neqv. .true.)) STOP 84\n call atomic_ref(var2, caf_log[num_images()], stat=stat)\n-if (stat /= 0 .or. var2 .neqv. .true.) STOP 85\n+if (stat /= 0 .or. (var2 .neqv. .true.)) STOP 85\n sync all\n \n if (this_image() == 1) then\n call atomic_cas(caf_log[num_images()], compare=.true., new=.false., old=var2, stat=stat)\n- if (stat /= 0 .or. var2 .neqv. .true.) STOP 86\n+ if (stat /= 0 .or. (var2 .neqv. .true.)) STOP 86\n call atomic_ref(var2, caf_log[num_images()], stat=stat)\n- if (stat /= 0 .or. var2 .neqv. .false.) STOP 87\n+ if (stat /= 0 .or. (var2 .neqv. .false.)) STOP 87\n end if\n sync all\n \n-if (this_image() == num_images() .and. caf_log .neqv. .false.) STOP 88\n+if (this_image() == num_images() .and. (caf_log .neqv. .false.)) STOP 88\n call atomic_ref(var2, caf_log[num_images()], stat=stat)\n-if (stat /= 0 .or. var2 .neqv. .false.) STOP 89\n+if (stat /= 0 .or. (var2 .neqv. .false.)) STOP 89\n+sync all\n end\ndiff --git a/gcc/testsuite/gfortran.dg/coarray/caf.exp b/gcc/testsuite/gfortran.dg/coarray/caf.exp\nindex c8ea08980e2..9cd99f8e0cb 100644\n--- a/gcc/testsuite/gfortran.dg/coarray/caf.exp\n+++ b/gcc/testsuite/gfortran.dg/coarray/caf.exp\n@@ -70,6 +70,12 @@ proc dg-compile-aux-modules { args } {\n }\n }\n \n+if { [getenv GFORTRAN_NUM_IMAGES] == \"\" } {\n+ # Some caf_shmem tests need at least 8 images. This is also to limit the\n+ # number of images on big machines preventing overload w/o any benefit.\n+ setenv GFORTRAN_NUM_IMAGES 8\n+}\n+\n # Main loop.\n foreach test [lsort [glob -nocomplain $srcdir/$subdir/*.\\[fF\\]{,90,95,03,08} ]] {\n # If we're only testing specific files and this isn't one of them, skip it.\n@@ -103,6 +109,13 @@ foreach test [lsort [glob -nocomplain $srcdir/$subdir/*.\\[fF\\]{,90,95,03,08} ]]\n \tdg-test $test \"-fcoarray=lib $flags -lcaf_single\" {}\n \tcleanup-modules \"\"\n }\n+\n+ foreach flags $option_list {\n+ verbose \"Testing $nshort (libcaf_shmem), $flags\" 1\n+ set gfortran_aux_module_flags \"-fcoarray=lib $flags -lcaf_shmem\"\n+ dg-test $test \"-fcoarray=lib $flags -lcaf_shmem\" {}\n+ cleanup-modules \"\"\n+ }\n }\n torture-finish\n dg-finish\ndiff --git a/gcc/testsuite/gfortran.dg/coarray/co_reduce_string.f90 b/gcc/testsuite/gfortran.dg/coarray/co_reduce_string.f90\nnew file mode 100644\nindex 00000000000..9b4c44f1ada\n--- /dev/null\n+++ b/gcc/testsuite/gfortran.dg/coarray/co_reduce_string.f90\n@@ -0,0 +1,94 @@\n+!{ dg-do run }\n+\n+! Check that co_reduce for strings works.\n+! This test is motivated by OpenCoarray's co_reduce_string test.\n+\n+program co_reduce_strings\n+ \n+ implicit none\n+\n+ integer, parameter :: numstrings = 10, strlen = 8, base_len = 4\n+ character(len=strlen), dimension(numstrings) :: fixarr\n+ character(len=strlen), dimension(:), allocatable :: allocarr\n+ character(len=:), allocatable :: defarr(:)\n+ character(len=strlen) :: expect\n+ integer :: i\n+\n+ ! Construct the strings by postfixing foo by a number.\n+ associate (me => this_image(), np => num_images())\n+ if (np > 999) error stop \"Too many images; increase format string modifiers and sizes!\"\n+ \n+ allocate(allocarr(numstrings))\n+ do i = 1, numstrings\n+ write(fixarr(i), \"('foo',I04)\") i * me\n+ write(allocarr(i), \"('foo',I04)\") i * me\n+ end do\n+ ! Collectively reduce the maximum string.\n+ call co_reduce(fixarr, fixmax)\n+ call check(fixarr, 1)\n+\n+ call co_reduce(allocarr, strmax)\n+ call check(allocarr, 2)\n+ end associate\n+\n+ ! Construct the strings by postfixing foo by a number.\n+ associate (me => this_image(), np => num_images())\n+ allocate(character(len=base_len + 4)::defarr(numstrings))\n+ do i = 1, numstrings\n+ write(defarr(i), \"('foo',I04)\") i * me\n+ end do\n+ call sub_red(defarr)\n+ end associate\n+ sync all\n+\n+contains\n+\n+ pure function fixmax(lhs, rhs) result(m)\n+ character(len=strlen), intent(in) :: lhs, rhs\n+ character(len=strlen) :: m\n+\n+ if (lhs > rhs) then\n+ m = lhs\n+ else\n+ m = rhs\n+ end if\n+ end function\n+\n+ pure function strmax(lhs, rhs) result(maxstr)\n+ character(len=strlen), intent(in) :: lhs, rhs\n+ character(len=strlen) :: maxstr\n+\n+ if (lhs > rhs) then\n+ maxstr = lhs \n+ else \n+ maxstr = rhs\n+ end if\n+ end function\n+\n+ subroutine sub_red(str)\n+ character(len=:), allocatable :: str(:)\n+\n+ call co_reduce(str, strmax)\n+ call check(str, 3)\n+ end subroutine\n+\n+ subroutine check(curr, stop_code)\n+ character(len=*), intent(in) :: curr(:)\n+ character(len=strlen) :: expect\n+ integer, intent(in) :: stop_code\n+ integer :: i\n+\n+ associate(np => num_images())\n+ do i = 1, numstrings\n+ write (expect, \"('foo',I04)\") i * np\n+ if (curr(i) /= expect) then\n+ ! On error print what we got and what we expected.\n+ print *, this_image(), \": Got: \", curr(i), \", expected: \", expect, \", for i=\", i\n+ stop stop_code\n+ end if\n+ end do\n+ end associate\n+ end subroutine\n+\n+end program co_reduce_strings\n+\ndiff --git a/gcc/testsuite/gfortran.dg/coarray/coarray_allocated.f90 b/gcc/testsuite/gfortran.dg/coarray/coarray_allocated.f90\nindex 27db0e8d8ce..ce7c6288a61 100644\n--- a/gcc/testsuite/gfortran.dg/coarray/coarray_allocated.f90\n+++ b/gcc/testsuite/gfortran.dg/coarray/coarray_allocated.f90\n@@ -19,7 +19,7 @@ program p\n ! For this reason, -fcoarray=single and -fcoarray=lib give the\n ! same result\n if (allocated (a[1])) stop 3\n- if (allocated (c%x[1,2,3])) stop 4\n+ if (allocated (c%x[1,1,1])) stop 4\n \n ! Allocate collectively\n allocate(a[*])\n@@ -28,16 +28,17 @@ program p\n if (.not. allocated (a)) stop 5\n if (.not. allocated (c%x)) stop 6\n if (.not. allocated (a[1])) stop 7\n- if (.not. allocated (c%x[1,2,3])) stop 8\n+ if (.not. allocated (c%x[1,1,1])) stop 8\n \n- ! Deallocate collectively\n+ sync all\n+ ! Dellocate collectively\n deallocate(a)\n deallocate(c%x)\n \n if (allocated (a)) stop 9\n if (allocated (c%x)) stop 10\n if (allocated (a[1])) stop 11\n- if (allocated (c%x[1,2,3])) stop 12\n+ if (allocated (c%x[1,1,1])) stop 12\n end\n \n ! Expected: always local access and never a call to _gfortran_caf_get\ndiff --git a/gcc/testsuite/gfortran.dg/coarray/coindexed_1.f90 b/gcc/testsuite/gfortran.dg/coarray/coindexed_1.f90\nindex f90b65cb389..8f7a83a9c99 100644\n--- a/gcc/testsuite/gfortran.dg/coarray/coindexed_1.f90\n+++ b/gcc/testsuite/gfortran.dg/coarray/coindexed_1.f90\n@@ -21,6 +21,7 @@ subroutine char_test()\n ustr2a = 4_\"zzzzzzzz\"; ustr2b = 4_\"zzzzzzzz\"\n str1a = 1_\"abc\"\n str2a = 1_\"XXXXXXX\"\n+ sync all\n if (this_image() == num_images()) then\n str2a[1] = str1a\n end if\n@@ -37,6 +38,7 @@ subroutine char_test()\n ustr2a = 4_\"zzzzzzzz\"; ustr2b = 4_\"zzzzzzzz\"\n ustr1a = 4_\"abc\"\n ustr2a = 4_\"XXXXXXX\"\n+ sync all\n if (this_image() == num_images()) then\n ustr2a[1] = ustr1a\n end if\n@@ -53,6 +55,7 @@ subroutine char_test()\n ustr2a = 4_\"zzzzzzzz\"; ustr2b = 4_\"zzzzzzzz\"\n str2a = 1_\"abcde\"\n str1a = 1_\"XXX\"\n+ sync all\n if (this_image() == num_images()) then\n str1a[1] = str2a\n end if\n@@ -69,6 +72,7 @@ subroutine char_test()\n ustr2a = 4_\"zzzzzzzz\"; ustr2b = 4_\"zzzzzzzz\"\n ustr2a = 4_\"abcde\"\n ustr1a = 4_\"XXX\"\n+ sync all\n if (this_image() == num_images()) then\n ustr1a[1] = ustr2a\n end if\n@@ -91,6 +95,7 @@ subroutine char_test()\n str2b(1) = 1_\"XXXXXXX\"\n str2b(2) = 1_\"YYYYYYY\"\n str2b(3) = 1_\"ZZZZZZZ\"\n+ sync all\n if (this_image() == num_images()) then\n str2b(:)[1] = str1b\n end if\n@@ -113,6 +118,7 @@ subroutine char_test()\n ustr2b(1) = 4_\"XXXXXXX\"\n ustr2b(2) = 4_\"YYYYYYY\"\n ustr2b(3) = 4_\"ZZZZZZZ\"\n+ sync all\n if (this_image() == num_images()) then\n ustr2b(:)[1] = ustr1b\n end if\n@@ -135,6 +141,7 @@ subroutine char_test()\n str1b(1) = 1_\"XXX\"\n str1b(2) = 1_\"YYY\"\n str1b(3) = 1_\"ZZZ\"\n+ sync all\n if (this_image() == num_images()) then\n str1b(:)[1] = str2b\n end if\n@@ -157,6 +164,7 @@ subroutine char_test()\n ustr1b(1) = 4_\"XXX\"\n ustr1b(2) = 4_\"YYY\"\n ustr1b(3) = 4_\"ZZZ\"\n+ sync all\n if (this_image() == num_images()) then\n ustr1b(:)[1] = ustr2b\n end if\n@@ -179,6 +187,7 @@ subroutine char_test()\n str2b(1) = 1_\"XXXXXXX\"\n str2b(2) = 1_\"YYYYYYY\"\n str2b(3) = 1_\"ZZZZZZZ\"\n+ sync all\n if (this_image() == num_images()) then\n str2b(:)[1] = str1a\n end if\n@@ -199,6 +208,7 @@ subroutine char_test()\n ustr2b(1) = 4_\"XXXXXXX\"\n ustr2b(2) = 4_\"YYYYYYY\"\n ustr2b(3) = 4_\"ZZZZZZZ\"\n+ sync all\n if (this_image() == num_images()) then\n ustr2b(:)[1] = ustr1a\n end if\n@@ -219,6 +229,7 @@ subroutine char_test()\n str1b(1) = 1_\"XXX\"\n str1b(2) = 1_\"YYY\"\n str1b(3) = 1_\"ZZZ\"\n+ sync all\n if (this_image() == num_images()) then\n str1b(:)[1] = str2a\n end if\n@@ -239,6 +250,7 @@ subroutine char_test()\n ustr1b(1) = 4_\"XXX\"\n ustr1b(2) = 4_\"YYY\"\n ustr1b(3) = 4_\"ZZZ\"\n+ sync all\n if (this_image() == num_images()) then\n ustr1b(:)[1] = ustr2a\n end if\n@@ -261,6 +273,7 @@ subroutine char_test()\n ustr2a = 4_\"zzzzzzzz\"; ustr2b = 4_\"zzzzzzzz\"\n str1a = 1_\"abc\"\n str2a = 1_\"XXXXXXX\"\n+ sync all\n if (this_image() == num_images()) then\n str2a = str1a[1]\n end if\n@@ -277,6 +290,7 @@ subroutine char_test()\n ustr2a = 4_\"zzzzzzzz\"; ustr2b = 4_\"zzzzzzzz\"\n ustr1a = 4_\"abc\"\n ustr2a = 4_\"XXXXXXX\"\n+ sync all\n if (this_image() == num_images()) then\n ustr2a = ustr1a[1]\n end if\n@@ -293,6 +307,7 @@ subroutine char_test()\n ustr2a = 4_\"zzzzzzzz\"; ustr2b = 4_\"zzzzzzzz\"\n str2a = 1_\"abcde\"\n str1a = 1_\"XXX\"\n+ sync all\n if (this_image() == num_images()) then\n str1a = str2a[1]\n end if\n@@ -309,6 +324,7 @@ subroutine char_test()\n ustr2a = 4_\"zzzzzzzz\"; ustr2b = 4_\"zzzzzzzz\"\n ustr2a = 4_\"abcde\"\n ustr1a = 4_\"XXX\"\n+ sync all\n if (this_image() == num_images()) then\n ustr1a = ustr2a[1]\n end if\n@@ -331,6 +347,7 @@ subroutine char_test()\n str2b(1) = 1_\"XXXXXXX\"\n str2b(2) = 1_\"YYYYYYY\"\n str2b(3) = 1_\"ZZZZZZZ\"\n+ sync all\n if (this_image() == num_images()) then\n str2b = str1b(:)[1]\n end if\n@@ -353,6 +370,7 @@ subroutine char_test()\n ustr2b(1) = 4_\"XXXXXXX\"\n ustr2b(2) = 4_\"YYYYYYY\"\n ustr2b(3) = 4_\"ZZZZZZZ\"\n+ sync all\n if (this_image() == num_images()) then\n ustr2b = ustr1b(:)[1]\n end if\n@@ -375,6 +393,7 @@ subroutine char_test()\n str1b(1) = 1_\"XXX\"\n str1b(2) = 1_\"YYY\"\n str1b(3) = 1_\"ZZZ\"\n+ sync all\n if (this_image() == num_images()) then\n str1b = str2b(:)[1]\n end if\n@@ -397,6 +416,7 @@ subroutine char_test()\n ustr1b(1) = 4_\"XXX\"\n ustr1b(2) = 4_\"YYY\"\n ustr1b(3) = 4_\"ZZZ\"\n+ sync all\n if (this_image() == num_images()) then\n ustr1b = ustr2b(:)[1]\n end if\n@@ -419,6 +439,7 @@ subroutine char_test()\n str2b(1) = 1_\"XXXXXXX\"\n str2b(2) = 1_\"YYYYYYY\"\n str2b(3) = 1_\"ZZZZZZZ\"\n+ sync all\n if (this_image() == num_images()) then\n str2b = str1a[1]\n end if\n@@ -439,6 +460,7 @@ subroutine char_test()\n ustr2b(1) = 4_\"XXXXXXX\"\n ustr2b(2) = 4_\"YYYYYYY\"\n ustr2b(3) = 4_\"ZZZZZZZ\"\n+ sync all\n if (this_image() == num_images()) then\n ustr2b = ustr1a[1]\n end if\n@@ -459,6 +481,7 @@ subroutine char_test()\n str1b(1) = 1_\"XXX\"\n str1b(2) = 1_\"YYY\"\n str1b(3) = 1_\"ZZZ\"\n+ sync all\n if (this_image() == num_images()) then\n str1b = str2a[1]\n end if\n@@ -479,6 +502,7 @@ subroutine char_test()\n ustr1b(1) = 4_\"XXX\"\n ustr1b(2) = 4_\"YYY\"\n ustr1b(3) = 4_\"ZZZ\"\n+ sync all\n if (this_image() == num_images()) then\n ustr1b = ustr2a[1]\n end if\n@@ -502,6 +526,7 @@ subroutine char_test()\n ustr2a = 4_\"zzzzzzzz\"; ustr2b = 4_\"zzzzzzzz\"\n str1a = 1_\"abc\"\n str2a = 1_\"XXXXXXX\"\n+ sync all\n if (this_image() == num_images()) then\n str2a[1] = str1a[mod(1, num_images())+1]\n end if\n@@ -518,6 +543,7 @@ subroutine char_test()\n ustr2a = 4_\"zzzzzzzz\"; ustr2b = 4_\"zzzzzzzz\"\n ustr1a = 4_\"abc\"\n ustr2a = 4_\"XXXXXXX\"\n+ sync all\n if (this_image() == num_images()) then\n ustr2a[1] = ustr1a[mod(1, num_images())+1]\n end if\n@@ -534,6 +560,7 @@ subroutine char_test()\n ustr2a = 4_\"zzzzzzzz\"; ustr2b = 4_\"zzzzzzzz\"\n str2a = 1_\"abcde\"\n str1a = 1_\"XXX\"\n+ sync all\n if (this_image() == num_images()) then\n str1a[1] = str2a[mod(1, num_images())+1]\n end if\n@@ -550,6 +577,7 @@ subroutine char_test()\n ustr2a = 4_\"zzzzzzzz\"; ustr2b = 4_\"zzzzzzzz\"\n ustr2a = 4_\"abcde\"\n ustr1a = 4_\"XXX\"\n+ sync all\n if (this_image() == num_images()) then\n ustr1a[1] = ustr2a[mod(1, num_images())+1]\n end if\n@@ -572,6 +600,7 @@ subroutine char_test()\n str2b(1) = 1_\"XXXXXXX\"\n str2b(2) = 1_\"YYYYYYY\"\n str2b(3) = 1_\"ZZZZZZZ\"\n+ sync all\n if (this_image() == num_images()) then\n str2b(:)[1] = str1b(:)[mod(1, num_images())+1]\n end if\n@@ -594,6 +623,7 @@ subroutine char_test()\n ustr2b(1) = 4_\"XXXXXXX\"\n ustr2b(2) = 4_\"YYYYYYY\"\n ustr2b(3) = 4_\"ZZZZZZZ\"\n+ sync all\n if (this_image() == num_images()) then\n ustr2b(:)[1] = ustr1b(:)[mod(1, num_images())+1]\n end if\n@@ -616,6 +646,7 @@ subroutine char_test()\n str1b(1) = 1_\"XXX\"\n str1b(2) = 1_\"YYY\"\n str1b(3) = 1_\"ZZZ\"\n+ sync all\n if (this_image() == num_images()) then\n str1b(:)[1] = str2b(:)[mod(1, num_images())+1]\n end if\n@@ -638,6 +669,7 @@ subroutine char_test()\n ustr1b(1) = 4_\"XXX\"\n ustr1b(2) = 4_\"YYY\"\n ustr1b(3) = 4_\"ZZZ\"\n+ sync all\n if (this_image() == num_images()) then\n ustr1b(:)[1] = ustr2b(:)[mod(1, num_images())+1]\n end if\n@@ -660,6 +692,7 @@ subroutine char_test()\n str2b(1) = 1_\"XXXXXXX\"\n str2b(2) = 1_\"YYYYYYY\"\n str2b(3) = 1_\"ZZZZZZZ\"\n+ sync all\n if (this_image() == num_images()) then\n str2b(:)[1] = str1a[mod(1, num_images())+1]\n end if\n@@ -680,6 +713,7 @@ subroutine char_test()\n ustr2b(1) = 4_\"XXXXXXX\"\n ustr2b(2) = 4_\"YYYYYYY\"\n ustr2b(3) = 4_\"ZZZZZZZ\"\n+ sync all\n if (this_image() == num_images()) then\n ustr2b(:)[1] = ustr1a[mod(1, num_images())+1]\n end if\n@@ -700,6 +734,7 @@ subroutine char_test()\n str1b(1) = 1_\"XXX\"\n str1b(2) = 1_\"YYY\"\n str1b(3) = 1_\"ZZZ\"\n+ sync all\n if (this_image() == num_images()) then\n str1b(:)[1] = str2a[mod(1, num_images())+1]\n end if\n@@ -720,6 +755,7 @@ subroutine char_test()\n ustr1b(1) = 4_\"XXX\"\n ustr1b(2) = 4_\"YYY\"\n ustr1b(3) = 4_\"ZZZ\"\n+ sync all\n if (this_image() == num_images()) then\n ustr1b(:)[1] = ustr2a[mod(1, num_images())+1]\n end if\n@@ -743,7 +779,8 @@ subroutine char_test()\n str2a = 1_\"zzzzzzzz\"; str2b = 1_\"zzzzzzzz\"\n ustr2a = 4_\"zzzzzzzz\"; ustr2b = 4_\"zzzzzzzz\"\n ustr1a = 4_\"abc\"\n- str1a = 1_\"XXXXXXX\"\n+ str2a = 1_\"XXXXXXX\"\n+ sync all\n if (this_image() == num_images()) then\n str2a[1] = ustr1a\n end if\n@@ -760,6 +797,7 @@ subroutine char_test()\n ustr2a = 4_\"zzzzzzzz\"; ustr2b = 4_\"zzzzzzzz\"\n str1a = 4_\"abc\"\n ustr2a = 1_\"XXXXXXX\"\n+ sync all\n if (this_image() == num_images()) then\n ustr2a[1] = str1a\n end if\n@@ -776,6 +814,7 @@ subroutine char_test()\n ustr2a = 4_\"zzzzzzzz\"; ustr2b = 4_\"zzzzzzzz\"\n ustr2a = 4_\"abcde\"\n str1a = 1_\"XXX\"\n+ sync all\n if (this_image() == num_images()) then\n str1a[1] = ustr2a\n end if\n@@ -792,6 +831,7 @@ subroutine char_test()\n ustr2a = 4_\"zzzzzzzz\"; ustr2b = 4_\"zzzzzzzz\"\n str2a = 4_\"abcde\"\n ustr1a = 1_\"XXX\"\n+ sync all\n if (this_image() == num_images()) then\n ustr1a[1] = str2a\n end if\n@@ -814,6 +854,7 @@ subroutine char_test()\n str2b(1) = 1_\"XXXXXXX\"\n str2b(2) = 1_\"YYYYYYY\"\n str2b(3) = 1_\"ZZZZZZZ\"\n+ sync all\n if (this_image() == num_images()) then\n str2b(:)[1] = ustr1b\n end if\n@@ -836,6 +877,7 @@ subroutine char_test()\n ustr2b(1) = 4_\"XXXXXXX\"\n ustr2b(2) = 4_\"YYYYYYY\"\n ustr2b(3) = 4_\"ZZZZZZZ\"\n+ sync all\n if (this_image() == num_images()) then\n ustr2b(:)[1] = str1b\n end if\n@@ -858,6 +900,7 @@ subroutine char_test()\n str1b(1) = 1_\"XXX\"\n str1b(2) = 1_\"YYY\"\n str1b(3) = 1_\"ZZZ\"\n+ sync all\n if (this_image() == num_images()) then\n str1b(:)[1] = ustr2b\n end if\n@@ -880,6 +923,7 @@ subroutine char_test()\n ustr1b(1) = 4_\"XXX\"\n ustr1b(2) = 4_\"YYY\"\n ustr1b(3) = 4_\"ZZZ\"\n+ sync all\n if (this_image() == num_images()) then\n ustr1b(:)[1] = str2b\n end if\n@@ -902,6 +946,7 @@ subroutine char_test()\n str2b(1) = 1_\"XXXXXXX\"\n str2b(2) = 1_\"YYYYYYY\"\n str2b(3) = 1_\"ZZZZZZZ\"\n+ sync all\n if (this_image() == num_images()) then\n str2b(:)[1] = ustr1a\n end if\n@@ -922,6 +967,7 @@ subroutine char_test()\n ustr2b(1) = 4_\"XXXXXXX\"\n ustr2b(2) = 4_\"YYYYYYY\"\n ustr2b(3) = 4_\"ZZZZZZZ\"\n+ sync all\n if (this_image() == num_images()) then\n ustr2b(:)[1] = str1a\n end if\n@@ -942,6 +988,7 @@ subroutine char_test()\n str1b(1) = 1_\"XXX\"\n str1b(2) = 1_\"YYY\"\n str1b(3) = 1_\"ZZZ\"\n+ sync all\n if (this_image() == num_images()) then\n str1b(:)[1] = ustr2a\n end if\n@@ -962,6 +1009,7 @@ subroutine char_test()\n ustr1b(1) = 4_\"XXX\"\n ustr1b(2) = 4_\"YYY\"\n ustr1b(3) = 4_\"ZZZ\"\n+ sync all\n if (this_image() == num_images()) then\n ustr1b(:)[1] = str2a\n end if\n@@ -984,6 +1032,7 @@ subroutine char_test()\n ustr2a = 4_\"zzzzzzzz\"; ustr2b = 4_\"zzzzzzzz\"\n ustr1a = 4_\"abc\"\n str2a = 1_\"XXXXXXX\"\n+ sync all\n if (this_image() == num_images()) then\n str2a = ustr1a[1]\n end if\n@@ -1000,6 +1049,7 @@ subroutine char_test()\n ustr2a = 4_\"zzzzzzzz\"; ustr2b = 4_\"zzzzzzzz\"\n str1a = 1_\"abc\"\n ustr2a = 4_\"XXXXXXX\"\n+ sync all\n if (this_image() == num_images()) then\n ustr2a = str1a[1]\n end if\n@@ -1016,6 +1066,7 @@ subroutine char_test()\n ustr2a = 4_\"zzzzzzzz\"; ustr2b = 4_\"zzzzzzzz\"\n ustr2a = 4_\"abcde\"\n str1a = 1_\"XXX\"\n+ sync all\n if (this_image() == num_images()) then\n str1a = ustr2a[1]\n end if\n@@ -1032,6 +1083,7 @@ subroutine char_test()\n ustr2a = 4_\"zzzzzzzz\"; ustr2b = 4_\"zzzzzzzz\"\n str2a = 1_\"abcde\"\n ustr1a = 4_\"XXX\"\n+ sync all\n if (this_image() == num_images()) then\n ustr1a = str2a[1]\n end if\n@@ -1054,6 +1106,7 @@ subroutine char_test()\n str2b(1) = 1_\"XXXXXXX\"\n str2b(2) = 1_\"YYYYYYY\"\n str2b(3) = 1_\"ZZZZZZZ\"\n+ sync all\n if (this_image() == num_images()) then\n str2b = ustr1b(:)[1]\n end if\n@@ -1076,6 +1129,7 @@ subroutine char_test()\n ustr2b(1) = 4_\"XXXXXXX\"\n ustr2b(2) = 4_\"YYYYYYY\"\n ustr2b(3) = 4_\"ZZZZZZZ\"\n+ sync all\n if (this_image() == num_images()) then\n ustr2b = str1b(:)[1]\n end if\n@@ -1098,6 +1152,7 @@ subroutine char_test()\n str1b(1) = 1_\"XXX\"\n str1b(2) = 1_\"YYY\"\n str1b(3) = 1_\"ZZZ\"\n+ sync all\n if (this_image() == num_images()) then\n str1b = ustr2b(:)[1]\n end if\n@@ -1120,6 +1175,7 @@ subroutine char_test()\n ustr1b(1) = 4_\"XXX\"\n ustr1b(2) = 4_\"YYY\"\n ustr1b(3) = 4_\"ZZZ\"\n+ sync all\n if (this_image() == num_images()) then\n ustr1b = str2b(:)[1]\n end if\n@@ -1142,6 +1198,7 @@ subroutine char_test()\n str2b(1) = 1_\"XXXXXXX\"\n str2b(2) = 1_\"YYYYYYY\"\n str2b(3) = 1_\"ZZZZZZZ\"\n+ sync all\n if (this_image() == num_images()) then\n str2b = ustr1a[1]\n end if\n@@ -1162,6 +1219,7 @@ subroutine char_test()\n ustr2b(1) = 4_\"XXXXXXX\"\n ustr2b(2) = 4_\"YYYYYYY\"\n ustr2b(3) = 4_\"ZZZZZZZ\"\n+ sync all\n if (this_image() == num_images()) then\n ustr2b = str1a[1]\n end if\n@@ -1182,6 +1240,7 @@ subroutine char_test()\n str1b(1) = 1_\"XXX\"\n str1b(2) = 1_\"YYY\"\n str1b(3) = 1_\"ZZZ\"\n+ sync all\n if (this_image() == num_images()) then\n str1b = ustr2a[1]\n end if\n@@ -1202,6 +1261,7 @@ subroutine char_test()\n ustr1b(1) = 4_\"XXX\"\n ustr1b(2) = 4_\"YYY\"\n ustr1b(3) = 4_\"ZZZ\"\n+ sync all\n if (this_image() == num_images()) then\n ustr1b = str2a[1]\n end if\n@@ -1225,6 +1285,7 @@ subroutine char_test()\n ustr2a = 4_\"zzzzzzzz\"; ustr2b = 4_\"zzzzzzzz\"\n ustr1a = 4_\"abc\"\n str2a = 1_\"XXXXXXX\"\n+ sync all\n if (this_image() == num_images()) then\n str2a[1] = ustr1a[mod(1, num_images())+1]\n end if\n@@ -1241,6 +1302,7 @@ subroutine char_test()\n ustr2a = 4_\"zzzzzzzz\"; ustr2b = 4_\"zzzzzzzz\"\n str1a = 1_\"abc\"\n ustr2a = 4_\"XXXXXXX\"\n+ sync all\n if (this_image() == num_images()) then\n ustr2a[1] = str1a[mod(1, num_images())+1]\n end if\n@@ -1257,6 +1319,7 @@ subroutine char_test()\n ustr2a = 4_\"zzzzzzzz\"; ustr2b = 4_\"zzzzzzzz\"\n ustr2a = 4_\"abcde\"\n str1a = 1_\"XXX\"\n+ sync all\n if (this_image() == num_images()) then\n str1a[1] = ustr2a[mod(1, num_images())+1]\n end if\n@@ -1273,6 +1336,7 @@ subroutine char_test()\n ustr2a = 4_\"zzzzzzzz\"; ustr2b = 4_\"zzzzzzzz\"\n str2a = 1_\"abcde\"\n ustr1a = 4_\"XXX\"\n+ sync all\n if (this_image() == num_images()) then\n ustr1a[1] = str2a[mod(1, num_images())+1]\n end if\n@@ -1295,6 +1359,7 @@ subroutine char_test()\n str2b(1) = 1_\"XXXXXXX\"\n str2b(2) = 1_\"YYYYYYY\"\n str2b(3) = 1_\"ZZZZZZZ\"\n+ sync all\n if (this_image() == num_images()) then\n str2b(:)[1] = ustr1b(:)[mod(1, num_images())+1]\n end if\n@@ -1317,6 +1382,7 @@ subroutine char_test()\n ustr2b(1) = 4_\"XXXXXXX\"\n ustr2b(2) = 4_\"YYYYYYY\"\n ustr2b(3) = 4_\"ZZZZZZZ\"\n+ sync all\n if (this_image() == num_images()) then\n ustr2b(:)[1] = str1b(:)[mod(1, num_images())+1]\n end if\n@@ -1339,6 +1405,7 @@ subroutine char_test()\n str1b(1) = 1_\"XXX\"\n str1b(2) = 1_\"YYY\"\n str1b(3) = 1_\"ZZZ\"\n+ sync all\n if (this_image() == num_images()) then\n str1b(:)[1] = ustr2b(:)[mod(1, num_images())+1]\n end if\n@@ -1361,6 +1428,7 @@ subroutine char_test()\n ustr1b(1) = 4_\"XXX\"\n ustr1b(2) = 4_\"YYY\"\n ustr1b(3) = 4_\"ZZZ\"\n+ sync all\n if (this_image() == num_images()) then\n ustr1b(:)[1] = str2b(:)[mod(1, num_images())+1]\n end if\n@@ -1383,6 +1451,7 @@ subroutine char_test()\n str2b(1) = 1_\"XXXXXXX\"\n str2b(2) = 1_\"YYYYYYY\"\n str2b(3) = 1_\"ZZZZZZZ\"\n+ sync all\n if (this_image() == num_images()) then\n str2b(:)[1] = ustr1a[mod(1, num_images())+1]\n end if\n@@ -1403,6 +1472,7 @@ subroutine char_test()\n ustr2b(1) = 4_\"XXXXXXX\"\n ustr2b(2) = 4_\"YYYYYYY\"\n ustr2b(3) = 4_\"ZZZZZZZ\"\n+ sync all\n if (this_image() == num_images()) then\n ustr2b(:)[1] = str1a[mod(1, num_images())+1]\n end if\n@@ -1423,6 +1493,7 @@ subroutine char_test()\n str1b(1) = 1_\"XXX\"\n str1b(2) = 1_\"YYY\"\n str1b(3) = 1_\"ZZZ\"\n+ sync all\n if (this_image() == num_images()) then\n str1b(:)[1] = ustr2a[mod(1, num_images())+1]\n end if\n@@ -1443,6 +1514,7 @@ subroutine char_test()\n ustr1b(1) = 4_\"XXX\"\n ustr1b(2) = 4_\"YYY\"\n ustr1b(3) = 4_\"ZZZ\"\n+ sync all\n if (this_image() == num_images()) then\n ustr1b(:)[1] = str2a[mod(1, num_images())+1]\n end if\ndiff --git a/gcc/testsuite/gfortran.dg/coarray/coindexed_3.f08 b/gcc/testsuite/gfortran.dg/coarray/coindexed_3.f08\nindex 7fd20851e0a..145835d461b 100644\n--- a/gcc/testsuite/gfortran.dg/coarray/coindexed_3.f08\n+++ b/gcc/testsuite/gfortran.dg/coarray/coindexed_3.f08\n@@ -15,8 +15,8 @@ program pr98903\n a = 42\n s = 42\n \n- ! Checking against single image only. Therefore team statements are\n- ! not viable nor are they (yet) supported by GFortran.\n+ sync all\n+ \n if (a[1, team_number=-1, stat=s] /= 42) stop 1\n if (s /= 0) stop 2\n \ndiff --git a/gcc/testsuite/gfortran.dg/coarray/coindexed_5.f90 b/gcc/testsuite/gfortran.dg/coarray/coindexed_5.f90\nindex c35ec1093c1..8eb64669628 100644\n--- a/gcc/testsuite/gfortran.dg/coarray/coindexed_5.f90\n+++ b/gcc/testsuite/gfortran.dg/coarray/coindexed_5.f90\n@@ -13,68 +13,72 @@ program coindexed_5\n parentteam = get_team()\n \n caf = [23, 32]\n- form team(t_num, team, new_index=1)\n+ form team(t_num, team) !, new_index=num_images() - this_image() + 1)\n form team(t_num, formed_team)\n \n change team(team, cell[*] => caf(2))\n- ! for get_from_remote\n- ! Checking against caf_single is very limitted.\n- if (cell[1, team_number=t_num] /= 32) stop 1\n- if (cell[1, team_number=st_num] /= 32) stop 2\n- if (cell[1, team=parentteam] /= 32) stop 3\n+ associate(me => this_image())\n+ ! for get_from_remote\n+ ! Checking against caf_single is very limitted.\n+ if (cell[me, team_number=t_num] /= 32) stop 1\n+ if (cell[me, team_number=st_num] /= 32) stop 2\n+ if (cell[me, team=parentteam] /= 32) stop 3\n \n- ! Check that team_number is validated\n- lhs = cell[1, team_number=5, stat=stat]\n- if (stat /= 1) stop 4\n+ ! Check that team_number is validated\n+ lhs = cell[me, team_number=5, stat=stat]\n+ if (stat /= 1) stop 4\n \n- ! Check that only access to active teams is valid\n- stat = 42\n- lhs = cell[1, team=formed_team, stat=stat]\n- if (stat /= 1) stop 5\n+ ! Check that only access to active teams is valid\n+ stat = 42\n+ lhs = cell[me, team=formed_team, stat=stat]\n+ if (stat /= 1) stop 5\n \n- ! for send_to_remote\n- ! Checking against caf_single is very limitted.\n- cell[1, team_number=t_num] = 45\n- if (cell /= 45) stop 11\n- cell[1, team_number=st_num] = 46\n- if (cell /= 46) stop 12\n- cell[1, team=parentteam] = 47\n- if (cell /= 47) stop 13\n+ ! for send_to_remote\n+ ! Checking against caf_single is very limitted.\n+ cell[me, team_number=t_num] = 45\n+ if (cell /= 45) stop 11\n+ cell[me, team_number=st_num] = 46\n+ if (cell /= 46) stop 12\n+ cell[me, team=parentteam] = 47\n+ if (cell /= 47) stop 13\n \n- ! Check that team_number is validated\n- stat = -1\n- cell[1, team_number=5, stat=stat] = 0\n- if (stat /= 1) stop 14\n+ ! Check that team_number is validated\n+ stat = -1\n+ cell[me, team_number=5, stat=stat] = 0\n+ if (stat /= 1) stop 14\n \n- ! Check that only access to active teams is valid\n- stat = 42\n- cell[1, team=formed_team, stat=stat] = -1\n- if (stat /= 1) stop 15\n+ ! Check that only access to active teams is valid\n+ stat = 42\n+ cell[me, team=formed_team, stat=stat] = -1\n+ if (stat /= 1) stop 15\n \n- ! for transfer_between_remotes\n- ! Checking against caf_single is very limitted.\n- cell[1, team_number=t_num] = caf(1)[1, team_number=-1]\n- if (cell /= 23) stop 21\n- cell[1, team_number=st_num] = caf(2)[1, team_number=-1]\n- ! cell is an alias for caf(2) and has been overwritten by caf(1)!\n- if (cell /= 23) stop 22\n- cell[1, team=parentteam] = caf(1)[1, team= team]\n- if (cell /= 23) stop 23\n+ ! for transfer_between_remotes\n+ ! Checking against caf_single is very limitted.\n+ cell[me, team_number=t_num] = caf(1)[me, team_number=-1]\n+ if (cell /= 23) stop 21\n+ cell[me, team_number=st_num] = caf(2)[me, team_number=-1]\n+ ! cell is an alias for caf(2) and has been overwritten by caf(1)!\n+ if (cell /= 23) stop 22\n+ cell[me, team=parentteam] = caf(1)[me, team= team]\n+ if (cell /= 23) stop 23\n \n- ! Check that team_number is validated\n- stat = -1\n- cell[1, team_number=5, stat=stat] = caf(1)[1, team_number= -1]\n- if (stat /= 1) stop 24\n- stat = -1\n- cell[1, team_number=t_num] = caf(1)[1, team_number= -2, stat=stat]\n- if (stat /= 1) stop 25\n+ ! Check that team_number is validated\n+ stat = -1\n+ cell[me, team_number=5, stat=stat] = caf(1)[me, team_number= -1]\n+ if (stat /= 1) stop 24\n+ stat = -1\n+ cell[me, team_number=t_num] = caf(1)[me, team_number= -2, stat=stat]\n+ if (stat /= 1) stop 25\n \n- ! Check that only access to active teams is valid\n- stat = 42\n- cell[1, team=formed_team, stat=stat] = caf(1)[1]\n- if (stat /= 1) stop 26\n- stat = 42\n- cell[1] = caf(1)[1, team=formed_team, stat=stat]\n- if (stat /= 1) stop 27\n+ ! Check that only access to active teams is valid\n+ stat = 42\n+ cell[me, team=formed_team, stat=stat] = caf(1)[me]\n+ if (stat /= 1) stop 26\n+ stat = 42\n+ cell[me] = caf(1)[me, team=formed_team, stat=stat]\n+ if (stat /= 1) stop 27\n+\n+ sync all\n+ end associate\n end team\n end program coindexed_5\ndiff --git a/gcc/testsuite/gfortran.dg/coarray/dummy_3.f90 b/gcc/testsuite/gfortran.dg/coarray/dummy_3.f90\nindex 4b45daab649..c569390e7c6 100644\n--- a/gcc/testsuite/gfortran.dg/coarray/dummy_3.f90\n+++ b/gcc/testsuite/gfortran.dg/coarray/dummy_3.f90\n@@ -15,6 +15,7 @@ program pr77871\n p%i = 42\n allocate (p2(5)[*])\n p2(:)%i = (/(i, i=0, 4)/)\n+ sync all\n call s(p, 1)\n call s2(p2, 1)\n contains\ndiff --git a/gcc/testsuite/gfortran.dg/coarray/event_1.f90 b/gcc/testsuite/gfortran.dg/coarray/event_1.f90\nindex 81dc90b7197..a9fecf93984 100644\n--- a/gcc/testsuite/gfortran.dg/coarray/event_1.f90\n+++ b/gcc/testsuite/gfortran.dg/coarray/event_1.f90\n@@ -5,47 +5,54 @@\n use iso_fortran_env, only: event_type\n implicit none\n \n-type(event_type), save :: var[*]\n+type(event_type), save, allocatable, dimension(:) :: events[:]\n integer :: count, stat\n \n-count = -42\n-call event_query (var, count)\n-if (count /= 0) STOP 1\n-\n-stat = 99\n-event post (var, stat=stat)\n-if (stat /= 0) STOP 2\n-call event_query(var, count, stat=stat)\n-if (count /= 1 .or. stat /= 0) STOP 3\n-\n-stat = 99\n-event post (var[this_image()])\n-call event_query(var, count)\n-if (count /= 2) STOP 4\n-\n-stat = 99\n-event wait (var)\n-call event_query(var, count)\n-if (count /= 1) STOP 5\n-\n-stat = 99\n-event post (var)\n-call event_query(var, count)\n-if (count /= 2) STOP 6\n-\n-stat = 99\n-event post (var)\n-call event_query(var, count)\n-if (count /= 3) STOP 7\n-\n-stat = 99\n-event wait (var, until_count=2)\n-call event_query(var, count)\n-if (count /= 1) STOP 8\n-\n-stat = 99\n-event wait (var, stat=stat, until_count=1)\n-if (stat /= 0) STOP 9\n-call event_query(event=var, stat=stat, count=count)\n-if (count /= 0 .or. stat /= 0) STOP 10\n+associate (me => this_image(), np => num_images())\n+ allocate(events(np)[*])\n+\n+ associate(var => events(me))\n+ count = -42\n+ call event_query (var, count)\n+ if (count /= 0) STOP 1\n+\n+ stat = 99\n+ event post (var, stat=stat)\n+ if (stat /= 0) STOP 2\n+ call event_query(var, count, stat=stat)\n+ if (count /= 1 .or. stat /= 0) STOP 3\n+\n+ count = 99\n+ event post (var[this_image()])\n+ call event_query(var, count)\n+ if (count /= 2) STOP 4\n+\n+ count = 99\n+ event wait (var)\n+ call event_query(var, count)\n+ if (count /= 1) STOP 5\n+\n+ count = 99\n+ event post (var)\n+ call event_query(var, count)\n+ if (count /= 2) STOP 6\n+\n+ count = 99\n+ event post (var)\n+ call event_query(var, count)\n+ if (count /= 3) STOP 7\n+\n+ count = 99\n+ event wait (var, until_count=2)\n+ call event_query(var, count)\n+ if (count /= 1) STOP 8\n+ \n+ stat = 99\n+ event wait (var, stat=stat, until_count=1)\n+ if (stat /= 0) STOP 9\n+ count = 99\n+ call event_query(event=var, stat=stat, count=count)\n+ if (count /= 0 .or. stat /= 0) STOP 10\n+ end associate\n+end associate\n end\ndiff --git a/gcc/testsuite/gfortran.dg/coarray/event_3.f08 b/gcc/testsuite/gfortran.dg/coarray/event_3.f08\nindex 60d3193f776..cedf636b79b 100644\n--- a/gcc/testsuite/gfortran.dg/coarray/event_3.f08\n+++ b/gcc/testsuite/gfortran.dg/coarray/event_3.f08\n@@ -11,8 +11,8 @@ program global_event\n contains\n subroutine exchange\n integer :: cnt\n- event post(x[1])\n- event post(x[1])\n+ event post(x[this_image()])\n+ event post(x[this_image()])\n call event_query(x, cnt)\n if (cnt /= 2) error stop 1\n event wait(x, until_count=2)\ndiff --git a/gcc/testsuite/gfortran.dg/coarray/event_4.f08 b/gcc/testsuite/gfortran.dg/coarray/event_4.f08\nindex de901c01aa4..26a1f59df03 100644\n--- a/gcc/testsuite/gfortran.dg/coarray/event_4.f08\n+++ b/gcc/testsuite/gfortran.dg/coarray/event_4.f08\n@@ -8,5 +8,6 @@ program event_4\n type(event_type) done[*]\n nc(1) = 1\n event post(done[1])\n- event wait(done,until_count=nc(1))\n+ if (this_image() == 1) event wait(done,until_count=nc(1))\n+ sync all\n end\ndiff --git a/gcc/testsuite/gfortran.dg/coarray/failed_images_2.f08 b/gcc/testsuite/gfortran.dg/coarray/failed_images_2.f08\nindex ca5fe4020d5..78d92daf071 100644\n--- a/gcc/testsuite/gfortran.dg/coarray/failed_images_2.f08\n+++ b/gcc/testsuite/gfortran.dg/coarray/failed_images_2.f08\n@@ -1,17 +1,44 @@\n ! { dg-do run }\n \n program test_failed_images_2\n+ use iso_fortran_env\n implicit none\n \n+ type(team_type) :: t\n integer, allocatable :: fi(:)\n integer(kind=1), allocatable :: sfi(:)\n+ integer, allocatable :: rem_images(:)\n+ integer :: i, st\n \n- fi = failed_images()\n- if (size(fi) > 0) error stop \"failed_images result shall be empty array\"\n- sfi = failed_images(KIND=1)\n- if (size(sfi) > 0) error stop \"failed_images result shall be empty array\"\n- sfi = failed_images(KIND=8)\n- if (size(sfi) > 0) error stop \"failed_images result shall be empty array\"\n+ associate(np => num_images())\n+ form team (1, t)\n+ fi = failed_images()\n+ if (size(fi) > 0) stop 1\n+ sfi = failed_images(KIND=1)\n+ if (size(sfi) > 0) stop 2\n+ sfi = failed_images(KIND=8)\n+ if (size(sfi) > 0) stop 3\n+ \n+ fi = failed_images(t)\n+ if (size(fi) > 0) stop 4\n \n+ if (num_images() > 1) then\n+ sync all\n+ if (this_image() == 2) fail image\n+ rem_images = (/ 1, ( i, i = 3, np )/)\n+ ! Can't synchronize well on a failed image. Try with a sleep.\n+ do i = 0, 10\n+ if (size(failed_images()) == 0) then\n+ call sleep(1)\n+ else\n+ exit\n+ end if\n+ end do\n+ if (i == 10 .AND. size(failed_images()) == 0) stop 5\n+ sync images (rem_images, stat=st)\n+ if (any(failed_images() /= [2])) stop 6\n+ if (any(failed_images(t, 8) /= [2])) stop 7\n+ end if\n+ end associate\n end program test_failed_images_2\n \ndiff --git a/gcc/testsuite/gfortran.dg/coarray/image_status_1.f08 b/gcc/testsuite/gfortran.dg/coarray/image_status_1.f08\nindex b7ec5a6a9c9..f725f81d4aa 100644\n--- a/gcc/testsuite/gfortran.dg/coarray/image_status_1.f08\n+++ b/gcc/testsuite/gfortran.dg/coarray/image_status_1.f08\n@@ -18,7 +18,7 @@ program test_image_status_1\n isv = image_status(k2) ! Ok\n isv = image_status(k4) ! Ok\n isv = image_status(k8) ! Ok\n- isv = image_status(1, team=1) ! { dg-error \"shall be of type 'team_type'\" }\n+ isv = image_status(1, team=1) ! { dg-error \"'team' argument of 'image_status' intrinsic at \\\\(1\\\\) shall be of type 'team_type'\" }\n isv = image_status() ! { dg-error \"Missing actual argument 'image' in call to 'image_status' at \\\\(1\\\\)\" }\n isv = image_status(team=1) ! { dg-error \"Missing actual argument 'image' in call to 'image_status' at \\\\(1\\\\)\" }\n \ndiff --git a/gcc/testsuite/gfortran.dg/coarray/image_status_2.f08 b/gcc/testsuite/gfortran.dg/coarray/image_status_2.f08\nindex fb49289cb78..8866f237481 100644\n--- a/gcc/testsuite/gfortran.dg/coarray/image_status_2.f08\n+++ b/gcc/testsuite/gfortran.dg/coarray/image_status_2.f08\n@@ -1,12 +1,38 @@\n ! { dg-do run }\n \n program test_image_status_2\n- use iso_fortran_env , only : STAT_STOPPED_IMAGE\n+ use iso_fortran_env\n implicit none\n \n+ type(team_type) :: t\n+ integer :: i, st\n+ integer, allocatable :: rem_images(:)\n+\n+ form team (1, t)\n+\n if (image_status(1) /= 0) error stop \"Image 1 should report OK.\"\n- if (image_status(2) /= STAT_STOPPED_IMAGE) error stop \"Image 2 should be stopped.\"\n- if (image_status(3) /= STAT_STOPPED_IMAGE) error stop \"Image 3 should be stopped.\"\n+ if (image_status(num_images() + 1) /= STAT_STOPPED_IMAGE) error stop \"Image should be stopped.\"\n+\n+ if (image_status(1, t) /= 0) error stop \"Image 1 in team t should report OK.\"\n+\n+ if (num_images() > 1) then\n+ associate (np => num_images())\n+ sync all\n+ if (this_image() == 2) fail image \n+ rem_images = (/ 1, ( i, i = 3, np )/)\n+ ! Can't synchronize well on failed image. Try with a sleep.\n+ do i = 0, 10\n+ if (image_status(2) /= STAT_FAILED_IMAGE) then\n+ call sleep(1)\n+ else\n+ exit\n+ end if\n+ end do\n+ sync images (rem_images, stat=st)\n+ if (image_status(2) /= STAT_FAILED_IMAGE) error stop \"Image 2 has NOT status failed.\"\n+ if (image_status(2, t) /= STAT_FAILED_IMAGE) error stop \"Image 2 has NOT status failed.\"\n+ end associate\n+ end if\n \n end program test_image_status_2\n \ndiff --git a/gcc/testsuite/gfortran.dg/coarray/lock_2.f90 b/gcc/testsuite/gfortran.dg/coarray/lock_2.f90\nindex 8e96154996d..3d445b9b5e8 100644\n--- a/gcc/testsuite/gfortran.dg/coarray/lock_2.f90\n+++ b/gcc/testsuite/gfortran.dg/coarray/lock_2.f90\n@@ -58,6 +58,8 @@ if (stat /= 0) STOP 9\n UNLOCK(lock3(4), stat=stat)\n if (stat /= 0) STOP 10\n \n+! Ensure all other (/=1) images have released the locks.\n+sync all\n if (this_image() == 1) then\n acquired = .false.\n LOCK (lock1[this_image()], acquired_lock=acquired)\ndiff --git a/gcc/testsuite/gfortran.dg/coarray/poly_run_3.f90 b/gcc/testsuite/gfortran.dg/coarray/poly_run_3.f90\nindex c284a566760..4da1b9569fe 100644\n--- a/gcc/testsuite/gfortran.dg/coarray/poly_run_3.f90\n+++ b/gcc/testsuite/gfortran.dg/coarray/poly_run_3.f90\n@@ -12,28 +12,28 @@ allocate(a(1)[*])\n if (this_image() == 1 .and. any (this_image(a) /= lcobound(a))) &\n STOP 1\n if (any (lcobound(a) /= 1)) STOP 2\n-if (any (ucobound(a) /= this_image())) STOP 3\n+if (any (ucobound(a) /= num_images())) STOP 3\n deallocate(a)\n \n allocate(b[*])\n if (this_image() == 1 .and. any (this_image(b) /= lcobound(b))) &\n STOP 4\n if (any (lcobound(b) /= 1)) STOP 5\n-if (any (ucobound(b) /= this_image())) STOP 6\n+if (any (ucobound(b) /= num_images())) STOP 6\n deallocate(b)\n \n allocate(a(1)[-10:*])\n if (this_image() == 1 .and. any (this_image(a) /= lcobound(a))) &\n STOP 7\n if (any (lcobound(a) /= -10)) STOP 8\n-if (any (ucobound(a) /= -11+this_image())) STOP 9\n+if (any (ucobound(a) /= -11 + num_images())) STOP 9\n deallocate(a)\n \n allocate(d[23:*])\n if (this_image() == 1 .and. any (this_image(d) /= lcobound(d))) &\n STOP 10\n if (any (lcobound(d) /= 23)) STOP 11\n-if (any (ucobound(d) /= 22+this_image())) STOP 12\n+if (any (ucobound(d) /= 22 + num_images())) STOP 12\n deallocate(d)\n \n end\ndiff --git a/gcc/testsuite/gfortran.dg/coarray/scalar_alloc_1.f90 b/gcc/testsuite/gfortran.dg/coarray/scalar_alloc_1.f90\nindex b0d27bdfb8f..8dd7df5d436 100644\n--- a/gcc/testsuite/gfortran.dg/coarray/scalar_alloc_1.f90\n+++ b/gcc/testsuite/gfortran.dg/coarray/scalar_alloc_1.f90\n@@ -19,7 +19,7 @@ if (lcobound(a, dim=1) /= 1 .or. ucobound(a,dim=1) /= num_images()) &\n deallocate(a)\n \n allocate(a[4:*])\n-a[this_image ()] = 8 - 2*this_image ()\n+a[this_image () + 3] = 8 - 2*this_image ()\n \n if (lcobound(a, dim=1) /= 4 .or. ucobound(a,dim=1) /= 3 + num_images()) &\n STOP 4\n@@ -30,6 +30,7 @@ n3 = 3\n allocate (B[n1:n2, n3:*])\n if (any (lcobound(b) /= [-1, 3]) .or. lcobound(B, dim=2) /= n3) &\n STOP 5\n+sync all\n call sub(A, B)\n \n if (allocated (a)) STOP 6\n@@ -47,7 +48,8 @@ contains\n STOP 8\n if (lcobound(x, dim=1) /= 4 .or. ucobound(x,dim=1) /= 3 + num_images()) &\n STOP 9\n- if (x[this_image ()] /= 8 - 2*this_image ()) STOP 3\n+ if (x[this_image () + 3] /= 8 - 2*this_image ()) STOP 10\n+ sync all\n deallocate(x)\n end subroutine sub\n \n@@ -56,12 +58,13 @@ contains\n integer, allocatable, SAVE :: a[:]\n \n if (init) then\n- if (allocated(a)) STOP 10\n+ if (allocated(a)) STOP 11\n allocate(a[*])\n a = 45\n else\n- if (.not. allocated(a)) STOP 11\n- if (a /= 45) STOP 12\n+ if (.not. allocated(a)) STOP 12\n+ if (a /= 45) STOP 13\n+ sync all\n deallocate(a)\n end if\n end subroutine two\ndiff --git a/gcc/testsuite/gfortran.dg/coarray/stopped_images_2.f08 b/gcc/testsuite/gfortran.dg/coarray/stopped_images_2.f08\nindex 0bf4a81a7e2..dadd00ecda7 100644\n--- a/gcc/testsuite/gfortran.dg/coarray/stopped_images_2.f08\n+++ b/gcc/testsuite/gfortran.dg/coarray/stopped_images_2.f08\n@@ -1,17 +1,44 @@\n ! { dg-do run }\n \n program test_stopped_images_2\n+ use iso_fortran_env\n implicit none\n \n+ type(team_type) :: t\n integer, allocatable :: si(:)\n integer(kind=1), allocatable :: ssi(:)\n+ integer, allocatable :: rem_images(:)\n+ integer :: i, st\n \n- si = stopped_images()\n- if (size(si) > 0) error stop \"stopped_images result shall be empty array\"\n- ssi = stopped_images(KIND=1)\n- if (size(ssi) > 0) error stop \"stopped_images result shall be empty array\"\n- ssi = stopped_images(KIND=8)\n- if (size(ssi) > 0) error stop \"stopped_images result shall be empty array\"\n+ associate(np => num_images())\n+ form team (1, t)\n+ si = stopped_images()\n+ if (size(si) > 0) stop 1\n+ ssi = stopped_images(KIND=1)\n+ if (size(ssi) > 0) stop 2\n+ ssi = stopped_images(KIND=8)\n+ if (size(ssi) > 0) stop 3\n+ \n+ si = stopped_images(t) \n+ if (size(si) > 0) stop 4\n \n+ if (num_images() > 1) then\n+ sync all\n+ if (this_image() == 2) stop\n+ rem_images = (/ 1, ( i, i = 3, np )/)\n+ ! Can't synchronize well on a stopped image. Try with a sleep.\n+ do i = 0, 10\n+ if (size(stopped_images()) == 0) then\n+ call sleep(1)\n+ else\n+ exit\n+ end if\n+ end do\n+ if (i == 10 .AND. size(stopped_images()) == 0) stop 5\n+ sync images (rem_images, stat=st)\n+ if (any(stopped_images() /= [2])) stop 6\n+ if (any(stopped_images(t, 8) /= [2])) stop 7\n+ end if\n+ end associate\n end program test_stopped_images_2\n \ndiff --git a/gcc/testsuite/gfortran.dg/coarray/sync_1.f90 b/gcc/testsuite/gfortran.dg/coarray/sync_1.f90\nindex 8633c4aa527..4abe5a3b548 100644\n--- a/gcc/testsuite/gfortran.dg/coarray/sync_1.f90\n+++ b/gcc/testsuite/gfortran.dg/coarray/sync_1.f90\n@@ -26,7 +26,6 @@ n = 5\n sync all (stat=n,errmsg=str)\n if (n /= 0) STOP 2\n \n-\n !\n ! Test SYNC MEMORY\n !\n@@ -42,17 +41,21 @@ n = 5\n sync memory (errmsg=str,stat=n)\n if (n /= 0) STOP 4\n \n-\n !\n ! Test SYNC IMAGES\n !\n sync images (*)\n+\n if (this_image() == 1) then\n sync images (1)\n sync images (1, errmsg=str)\n sync images ([1])\n end if\n \n+! Need to sync all here, because otherwise sync image 1 may overlap with the\n+! sync images(*, stat=n) below and that may hang for num_images() > 1.\n+sync all\n+\n n = 5\n sync images (*, stat=n)\n if (n /= 0) STOP 5\n@@ -61,4 +64,5 @@ n = 5\n sync images (*,errmsg=str,stat=n)\n if (n /= 0) STOP 6\n \n+sync all\n end\ndiff --git a/gcc/testsuite/gfortran.dg/coarray/sync_3.f90 b/gcc/testsuite/gfortran.dg/coarray/sync_3.f90\nindex fe1e4c548c8..ceb4b19d517 100644\n--- a/gcc/testsuite/gfortran.dg/coarray/sync_3.f90\n+++ b/gcc/testsuite/gfortran.dg/coarray/sync_3.f90\n@@ -9,8 +9,9 @@\n ! PR fortran/18918\n \n implicit none\n-integer :: n\n-character(len=30) :: str\n+integer :: n, st\n+integer,allocatable :: others(:)\n+character(len=40) :: str\n critical\n end critical\n myCr: critical\n@@ -58,17 +59,32 @@ if (this_image() == 1) then\n sync images ([1])\n end if\n \n+! Need to sync all here, because otherwise sync image 1 may overlap with the\n+! sync images(*, stat=n) below and that may hang for num_images() > 1.\n+sync all\n+\n n = 5\n sync images (*, stat=n)\n if (n /= 0) STOP 5\n \n n = 5\n-sync images (*,errmsg=str,stat=n)\n+sync images (*, errmsg=str, stat=n)\n if (n /= 0) STOP 6\n \n+if (this_image() == num_images()) then\n+ others = (/( n, n=1, (num_images() - 1)) /)\n+ sync images(others)\n+else\n+ sync images ( num_images() )\n+end if \n+\n n = -1\n-sync images ( num_images() )\n-sync images (n) ! Invalid: \"-1\"\n+st = 0\n+sync images (n, errmsg=str, stat=st)\n+if (st /= 1 .OR. str /= \"Invalid image number -1 in SYNC IMAGES\") STOP 7\n+\n+! Do this only on image 1, or output of error messages will clutter\n+if (this_image() == 1) sync images (n) ! Invalid: \"-1\"\n \n end\n \ndiff --git a/gcc/testsuite/gfortran.dg/coarray/sync_team.f90 b/gcc/testsuite/gfortran.dg/coarray/sync_team.f90\nnew file mode 100644\nindex 00000000000..a96884549a3\n--- /dev/null\n+++ b/gcc/testsuite/gfortran.dg/coarray/sync_team.f90\n@@ -0,0 +1,33 @@\n+!{ dg-do run }\n+\n+program main\n+ use, intrinsic :: iso_fortran_env, only: team_type\n+ implicit none\n+ integer, parameter :: PARENT_TEAM = 1, CURRENT_TEAM = 2, CHILD_TEAM = 3\n+ type(team_type) :: team(3)\n+\n+ if (num_images() > 7) then\n+\n+ form team (1, team(PARENT_TEAM))\n+ change team (team(PARENT_TEAM))\n+ form team (mod(this_image(),2) + 1, team(CURRENT_TEAM))\n+ change team (team(CURRENT_TEAM))\n+ form team(mod(this_image(),2) + 1, team(CHILD_TEAM))\n+ sync team(team(PARENT_TEAM))\n+ ! change order / number of syncs between teams to try to expose deadlocks\n+ if (team_number() == 1) then\n+ sync team(team(CURRENT_TEAM))\n+ sync team(team(CHILD_TEAM))\n+ else\n+ sync team(team(CHILD_TEAM))\n+ sync team(team(CURRENT_TEAM))\n+ sync team(team(CHILD_TEAM))\n+ sync team(team(CURRENT_TEAM))\n+ end if\n+ end team\n+ end team\n+\n+ sync all\n+ end if\n+\n+end program\n", "prefixes": [ "6/13" ] }