From patchwork Sat Jun 26 07:58:11 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 57052 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]) by ozlabs.org (Postfix) with SMTP id 9E53CB6EF2 for ; Sat, 26 Jun 2010 17:58:43 +1000 (EST) Received: (qmail 32101 invoked by alias); 26 Jun 2010 07:58:40 -0000 Received: (qmail 32076 invoked by uid 22791); 26 Jun 2010 07:58:38 -0000 X-SWARE-Spam-Status: No, hits=-2.0 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_NONE X-Spam-Check-By: sourceware.org Received: from mx01.qsc.de (HELO mx01.qsc.de) (213.148.129.14) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Sat, 26 Jun 2010 07:58:28 +0000 Received: from [192.168.178.22] (port-92-204-98-222.dynamic.qsc.de [92.204.98.222]) by mx01.qsc.de (Postfix) with ESMTP id CA5803D628; Sat, 26 Jun 2010 09:58:13 +0200 (CEST) Message-ID: <4C25B313.1000607@net-b.de> Date: Sat, 26 Jun 2010 09:58:11 +0200 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; U; Linux x86_64; de; rv:1.9.1.9) Gecko/20100317 SUSE/3.0.4 Thunderbird/3.0.4 MIME-Version: 1.0 To: gfortran , gcc patches Subject: [Patch,Fortran] F2008: Support TYPE (intrinsic-type-spec) 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 Fortran 2003 has: R502 declaration-type-spec is intrinsic-type-spec or TYPE ( derived-type-spec ) Fortran 2008 added: or TYPE ( intrinsic-type-spec ) which the attached patch implements. Build and regtested on x86-64-linux. OK for the trunk? Tobias 2010-06-25 Tobias Burnus * decl.c (gfc_match_decl_type_spec): Support TYPE(intrinsic-type-spec). 2010-06-25 Tobias Burnus * gfortran.dg/type_decl_1.f90: New. * gfortran.dg/type_decl_2.f90: New. Index: gcc/fortran/decl.c =================================================================== --- gcc/fortran/decl.c (Revision 161426) +++ gcc/fortran/decl.c (Arbeitskopie) @@ -2342,7 +2342,7 @@ gfc_match_decl_type_spec (gfc_typespec * gfc_symbol *sym; match m; char c; - bool seen_deferred_kind; + bool seen_deferred_kind, matched_type; /* A belt and braces check that the typespec is correctly being treated as a deferred characteristic association. */ @@ -2374,47 +2374,88 @@ gfc_match_decl_type_spec (gfc_typespec * return MATCH_YES; } - if (gfc_match (" integer") == MATCH_YES) + + m = gfc_match (" type ( %n", name); + matched_type = (m == MATCH_YES); + + if ((matched_type && strcmp ("integer", name) == 0) + || (!matched_type && gfc_match (" integer") == MATCH_YES)) { ts->type = BT_INTEGER; ts->kind = gfc_default_integer_kind; goto get_kind; } - if (gfc_match (" character") == MATCH_YES) + if ((matched_type && strcmp ("character", name) == 0) + || (!matched_type && gfc_match (" character") == MATCH_YES)) { + if (matched_type + && gfc_notify_std (GFC_STD_F2008, "Fortran 2008: TYPE with " + "intrinsic-type-spec at %C") == FAILURE) + return MATCH_ERROR; + ts->type = BT_CHARACTER; if (implicit_flag == 0) - return gfc_match_char_spec (ts); + m = gfc_match_char_spec (ts); else - return MATCH_YES; + m = MATCH_YES; + + if (matched_type && m == MATCH_YES && gfc_match_char (')') != MATCH_YES) + m = MATCH_ERROR; + + return m; } - if (gfc_match (" real") == MATCH_YES) + if ((matched_type && strcmp ("real", name) == 0) + || (!matched_type && gfc_match (" real") == MATCH_YES)) { ts->type = BT_REAL; ts->kind = gfc_default_real_kind; goto get_kind; } - if (gfc_match (" double precision") == MATCH_YES) - { + if ((matched_type + && (strcmp ("doubleprecision", name) == 0 + || (strcmp ("double", name) == 0 + && gfc_match (" precision") == MATCH_YES))) + || (!matched_type && gfc_match (" double precision") == MATCH_YES)) + { + if (matched_type + && gfc_notify_std (GFC_STD_F2008, "Fortran 2008: TYPE with " + "intrinsic-type-spec at %C") == FAILURE) + return MATCH_ERROR; + if (matched_type && gfc_match_char (')') != MATCH_YES) + return MATCH_ERROR; + ts->type = BT_REAL; ts->kind = gfc_default_double_kind; return MATCH_YES; } - if (gfc_match (" complex") == MATCH_YES) + if ((matched_type && strcmp ("complex", name) == 0) + || (!matched_type && gfc_match (" complex") == MATCH_YES)) { ts->type = BT_COMPLEX; ts->kind = gfc_default_complex_kind; goto get_kind; } - if (gfc_match (" double complex") == MATCH_YES) + if ((matched_type + && (strcmp ("doublecomplex", name) == 0 + || (strcmp ("double", name) == 0 + && gfc_match (" complex") == MATCH_YES))) + || (!matched_type && gfc_match (" double complex") == MATCH_YES)) { - if (gfc_notify_std (GFC_STD_GNU, "DOUBLE COMPLEX at %C does not " - "conform to the Fortran 95 standard") == FAILURE) + if (gfc_notify_std (GFC_STD_GNU, "Extension: DOUBLE COMPLEX at %C") + == FAILURE) + return MATCH_ERROR; + + if (matched_type + && gfc_notify_std (GFC_STD_F2008, "Fortran 2008: TYPE with " + "intrinsic-type-spec at %C") == FAILURE) + return MATCH_ERROR; + + if (matched_type && gfc_match_char (')') != MATCH_YES) return MATCH_ERROR; ts->type = BT_COMPLEX; @@ -2422,14 +2463,17 @@ gfc_match_decl_type_spec (gfc_typespec * return MATCH_YES; } - if (gfc_match (" logical") == MATCH_YES) + if ((matched_type && strcmp ("logical", name) == 0) + || (!matched_type && gfc_match (" logical") == MATCH_YES)) { ts->type = BT_LOGICAL; ts->kind = gfc_default_logical_kind; goto get_kind; } - m = gfc_match (" type ( %n )", name); + if (matched_type) + m = gfc_match_char (')'); + if (m == MATCH_YES) ts->type = BT_DERIVED; else @@ -2490,23 +2534,43 @@ gfc_match_decl_type_spec (gfc_typespec * return MATCH_YES; get_kind: + if (matched_type + && gfc_notify_std (GFC_STD_F2008, "Fortran 2008: TYPE with " + "intrinsic-type-spec at %C") == FAILURE) + return MATCH_ERROR; + /* For all types except double, derived and character, look for an optional kind specifier. MATCH_NO is actually OK at this point. */ if (implicit_flag == 1) - return MATCH_YES; + { + if (matched_type && gfc_match_char (')') != MATCH_YES) + return MATCH_ERROR; + + return MATCH_YES; + } if (gfc_current_form == FORM_FREE) { c = gfc_peek_ascii_char (); if (!gfc_is_whitespace (c) && c != '*' && c != '(' && c != ':' && c != ',') - return MATCH_NO; + { + if (matched_type && c == ')') + { + gfc_next_ascii_char (); + return MATCH_YES; + } + return MATCH_NO; + } } m = gfc_match_kind_spec (ts, false); if (m == MATCH_NO && ts->type != BT_CHARACTER) m = gfc_match_old_kind_spec (ts); + if (matched_type && gfc_match_char (')') != MATCH_YES) + return MATCH_ERROR; + /* Defer association of the KIND expression of function results until after USE and IMPORT statements. */ if ((gfc_current_state () == COMP_NONE && gfc_error_flag_test ()) Index: gcc/testsuite/gfortran.dg/type_decl_1.f90 =================================================================== --- gcc/testsuite/gfortran.dg/type_decl_1.f90 (Revision 0) +++ gcc/testsuite/gfortran.dg/type_decl_1.f90 (Revision 0) @@ -0,0 +1,30 @@ +! { dg-do compile } +! { dg-options "-std=f2008" } +! +! Fortran 2008: TYPE ( intrinsic-type-spec ) +! +implicit none +type(integer) :: a +type(real) :: b +type(logical ) :: c +type(character) :: d +type(double precision) :: e + +type(integer(8)) :: f +type(real(kind=4)) :: g +type(logical ( kind = 1 ) ) :: h +type(character (len=10,kind=1) ) :: i + +type(double complex) :: j ! { dg-error "Extension: DOUBLE COMPLEX" } +end + +module m + integer, parameter :: k4 = 4 +end module m + +type(integer (kind=k4)) function f() + use m + f = 42 +end + +! { dg-final { cleanup-modules "m" } } Index: gcc/testsuite/gfortran.dg/type_decl_2.f90 =================================================================== --- gcc/testsuite/gfortran.dg/type_decl_2.f90 (Revision 0) +++ gcc/testsuite/gfortran.dg/type_decl_2.f90 (Revision 0) @@ -0,0 +1,12 @@ +! { dg-do compile } +! { dg-options "-std=f2003" } +! +! Fortran 2008: TYPE ( intrinsic-type-spec ) +! +implicit none +type(integer) :: a ! { dg-error "Fortran 2008" } +type(real) :: b ! { dg-error "Fortran 2008" } +type(logical) :: c ! { dg-error "Fortran 2008" } +type(character) :: d ! { dg-error "Fortran 2008" } +type(double precision) :: e ! { dg-error "Fortran 2008" } +end