From patchwork Thu Mar 15 01:23:56 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Steve Kargl X-Patchwork-Id: 886098 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-474756-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=troutmask.apl.washington.edu Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="ksX+XMrA"; 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 401rTp3Sn8z9sVB for ; Thu, 15 Mar 2018 12:24:12 +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:date :from:to:subject:message-id:reply-to:mime-version:content-type; q=dns; s=default; b=PmR6b/bckHCNp0hdLz2TrnCyk34GjjWoys7glkStq56 L3hx6MjOJKv9/DR/enJuD5EuhzX87gpQHkxu/nqu8eRfOfISloeVe14YwyDBDIuP bJ9a0VTqy44k0bywHvEUJNpSQuFiC47nytmY7jtHTLqMrgyO92UaVWslwwG7r6fs = 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:date :from:to:subject:message-id:reply-to:mime-version:content-type; s=default; bh=djFKztM4m320y80KF4bLVKvgKkk=; b=ksX+XMrAARUASFbvb lUvj0enm3fURtHRIARmtQn+eG2Z7Zh2yOKYV8WD80puRwjPT21K5Rek/TaST1Rs6 IgMJB2atxuumtX2yjXkgS5KYRq7j2/7c5C0lawA55yIy4OCPHn45dvuyvMhjZtC5 aK2rmJagQAprRWmyPmQcuJOeAU= Received: (qmail 81300 invoked by alias); 15 Mar 2018 01:24:00 -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 81271 invoked by uid 89); 15 Mar 2018 01:23:59 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-10.0 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_2, GIT_PATCH_3, KAM_ASCII_DIVIDERS, KAM_LAZY_DOMAIN_SECURITY, RCVD_IN_DNSWL_LOW, T_RP_MATCHES_RCVD autolearn=ham version=3.3.2 spammy=Limit, sum X-Spam-User: qpsmtpd, 2 recipients X-HELO: troutmask.apl.washington.edu Received: from troutmask.apl.washington.edu (HELO troutmask.apl.washington.edu) (128.95.76.21) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Thu, 15 Mar 2018 01:23:58 +0000 Received: from troutmask.apl.washington.edu (localhost [127.0.0.1]) by troutmask.apl.washington.edu (8.15.2/8.15.2) with ESMTPS id w2F1Nu8w052840 (version=TLSv1.2 cipher=DHE-RSA-AES256-GCM-SHA384 bits=256 verify=NO); Wed, 14 Mar 2018 18:23:56 -0700 (PDT) (envelope-from sgk@troutmask.apl.washington.edu) Received: (from sgk@localhost) by troutmask.apl.washington.edu (8.15.2/8.15.2/Submit) id w2F1NuwB052839; Wed, 14 Mar 2018 18:23:56 -0700 (PDT) (envelope-from sgk) Date: Wed, 14 Mar 2018 18:23:56 -0700 From: Steve Kargl To: fortran@gcc.gnu.org, gcc-patches@gcc.gnu.org Subject: [PATCH] PR fortran/69395 -- don't exceed max allowed array dimensions Message-ID: <20180315012356.GA51103@troutmask.apl.washington.edu> Reply-To: sgk@troutmask.apl.washington.edu MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.9.2 (2017-12-15) The attachedi patch detects situations where the sum of an array's rank and corank exceeds the maximum allowed by the Standard. Regression tested on x86_64-*-freebsd. 2018-03-14 Steven G. Kargl PR fortran/69395 * decl.c (merge_array_spec): Limit the merging to maximum allowed dimensions, and issue error message if limit is exceeded. 2018-03-14 Steven G. Kargl PR fortran/69395 * gfortran.dg/pr69395.f90 Index: gcc/fortran/decl.c =================================================================== --- gcc/fortran/decl.c (revision 258537) +++ gcc/fortran/decl.c (working copy) @@ -804,7 +804,7 @@ cleanup: static bool merge_array_spec (gfc_array_spec *from, gfc_array_spec *to, bool copy) { - int i; + int i, j; if ((from->type == AS_ASSUMED_RANK && to->corank) || (to->type == AS_ASSUMED_RANK && from->corank)) @@ -822,8 +822,14 @@ merge_array_spec (gfc_array_spec *from, gfc_array_spec for (i = 0; i < to->corank; i++) { - to->lower[from->rank + i] = to->lower[i]; - to->upper[from->rank + i] = to->upper[i]; + /* Do not exceed the limits on lower[] and upper[]. gfortran + cleans up elsewhere. */ + j = from->rank + i; + if (j >= GFC_MAX_DIMENSIONS) + break; + + to->lower[j] = to->lower[i]; + to->upper[j] = to->upper[i]; } for (i = 0; i < from->rank; i++) { @@ -846,19 +852,33 @@ merge_array_spec (gfc_array_spec *from, gfc_array_spec for (i = 0; i < from->corank; i++) { + /* Do not exceed the limits on lower[] and upper[]. gfortran + cleans up elsewhere. */ + j = to->rank + i; + if (j >= GFC_MAX_DIMENSIONS) + break; + if (copy) { - to->lower[to->rank + i] = gfc_copy_expr (from->lower[i]); - to->upper[to->rank + i] = gfc_copy_expr (from->upper[i]); + to->lower[j] = gfc_copy_expr (from->lower[i]); + to->upper[j] = gfc_copy_expr (from->upper[i]); } else { - to->lower[to->rank + i] = from->lower[i]; - to->upper[to->rank + i] = from->upper[i]; + to->lower[j] = from->lower[i]; + to->upper[j] = from->upper[i]; } } } + if (to->rank + to->corank >= GFC_MAX_DIMENSIONS) + { + gfc_error ("Sum of array rank %d and corank %d at %C exceeds maximum " + "allowed dimensions of %d", + to->rank, to->corank, GFC_MAX_DIMENSIONS); + to->corank = GFC_MAX_DIMENSIONS - to->rank; + return false; + } return true; } Index: gcc/testsuite/gfortran.dg/pr69395.f90 =================================================================== --- gcc/testsuite/gfortran.dg/pr69395.f90 (nonexistent) +++ gcc/testsuite/gfortran.dg/pr69395.f90 (working copy) @@ -0,0 +1,5 @@ +! { dg-do compile } +! { dg-options "-fcoarray=single" } +program p +real, dimension(1,2,1,2,1,2,1,2), codimension[1,2,1,2,1,2,1,*] :: z ! { dg-error "allowed dimensions" } +end