From patchwork Tue Mar 24 07:16:16 2015 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 453744 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 8094B14009B for ; Tue, 24 Mar 2015 18:16:34 +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=YQUd3P66; 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:cc:subject:references :in-reply-to:content-type; q=dns; s=default; b=VfD4mnsIQ524glSna p090erK9lD9w9H5IK+73LXYJpCndenSFqHtNjxoXrdSCNpdwrclm/+vNIcnz6k9y AC2tL7QFrH1+j4U/T4ZEp94Ojr8L3EdvLy0O0SFTxTusniWZYmJoNdQD8Jn+4uKP I3dAPDzkZqE5UWBi9B+7wY0h1A= 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:cc:subject:references :in-reply-to:content-type; s=default; bh=su4Ek8x05CUqyzuwLlZeXQe fjkE=; b=YQUd3P66B3RnkTpTj9dd3vfIt+Ok8E4CRFWSVCRe5vzaqa+anC1o3RO eic2UJe/opmzJTJDbxB4TGBcFzuNbSC/WME2WELwfJrlC7DahsSsH8mO4XFKRPbi oMKB6YAkqnW2DqolEPhQSYV92XbKA42AZoMwJjtbqApaPW4f3H28= Received: (qmail 119585 invoked by alias); 24 Mar 2015 07:16:23 -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 119555 invoked by uid 89); 24 Mar 2015 07:16:22 -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; Tue, 24 Mar 2015 07:16:21 +0000 Received: from tux.net-b.de (port-92-194-74-166.dynamic.qsc.de [92.194.74.166]) (using TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits)) (No client certificate requested) by mx02.qsc.de (Postfix) with ESMTPSA id E2E72277F7; Tue, 24 Mar 2015 08:16:16 +0100 (CET) Message-ID: <55110F40.8070702@net-b.de> Date: Tue, 24 Mar 2015 08:16:16 +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: Dominique Dhumieres CC: gcc-patches@gcc.gnu.org, fortran@gcc.gnu.org Subject: Re: [Patch, Fortran] Reject unsupported coarray communication References: <20150322092422.7CBFA105@mailhost.lps.ens.fr> In-Reply-To: <20150322092422.7CBFA105@mailhost.lps.ens.fr> Dear Dominique, Dominique Dhumieres wrote: > The test gfortran.dg/coarray/coindexed_3.f90 compiles without error, > see https://gcc.gnu.org/ml/gcc-testresults/2015-03/msg02446.html. Ups, I somehow missed that files under coarray/ are run with both -fcoarray=single and =lib; the error (rightly!) only is shown with =lib. I have now moved the test case and added an explicit -fcoarray=lib. Thanks for the report! (Committed as Rev. 221618.) Tobias Index: gcc/testsuite/ChangeLog =================================================================== --- gcc/testsuite/ChangeLog (Revision 221614) +++ gcc/testsuite/ChangeLog (Arbeitskopie) @@ -1,3 +1,8 @@ +2015-03-24 Tobias Burnus + + * gfortran.dg/coindexed_1.f90: Moved from + gfortran.dg/coarray/coindexed_3.f90; added dg-options. + 2015-03-23 Jakub Jelinek PR testsuite/65506 Index: gcc/testsuite/gfortran.dg/coarray/coindexed_3.f90 =================================================================== --- gcc/testsuite/gfortran.dg/coarray/coindexed_3.f90 (Revision 221614) +++ gcc/testsuite/gfortran.dg/coarray/coindexed_3.f90 (Arbeitskopie) @@ -1,71 +0,0 @@ -! { dg-do compile } -! -! Contributed by Reinhold Bader -! - -program pmup - implicit none - type t - integer :: b, a - end type t - - CLASS(*), allocatable :: a(:)[:] - integer :: ii - - !! --- ONE --- - allocate(real :: a(3)[*]) - IF (this_image() == num_images()) THEN - SELECT TYPE (a) - TYPE IS (real) - a(:)[1] = 2.0 - END SELECT - END IF - SYNC ALL - - IF (this_image() == 1) THEN - SELECT TYPE (a) - TYPE IS (real) - IF (ALL(A(:)[1] == 2.0)) THEN - !WRITE(*,*) 'OK' - ELSE - WRITE(*,*) 'FAIL' - call abort() - END IF - TYPE IS (t) - ii = a(1)[1]%a - call abort() - CLASS IS (t) - ii = a(1)[1]%a - call abort() - END SELECT - END IF - - !! --- TWO --- - deallocate(a) - allocate(t :: a(3)[*]) - IF (this_image() == num_images()) THEN - SELECT TYPE (a) - TYPE IS (t) ! FIXME: When implemented, turn into "do-do run" - a(:)[1]%a = 4.0 ! { dg-error "Sorry, coindexed access at \\(1\\) to a scalar component with an array partref is not yet supported" } - END SELECT - END IF - SYNC ALL - - IF (this_image() == 1) THEN - SELECT TYPE (a) - TYPE IS (real) - ii = a(1)[1] - call abort() - TYPE IS (t) ! FIXME: When implemented, turn into "do-do run" - IF (ALL(A(:)[1]%a == 4.0)) THEN ! { dg-error "Sorry, coindexed access at \\(1\\) to a scalar component with an array partref is not yet supported" } - !WRITE(*,*) 'OK' - ELSE - WRITE(*,*) 'FAIL' - call abort() - END IF - CLASS IS (t) - ii = a(1)[1]%a - call abort() - END SELECT - END IF -end program Index: gcc/testsuite/gfortran.dg/coindexed_1.f90 =================================================================== --- gcc/testsuite/gfortran.dg/coindexed_1.f90 (Revision 0) +++ gcc/testsuite/gfortran.dg/coindexed_1.f90 (Arbeitskopie) @@ -0,0 +1,72 @@ +! { dg-do compile } +! { dg-options "-fcoarray=lib" } +! +! Contributed by Reinhold Bader +! + +program pmup + implicit none + type t + integer :: b, a + end type t + + CLASS(*), allocatable :: a(:)[:] + integer :: ii + + !! --- ONE --- + allocate(real :: a(3)[*]) + IF (this_image() == num_images()) THEN + SELECT TYPE (a) + TYPE IS (real) + a(:)[1] = 2.0 + END SELECT + END IF + SYNC ALL + + IF (this_image() == 1) THEN + SELECT TYPE (a) + TYPE IS (real) + IF (ALL(A(:)[1] == 2.0)) THEN + !WRITE(*,*) 'OK' + ELSE + WRITE(*,*) 'FAIL' + call abort() + END IF + TYPE IS (t) + ii = a(1)[1]%a + call abort() + CLASS IS (t) + ii = a(1)[1]%a + call abort() + END SELECT + END IF + + !! --- TWO --- + deallocate(a) + allocate(t :: a(3)[*]) + IF (this_image() == num_images()) THEN + SELECT TYPE (a) + TYPE IS (t) ! FIXME: When implemented, turn into "do-do run" + a(:)[1]%a = 4.0 ! { dg-error "Sorry, coindexed access at \\(1\\) to a scalar component with an array partref is not yet supported" } + END SELECT + END IF + SYNC ALL + + IF (this_image() == 1) THEN + SELECT TYPE (a) + TYPE IS (real) + ii = a(1)[1] + call abort() + TYPE IS (t) ! FIXME: When implemented, turn into "do-do run" + IF (ALL(A(:)[1]%a == 4.0)) THEN ! { dg-error "Sorry, coindexed access at \\(1\\) to a scalar component with an array partref is not yet supported" } + !WRITE(*,*) 'OK' + ELSE + WRITE(*,*) 'FAIL' + call abort() + END IF + CLASS IS (t) + ii = a(1)[1]%a + call abort() + END SELECT + END IF +end program