From patchwork Thu Mar 19 15:13:46 2015 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Andre Vehreschild X-Patchwork-Id: 452006 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 5878714008F for ; Fri, 20 Mar 2015 02:14:03 +1100 (AEDT) Authentication-Results: ozlabs.org; dkim=pass reason="1024-bit key; unprotected key" header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b=wuU5TaPa; dkim-adsp=none (unprotected policy); 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:subject:message-id:mime-version:content-type; q=dns; s= default; b=rXJQcvf8J8pOhxqv2kqmaC93SG4/cb2IeW4IdcEYwpsS24LInc6+V Oxpc6kO8K+MJ2JIqmoVTVzr/PP1fKN1YnMAcnd7W/EZONyPTJ2WwgMPSUwB5SFiP qBU9x6/CrObsxumKdTmpdmiezwVcRro2zTvtSVRKtbQz7ovBFXOh18= 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:mime-version:content-type; s= default; bh=jy1uwZNSLlN0PY+DfNgB+LgcPSY=; b=wuU5TaPae0Jga8FBHMGq 8B8xS/MM2yg/J/ynBMCxuKfBU3dMhkDBuMsDU9s+ZUuBH/L4e7PDyYyPMUSmsBTD rQGkble6dB58CYPII7YOD958fS4VqBqNgpZcdaj0/FhaV63D1QqPWJz/PySrRftM kZmwge48QjTfktx2MZXS3Sg= Received: (qmail 101635 invoked by alias); 19 Mar 2015 15:13:53 -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 101615 invoked by uid 89); 19 Mar 2015 15:13:53 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-1.7 required=5.0 tests=AWL, BAYES_00, FREEMAIL_FROM, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.2 X-Spam-User: qpsmtpd, 2 recipients X-HELO: mout.gmx.net Received: from mout.gmx.net (HELO mout.gmx.net) (212.227.17.20) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES256-GCM-SHA384 encrypted) ESMTPS; Thu, 19 Mar 2015 15:13:51 +0000 Received: from vepi2 ([88.75.104.20]) by mail.gmx.com (mrgmx103) with ESMTPSA (Nemesis) id 0Md31i-1YpanJ3WSI-00IFcK; Thu, 19 Mar 2015 16:13:47 +0100 Date: Thu, 19 Mar 2015 16:13:46 +0100 From: Andre Vehreschild To: GCC-Patches-ML , GCC-Fortran-ML Subject: [Patch, Fortran, pr55901, v1] [OOP] type is (character(len=*)) misinterpreted as array Message-ID: <20150319161346.7041ea23@vepi2> MIME-Version: 1.0 X-UI-Out-Filterresults: notjunk:1; Hi all, please find attached the parts missing to stop valgrind's complaining about the use of uninitialized memory. The issue was, that when constructing a temporary class-object to call a routine with unlimited polymorphic arguments, the _len component was never set. This is fixed by this patch now. Note, the patch is based on all these preliminary patches: https://gcc.gnu.org/ml/fortran/2015-03/msg00074.html https://gcc.gnu.org/ml/fortran/2015-03/msg00075.html https://gcc.gnu.org/ml/fortran/2015-03/msg00085.html Bootstraps and regtests ok on x86_64-linux-gnu/F20. Please review! - Andre diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 7d3f3be..a30c391 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -578,6 +578,34 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e, } } + if (class_ts.u.derived->components->ts.type == BT_DERIVED + && class_ts.u.derived->components->ts.u.derived + ->attr.unlimited_polymorphic) + { + /* Take care about initializing the _len component correctly. */ + ctree = gfc_class_len_get (var); + if (UNLIMITED_POLY (e)) + { + gfc_expr *len; + gfc_se se; + + len = gfc_copy_expr (e); + gfc_add_len_component (len); + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, len); + if (optional) + tmp = build3_loc (input_location, COND_EXPR, TREE_TYPE (se.expr), + cond_optional, se.expr, + fold_convert (TREE_TYPE (se.expr), + integer_zero_node)); + else + tmp = se.expr; + } + else + tmp = integer_zero_node; + gfc_add_modify (&parmse->pre, ctree, fold_convert (TREE_TYPE (ctree), + tmp)); + } /* Pass the address of the class object. */ parmse->expr = gfc_build_addr_expr (NULL_TREE, var); @@ -736,44 +764,54 @@ gfc_conv_intrinsic_to_class (gfc_se *parmse, gfc_expr *e, } } - /* When the actual arg is a char array, then set the _len component of the - unlimited polymorphic entity, too. */ - if (e->ts.type == BT_CHARACTER) + gcc_assert (class_ts.type == BT_CLASS); + if (class_ts.u.derived->components->ts.type == BT_DERIVED + && class_ts.u.derived->components->ts.u.derived + ->attr.unlimited_polymorphic) { ctree = gfc_class_len_get (var); - /* Start with parmse->string_length because this seems to be set to a - correct value more often. */ - if (parmse->string_length) - gfc_add_modify (&parmse->pre, ctree, parmse->string_length); - /* When the string_length is not yet set, then try the backend_decl of - the cl. */ - else if (e->ts.u.cl->backend_decl) - gfc_add_modify (&parmse->pre, ctree, e->ts.u.cl->backend_decl); - /* If both of the above approaches fail, then try to generate an - expression from the input, which is only feasible currently, when the - expression can be evaluated to a constant one. */ - else - { - /* Try to simplify the expression. */ - gfc_simplify_expr (e, 0); - if (e->expr_type == EXPR_CONSTANT && !e->ts.u.cl->resolved) - { - /* Amazingly all data is present to compute the length of a - constant string, but the expression is not yet there. */ - e->ts.u.cl->length = gfc_get_constant_expr (BT_INTEGER, 4, - &e->where); - mpz_set_ui (e->ts.u.cl->length->value.integer, - e->value.character.length); - gfc_conv_const_charlen (e->ts.u.cl); - e->ts.u.cl->resolved = 1; - gfc_add_modify (&parmse->pre, ctree, e->ts.u.cl->backend_decl); - } + /* When the actual arg is a char array, then set the _len component of the + unlimited polymorphic entity, too. */ + if (e->ts.type == BT_CHARACTER) + { + /* Start with parmse->string_length because this seems to be set to a + correct value more often. */ + if (parmse->string_length) + tmp = parmse->string_length; + /* When the string_length is not yet set, then try the backend_decl of + the cl. */ + else if (e->ts.u.cl->backend_decl) + tmp = e->ts.u.cl->backend_decl; + /* If both of the above approaches fail, then try to generate an + expression from the input, which is only feasible currently, when the + expression can be evaluated to a constant one. */ else { - gfc_error ("Can't compute the length of the char array at %L.", - &e->where); + /* Try to simplify the expression. */ + gfc_simplify_expr (e, 0); + if (e->expr_type == EXPR_CONSTANT && !e->ts.u.cl->resolved) + { + /* Amazingly all data is present to compute the length of a + constant string, but the expression is not yet there. */ + e->ts.u.cl->length = gfc_get_constant_expr (BT_INTEGER, 4, + &e->where); + mpz_set_ui (e->ts.u.cl->length->value.integer, + e->value.character.length); + gfc_conv_const_charlen (e->ts.u.cl); + e->ts.u.cl->resolved = 1; + tmp = e->ts.u.cl->backend_decl; + } + else + { + gfc_error ("Can't compute the length of the char array at %L.", + &e->where); + } } } + else + tmp = integer_zero_node; + + gfc_add_modify (&parmse->pre, ctree, tmp); } /* Pass the address of the class object. */ parmse->expr = gfc_build_addr_expr (NULL_TREE, var);