From patchwork Thu Mar 7 22:42:25 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Harald Anlauf X-Patchwork-Id: 1053279 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-497533-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=gmx.de Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="v0HUj++a"; dkim-atps=neutral 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 44FlyL402Rz9s7h for ; Fri, 8 Mar 2019 09:42:48 +1100 (AEDT) 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=HXMDOg9Zeo3me8NG4LrjoUlGU5Vj68fRNUz4Vf29/w6VWL mkT5lqG6VeM3S1jQcWD73Dpg9VJjmxvMjpBX4lhuUE5DfAL3Lz+DqjyrenF00yBR fRMvKnVG2BDXqwSQ2kK+X/yU3MDHyov6VIqR53Spp7iBbOYn4ILWL6K8lFrCY= 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=txmqXgHCQ2VS07zqu4MyPdYxXZg=; b=v0HUj++ayCFP2Ohz2gXS l/2YRDLynV/pZAT117auSBBWe0nn2W+mY+bE+ErXoJl46Bp9gihsQDdqNC9yqKUA Dz4I9jEfnR6VT2vX56ywRWqxWBjUvB5xVzmy1+NdflfEc+5WqKFahnkZ6YfLM8w9 E9g3mbGqsmLIRazghBKRdvc= Received: (qmail 108336 invoked by alias); 7 Mar 2019 22:42:37 -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 108315 invoked by uid 89); 7 Mar 2019 22:42:36 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-11.8 required=5.0 tests=BAYES_00, FREEMAIL_FROM, GIT_PATCH_2, GIT_PATCH_3, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_LOW, SPF_PASS autolearn=ham version=3.3.1 spammy=mat, anlauf@gmx.de, anlaufgmxde, U*anlauf X-HELO: mout.gmx.net Received: from mout.gmx.net (HELO mout.gmx.net) (212.227.15.18) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Thu, 07 Mar 2019 22:42:34 +0000 Received: from proton.at.home ([93.207.82.33]) by mail.gmx.com (mrgmx001 [212.227.17.190]) with ESMTPSA (Nemesis) id 0Lp3Lw-1gYAbr0A5s-00etJK; Thu, 07 Mar 2019 23:42:31 +0100 Message-ID: <5C819E51.6000205@gmx.de> Date: Thu, 07 Mar 2019 23:42:25 +0100 From: Harald Anlauf User-Agent: Mozilla/5.0 (X11; Linux i686; rv:17.0) Gecko/20130329 Thunderbird/17.0.5 MIME-Version: 1.0 To: gfortran , gcc-patches Subject: [PR fortran/60091, patch] - Misleading error messages in rank-2 pointer assignment to rank-1 target The PR rightly complains about bad error messages for invalid pointer assignments. I've tried to adjust the logic slightly so that we now print error messages that should explain more clearly what is wrong. This required adjustment of 2 testcases, one of which also had an incorrect comment. OK for trunk? Thanks, Harald 2019-03-07 Harald Anlauf PR fortran/60091 * expr.c (gfc_check_pointer_assign): Correct and improve error messages for invalid pointer assignments. 2019-03-07 Harald Anlauf PR fortran/60091 * gfortran.dg/pointer_remapping_3.f08: Adjust error messages. * gfortran.dg/pointer_remapping_7.f90: Adjust error message. Index: gcc/testsuite/gfortran.dg/pointer_remapping_3.f08 =================================================================== --- gcc/testsuite/gfortran.dg/pointer_remapping_3.f08 (revision 269445) +++ gcc/testsuite/gfortran.dg/pointer_remapping_3.f08 (working copy) @@ -3,6 +3,7 @@ ! PR fortran/29785 ! PR fortran/45016 +! PR fortran/60091 ! Check for pointer remapping compile-time errors. ! Contributed by Daniel Kraft, d@domob.eu. @@ -13,13 +14,13 @@ INTEGER, POINTER :: vec(:), mat(:, :) ! Existence of reference elements. - vec(:) => arr ! { dg-error "Lower bound has to be present" } - vec(5:7:1) => arr ! { dg-error "Stride must not be present" } - mat(1:, 2:5) => arr ! { dg-error "Either all or none of the upper bounds" } - mat(2, 6) => arr ! { dg-error "Expected bounds specification" } + vec(:) => arr ! { dg-error "bounds-remapping-list or bounds-specification-list" } + vec(5:7:1) => arr ! { dg-error "Stride must not be present" } + mat(1:,2:5) => arr ! { dg-error "requires a bounds-specification-list" } + mat(1:3,4:) => arr ! { dg-error "requires a bounds-specification-list" } + mat(2, 6) => arr ! { dg-error "Expected bounds specification" } - ! This is bound remapping not rank remapping! - mat(1:, 3:) => arr ! { dg-error "Different ranks" } + mat(1:,3:) => arr ! { dg-error "requires a bounds-specification-list" } ! Invalid remapping target; for non-rank one we already check the F2008 ! error elsewhere. Here, test that not-contiguous target is disallowed Index: gcc/testsuite/gfortran.dg/pointer_remapping_7.f90 =================================================================== --- gcc/testsuite/gfortran.dg/pointer_remapping_7.f90 (revision 269445) +++ gcc/testsuite/gfortran.dg/pointer_remapping_7.f90 (working copy) @@ -4,5 +4,5 @@ ! integer, target :: A(100) integer,pointer :: P(:,:) - p(10,1:) => A ! { dg-error "Lower bound has to be present" } + p(10,1:) => A ! { dg-error "Expected bounds-remapping-list" } end Index: gcc/fortran/expr.c =================================================================== --- gcc/fortran/expr.c (revision 269445) +++ gcc/fortran/expr.c (working copy) @@ -3703,6 +3703,7 @@ gfc_ref *ref; bool is_pure, is_implicit_pure, rank_remap; int proc_pointer; + bool same_rank; lhs_attr = gfc_expr_attr (lvalue); if (lvalue->ts.type == BT_UNKNOWN && !lhs_attr.proc_pointer) @@ -3724,6 +3725,7 @@ proc_pointer = lvalue->symtree->n.sym->attr.proc_pointer; rank_remap = false; + same_rank = lvalue->rank == rvalue->rank; for (ref = lvalue->ref; ref; ref = ref->next) { if (ref->type == REF_COMPONENT) @@ -3748,36 +3750,67 @@ lvalue->symtree->n.sym->name, &lvalue->where)) return false; - /* When bounds are given, all lbounds are necessary and either all - or none of the upper bounds; no strides are allowed. If the - upper bounds are present, we may do rank remapping. */ + /* Fortran standard (e.g. F2018, 10.2.2 Pointer assignment): + * + * (C1017) If bounds-spec-list is specified, the number of + * bounds-specs shall equal the rank of data-pointer-object. + * + * If bounds-spec-list appears, it specifies the lower bounds. + * + * (C1018) If bounds-remapping-list is specified, the number of + * bounds-remappings shall equal the rank of data-pointer-object. + * + * If bounds-remapping-list appears, it specifies the upper and + * lower bounds of each dimension of the pointer; the pointer target + * shall be simply contiguous or of rank one. + * + * (C1019) If bounds-remapping-list is not specified, the ranks of + * data-pointer-object and data-target shall be the same. + * + * Thus when bounds are given, all lbounds are necessary and either + * all or none of the upper bounds; no strides are allowed. If the + * upper bounds are present, we may do rank remapping. */ for (dim = 0; dim < ref->u.ar.dimen; ++dim) { - if (!ref->u.ar.start[dim] - || ref->u.ar.dimen_type[dim] != DIMEN_RANGE) + if (ref->u.ar.stride[dim]) { - gfc_error ("Lower bound has to be present at %L", + gfc_error ("Stride must not be present at %L", &lvalue->where); return false; } - if (ref->u.ar.stride[dim]) + if (!same_rank && (!ref->u.ar.start[dim] ||!ref->u.ar.end[dim])) { - gfc_error ("Stride must not be present at %L", + gfc_error ("Rank remapping requires a " + "bounds-specification-list at %L", &lvalue->where); return false; } + if (!ref->u.ar.start[dim] + || ref->u.ar.dimen_type[dim] != DIMEN_RANGE) + { + gfc_error ("Expected bounds-remapping-list or " + "bounds-specification-list at %L", + &lvalue->where); + return false; + } if (dim == 0) rank_remap = (ref->u.ar.end[dim] != NULL); else { - if ((rank_remap && !ref->u.ar.end[dim]) - || (!rank_remap && ref->u.ar.end[dim])) + if ((rank_remap && !ref->u.ar.end[dim])) { - gfc_error ("Either all or none of the upper bounds" - " must be specified at %L", &lvalue->where); + gfc_error ("Rank remapping requires a " + "bounds-specification-list at %L", + &lvalue->where); return false; } + if (!rank_remap && ref->u.ar.end[dim]) + { + gfc_error ("Expected bounds-remapping-list or " + "bounds-specification-list at %L", + &lvalue->where); + } } } }