From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 129331 invoked by alias); 9 Dec 2015 07:24:48 -0000 Mailing-List: contact fortran-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Subscribe: List-Post: List-Help: , Sender: fortran-owner@gcc.gnu.org Received: (qmail 129294 invoked by uid 89); 9 Dec 2015 07:24:44 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-0.5 required=5.0 tests=AWL,BAYES_00,KAM_LAZY_DOMAIN_SECURITY autolearn=no version=3.3.2 X-Spam-User: qpsmtpd, 2 recipients X-HELO: mx01.qsc.de Received: from mx01.qsc.de (HELO mx01.qsc.de) (213.148.129.14) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES256-SHA encrypted) ESMTPS; Wed, 09 Dec 2015 07:24:43 +0000 Received: from tux.net-b.de (port-92-194-127-198.dynamic.qsc.de [92.194.127.198]) (using TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits)) (No client certificate requested) by mx01.qsc.de (Postfix) with ESMTPSA id D9E473D12D; Wed, 9 Dec 2015 08:24:39 +0100 (CET) Subject: Re: [Patch, Fortran] PR45859 - Permit array elements to coarray dummy arguments To: Tobias Burnus , gcc-patches@gcc.gnu.org, fortran@gcc.gnu.org References: <20151204123922.GA31837@physik.fu-berlin.de> <20151204131601.GA13770@physik.fu-berlin.de> From: Tobias Burnus Message-ID: <5667D737.2070601@net-b.de> Date: Wed, 09 Dec 2015 07:24:00 -0000 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:38.0) Gecko/20100101 Thunderbird/38.3.0 MIME-Version: 1.0 In-Reply-To: <20151204131601.GA13770@physik.fu-berlin.de> Content-Type: text/plain; charset=windows-1252; format=flowed Content-Transfer-Encoding: 7bit X-IsSubscribed: yes X-SW-Source: 2015-12/txt/msg00065.txt.bz2 PING On 4 December 2015, Tobias Burnus wrote: > I pressed "Send" too early - as the testsuite fails unless the following > patch is applied. I think I will just use this test case (with patch) > instead of adding a new test-suite file. Required patch: > > --- a/gcc/testsuite/gfortran.dg/coarray_args_2.f90 > +++ b/gcc/testsuite/gfortran.dg/coarray_args_2.f90 > @@ -40,8 +40,7 @@ program rank_mismatch_02 > sync all > > call subr(ndim, a(1:1,2)) ! OK > - call subr(ndim, a(1,2)) ! { dg-error "must be simply contiguous" } > - ! See also F08/0048 and PR 45859 about the validity > + call subr(ndim, a(1,2)) ! See also F08/0048 and PR 45859 about the validity > if (this_image() == 1) then > write(*, *) 'OK' > end if > > > Tobias > > On Fri, Dec 04, 2015 at 01:39:22PM +0100, Tobias Burnus wrote: >> This patch permits >> >> interface >> subroutine sub (x) >> real x(10)[*] >> end subroutine >> end interface >> real :: x(100)[*] >> call sub (x(10)) >> end >> >> where one passes an array element ("x(10)") of a contiguous array to a >> coarray dummy argument. That's permitted per interpretation request >> F08/0048, which ended up in Fortran 2008's Corrigendum 2 - and is also >> in the current Fortran 2015 drafts: >> >> "If the dummy argument is an array coarray that has the CONTIGUOUS attribute >> or is not of assumed shape, the corresponding actual argument shall be >> simply contiguous or an element of a simply contiguous array." >> >> the "or ..." of the last line was added in the corrigendum. >> >> >> I hope and think that I got the true/false of the other users correct - in >> most cases, it probably doesn't matter as the caller is only reached for >> expr->rank > 0. >> >> Build and regtested on x86-64-gnu-linux. >> OK for the trunk? >> >> Tobias >> gcc/fortran >> PR fortran/45859 >> * expr.c (gfc_is_simply_contiguous): Optionally permit array elements. >> (gfc_check_pointer_assign): Update call. >> * interface.c (compare_parameter): Ditto. >> * trans-array.c (gfc_conv_array_parameter): Ditto. >> * trans-intrinsic.c (gfc_conv_intrinsic_transfer, >> conv_isocbinding_function): Ditto. >> * gfortran.h (gfc_is_simply_contiguous): >> >> gcc/testsuite/ >> PR fortran/45859 >> * gfortran.dg/coarray_argument_1.f90: New. >> >> diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c >> index 2aeb0b5..5dd90ef 100644 >> --- a/gcc/fortran/expr.c >> +++ b/gcc/fortran/expr.c >> @@ -3683,7 +3683,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) >> and F2008 must be allowed. */ >> if (rvalue->rank != 1) >> { >> - if (!gfc_is_simply_contiguous (rvalue, true)) >> + if (!gfc_is_simply_contiguous (rvalue, true, false)) >> { >> gfc_error ("Rank remapping target must be rank 1 or" >> " simply contiguous at %L", &rvalue->where); >> @@ -4601,7 +4601,7 @@ gfc_has_ultimate_pointer (gfc_expr *e) >> a "(::1)" is accepted. */ >> >> bool >> -gfc_is_simply_contiguous (gfc_expr *expr, bool strict) >> +gfc_is_simply_contiguous (gfc_expr *expr, bool strict, bool permit_element) >> { >> bool colon; >> int i; >> @@ -4615,7 +4615,7 @@ gfc_is_simply_contiguous (gfc_expr *expr, bool strict) >> else if (expr->expr_type != EXPR_VARIABLE) >> return false; >> >> - if (expr->rank == 0) >> + if (!permit_element && expr->rank == 0) >> return false; >> >> for (ref = expr->ref; ref; ref = ref->next) >> diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h >> index 9f61e45..d203c32 100644 >> --- a/gcc/fortran/gfortran.h >> +++ b/gcc/fortran/gfortran.h >> @@ -2982,7 +2982,7 @@ void gfc_free_actual_arglist (gfc_actual_arglist *); >> gfc_actual_arglist *gfc_copy_actual_arglist (gfc_actual_arglist *); >> const char *gfc_extract_int (gfc_expr *, int *); >> bool is_subref_array (gfc_expr *); >> -bool gfc_is_simply_contiguous (gfc_expr *, bool); >> +bool gfc_is_simply_contiguous (gfc_expr *, bool, bool); >> bool gfc_check_init_expr (gfc_expr *); >> >> gfc_expr *gfc_build_conversion (gfc_expr *); >> diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c >> index f74239d..bfd5d36 100644 >> --- a/gcc/fortran/interface.c >> +++ b/gcc/fortran/interface.c >> @@ -2020,7 +2020,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, >> >> /* F2008, C1241. */ >> if (formal->attr.pointer && formal->attr.contiguous >> - && !gfc_is_simply_contiguous (actual, true)) >> + && !gfc_is_simply_contiguous (actual, true, false)) >> { >> if (where) >> gfc_error ("Actual argument to contiguous pointer dummy %qs at %L " >> @@ -2131,15 +2131,17 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, >> >> if (formal->attr.codimension) >> { >> - /* F2008, 12.5.2.8. */ >> + /* F2008, 12.5.2.8 + Corrig 2 (IR F08/0048). */ >> + /* F2015, 12.5.2.8. */ >> if (formal->attr.dimension >> && (formal->attr.contiguous || formal->as->type != AS_ASSUMED_SHAPE) >> && gfc_expr_attr (actual).dimension >> - && !gfc_is_simply_contiguous (actual, true)) >> + && !gfc_is_simply_contiguous (actual, true, true)) >> { >> if (where) >> gfc_error ("Actual argument to %qs at %L must be simply " >> - "contiguous", formal->name, &actual->where); >> + "contiguous or an element of such an array", >> + formal->name, &actual->where); >> return 0; >> } >> >> @@ -2179,7 +2181,8 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, >> && (actual->symtree->n.sym->attr.asynchronous >> || actual->symtree->n.sym->attr.volatile_) >> && (formal->attr.asynchronous || formal->attr.volatile_) >> - && actual->rank && formal->as && !gfc_is_simply_contiguous (actual, true) >> + && actual->rank && formal->as >> + && !gfc_is_simply_contiguous (actual, true, false) >> && ((formal->as->type != AS_ASSUMED_SHAPE >> && formal->as->type != AS_ASSUMED_RANK && !formal->attr.pointer) >> || formal->attr.contiguous)) >> diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c >> index 69f6e19..6e24e2e 100644 >> --- a/gcc/fortran/trans-array.c >> +++ b/gcc/fortran/trans-array.c >> @@ -7386,7 +7386,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77, >> && ref->u.ar.as->type != AS_ASSUMED_RANK >> && ref->u.ar.as->type != AS_ASSUMED_SHAPE) >> || >> - gfc_is_simply_contiguous (expr, false)); >> + gfc_is_simply_contiguous (expr, false, true)); >> >> no_pack = contiguous && no_pack; >> >> @@ -7464,7 +7464,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77, >> } >> >> if (g77 || (fsym && fsym->attr.contiguous >> - && !gfc_is_simply_contiguous (expr, false))) >> + && !gfc_is_simply_contiguous (expr, false, true))) >> { >> tree origptr = NULL_TREE; >> >> diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c >> index 21efe44..743148e 100644 >> --- a/gcc/fortran/trans-intrinsic.c >> +++ b/gcc/fortran/trans-intrinsic.c >> @@ -6244,7 +6244,7 @@ gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr) >> source_type = gfc_get_element_type (TREE_TYPE (argse.expr)); >> >> /* Repack the source if not simply contiguous. */ >> - if (!gfc_is_simply_contiguous (arg->expr, false)) >> + if (!gfc_is_simply_contiguous (arg->expr, false, true)) >> { >> tmp = gfc_build_addr_expr (NULL_TREE, argse.expr); >> >> @@ -7142,7 +7142,7 @@ conv_isocbinding_function (gfc_se *se, gfc_expr *expr) >> { >> if (arg->expr->rank == 0) >> gfc_conv_expr_reference (se, arg->expr); >> - else if (gfc_is_simply_contiguous (arg->expr, false)) >> + else if (gfc_is_simply_contiguous (arg->expr, false, false)) >> gfc_conv_array_parameter (se, arg->expr, true, NULL, NULL, NULL); >> else >> { >> diff --git a/gcc/testsuite/gfortran.dg/coarray_argument_1.f90 b/gcc/testsuite/gfortran.dg/coarray_argument_1.f90 >> new file mode 100644 >> index 0000000..511da29 >> --- /dev/null >> +++ b/gcc/testsuite/gfortran.dg/coarray_argument_1.f90 >> @@ -0,0 +1,14 @@ >> +! { dg-do compile } >> +! { dg-options "-fcoarray=lib" } >> +! >> +! PR fortran/45859 >> +! Interpretation request F08/0048 >> +! >> + interface >> + subroutine sub (x) >> + real x(10)[*] >> + end subroutine >> + end interface >> + real :: x(100)[*] >> + call sub (x(10)) >> + end >