From patchwork Sun Mar 1 22:35:54 2015 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 444882 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4337E14017B for ; Mon, 2 Mar 2015 09:36:11 +1100 (AEDT) Authentication-Results: ozlabs.org; dkim=pass reason="1024-bit key; unprotected key" header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b=uE52PJRp; dkim-adsp=none (unprotected policy); dkim-atps=neutral DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender :message-id:date:from:mime-version:to:subject:content-type; q= dns; s=default; b=OmW+9n+jJ/KwSf141X1oNpf5Bgt9OeHhseDyWDRNO0Znvt 9wA7qNlZ8HZc6EuRrHFAIRA9jKtP72W7HaeDnabRen/ULs9jTx2vF9r4YQUnygMU xJHYwRBTTByH0TsE+WIe2l+Yv734HaTpgZwpbvoLS4pgpeJy9PCtjWxDg5u1M= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender :message-id:date:from:mime-version:to:subject:content-type; s= default; bh=tlQ9ygCa1IlVDOoFiPsSrjsOW4U=; b=uE52PJRp5otrAwEyAz6S o/UeJwYAKf1AtuSHbFgph8vgsv8N6Imz8X5d7JPYIuNWeQNKlJNuf/Etgt3U5gVq a5FMf/OvrvMlt9QZLmiYRsCoSKEgIhS2Imh8zsaUKWIjc3YLtiGrO946Bu7DT/I+ r7rrrg3iLxIbdWnA3yZCbEc= Received: (qmail 79357 invoked by alias); 1 Mar 2015 22:36:01 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 79312 invoked by uid 89); 1 Mar 2015 22:35:59 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-1.3 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_LOW autolearn=ham version=3.3.2 X-Spam-User: qpsmtpd, 2 recipients X-HELO: mx02.qsc.de Received: from mx02.qsc.de (HELO mx02.qsc.de) (213.148.130.14) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES256-SHA encrypted) ESMTPS; Sun, 01 Mar 2015 22:35:58 +0000 Received: from tux.net-b.de (port-92-194-228-167.dynamic.qsc.de [92.194.228.167]) (using TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits)) (No client certificate requested) by mx02.qsc.de (Postfix) with ESMTPSA id BA0A724CCA; Sun, 1 Mar 2015 23:35:54 +0100 (CET) Message-ID: <54F3944A.5000800@net-b.de> Date: Sun, 01 Mar 2015 23:35:54 +0100 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:31.0) Gecko/20100101 Thunderbird/31.4.0 MIME-Version: 1.0 To: gcc-patches , gfortran Subject: [Patch, Fortran] Fix ATOMIC checks This patch changes the coarray/coindexed check to match what the error message already claimed. OK for the trunk? Tobias diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 3be4fb1..cdb5ff1 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -1022,7 +1022,7 @@ gfc_check_atomic (gfc_expr *atom, int atom_no, gfc_expr *value, int val_no, return false; } - if (!gfc_expr_attr (atom).codimension) + if (!gfc_is_coarray (atom) && !gfc_is_coindexed (atom)) { gfc_error ("ATOM argument at %L of the %s intrinsic function shall be a " "coarray or coindexed", &atom->where, gfc_current_intrinsic); diff --git a/gcc/testsuite/gfortran.dg/coarray_atomic_6.f90 b/gcc/testsuite/gfortran.dg/coarray_atomic_6.f90 new file mode 100644 index 0000000..ae155ec --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray_atomic_6.f90 @@ -0,0 +1,36 @@ +! { dg-do compile } +! { dg-options "-fcoarray=single" } +! +! Contributed by Reinhold Bader +! +! +program def_and_ref +! compile only + use, intrinsic :: iso_fortran_env + implicit none + type :: e + integer(kind=atomic_int_kind) :: ia = 0 + logical(kind=atomic_logical_kind) :: la = .false. + end type + + type(e) :: a[*] + + integer :: ival = 0 + logical :: lval = .false. + + if (this_image() == 1) then + call atomic_define(a[num_images()]%ia, 4) + call atomic_define(a[num_images()]%la, .true.) + end if + if (this_image() == num_images()) then + do while (ival == 0 .and. .not. lval) + call atomic_ref(ival, a%ia) + call atomic_ref(lval, a%la) + end do + if (ival == 4 .and. lval) then + write(*,*) 'OK' + else + write(*,*) 'FAIL: ival,lval =', ival, lval + end if + end if +end program