From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 119109 invoked by alias); 15 Mar 2018 20:18:07 -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 119090 invoked by uid 89); 15 Mar 2018 20:18:06 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-9.4 required=5.0 tests=AWL,BAYES_00,GIT_PATCH_2,GIT_PATCH_3,KAM_ASCII_DIVIDERS,KAM_LAZY_DOMAIN_SECURITY,T_RP_MATCHES_RCVD autolearn=ham version=3.3.2 spammy= 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 20:18:04 +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 w2FKI2we073293 (version=TLSv1.2 cipher=DHE-RSA-AES256-GCM-SHA384 bits=256 verify=NO); Thu, 15 Mar 2018 13:18:02 -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 w2FKI29C073292; Thu, 15 Mar 2018 13:18:02 -0700 (PDT) (envelope-from sgk) Date: Thu, 15 Mar 2018 20:18:00 -0000 From: Steve Kargl To: fortran@gcc.gnu.org, gcc-patches@gcc.gnu.org Subject: [PATCH] PR fortran/78741 -- Detect clash of entry and subroutine name Message-ID: <20180315201802.GA73285@troutmask.apl.washington.edu> Reply-To: sgk@troutmask.apl.washington.edu MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="dDRMvlgZJXvWKvBx" Content-Disposition: inline User-Agent: Mutt/1.9.2 (2017-12-15) X-IsSubscribed: yes X-SW-Source: 2018-03/txt/msg00068.txt.bz2 --dDRMvlgZJXvWKvBx Content-Type: text/plain; charset=us-ascii Content-Disposition: inline Content-length: 359 The patch is fairly slef-explanatory. Regression tested on x86_64-*-freebsd. OK to commit? 2018-03-15 Steven G. Kargl PR fortran/78741 * decl.c (get_proc_name): Check for clash of entry name with subroutine name. 2018-03-15 Steven G. Kargl PR fortran/78741 * gfortran.dg/pr78741.f90: New test. -- Steve --dDRMvlgZJXvWKvBx Content-Type: text/x-diff; charset=us-ascii Content-Disposition: attachment; filename="pr78741.diff" Content-length: 3293 Index: gcc/fortran/decl.c =================================================================== --- gcc/fortran/decl.c (revision 258571) +++ 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; } @@ -1189,8 +1209,13 @@ get_proc_name (const char *name, gfc_symbol **result, accessible names. */ if (sym->attr.flavor != 0 && sym->attr.proc != 0 - && (sym->attr.subroutine || sym->attr.function) + && (sym->attr.subroutine || sym->attr.function || sym->attr.entry) && sym->attr.if_source != IFSRC_UNKNOWN) + gfc_error_now ("Procedure %qs at %C is already defined at %L", + name, &sym->declared_at); + + if (sym->attr.flavor != 0 + && sym->attr.entry && sym->attr.if_source != IFSRC_UNKNOWN) gfc_error_now ("Procedure %qs at %C is already defined at %L", name, &sym->declared_at); Index: gcc/testsuite/gfortran.dg/pr78741.f90 =================================================================== --- gcc/testsuite/gfortran.dg/pr78741.f90 (nonexistent) +++ gcc/testsuite/gfortran.dg/pr78741.f90 (working copy) @@ -0,0 +1,16 @@ +! { dg-do compile } +! PR fortran/78741 +! Contributed by Gerhard Steinmetz +subroutine s(n, x) + integer :: n + character(n) :: x + character, pointer :: z(:) + x = 'a' + return +entry g(n, x) ! { dg-error "is already defined" } + x = 'b' +contains + subroutine g ! { dg-error "(1)" } + z(1) = x(1:1) + end +end --dDRMvlgZJXvWKvBx--