From patchwork Thu Oct 9 20:27:09 2014 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 398135 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 714C61400AF for ; Fri, 10 Oct 2014 07:27:24 +1100 (EST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender :message-id:date:from:mime-version:to:subject:content-type; q= dns; s=default; b=KDJSMfWoEmYw0mAUq8/Oz3fzI8qz6b7j4Cc84x6soWALS7 Qw897CstSjju3lHE+jn7Yr8a+wAVrO2XT5iL01mIZV8HCWejPzv2ZcmmUrMj/MY/ pz1AhfP2+rCiKz5laF7O7NDraeeDhJkap9FQzDTn7ccOJ8OoLaNWjYjbp62y4= 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 :message-id:date:from:mime-version:to:subject:content-type; s= default; bh=E/fSoZaYRHg6gvCYCr4BVC3ZetA=; b=yXxoj53gaXMlKACzJhDs /z3PkaP+FYJpCDDkatq06C/Tu3eP2p54IqTtyDZ6eXe8h1SUfQ/JKJOIu1JG7q/M oftYxJ4bGJ8HeXGMhaaZPlbNj2fk+zqULuxRnAY3QHG7WRBLggJlfIe9v5byFTRY yt5JtUHtJLLPFD0fdfdzXkI= Received: (qmail 8454 invoked by alias); 9 Oct 2014 20:27:17 -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 8430 invoked by uid 89); 9 Oct 2014 20:27:16 -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 autolearn=ham version=3.3.2 X-Spam-User: qpsmtpd, 2 recipients X-HELO: mx01.qsc.de Received: from mx01.qsc.de (HELO mx01.qsc.de) (213.148.129.14) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES256-SHA encrypted) ESMTPS; Thu, 09 Oct 2014 20:27:15 +0000 Received: from tux.net-b.de (port-92-194-55-197.dynamic.qsc.de [92.194.55.197]) (using TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits)) (No client certificate requested) by mx01.qsc.de (Postfix) with ESMTPSA id 20EDA3CE81; Thu, 9 Oct 2014 22:27:09 +0200 (CEST) Message-ID: <5436EF9D.5070800@net-b.de> Date: Thu, 09 Oct 2014 22:27:09 +0200 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:31.0) Gecko/20100101 Thunderbird/31.1.0 MIME-Version: 1.0 To: gfortran , gcc-patches , Alan Greynolds Subject: [Patch, Fortran] IMPLICIT fixes Hi all, this patch fixes Alan's issue with IMPLICIT followed by ";". I am not sure whether using the _eos machinery is really needed – especially as "!" seem to be already handled. Additionally, I missed the inner "[...]" for the new: R563 implicit-stmt is IMPLICIT implicit-spec-list or IMPLICIT NONE [ ( [ implicit-none-spec-list ] ) ] Namely, "IMPLICIT NONE ()" is also valid - but was rejected before. As implicit-none-spec implies type,* that's now also handled. (* "An IMPLICIT statement specifies the mapping for the letters in its letter-spec-list. IMPLICIT NONE with an implicit-none-spec of TYPE or with no implicit-none-spec-list specifies the null mapping for all the letters.") And finally, Dominque correctly observed that the location of some of the error messages was rather off, e.g. if there was a long comment following the actual statement. Hence, I have modified the code to provide a better error message. Build and regtested on x86-64-gnu-linux. OK for the trunk? Tobias 2014-10-09 Tobias Burnus gcc/fortran/ * gfortran.h (gfc_set_implicit_none): Update prototype. * symbol.c (gfc_set_implicit_none): Take and use error location. Move diagnostic from here to ... * decl.c (gfc_match_implicit_none): ... here. And update call. Handle empty implicit-none-spec. (gfc_match_implicit): Handle statement-separator ";". gcc/testsuite/ * gfortran.dg/implicit_16.f90: New. diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index a089be4..e4e41cb 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -2951,6 +2951,14 @@ gfc_match_implicit_none (void) char name[GFC_MAX_SYMBOL_LEN + 1]; bool type = false; bool external = false; + locus cur_loc = gfc_current_locus; + + if (gfc_current_ns->seen_implicit_none + || gfc_current_ns->has_implicit_none_export) + { + gfc_error ("Duplicate IMPLICIT NONE statement at %C"); + return MATCH_ERROR; + } gfc_gobble_whitespace (); c = gfc_peek_ascii_char (); @@ -2959,27 +2967,35 @@ gfc_match_implicit_none (void) (void) gfc_next_ascii_char (); if (!gfc_notify_std (GFC_STD_F2015, "IMPORT NONE with spec list at %C")) return MATCH_ERROR; - for(;;) + + gfc_gobble_whitespace (); + if (gfc_peek_ascii_char () == ')') { - m = gfc_match (" %n", name); - if (m != MATCH_YES) - return MATCH_ERROR; + (void) gfc_next_ascii_char (); + type = true; + } + else + for(;;) + { + m = gfc_match (" %n", name); + if (m != MATCH_YES) + return MATCH_ERROR; - if (strcmp (name, "type") == 0) - type = true; - else if (strcmp (name, "external") == 0) - external = true; - else - return MATCH_ERROR; + if (strcmp (name, "type") == 0) + type = true; + else if (strcmp (name, "external") == 0) + external = true; + else + return MATCH_ERROR; - gfc_gobble_whitespace (); - c = gfc_next_ascii_char (); - if (c == ',') - continue; - if (c == ')') - break; - return MATCH_ERROR; - } + gfc_gobble_whitespace (); + c = gfc_next_ascii_char (); + if (c == ',') + continue; + if (c == ')') + break; + return MATCH_ERROR; + } } else type = true; @@ -2987,7 +3003,7 @@ gfc_match_implicit_none (void) if (gfc_match_eos () != MATCH_YES) return MATCH_ERROR; - gfc_set_implicit_none (type, external); + gfc_set_implicit_none (type, external, &cur_loc); return MATCH_YES; } @@ -3140,8 +3156,8 @@ gfc_match_implicit (void) { /* We may have (). */ gfc_gobble_whitespace (); - c = gfc_next_ascii_char (); - if ((c == '\n') || (c == ',')) + c = gfc_peek_ascii_char (); + if (c == ',' || c == '\n' || c == ';' || c == '!') { /* Check for CHARACTER with no length parameter. */ if (ts.type == BT_CHARACTER && !ts.u.cl) @@ -3155,6 +3171,10 @@ gfc_match_implicit (void) /* Record the Successful match. */ if (!gfc_merge_new_implicit (&ts)) return MATCH_ERROR; + if (c == ',') + c = gfc_next_ascii_char (); + else if (gfc_match_eos () == MATCH_ERROR) + goto error; continue; } @@ -3190,7 +3210,7 @@ gfc_match_implicit (void) gfc_gobble_whitespace (); c = gfc_next_ascii_char (); - if ((c != '\n') && (c != ',')) + if (c != ',' && gfc_match_eos () != MATCH_YES) goto syntax; if (!gfc_merge_new_implicit (&ts)) diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 0809379..6f258db 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -2759,7 +2759,7 @@ extern int gfc_character_storage_size; void gfc_clear_new_implicit (void); bool gfc_add_new_implicit_range (int, int); bool gfc_merge_new_implicit (gfc_typespec *); -void gfc_set_implicit_none (bool, bool); +void gfc_set_implicit_none (bool, bool, locus *); void gfc_check_function_type (gfc_namespace *); bool gfc_is_intrinsic_typename (const char *); diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 0ccbd1f..3eb58f4 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -114,17 +114,10 @@ static int new_flag[GFC_LETTERS]; /* Handle a correctly parsed IMPLICIT NONE. */ void -gfc_set_implicit_none (bool type, bool external) +gfc_set_implicit_none (bool type, bool external, locus *loc) { int i; - if (gfc_current_ns->seen_implicit_none - || gfc_current_ns->has_implicit_none_export) - { - gfc_error_now ("Duplicate IMPLICIT NONE statement at %C"); - return; - } - if (external) gfc_current_ns->has_implicit_none_export = 1; @@ -135,8 +128,8 @@ gfc_set_implicit_none (bool type, bool external) { if (gfc_current_ns->set_flag[i]) { - gfc_error_now ("IMPLICIT NONE (type) statement at %C following an " - "IMPLICIT statement"); + gfc_error_now ("IMPLICIT NONE (type) statement at %L following an " + "IMPLICIT statement", loc); return; } gfc_clear_ts (&gfc_current_ns->default_type[i]); diff --git a/gcc/testsuite/gfortran.dg/implicit_16.f90 b/gcc/testsuite/gfortran.dg/implicit_16.f90 new file mode 100644 index 0000000..b44be67 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/implicit_16.f90 @@ -0,0 +1,40 @@ +! { dg-do compile } +! { dg-options "" } +! +! Support Fortran 2015's IMPLICIT NONE with empty spec list +! +! And IMPLICIT with ";" followed by an additional statement. +! Contributed by Alan Greynolds +! + +module m + type t + end type t +end module m + +subroutine sub0 +implicit integer (a-h,o-z); parameter (i=0) +end subroutine sub0 + +subroutine sub1 +implicit integer (a-h,o-z)!test +parameter (i=0) +end subroutine sub1 + +subroutine sub2 +use m +implicit type(t) (a-h,o-z); parameter (i=0) +end subroutine sub2 + + +subroutine sub3 +use m +implicit type(t) (a-h,o-z)! Foobar +parameter (i=0) +end subroutine sub3 + +subroutine sub4 +implicit none () +call test() +i = 1 ! { dg-error "Symbol 'i' at .1. has no IMPLICIT type" } +end subroutine sub4