From patchwork Sun Dec 11 13:01:37 2016 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Andre Vehreschild X-Patchwork-Id: 704825 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 3tc5j00VwJz9t0G for ; Mon, 12 Dec 2016 00:02:10 +1100 (AEDT) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="ZZM1hFtv"; dkim-atps=neutral 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:cc:subject:message-id:in-reply-to:references :mime-version:content-type; q=dns; s=default; b=UbD7tYOlggVP0T4Z ixX14j4Z4lVKpoJQC3OMZQHHtuxibjIKbV7CEZgCuvH3/yj7daHR9xdVPNoebKH8 mx2PWqtI3gC28g3BfrTMSMpkyAn0Q9Kl977tPfruT6gFFpQCdQmvic1zypSjZIO0 RufMyoSjf/a/G4vOHVjERahp+AU= 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:cc:subject:message-id:in-reply-to:references :mime-version:content-type; s=default; bh=CF6aJmGnzdJDQgfUJZ79Qv 2gxSY=; b=ZZM1hFtvlU/gaZ6NF/au0caaM3jNs5T68IJeH1gHAIa1gimiNWGkYm Wy/qkjDEWkgWO/WEt4ikiLMkHN0Ye9n+FU4GEHpRfH3jyqdebWqhrYsNsePch+P9 jhj72lH2YGX8kPvGcDIpeW/8wchruLaXmknVqRNBTQumdWYJ8L9pw= Received: (qmail 103330 invoked by alias); 11 Dec 2016 13:02:00 -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 103259 invoked by uid 89); 11 Dec 2016 13:01:56 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-2.5 required=5.0 tests=AWL, BAYES_00, FREEMAIL_FROM, RCVD_IN_DNSWL_LOW, SPF_PASS autolearn=ham version=3.3.2 spammy=UD:ar, H*i:sk:848d42c, H*f:sk:848d42c, Prevent X-Spam-User: qpsmtpd, 2 recipients X-HELO: mout.gmx.net Received: from mout.gmx.net (HELO mout.gmx.net) (212.227.17.21) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Sun, 11 Dec 2016 13:01:45 +0000 Received: from vepi2 ([92.76.205.227]) by mail.gmx.com (mrgmx102 [212.227.17.168]) with ESMTPSA (Nemesis) id 0M0Kp7-1cU8pq0RYb-00ube5; Sun, 11 Dec 2016 14:01:39 +0100 Date: Sun, 11 Dec 2016 14:01:37 +0100 From: Andre Vehreschild To: Mikael Morin Cc: GCC-Patches-ML , GCC-Fortran-ML , Dominique Dhumieres , Jerry DeLisle Subject: Re: [PATCH, Fortran, pr78672, ctp1, v2] Gfortran test suite failures with a sanitized compiler Message-ID: <20161211140137.5174fcca@vepi2> In-Reply-To: <848d42c4-21a1-6414-b942-dce80220d539@orange.fr> References: <20161208143937.0153b2a8@vepi2> <20161209115519.12f1422b@vepi2> <848d42c4-21a1-6414-b942-dce80220d539@orange.fr> MIME-Version: 1.0 X-UI-Out-Filterresults: notjunk:1; V01:K0:NZio14ygMQw=:Nu87e1nWgihlP3ZBwLqwmO gDm9BP1Bdgi1qGbz1wvudeOW++kCWq+04F/SOLL4QLsEQly5SaKkLGBCMkuYdKGa4/uhIS3KR 9XisfL1f8aWpWxrEJzn4sPMaF0qPycYg7stOtqNlMffgF09aSceo8HAmYkMixPRZgJf6M8cR8 4FPosFPtvNR0oBDt5QbV040GW/uUDFKrpE5Kb1tACgsZyqJjcTm4PfG9GuKr/t++K9ZmxRLZG A/+vvru50Z/6cDFdTm8rbFjvbnMkel8BrFZ6yCIBthTL4bt4v6QrUqWRlv5FyTk/lGflOFGRM gUD1asKoAXAaLG3LL6Yb93xQXSxhekI6s8XXi2Z4wKc1B8o+soLMD6hUb3NnqP3y+LqxFVgW0 mL6gxpdi23V7ErpDIfRfDMNeCS0i9BL39Xyi3Jm/gqGblvQWwmMGR+FUMMDRZAbVAdzrJ04kT lMPfKaCX61jABe1udLdYsZ/wFSpWjSPxhRfxDaMexrA4ats7Q49qZ9OdfjoKVKj2jLv81fwIl hRxUkj/e56kx6CJDbijyxVH0e1MDf+qfF2FC7TBfgas1wh7ThzCeayIKC37RfFwq5U5vnolu/ sH08DVnqbOHWIxNf1ZFS8gk8t4zDXgnfCOSvxo/rbQfezvBHixO1RVIzmrQE52CBf5xQ71i70 dWKGHJHU1z/Ju22g5xtCJ/UgXTcClzH0PAMr5vspjVkVs73aG1SrrhKlrWivUXc5+xeb6aT6i RWkglgZ5117Wh9BSz/4CrEs6h+OrfJETXaGZnHtQz8K7IUuSYnGt5wuQQTc= Hi Mikael, hi Jerry, hi Steve, hi Jane, hi Thomas, hi Paul, hi all, thanks for all the input you gave on the patch I have present. I tried to address all of it in the new version of the patch attached. Mikael: data.c::create_character_initializer() I have remove the test for rvalue->value.character.string and went to gfc_assign_data_value () line 483 to prevent calling the routine when rvalue is not an EXPR_CONSTANT (third chunk of the patch). interface.c::compare_actual_formal() I have reverted the change to look at actual_arr_ref when looking for assumed size arrays which are dummy argument arrays. That chunk (#5) is now only additionally checking whether f.sym is really of type BT_CHARACTER before accessing its ts.u.cl.lenght. For the second occurrence of actual_arr_ref I have extended gfc_find_array_ref() with a flag to pass the search when no array ref is found (Chunks #1, 2 and 6). Jerry: trans-expr.c::gfc_conv_cst_int_power() I have added comment to new C++ code. Would you like to add something to it? The updated patch bootstraps and regtests fine on x86_64-linux/f23 on a regular and on an instrumented gfortran. How do you like this patch? Regards, Andre diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c index e6917a5..b2f5613 100644 --- a/gcc/fortran/array.c +++ b/gcc/fortran/array.c @@ -2563,7 +2563,7 @@ cleanup: characterizes the reference. */ gfc_array_ref * -gfc_find_array_ref (gfc_expr *e) +gfc_find_array_ref (gfc_expr *e, bool allow_null) { gfc_ref *ref; @@ -2573,7 +2573,12 @@ gfc_find_array_ref (gfc_expr *e) break; if (ref == NULL) - gfc_internal_error ("gfc_find_array_ref(): No ref found"); + { + if (allow_null) + return NULL; + else + gfc_internal_error ("gfc_find_array_ref(): No ref found"); + } return &ref->u.ar; } diff --git a/gcc/fortran/data.c b/gcc/fortran/data.c index 139ce88..ea19732 100644 --- a/gcc/fortran/data.c +++ b/gcc/fortran/data.c @@ -483,7 +483,10 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index, if (ref || last_ts->type == BT_CHARACTER) { - if (lvalue->ts.u.cl->length == NULL && !(ref && ref->u.ss.length != NULL)) + /* An initializer has to be constant. */ + if (rvalue->expr_type != EXPR_CONSTANT + || (lvalue->ts.u.cl->length == NULL + && !(ref && ref->u.ss.length != NULL))) return false; expr = create_character_initializer (init, last_ts, ref, rvalue); } diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 670c13a..6a8d6eb 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -3207,7 +3208,7 @@ bool gfc_check_constructor (gfc_expr *, bool (*)(gfc_expr *)); bool gfc_array_size (gfc_expr *, mpz_t *); bool gfc_array_dimen_size (gfc_expr *, int, mpz_t *); bool gfc_array_ref_shape (gfc_array_ref *, mpz_t *); -gfc_array_ref *gfc_find_array_ref (gfc_expr *); +gfc_array_ref *gfc_find_array_ref (gfc_expr *, bool a = false); tree gfc_conv_array_initializer (tree type, gfc_expr *); bool spec_size (gfc_array_spec *, mpz_t *); bool spec_dimen_size (gfc_array_spec *, int, mpz_t *); diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 8afba84..b1d11c5 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -2803,6 +2803,7 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, int i, n, na; unsigned long actual_size, formal_size; bool full_array = false; + gfc_array_ref *actual_arr_ref; actual = *ap; @@ -2942,37 +2943,38 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, and assumed-shape dummies, the string length needs to match exactly. */ if (a->expr->ts.type == BT_CHARACTER - && a->expr->ts.u.cl && a->expr->ts.u.cl->length - && a->expr->ts.u.cl->length->expr_type == EXPR_CONSTANT - && f->sym->ts.u.cl && f->sym->ts.u.cl && f->sym->ts.u.cl->length - && f->sym->ts.u.cl->length->expr_type == EXPR_CONSTANT - && (f->sym->attr.pointer || f->sym->attr.allocatable - || (f->sym->as && f->sym->as->type == AS_ASSUMED_SHAPE)) - && (mpz_cmp (a->expr->ts.u.cl->length->value.integer, - f->sym->ts.u.cl->length->value.integer) != 0)) - { - if (where && (f->sym->attr.pointer || f->sym->attr.allocatable)) - gfc_warning (OPT_Wargument_mismatch, - "Character length mismatch (%ld/%ld) between actual " - "argument and pointer or allocatable dummy argument " - "%qs at %L", - mpz_get_si (a->expr->ts.u.cl->length->value.integer), - mpz_get_si (f->sym->ts.u.cl->length->value.integer), - f->sym->name, &a->expr->where); - else if (where) - gfc_warning (OPT_Wargument_mismatch, - "Character length mismatch (%ld/%ld) between actual " - "argument and assumed-shape dummy argument %qs " - "at %L", - mpz_get_si (a->expr->ts.u.cl->length->value.integer), - mpz_get_si (f->sym->ts.u.cl->length->value.integer), - f->sym->name, &a->expr->where); - return 0; - } + && a->expr->ts.u.cl && a->expr->ts.u.cl->length + && a->expr->ts.u.cl->length->expr_type == EXPR_CONSTANT + && f->sym->ts.type == BT_CHARACTER && f->sym->ts.u.cl + && f->sym->ts.u.cl->length + && f->sym->ts.u.cl->length->expr_type == EXPR_CONSTANT + && (f->sym->attr.pointer || f->sym->attr.allocatable + || (f->sym->as && f->sym->as->type == AS_ASSUMED_SHAPE)) + && (mpz_cmp (a->expr->ts.u.cl->length->value.integer, + f->sym->ts.u.cl->length->value.integer) != 0)) + { + if (where && (f->sym->attr.pointer || f->sym->attr.allocatable)) + gfc_warning (OPT_Wargument_mismatch, + "Character length mismatch (%ld/%ld) between actual " + "argument and pointer or allocatable dummy argument " + "%qs at %L", + mpz_get_si (a->expr->ts.u.cl->length->value.integer), + mpz_get_si (f->sym->ts.u.cl->length->value.integer), + f->sym->name, &a->expr->where); + else if (where) + gfc_warning (OPT_Wargument_mismatch, + "Character length mismatch (%ld/%ld) between actual " + "argument and assumed-shape dummy argument %qs " + "at %L", + mpz_get_si (a->expr->ts.u.cl->length->value.integer), + mpz_get_si (f->sym->ts.u.cl->length->value.integer), + f->sym->name, &a->expr->where); + return 0; + } if ((f->sym->attr.pointer || f->sym->attr.allocatable) - && f->sym->ts.deferred != a->expr->ts.deferred - && a->expr->ts.type == BT_CHARACTER) + && f->sym->ts.deferred != a->expr->ts.deferred + && a->expr->ts.type == BT_CHARACTER) { if (where) gfc_error ("Actual argument at %L to allocatable or " @@ -3195,15 +3197,20 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, return 0; } + /* Find the last array_ref. */ + actual_arr_ref = NULL; + if (a->expr->ref) + actual_arr_ref = gfc_find_array_ref (a->expr, true); + if (f->sym->attr.volatile_ - && a->expr->ref && a->expr->ref->u.ar.type == AR_SECTION + && actual_arr_ref && actual_arr_ref->type == AR_SECTION && !(f->sym->as && f->sym->as->type == AS_ASSUMED_SHAPE)) { if (where) gfc_error ("Array-section actual argument at %L is " "incompatible with the non-assumed-shape " "dummy argument %qs due to VOLATILE attribute", - &a->expr->where,f->sym->name); + &a->expr->where, f->sym->name); return 0; } diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index e727ade..713f272 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -4710,6 +4710,7 @@ load_omp_udrs (void) mio_lparen (); mio_pool_string (&name); + gfc_clear_ts (&ts); mio_typespec (&ts); if (strncmp (name, "operator ", sizeof ("operator ") - 1) == 0) { diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index f659a48..a7a5e2a 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -1053,7 +1053,7 @@ gfc_build_qualified_array (tree decl, gfc_symbol * sym) layout_type (type); } - if (TYPE_NAME (type) != NULL_TREE + if (TYPE_NAME (type) != NULL_TREE && as->rank > 0 && GFC_TYPE_ARRAY_UBOUND (type, as->rank - 1) != NULL_TREE && VAR_P (GFC_TYPE_ARRAY_UBOUND (type, as->rank - 1))) { diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index cbfad0b..2f45d40 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -2864,9 +2864,9 @@ gfc_conv_cst_int_power (gfc_se * se, tree lhs, tree rhs) return 0; m = wrhs.to_shwi (); - /* There's no ABS for HOST_WIDE_INT, so here we go. It also takes care - of the asymmetric range of the integer type. */ - n = (unsigned HOST_WIDE_INT) (m < 0 ? -m : m); + /* Use the wide_int's routine to reliably get the absolute value on all + platforms. Then convert it to a HOST_WIDE_INT like above. */ + n = wi::abs (wrhs).to_shwi (); type = TREE_TYPE (lhs); sgn = tree_int_cst_sgn (rhs); diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index d34bdba..d9e185f 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -6483,7 +6483,8 @@ gfc_trans_deallocate (gfc_code *code) && !(!last && expr->symtree->n.sym->attr.pointer)) { if (is_coarray && expr->rank == 0 - && (!last || !last->u.c.component->attr.dimension)) + && (!last || !last->u.c.component->attr.dimension) + && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se.expr))) { /* Add the ref to the data member only, when this is not a regular array or deallocate_alloc_comp will try to