From patchwork Mon Dec 25 19:45:40 2017 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Steve Kargl X-Patchwork-Id: 852844 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-469819-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="nPUqUK/y"; 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 3z58jx2YW2z9ryv for ; Tue, 26 Dec 2017 06:45:53 +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=lUS55BaTRByqw30jFtR16pQjiRg9MY0BV6fwFyuisGQ /I5o/9zQuvXgGozdoegD2P2YTpmSNeBQ0WzJL+DcgQFTsKJ0XcPgRI0ajLm0OaQO 3vyADp7jbQvnp0YvzCgd8wq9vAUYyUIxaE6pzPcAX0OULG8gir8VDEI39UhqKSlY = 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=kJlPO0lC0e9hlZCINYVsWBLRUgs=; b=nPUqUK/ygjrboW+7k 8fSNi8Uo5+c7fZAfT+LeC02twaB+KCDW1pAknj8uldN/lgp/YTlJzcvcn2ggQoAj 9j5Oy7JxppcDSqkdYvHdZiJCENFJ+COcJ2Pzv8ZGtcee+Gz4sPn6rZi45f5W36du YXRzlqyQITlSRbyzTX6jYa88HI= Received: (qmail 98037 invoked by alias); 25 Dec 2017 19:45:45 -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 97971 invoked by uid 89); 25 Dec 2017 19:45:44 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-9.3 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=H*R:D*edu, U*kargl, sk:karglg, kargl@gcc.gnu.org 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; Mon, 25 Dec 2017 19:45:43 +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 vBPJjev2089547 (version=TLSv1.2 cipher=DHE-RSA-AES256-GCM-SHA384 bits=256 verify=NO); Mon, 25 Dec 2017 11:45:40 -0800 (PST) (envelope-from sgk@troutmask.apl.washington.edu) Received: (from sgk@localhost) by troutmask.apl.washington.edu (8.15.2/8.15.2/Submit) id vBPJje7m089546; Mon, 25 Dec 2017 11:45:40 -0800 (PST) (envelope-from sgk) Date: Mon, 25 Dec 2017 11:45:40 -0800 From: Steve Kargl To: fortran@gcc.gnu.org, gcc-patches@gcc.gnu.org Subject: [PATCH] PR Fortran/83548 -- a LOGICAL fix Message-ID: <20171225194540.GA89519@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 attach patch fixes a problem when a LOGICAL subprogram appears as the first element in an array constructor, which is interpreted as a LOGICAL type-spec, which fails because the argument is of type LOGICAL instead of INTEGER. Regression tested on i686-*-freebsd and x86_64-*-freebsd. OK to commit? 2017-12-25 Steven G. Kargl PR Fortran/83548 * match.c (gfc_match_type_spec): Check for LOGICAL conflict in type-spec versus LOGICAL intrinsic subprogram. 2017-12-25 Steven G. Kargl PR Fortran/83548 * gfortran.dg/array_constructor_type_22.f03: New test. Index: gcc/fortran/match.c =================================================================== --- gcc/fortran/match.c (revision 255997) +++ gcc/fortran/match.c (working copy) @@ -2102,27 +2102,31 @@ gfc_match_type_spec (gfc_typespec *ts) return m; } - if (gfc_match ("logical") == MATCH_YES) - { - ts->type = BT_LOGICAL; - ts->kind = gfc_default_logical_kind; - goto kind_selector; - } - /* REAL is a real pain because it can be a type, intrinsic subprogram, or list item in a type-list of an OpenMP reduction clause. Need to differentiate REAL([KIND]=scalar-int-initialization-expr) from - REAL(A,[KIND]) and REAL(KIND,A). */ + REAL(A,[KIND]) and REAL(KIND,A). Logically, when this code was + written the use of LOGICAL as a type-spec or intrinsic subprogram + was overlooked. */ m = gfc_match (" %n", name); - if (m == MATCH_YES && strcmp (name, "real") == 0) + if (m == MATCH_YES + && (strcmp (name, "real") == 0 || strcmp (name, "logical") == 0)) { char c; gfc_expr *e; locus where; - ts->type = BT_REAL; - ts->kind = gfc_default_real_kind; + if (*name == 'r') + { + ts->type = BT_REAL; + ts->kind = gfc_default_real_kind; + } + else + { + ts->type = BT_LOGICAL; + ts->kind = gfc_default_logical_kind; + } gfc_gobble_whitespace (); @@ -2154,7 +2158,7 @@ gfc_match_type_spec (gfc_typespec *ts) c = gfc_next_char (); if (c == '=') { - if (strcmp(name, "a") == 0) + if (strcmp(name, "a") == 0 || strcmp(name, "l") == 0) return MATCH_NO; else if (strcmp(name, "kind") == 0) goto found; @@ -2194,7 +2198,7 @@ found: gfc_next_char (); /* Burn the ')'. */ ts->kind = (int) mpz_get_si (e->value.integer); - if (gfc_validate_kind (BT_REAL, ts->kind , true) == -1) + if (gfc_validate_kind (ts->type, ts->kind , true) == -1) { gfc_error ("Invalid type-spec at %C"); return MATCH_ERROR; Index: gcc/testsuite/gfortran.dg/array_constructor_type_22.f03 =================================================================== --- gcc/testsuite/gfortran.dg/array_constructor_type_22.f03 (nonexistent) +++ gcc/testsuite/gfortran.dg/array_constructor_type_22.f03 (working copy) @@ -0,0 +1,29 @@ +! { dg-do compile } +! PR Fortran/83548 +program foo + + implicit none + + logical, parameter :: t = .true., f = .false. + logical, parameter :: a1(2) = [t, f] + logical(kind=1), parameter :: a2(2) = [logical(kind=1) :: t, f] + logical(kind=4), parameter :: a3(2) = [logical(kind=4) :: t, f] + logical(kind=1), parameter :: a4(2) = [logical(t, 1), logical(f, 1)] + logical(kind=4), parameter :: a5(2) = [logical(t, 4), logical(f, 4)] + logical(kind=1) b(2) + logical(kind=4) c(2) + + real, parameter :: x = 1, y = 2 + real, parameter :: r1(2) = [x, y] + real(kind=4), parameter :: r2(2) = [real(kind=4) :: x, y] + real(kind=8), parameter :: r3(2) = [real(kind=8) :: x, y] + real(kind=4), parameter :: r4(2) = [real(x, 4), real(y, 4)] + real(kind=8), parameter :: r5(2) = [real(x, 8), real(y, 8)] + real(kind=4) p(2) + real(kind=8) q(2) + + p = [real(kind=4) :: x, y] + q = [real(kind=8) :: x, y] + if (any(p .ne. r2)) call abort + if (any(q .ne. r3)) call aborts +end program foo