From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 125229 invoked by alias); 19 Jan 2019 15:05:53 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Received: (qmail 125210 invoked by uid 89); 19 Jan 2019 15:05:52 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-11.8 required=5.0 tests=BAYES_00,GIT_PATCH_2,GIT_PATCH_3,KAM_ASCII_DIVIDERS,RCVD_IN_DNSWL_LOW,SPF_PASS autolearn=ham version=3.3.2 spammy=sk:pault@g, sk:paultg, U*pault, 55 X-HELO: cc-smtpout2.netcologne.de Received: from cc-smtpout2.netcologne.de (HELO cc-smtpout2.netcologne.de) (89.1.8.212) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Sat, 19 Jan 2019 15:05:49 +0000 Received: from cc-smtpin3.netcologne.de (cc-smtpin3.netcologne.de [89.1.8.203]) by cc-smtpout2.netcologne.de (Postfix) with ESMTP id BE21012663; Sat, 19 Jan 2019 16:05:46 +0100 (CET) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=netcologne.de; s=nc1116a; t=1547910346; bh=EVmRG9Hd5olVGF5TqVnaNisUni/GeGT1T3HSqQAA1ts=; h=To:From:Subject:Message-ID:Date:From; b=Upfips8nc8qS0JMXqKKe11BkbTYLjJU++OrsUnU9Bx8m/6NrDPKwroQEgr1l6GHbF 1rPIOXUF5ucE3llWCzwpEFebAZL/Oqs8mgGcqPhTIZqE7hu8/EiYtoNrUK2zRtjbpn sX/T5ck0PiXMBceubb5NORvOgsChu9+YZik83utEGR2GKMEnr1S4iC9/c5B5Sf1RFp JRgB6TnVx1rGko80n9D3YUaeyQt7MYxgaqBIZcNC+cs7V6Gz2dUfQbVEgj/AAnWWpc DuxDtiKX/VoMqfD/X2LWMi+xji1uEUfOAMOfIrKqg/lKdSECu0bde/VXxxwRC9AyE9 FHMOZnS1cc0CA== Received: from localhost (localhost [127.0.0.1]) by cc-smtpin3.netcologne.de (Postfix) with ESMTP id B00E011D69; Sat, 19 Jan 2019 16:05:46 +0100 (CET) Received: from [78.35.145.129] (helo=cc-smtpin3.netcologne.de) by localhost with ESMTP (eXpurgate 4.6.0) (envelope-from ) id 5c433cca-0bea-7f0000012729-7f000001bcae-1 for ; Sat, 19 Jan 2019 16:05:46 +0100 Received: from [192.168.178.68] (xdsl-78-35-145-129.nc.de [78.35.145.129]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by cc-smtpin3.netcologne.de (Postfix) with ESMTPSA; Sat, 19 Jan 2019 16:05:45 +0100 (CET) To: "fortran@gcc.gnu.org" , gcc-patches From: Thomas Koenig Subject: [patch, fortran] Fix contiguous dummy arguments Message-ID: Date: Sat, 19 Jan 2019 15:05:00 -0000 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:60.0) Gecko/20100101 Thunderbird/60.3.0 MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="------------2E2404182F8278DEA69BD44E" X-SW-Source: 2019-01/txt/msg01124.txt.bz2 This is a multi-part message in MIME format. --------------2E2404182F8278DEA69BD44E Content-Type: text/plain; charset=utf-8; format=flowed Content-Transfer-Encoding: 7bit Content-length: 1109 Hello world, the attached patch fixes handling of contiguous dummy arguments when the actual arguments are not contiguous. The patch to trans-expr.c itself was written by Paul and attached to the PR. I just added the test case. Regression-testing revealed some failing scan-tree tests due to different code being generated. I put corresponding run time tests into the new test case to make sure that no wrong code is being generated. I have also tested the new test case and the compiler with valgrind. OK for trunk? Regards Thomas 2018-01-19 Thomas Koenig Paul Thomas PR fortran/56789 * trans-expr.c (gfc_conv_procedure_call): Call gfc_conv_subref_array_arg if the formal arg is contiguous and the actual arg may not be. 2018-01-19 Thomas Koenig Paul Thomas PR fortran/56789 * gfortran.dg/contiguous_3.f90: Make code compilant. Remove scan-tree tests that fail with patch. * gfortran.dg/contiguous_8.f90: New test. --------------2E2404182F8278DEA69BD44E Content-Type: text/x-patch; name="p2.diff" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename="p2.diff" Content-length: 1502 Index: fortran/trans-expr.c =================================================================== --- fortran/trans-expr.c (Revision 267903) +++ fortran/trans-expr.c (Arbeitskopie) @@ -5819,6 +5819,13 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * INTENT_IN, fsym && fsym->attr.pointer); } + else if (fsym && fsym->attr.contiguous + && !gfc_is_simply_contiguous (e, false, true)) + { + gfc_conv_subref_array_arg (&parmse, e, nodesc_arg, + fsym ? fsym->attr.intent : INTENT_INOUT, + fsym && fsym->attr.pointer); + } else gfc_conv_array_parameter (&parmse, e, nodesc_arg, fsym, sym->name, NULL); Index: testsuite/gfortran.dg/contiguous_3.f90 =================================================================== --- testsuite/gfortran.dg/contiguous_3.f90 (Revision 267903) +++ testsuite/gfortran.dg/contiguous_3.f90 (Arbeitskopie) @@ -8,6 +8,8 @@ subroutine test1(a,b) integer, pointer, contiguous :: test1_a(:) + integer, target, dimension(3) :: aa + test1_a => aa call foo(test1_a) call foo(test1_a(::1)) call foo(test1_a(::2)) @@ -56,9 +58,3 @@ contains end subroutine bar end subroutine test3 -! Once for test1 (third call), once for test3 (second call) -! { dg-final { scan-tree-dump-times "data = origptr" 1 "original" } } -! { dg-final { scan-tree-dump-times "_gfortran_internal_pack .&parm" 2 "original" } } -! { dg-final { scan-tree-dump-times "_gfortran_internal_unpack .&parm" 2 "original" } } - - --------------2E2404182F8278DEA69BD44E Content-Type: text/x-fortran; name="contiguous_8.f90" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename="contiguous_8.f90" Content-length: 1751 ! { dg-do run } ! PR 56789 - packing / unpacking of contiguous arguments ! did not happen. module my_module implicit none contains subroutine cont_arg(a) real, contiguous :: a(:,:) integer :: i,j do j=1,size(a,2) do i=1,size(a,1) a(i,j) = i+10*j end do end do end subroutine cont_arg subroutine cont_pointer_arg (a) integer, pointer, contiguous :: a(:) call assumed_size(a) call assumed_size(a(::1)) call assumed_size_2(a(::2)) end subroutine cont_pointer_arg subroutine assumed_size(y) integer, dimension(*) :: y if (y(2) /= 2 .or. y(3) /= 3 .or. y(4) /= 4 .or. y(5) /= 5 .or. y(6) /= 6) & stop 2 end subroutine assumed_size subroutine assumed_size_2(y) integer, dimension(*) :: y if (y(1) /= 1 .or. y(2) /= 3 .or. y(3) /= 5) stop 3 end subroutine assumed_size_2 subroutine cont_assumed_shape(x) integer, dimension(:), contiguous :: x if (size(x,1) == 8) then if (any(x /= [1,2,3,4,5,6,7,8])) stop 4 else if (any(x /= [1,3,5,7])) stop 5 end if end subroutine cont_assumed_shape end module my_module program main use my_module implicit none real, dimension(5,5) :: a real, dimension(5,5) :: res integer, dimension(8), target :: t integer, dimension(:), pointer, contiguous :: p res = reshape([11., 1.,12., 1.,13.,& 1., 1., 1., 1., 1.,& 21., 1.,22., 1.,23.,& 1., 1., 1., 1., 1.,& 31., 1.,32., 1., 33.], shape(res)) a = 1. call cont_arg(a(1:5:2,1:5:2)) if (any(a /= res)) stop 1 t = [1,2,3,4,5,6,7,8] p => t call cont_pointer_arg(p) call cont_assumed_shape (t) call cont_assumed_shape (t(::2)) end program main --------------2E2404182F8278DEA69BD44E--