From patchwork Sat Oct 22 00:22:41 2016 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Steve Kargl X-Patchwork-Id: 78760 Delivered-To: patch@linaro.org Received: by 10.140.97.247 with SMTP id m110csp1560880qge; Fri, 21 Oct 2016 17:23:22 -0700 (PDT) X-Received: by 10.99.241.17 with SMTP id f17mr5246447pgi.175.1477095801999; Fri, 21 Oct 2016 17:23:21 -0700 (PDT) Return-Path: Received: from sourceware.org (server1.sourceware.org. [209.132.180.131]) by mx.google.com with ESMTPS id o7si3829949paw.324.2016.10.21.17.23.21 for (version=TLS1_2 cipher=ECDHE-RSA-AES128-GCM-SHA256 bits=128/128); Fri, 21 Oct 2016 17:23:21 -0700 (PDT) Received-SPF: pass (google.com: domain of gcc-patches-return-439300-patch=linaro.org@gcc.gnu.org designates 209.132.180.131 as permitted sender) client-ip=209.132.180.131; Authentication-Results: mx.google.com; dkim=pass header.i=@gcc.gnu.org; spf=pass (google.com: domain of gcc-patches-return-439300-patch=linaro.org@gcc.gnu.org designates 209.132.180.131 as permitted sender) smtp.mailfrom=gcc-patches-return-439300-patch=linaro.org@gcc.gnu.org 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=nykS8YOibneKO/OcLYW6BnKSuDZoSLw4wz1q3dXTpJg 1vg8y6tvMHIQeKSb+REOjqYMbiuY5r7Xs973QnlE5dcwNsQhCeSqcr1gNW+vPnbg L39z8fO2cdcuWDTwy4qqatx67xEDl+93bW2HiFw8cwoANeKDFR+uRgxFdVLNIsLo = 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=CaHI0B5JvcWwAp6/p/L2whnKp2o=; b=N0/7xuW/nWpe6Il7V 2RZ25OZb8bERqrfYMaqUPlLBQqxKQh8vmPfNUFk2whCOqqvHc//Zm3jPNoJ8E5rQ E9bO2qYzP2cCclETRxvu6GI/QQHhfPyqNJYFUaeEru+7kNdcl6g4+r3094mDBoHz sL1n51i90wBp7n4ZvYdt6ui0jk= Received: (qmail 116206 invoked by alias); 22 Oct 2016 00:22:55 -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 116178 invoked by uid 89); 22 Oct 2016 00:22:55 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=1.9 required=5.0 tests=AWL, BAYES_50, KAM_ASCII_DIVIDERS, KAM_LAZY_DOMAIN_SECURITY, RP_MATCHES_RCVD autolearn=no version=3.3.2 spammy=19896, 1989, 6, kinda, colon 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; Sat, 22 Oct 2016 00:22:45 +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 u9M0MggS088268 (version=TLSv1.2 cipher=DHE-RSA-AES256-GCM-SHA384 bits=256 verify=NO); Fri, 21 Oct 2016 17:22:43 -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 u9M0MfCr088243; Fri, 21 Oct 2016 17:22:41 -0700 (PDT) (envelope-from sgk) Date: Fri, 21 Oct 2016 17:22:41 -0700 From: Steve Kargl To: fortran@gcc.gnu.org, gcc-patches@gcc.gnu.org Subject: [PATCH] PR fortran/78033 -- This was a REAL pain Message-ID: <20161022002241.GA38269@troutmask.apl.washington.edu> Reply-To: kargl@uw.edu MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.6.1 (2016-04-27) All, The attached patch fixes PR fortran/78033. This was a REAL pain to fix because Fortran overloads REAL as an intrinsic type and an intrinsic subprogram. gfc_match_type_spec() in match.c is used to match Fortran 2003 type-specs in things like array constructors and TYPE IS statements. At some point in time, PR fortran/54730 was submitted because an ICE occurred for subroutine s implicit none intrinsic :: real real :: vec(1:2) vec = (/ real(a = 1), 1. /) end subroutine s where a symbol for 'a' was create while parsing for a validate typespec. The invalid 'a' was causing an ICE during translation. Mikael fixed the ICE by introducing checkpointing of the symbols in gfc_match_array_constructor() in array.c, which allowed 'a' to be removed. Fast-forward to PR fortran/78033, submitted a few days ago. Code like subroutine f(n, x) integer, intent(in) :: n complex, intent(in) :: x(1:n) real :: y(2*n) y = [real(x(1:n), aimag(x(1:n))] end subroutine f was now ICE'ing due what appears to be a tangling checkpoint. f951: internal compiler error: in enforce_single_undo_checkpoint, at fortran/symbol.c:3514 If I disabled, Mikael's fix for PR fortran/54730 then PR fortran/78033 would compile with the expected regression with PR fortran/54730. Having spent to much time looking for a mismatch in checkpoints, I decided to remove Mikael's fix in gfc_match_array_constructor() and fix the issue in gfc_match_type_spec() where I special case the parsing of REAL([KIND]=scalar-int-initialization-expr). An early version of the patch passed regression except for gomp/udr3.f90. Note that gfortran never vists gfc_match_type_spec while compling udr3.f90. I've deleted obj/ and started a clean bootstrap to see if this failure was collateral damage for my tinkering. If regression testing is successfull, OK to commit? 2016-10-21 Steven G. Kargl PR fortran/78033 * array.c (gfc_match_array_constructor): Remove checkpointing introduced in r196416. Move initialization to top of function. * match.c (gfc_match_type_spec): Special case matching for REAL. 2016-10-21 Steven G. Kargl PR fortran/78033 * gfortran.dg/pr78033.f90: New test. -- Steve Index: gcc/fortran/array.c =================================================================== --- gcc/fortran/array.c (revision 241433) +++ gcc/fortran/array.c (working copy) @@ -1091,7 +1091,6 @@ gfc_match_array_constructor (gfc_expr ** { gfc_constructor *c; gfc_constructor_base head; - gfc_undo_change_set changed_syms; gfc_expr *expr; gfc_typespec ts; locus where; @@ -1099,6 +1098,9 @@ gfc_match_array_constructor (gfc_expr ** const char *end_delim; bool seen_ts; + head = NULL; + seen_ts = false; + if (gfc_match (" (/") == MATCH_NO) { if (gfc_match (" [") == MATCH_NO) @@ -1115,12 +1117,9 @@ gfc_match_array_constructor (gfc_expr ** end_delim = " /)"; where = gfc_current_locus; - head = NULL; - seen_ts = false; /* Try to match an optional "type-spec ::" */ gfc_clear_ts (&ts); - gfc_new_undo_checkpoint (changed_syms); m = gfc_match_type_spec (&ts); if (m == MATCH_YES) { @@ -1130,16 +1129,12 @@ gfc_match_array_constructor (gfc_expr ** { if (!gfc_notify_std (GFC_STD_F2003, "Array constructor " "including type specification at %C")) - { - gfc_restore_last_undo_checkpoint (); - goto cleanup; - } + goto cleanup; if (ts.deferred) { gfc_error ("Type-spec at %L cannot contain a deferred " "type parameter", &where); - gfc_restore_last_undo_checkpoint (); goto cleanup; } @@ -1148,24 +1143,15 @@ gfc_match_array_constructor (gfc_expr ** { gfc_error ("Type-spec at %L cannot contain an asterisk for a " "type parameter", &where); - gfc_restore_last_undo_checkpoint (); goto cleanup; } } } else if (m == MATCH_ERROR) - { - gfc_restore_last_undo_checkpoint (); - goto cleanup; - } + goto cleanup; - if (seen_ts) - gfc_drop_last_undo_checkpoint (); - else - { - gfc_restore_last_undo_checkpoint (); - gfc_current_locus = where; - } + if (!seen_ts) + gfc_current_locus = where; if (gfc_match (end_delim) == MATCH_YES) { Index: gcc/fortran/match.c =================================================================== --- gcc/fortran/match.c (revision 241433) +++ gcc/fortran/match.c (working copy) @@ -1989,6 +1989,7 @@ gfc_match_type_spec (gfc_typespec *ts) { match m; locus old_locus; + char name[GFC_MAX_SYMBOL_LEN + 1]; gfc_clear_ts (ts); gfc_gobble_whitespace (); @@ -2013,13 +2014,6 @@ gfc_match_type_spec (gfc_typespec *ts) goto kind_selector; } - if (gfc_match ("real") == MATCH_YES) - { - ts->type = BT_REAL; - ts->kind = gfc_default_real_kind; - goto kind_selector; - } - if (gfc_match ("double precision") == MATCH_YES) { ts->type = BT_REAL; @@ -2053,6 +2047,85 @@ gfc_match_type_spec (gfc_typespec *ts) goto kind_selector; } + /* REAL is a real pain because it can be a type or intrinsic subprogram. + Need to differentiate REAL([KIND]=scalar-int-initialization-expr) + from REAL(A,[KIND]) and REAL(KIND,A). */ + + m = gfc_match (" %n", name); + if (m == MATCH_YES && strcmp (name, "real") == 0) + { + char c; + gfc_expr *e; + locus where; + + ts->type = BT_REAL; + ts->kind = gfc_default_real_kind; + + gfc_gobble_whitespace (); + + /* Prevent REAL*4, etc. */ + c = gfc_peek_ascii_char (); + if (c == '*') + { + gfc_error ("Invalid type-spec at %C"); + return MATCH_ERROR; + } + + /* Found leading colon in REAL:: or trailing ')' in TYPE IS (REAL). */ + if (c == ':' || c == ')') + return MATCH_YES; + + /* Found something other than the opening '(' in REAL(... */ + if (c != '(') + return MATCH_NO; + else + gfc_next_char (); /* Burn the '('. */ + + /* Look for the optional KIND=. */ + where = gfc_current_locus; + m = gfc_match (" %n", name); + if (m == MATCH_YES) + { + gfc_gobble_whitespace (); + c = gfc_next_char (); + if (c != '=') + gfc_current_locus = where; + } + + m = gfc_match_init_expr (&e); + if (m == MATCH_NO || m == MATCH_ERROR) + return MATCH_NO; + + /* If a comma appears, it is an intrinsic subprogram. */ + gfc_gobble_whitespace (); + c = gfc_peek_ascii_char (); + if (c == ',') + { + gfc_free_expr (e); + return MATCH_NO; + } + + /* If ')' appears, we have REAL(initialization-expr), here check for + a scalar integer initialization-expr and valid kind parameter. */ + if (c == ')') + { + if (e->ts.type != BT_INTEGER || e->rank > 0) + { + gfc_free_expr (e); + return MATCH_NO; + } + + gfc_next_char (); /* Burn the ')'. */ + ts->kind = (int) mpz_get_si (e->value.integer); + if (gfc_validate_kind (BT_REAL, ts->kind , true) == -1) + { + gfc_error ("Invalid type-spec at %C"); + return MATCH_ERROR; + } + return MATCH_YES; + } + } + /* If a type is not matched, simply return MATCH_NO. */ gfc_current_locus = old_locus; return MATCH_NO; @@ -2060,6 +2133,8 @@ gfc_match_type_spec (gfc_typespec *ts) kind_selector: gfc_gobble_whitespace (); + + /* This prevents INTEGER*4, etc. */ if (gfc_peek_ascii_char () == '*') { gfc_error ("Invalid type-spec at %C"); @@ -2068,13 +2143,9 @@ kind_selector: m = gfc_match_kind_spec (ts, false); + /* No kind specifier found. */ if (m == MATCH_NO) - m = MATCH_YES; /* No kind specifier found. */ - - /* gfortran may have matched REAL(a=1), which is the keyword form of the - intrinsic procedure. */ - if (ts->type == BT_REAL && m == MATCH_ERROR) - m = MATCH_NO; + m = MATCH_YES; return m; } Index: gcc/testsuite/gfortran.dg/pr78033.f90 =================================================================== --- gcc/testsuite/gfortran.dg/pr78033.f90 (nonexistent) +++ gcc/testsuite/gfortran.dg/pr78033.f90 (working copy) @@ -0,0 +1,22 @@ +! { dg-do compile } +subroutine f(n, x, y) + + implicit none + + integer, parameter :: knd = kind(1.e0) + + integer, intent(in) :: n + complex(knd), intent(in) :: x(1:n) + + integer i + real(knd) y(2*n) + + y = [real(x), aimag(x)] + y = [real(knd) :: 1] + y = [real(kind=42) :: 1] { dg-error "Invalid type-spec" } + y = [real(kind=knd) :: 1] + y = [real(kind=knd, a=1.)] + y = [real(a=1.)] + y = [real(a=1, kind=knd)] + +end subroutine f