From patchwork Wed Oct 21 20:05:58 2015 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Steve Kargl X-Patchwork-Id: 534026 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org 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 14AD6141314 for ; Thu, 22 Oct 2015 07:06:14 +1100 (AEDT) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b=dxS255iQ; dkim-atps=neutral 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:mime-version:content-type; q=dns; s= default; b=Zlnb0Bm5hyyxRtjClNy/59dHZtxeZDiyHbZrUsOtiIx2T0E7Liuuw fyW4T1fPfuW2s7wMM32DcacRYE2v787Lp8RxkZKroTyFbVe4eH/eysbB7IfO+qB1 L5z/lZ8Ndg7Nx03BqlztNHujLMl6EMju9s6O6Yck4AJngM46oJtubs= 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:mime-version:content-type; s= default; bh=JAFRndilAMkoDhPk2sRnSwHHUXc=; b=dxS255iQ5DQw1pPdb5xp fJ0JX9sT+9AKbKROpYT9fNvRQERAJ+xrY7Io4xLDnVZa9QIH3ycU77sZYafhO1O9 KC6v+E+ge7FbJeuyotupUX6dAcp2CXvhVz1P5xPCaYPS39G7SAkpDAeO2fzTy1tA waK8tBEcw0zH56huhRGPQoc= Received: (qmail 76949 invoked by alias); 21 Oct 2015 20:06:06 -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 76930 invoked by uid 89); 21 Oct 2015 20:06:05 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-1.0 required=5.0 tests=AWL, BAYES_00, KAM_ASCII_DIVIDERS, KAM_LAZY_DOMAIN_SECURITY, RP_MATCHES_RCVD autolearn=no version=3.3.2 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 (AES256-GCM-SHA384 encrypted) ESMTPS; Wed, 21 Oct 2015 20:06:01 +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 t9LK5xQI071526 (version=TLSv1.2 cipher=DHE-RSA-AES256-GCM-SHA384 bits=256 verify=NO); Wed, 21 Oct 2015 13:05:59 -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 t9LK5whr071525; Wed, 21 Oct 2015 13:05:58 -0700 (PDT) (envelope-from sgk) Date: Wed, 21 Oct 2015 13:05:58 -0700 From: Steve Kargl To: fortran@gcc.gnu.org, gcc-patches@gcc.gnu.org Subject: [PATCH] PR fortran/67939 -- Fix zero length strings in DATA statement Message-ID: <20151021200558.GA71516@troutmask.apl.washington.edu> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.24 (2015-08-30) The attach patch properly sets the length for a zero length string in a data. Built and regression tested on x86_64-*-freebsd. The testcase is self-explanatory. OK to commit? 2015-10-21 Steven G. Kargl PR fortran/67939 * data.c (create_character_initializer): Deal with zero length string. 2015-10-21 Steven G. Kargl PR fortran/67939 * gfortran.dg/pr67939.f90: New test. Index: gcc/fortran/data.c =================================================================== --- gcc/fortran/data.c (revision 229138) +++ gcc/fortran/data.c (working copy) @@ -104,7 +104,7 @@ static gfc_expr * create_character_initializer (gfc_expr *init, gfc_typespec *ts, gfc_ref *ref, gfc_expr *rvalue) { - int len, start, end; + int len, start, end, tlen; gfc_char_t *dest; bool alloced_init = false; @@ -162,12 +162,22 @@ create_character_initializer (gfc_expr * else len = rvalue->value.character.length; - if (len > end - start) + tlen = end - start; + if (len > tlen) { - gfc_warning_now (0, "Initialization string starting at %L was " - "truncated to fit the variable (%d/%d)", - &rvalue->where, end - start, len); - len = end - start; + if (tlen < 0) + { + gfc_warning_now (0, "Unused initialization string at %L because " + "variable has zero length", &rvalue->where); + len = 0; + } + else + { + gfc_warning_now (0, "Initialization string at %L was truncated to " + "fit the variable (%d/%d)", &rvalue->where, + tlen, len); + len = tlen; + } } if (rvalue->ts.type == BT_HOLLERITH) @@ -181,7 +191,7 @@ create_character_initializer (gfc_expr * len * sizeof (gfc_char_t)); /* Pad with spaces. Substrings will already be blanked. */ - if (len < end - start && ref == NULL) + if (len < tlen && ref == NULL) gfc_wide_memset (&dest[start + len], ' ', end - (start + len)); if (rvalue->ts.type == BT_HOLLERITH) Index: gcc/testsuite/gfortran.dg/pr67939.f90 =================================================================== --- gcc/testsuite/gfortran.dg/pr67939.f90 (revision 0) +++ gcc/testsuite/gfortran.dg/pr67939.f90 (working copy) @@ -0,0 +1,21 @@ +! { dg-do compile } +! PR fortran/67939 +! Original code by Gerhard Steinmetz +! gerhard dot steinmetz dot fortran at t-online dot de +! +program p + character(100) :: x + data x(998:99) /'ab'/ ! { dg-warning "Unused initialization string" } + call a +end + +subroutine a + character(2) :: x + data x(:-1) /'ab'/ ! { dg-warning "Unused initialization string" } +end subroutine a + +subroutine b + character(8) :: x + data x(3:1) /'abc'/ ! { dg-warning "Unused initialization string" } +end subroutine b +