From patchwork Tue Nov 2 17:14:42 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 69912 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 B591E1007D4 for ; Wed, 3 Nov 2010 04:15:18 +1100 (EST) Received: (qmail 22164 invoked by alias); 2 Nov 2010 17:15:12 -0000 Received: (qmail 21838 invoked by uid 22791); 2 Nov 2010 17:15:02 -0000 X-SWARE-Spam-Status: No, hits=-1.8 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; Tue, 02 Nov 2010 17:14:48 +0000 Received: from [192.168.178.22] (port-92-204-92-55.dynamic.qsc.de [92.204.92.55]) by mx01.qsc.de (Postfix) with ESMTP id D46803CCBC; Tue, 2 Nov 2010 18:14:43 +0100 (CET) Message-ID: <4CD04702.6060903@net-b.de> Date: Tue, 02 Nov 2010 18:14:42 +0100 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; U; Linux x86_64; en-US; rv:1.9.2.12) Gecko/20101026 SUSE/3.1.6 Thunderbird/3.1.6 MIME-Version: 1.0 To: Daniel Kraft CC: gcc patches , gfortran Subject: Re: [Fortran, Patch] PR 45170 - Implement parsing/resolution of character deferred type parameter References: <4CC33FBF.10506@net-b.de> <4CCFD53B.6060905@net-b.de> <4CCFECC3.5080803@domob.eu> In-Reply-To: <4CCFECC3.5080803@domob.eu> 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 On 11/02/2010 11:49 AM, Daniel Kraft wrote: > Tobias Burnus wrote: >> OK for the trunk? > > Yes. Two comments: > > It seems that in match_char_length (unlike gfc_match_char_spec) you > simply ignore the value of deferred... Thanks for the review! The former is used for character :: var*(:) and thus was not correctly handled. decl.c (incl. build_sym) has been modified to take "deferred" into account and an example has been added to the test-case files. Committed revision 166205. The committed patch is attached. Tobias 2010-11-02 Steven G. Kargl < kargl@gcc.gnu.org> Tobias Burnus PR fortran/45170 * array.c (gfc_match_array_constructor): Reject deferred type parameter (DTP) in type-spec. * decl.c (char_len_param_value, match_char_length, gfc_match_char_spec, build_sym, variable_decl, enumerator_decl): Support DTP. * expr.c (check_inquiry): Fix check due to support for DTP. * gfortran.h (gfc_typespec): Add Boolean 'deferred'. * misc.c (gfc_clear_ts): Set it to false. * match.c (gfc_match_allocate): Support DTP. * resolve.c (resolve_allocate_expr): Not-implemented error for DTP. (resolve_fl_variable): Add DTP constraint check. * trans-decl.c (gfc_trans_deferred_vars): Add not-implemented error for DTP. 2010-11-02 Steven G. Kargl < kargl@gcc.gnu.org> Tobias Burnus PR fortran/45170 * gfortran.dg/deferred_type_param_1.f90: New. * gfortran.dg/deferred_type_param_2.f90: New. * gfortran.dg/initialization_1.f90: Update dg-errors. * gfortran.dg/initialization_9.f90: Update dg-errors. diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c index 8c74e70..ff0977a 100644 --- a/gcc/fortran/array.c +++ b/gcc/fortran/array.c @@ -1035,6 +1035,13 @@ gfc_match_array_constructor (gfc_expr **result) if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Array constructor " "including type specification at %C") == FAILURE) goto cleanup; + + if (ts.deferred) + { + gfc_error ("Type-spec at %L cannot contain a deferred " + "type parameter", &where); + goto cleanup; + } } } diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 009b010..ed139c4 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -647,16 +647,27 @@ match_intent_spec (void) /* Matches a character length specification, which is either a - specification expression or a '*'. */ + specification expression, '*', or ':'. */ static match -char_len_param_value (gfc_expr **expr) +char_len_param_value (gfc_expr **expr, bool *deferred) { match m; + *expr = NULL; + *deferred = false; + if (gfc_match_char ('*') == MATCH_YES) + return MATCH_YES; + + if (gfc_match_char (':') == MATCH_YES) { - *expr = NULL; + if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: deferred type " + "parameter at %C") == FAILURE) + return MATCH_ERROR; + + *deferred = true; + return MATCH_YES; } @@ -697,10 +708,11 @@ syntax: char_len_param_value in parenthesis. */ static match -match_char_length (gfc_expr **expr) +match_char_length (gfc_expr **expr, bool *deferred) { int length; match m; + *deferred = false; m = gfc_match_char ('*'); if (m != MATCH_YES) @@ -722,7 +734,7 @@ match_char_length (gfc_expr **expr) if (gfc_match_char ('(') == MATCH_NO) goto syntax; - m = char_len_param_value (expr); + m = char_len_param_value (expr, deferred); if (m != MATCH_YES && gfc_matching_function) { gfc_undo_symbols (); @@ -1086,7 +1098,7 @@ verify_c_interop_param (gfc_symbol *sym) /* Function called by variable_decl() that adds a name to the symbol table. */ static gfc_try -build_sym (const char *name, gfc_charlen *cl, +build_sym (const char *name, gfc_charlen *cl, bool cl_deferred, gfc_array_spec **as, locus *var_locus) { symbol_attribute attr; @@ -1103,7 +1115,10 @@ build_sym (const char *name, gfc_charlen *cl, return FAILURE; if (sym->ts.type == BT_CHARACTER) - sym->ts.u.cl = cl; + { + sym->ts.u.cl = cl; + sym->ts.deferred = cl_deferred; + } /* Add dimension attribute if present. */ if (gfc_set_array_spec (sym, *as, var_locus) == FAILURE) @@ -1710,6 +1725,7 @@ variable_decl (int elem) gfc_array_spec *as; gfc_array_spec *cp_as; /* Extra copy for Cray Pointees. */ gfc_charlen *cl; + bool cl_deferred; locus var_locus; match m; gfc_try t; @@ -1770,10 +1786,11 @@ variable_decl (int elem) char_len = NULL; cl = NULL; + cl_deferred = false; if (current_ts.type == BT_CHARACTER) { - switch (match_char_length (&char_len)) + switch (match_char_length (&char_len, &cl_deferred)) { case MATCH_YES: cl = gfc_new_charlen (gfc_current_ns, NULL); @@ -1794,6 +1811,8 @@ variable_decl (int elem) else cl = current_ts.u.cl; + cl_deferred = current_ts.deferred; + break; case MATCH_ERROR: @@ -1869,7 +1888,7 @@ variable_decl (int elem) create a symbol for those yet. If we fail to create the symbol, bail out. */ if (gfc_current_state () != COMP_DERIVED - && build_sym (name, cl, &as, &var_locus) == FAILURE) + && build_sym (name, cl, cl_deferred, &as, &var_locus) == FAILURE) { m = MATCH_ERROR; goto cleanup; @@ -2277,16 +2296,18 @@ gfc_match_char_spec (gfc_typespec *ts) gfc_charlen *cl; gfc_expr *len; match m; + bool deferred; len = NULL; seen_length = 0; kind = 0; is_iso_c = 0; + deferred = false; /* Try the old-style specification first. */ old_char_selector = 0; - m = match_char_length (&len); + m = match_char_length (&len, &deferred); if (m != MATCH_NO) { if (m == MATCH_YES) @@ -2315,7 +2336,7 @@ gfc_match_char_spec (gfc_typespec *ts) if (gfc_match (" , len =") == MATCH_NO) goto rparen; - m = char_len_param_value (&len); + m = char_len_param_value (&len, &deferred); if (m == MATCH_NO) goto syntax; if (m == MATCH_ERROR) @@ -2328,7 +2349,7 @@ gfc_match_char_spec (gfc_typespec *ts) /* Try to match "LEN = " or "LEN = , KIND = ". */ if (gfc_match (" len =") == MATCH_YES) { - m = char_len_param_value (&len); + m = char_len_param_value (&len, &deferred); if (m == MATCH_NO) goto syntax; if (m == MATCH_ERROR) @@ -2348,7 +2369,7 @@ gfc_match_char_spec (gfc_typespec *ts) } /* Try to match ( ) or ( , [ KIND = ] ). */ - m = char_len_param_value (&len); + m = char_len_param_value (&len, &deferred); if (m == MATCH_NO) goto syntax; if (m == MATCH_ERROR) @@ -2407,6 +2428,7 @@ done: ts->u.cl = cl; ts->kind = kind == 0 ? gfc_default_character_kind : kind; + ts->deferred = deferred; /* We have to know if it was a c interoperable kind so we can do accurate type checking of bind(c) procs, etc. */ @@ -7449,7 +7471,7 @@ enumerator_decl (void) /* OK, we've successfully matched the declaration. Now put the symbol in the current namespace. If we fail to create the symbol, bail out. */ - if (build_sym (name, NULL, &as, &var_locus) == FAILURE) + if (build_sym (name, NULL, false, &as, &var_locus) == FAILURE) { m = MATCH_ERROR; goto cleanup; diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index e567c98..8dfbf73 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -2292,10 +2292,13 @@ check_inquiry (gfc_expr *e, int not_restricted) with LEN, as required by the standard. */ if (i == 5 && not_restricted && ap->expr->symtree->n.sym->ts.type == BT_CHARACTER - && ap->expr->symtree->n.sym->ts.u.cl->length == NULL) + && (ap->expr->symtree->n.sym->ts.u.cl->length == NULL + || ap->expr->symtree->n.sym->ts.deferred)) { - gfc_error ("Assumed character length variable '%s' in constant " - "expression at %L", e->symtree->n.sym->name, &e->where); + gfc_error ("Assumed or deferred character length variable '%s' " + " in constant expression at %L", + ap->expr->symtree->n.sym->name, + &ap->expr->where); return MATCH_ERROR; } else if (not_restricted && check_init_expr (ap->expr) == FAILURE) diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index b96dd64..2d0d4eb 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -885,7 +885,7 @@ typedef struct gfc_charlen struct gfc_charlen *next; bool length_from_typespec; /* Length from explicit array ctor typespec? */ tree backend_decl; - tree passed_length; /* Length argument explicitelly passed. */ + tree passed_length; /* Length argument explicitly passed. */ int resolved; } @@ -910,7 +910,8 @@ typedef struct struct gfc_symbol *interface; /* For PROCEDURE declarations. */ int is_c_interop; int is_iso_c; - bt f90_type; + bt f90_type; + bool deferred; } gfc_typespec; diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index 1b895f0..41818e9 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -2845,12 +2845,12 @@ gfc_match_allocate (void) gfc_typespec ts; gfc_symbol *sym; match m; - locus old_locus; - bool saw_stat, saw_errmsg, saw_source, saw_mold, b1, b2, b3; + locus old_locus, deferred_locus; + bool saw_stat, saw_errmsg, saw_source, saw_mold, saw_deferred, b1, b2, b3; head = tail = NULL; stat = errmsg = source = mold = tmp = NULL; - saw_stat = saw_errmsg = saw_source = saw_mold = false; + saw_stat = saw_errmsg = saw_source = saw_mold = saw_deferred = false; if (gfc_match_char ('(') != MATCH_YES) goto syntax; @@ -2879,6 +2879,13 @@ gfc_match_allocate (void) if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: typespec in " "ALLOCATE at %L", &old_locus) == FAILURE) goto cleanup; + + if (ts.deferred) + { + gfc_error ("Type-spec at %L cannot contain a deferred " + "type parameter", &old_locus); + goto cleanup; + } } else { @@ -2912,6 +2919,12 @@ gfc_match_allocate (void) goto cleanup; } + if (tail->expr->ts.deferred) + { + saw_deferred = true; + deferred_locus = tail->expr->where; + } + /* The ALLOCATE statement had an optional typespec. Check the constraints. */ if (ts.type != BT_UNKNOWN) @@ -3095,7 +3108,6 @@ alloc_opt_list: break; } - if (gfc_match (" )%t") != MATCH_YES) goto syntax; @@ -3106,6 +3118,14 @@ alloc_opt_list: &mold->where, &source->where); goto cleanup; } + + /* Check F03:C623, */ + if (saw_deferred && ts.type == BT_UNKNOWN && !source) + { + gfc_error ("Allocate-object at %L with a deferred type parameter " + "requires either a type-spec or SOURCE tag", &deferred_locus); + goto cleanup; + } new_st.op = EXEC_ALLOCATE; new_st.expr1 = stat; diff --git a/gcc/fortran/misc.c b/gcc/fortran/misc.c index b5e6275..397c872 100644 --- a/gcc/fortran/misc.c +++ b/gcc/fortran/misc.c @@ -77,6 +77,7 @@ gfc_clear_ts (gfc_typespec *ts) ts->f90_type = BT_UNKNOWN; /* flag that says whether it's from iso_c_binding or not */ ts->is_iso_c = 0; + ts->deferred = false; } diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 4280555..6e71e13 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -6856,6 +6856,12 @@ check_symbols: } success: + if (e->ts.deferred) + { + gfc_error ("Support for entity at %L with deferred type parameter " + "not yet implemented", &e->where); + return FAILURE; + } return SUCCESS; failure: @@ -9371,6 +9377,7 @@ resolve_index_expr (gfc_expr *e) return SUCCESS; } + /* Resolve a charlen structure. */ static gfc_try @@ -9684,6 +9691,7 @@ apply_default_init_local (gfc_symbol *sym) build_init_assign (sym, init); } + /* Resolution of common features of flavors variable and procedure. */ static gfc_try @@ -9847,12 +9855,22 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag) return FAILURE; } + /* Constraints on deferred type parameter. */ + if (sym->ts.deferred && !(sym->attr.pointer || sym->attr.allocatable)) + { + gfc_error ("Entity '%s' at %L has a deferred type parameter and " + "requires either the pointer or allocatable attribute", + sym->name, &sym->declared_at); + return FAILURE; + } + if (sym->ts.type == BT_CHARACTER) { /* Make sure that character string variables with assumed length are dummy arguments. */ e = sym->ts.u.cl->length; - if (e == NULL && !sym->attr.dummy && !sym->attr.result) + if (e == NULL && !sym->attr.dummy && !sym->attr.result + && !sym->ts.deferred) { gfc_error ("Entity with assumed character length at %L must be a " "dummy argument or a PARAMETER", &sym->declared_at); diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 2c4ebbb..4b668c8 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -3416,6 +3416,8 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) gfc_add_init_cleanup (block, gfc_finish_block (&init), tmp); } } + else if (sym->ts.deferred) + gfc_fatal_error ("Deferred type parameter not yet supported"); else if (sym_has_alloc_comp) gfc_trans_deferred_array (sym, block); else if (sym->ts.type == BT_CHARACTER) diff --git a/gcc/testsuite/gfortran.dg/allocate_with_typespec_3.f90 b/gcc/testsuite/gfortran.dg/allocate_with_typespec_3.f90 index 57f8a11..13a1596 100644 --- a/gcc/testsuite/gfortran.dg/allocate_with_typespec_3.f90 +++ b/gcc/testsuite/gfortran.dg/allocate_with_typespec_3.f90 @@ -23,7 +23,7 @@ subroutine implicit_none_test1 allocate(real(8) :: x4(1)) ! { dg-error "differs from the kind type parameter" } allocate(real(4) :: x8(1)) ! { dg-error "differs from the kind type parameter" } allocate(double :: d1(1)) ! { dg-error "Error in type-spec at" } - allocate(character(:) :: c1(1)) ! { dg-error "Syntax error in CHARACTER declaration" } + allocate(character(:) :: c1(1)) ! { dg-error "cannot contain a deferred type parameter" } allocate(real :: b(1)) ! { dg-error "is type incompatible" } end subroutine implicit_none_test1 @@ -50,7 +50,7 @@ subroutine implicit_none_test2 allocate(real(8) :: x4) ! { dg-error "differs from the kind type parameter" } allocate(real(4) :: x8) ! { dg-error "differs from the kind type parameter" } allocate(double :: d1) ! { dg-error "Error in type-spec at" } - allocate(character(:) :: c1) ! { dg-error "Syntax error in CHARACTER declaration" } + allocate(character(:) :: c1) ! { dg-error "cannot contain a deferred type parameter" } allocate(real :: b) ! { dg-error "is type incompatible" } end subroutine implicit_none_test2 @@ -76,7 +76,7 @@ subroutine implicit_test3 allocate(real(8) :: x4(1)) ! { dg-error "differs from the kind type parameter" } allocate(real(4) :: x8(1)) ! { dg-error "differs from the kind type parameter" } allocate(double :: d1(1)) ! { dg-error "Error in type-spec" } - allocate(character(:) :: c1(1)) ! { dg-error "Syntax error in CHARACTER declaration" } + allocate(character(:) :: c1(1)) ! { dg-error "cannot contain a deferred type parameter" } allocate(real :: b(1)) ! { dg-error "is type incompatible" } end subroutine implicit_test3 @@ -101,7 +101,7 @@ subroutine implicit_test4 allocate(real(8) :: x4) ! { dg-error "differs from the kind type parameter" } allocate(real(4) :: x8) ! { dg-error "differs from the kind type parameter" } allocate(double :: d1) ! { dg-error "Error in type-spec at" } - allocate(character(:) :: c1) ! { dg-error "Syntax error in CHARACTER declaration" } + allocate(character(:) :: c1) ! { dg-error "cannot contain a deferred type parameter" } allocate(real :: b) ! { dg-error "is type incompatible" } end subroutine implicit_test4 diff --git a/gcc/testsuite/gfortran.dg/deferred_type_param_1.f90 b/gcc/testsuite/gfortran.dg/deferred_type_param_1.f90 new file mode 100644 index 0000000..4382fae --- /dev/null +++ b/gcc/testsuite/gfortran.dg/deferred_type_param_1.f90 @@ -0,0 +1,12 @@ +! { dg-do compile } +! { dg-options "-std=f95" } +! +! PR fortran/45170 +! +! Character deferred type parameter +! +implicit none +character(len=:), allocatable :: str(:) ! { dg-error "Fortran 2003: deferred type parameter" } + +character(len=4) :: str2*(:) ! { dg-error "Fortran 2003: deferred type parameter" } +end diff --git a/gcc/testsuite/gfortran.dg/deferred_type_param_2.f90 b/gcc/testsuite/gfortran.dg/deferred_type_param_2.f90 new file mode 100644 index 0000000..7bfd2a6 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/deferred_type_param_2.f90 @@ -0,0 +1,62 @@ +! { dg-do compile } +! { dg-options "-std=f2008" } +! +! PR fortran/45170 +! +! Character deferred type parameter +! + +subroutine one(x, y) ! { dg-error "Entity .y. at .1. has a deferred type parameter" } + implicit none + character(len=:), pointer :: x + character(len=:) :: y + character(len=:), allocatable, target :: str2 + character(len=:), target :: str ! { dg-error "deferred type parameter" } +end subroutine one + +subroutine two() + implicit none + character(len=:), allocatable, target :: str1(:) + character(len=5), save, target :: str2 + character(len=:), pointer :: pstr => str2 + character(len=:), pointer :: pstr2(:) +end subroutine two + +subroutine three() +! implicit none ! Disabled because of PR 46152 + character(len=:), allocatable, target :: str1(:) + character(len=5), save, target :: str2 + character(len=:), pointer :: pstr + character(len=:), pointer :: pstr2(:) + + pstr => str2 + pstr2 => str1 + str1 = ["abc"] + pstr2 => str1 + + allocate (character(len=77) :: str1(1)) ! OK ! { dg-error "not yet implemented" } + allocate (pstr, source=str2) ! OK ! { dg-error "not yet implemented" } + allocate (pstr, mold=str2) ! { dg-error "requires either a type-spec or SOURCE tag" } + allocate (pstr) ! { dg-error "requires either a type-spec or SOURCE tag" } + allocate (character(len=:) :: str1(1)) ! { dg-error "cannot contain a deferred type parameter" } + + str1 = [ character(len=2) :: "abc" ] + str1 = [ character(len=:) :: "abc" ] ! { dg-error "cannot contain a deferred type parameter" } +end subroutine three + +subroutine four() + implicit none + character(len=:), allocatable, target :: str + character(len=:), pointer :: pstr + pstr => str + str = "abc" + if(len(pstr) /= len(str) .or. len(str)/= 3) call abort() + str = "abcd" + if(len(pstr) /= len(str) .or. len(str)/= 4) call abort() +end subroutine four + +subroutine five() +character(len=4) :: str*(:) +allocatable :: str +end subroutine five + diff --git a/gcc/testsuite/gfortran.dg/initialization_1.f90 b/gcc/testsuite/gfortran.dg/initialization_1.f90 index 63035cc..3ca20ac 100644 --- a/gcc/testsuite/gfortran.dg/initialization_1.f90 +++ b/gcc/testsuite/gfortran.dg/initialization_1.f90 @@ -24,7 +24,7 @@ contains real :: z(2, 2) ! However, this gives a warning because it is an initialization expression. - integer :: l1 = len (ch1) ! { dg-warning "Assumed character length variable" } + integer :: l1 = len (ch1) ! { dg-warning "Assumed or deferred character length variable" } ! These are warnings because they are gfortran extensions. integer :: m3 = size (x, 1) ! { dg-error "Assumed size array" } diff --git a/gcc/testsuite/gfortran.dg/initialization_9.f90 b/gcc/testsuite/gfortran.dg/initialization_9.f90 index 2341d40..d904047 100644 --- a/gcc/testsuite/gfortran.dg/initialization_9.f90 +++ b/gcc/testsuite/gfortran.dg/initialization_9.f90 @@ -5,7 +5,7 @@ integer function xstrcmp(s1) character*(*), intent(in) :: s1 - integer :: n1 = len(s1) ! { dg-error "Assumed character length variable" } + integer :: n1 = len(s1) ! { dg-error "Assumed or deferred character length variable" } n1 = 1 return end function xstrcmp