From patchwork Wed May 22 19:02:38 2013 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 245695 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 with cipher DHE-RSA-AES256-SHA (256/256 bits)) (Client CN "localhost", Issuer "www.qmailtoaster.com" (not verified)) by ozlabs.org (Postfix) with ESMTPS id B67B72C00A2 for ; Thu, 23 May 2013 05:03:03 +1000 (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=FfUPiR6bVWt7uOo6Y1zvubSpRYrrDReRUCfwI+69CpQbBf WpfCbKNlBrZLsPinCE3CzsO96UPdwnDHHZSC410lSfPm2sWH1haDzOCyAgutdjQR aYBajai+PSDJhpe26iuclXOAhJ1CwYwcW5ykmL5gYPZKSYIeR1xERwZAwDtqs= 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=F7oZfwdrdvIwZFB6VN15IVuO7Gg=; b=tsBWc8993+RcqETiX5rI FA3Tjltus1OFepefUyutF7JqgvoBNTcXQS8S1orNRzrUjoeiHX5XoAVBVi7gxEuy BA5BkfgO5hs00A+CGClVx/0al5KfE+RLsFGFhx5nbMC70ExM68SF/occ9ObW+3mO RxB5GSKWLeKr2iHNO/JAsG8= Received: (qmail 12197 invoked by alias); 22 May 2013 19:02:51 -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 12114 invoked by uid 89); 22 May 2013 19:02:43 -0000 X-Spam-SWARE-Status: No, score=-1.9 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_NONE, RCVD_IN_SEMBACKSCATTER, TW_GZ, TW_VP autolearn=no version=3.3.1 X-Spam-User: qpsmtpd, 2 recipients Received: from mx02.qsc.de (HELO mx02.qsc.de) (213.148.130.14) by sourceware.org (qpsmtpd/0.84/v0.84-167-ge50287c) with ESMTP; Wed, 22 May 2013 19:02:42 +0000 Received: from archimedes.net-b.de (port-92-195-69-235.dynamic.qsc.de [92.195.69.235]) by mx02.qsc.de (Postfix) with ESMTP id 05C2C24A29; Wed, 22 May 2013 21:02:38 +0200 (CEST) Message-ID: <519D164E.100@net-b.de> Date: Wed, 22 May 2013 21:02:38 +0200 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:17.0) Gecko/20130510 Thunderbird/17.0.6 MIME-Version: 1.0 To: gcc patches , gfortran Subject: [Patch, Fortran] Enable the generation of the FINALization wrapper function X-Virus-Found: No Pre-remark: This patch does *not* enable finalization or polymorphic deallocation. * * * Dear all, The attached patch is a bit boring and invasive, but it paves the way to FINAL support. Changes of technical kind: * Changed ABI for CLASS's virtual table (due to _final) - and, hence, it bumps the .mod version * The finalization wrapper is now generated (this should not but might lead to ICEs) * It also causes that the virtual table is now more often generated New feature: _copy no longer deallocates the "dst" argument. Doing so lead to bogus finalization with ALLOCATE (exposed with the pending FINAL patch). As a sideeffect, memset could be removed and CALLOC could be replased by MALLOC (minute performance advantage). In order to keep the deallocation in gfc_trans_class_array_init_assign, there is now a call to the finalization wrapper. Next steps: * Add end-of-scope/intent(out) deallocation for polymorphic arrays * Enable FINAL parsing * Stepwise enabling for polymorphic deallocation/finalization * Fix issues with ELEMENTAL(+optional) with intent(out) * Fix some issues related to intrinsic assignment * Fix fallout of any of those items Build and regtested on x86-64-gnu-linux. OK for the trunk? Tobias 2013-05-22 Tobias Burnus * class.c (finalize_component): Fix coarray array refs. (gfc_find_derived_vtab): _copy's dst is now intent(inout). Enable finalization-wrapper generation. * module.c (MOD_VERSION): Bump. (gfc_dump_module, gfc_use_module): Remove empty line in .mod. * trans-array.c (gfc_conv_descriptor_token): Accept nonrestricted void pointer. (gfc_array_allocate, structure_alloc_comps): Don't nullify for BT_CLASS allocations. * trans-stmt.c (gfc_trans_allocate): Ditto. * trans-expr.c (gfc_trans_class_array_init_assign): Call _final before _copy. 2013-05-22 Tobias Burnus * gfortran.dg/auto_dealloc_2.f90: Update _free count in the dump. * gfortran.dg/class_19.f03: Ditto. diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c index 349f494..c41b95a 100644 --- a/gcc/fortran/class.c +++ b/gcc/fortran/class.c @@ -832,17 +832,18 @@ finalize_component (gfc_expr *expr, gfc_symbol *derived, gfc_component *comp, ref->u.c.component = comp; e->ts = comp->ts; - if (comp->attr.dimension + if (comp->attr.dimension || comp->attr.codimension || (comp->ts.type == BT_CLASS && CLASS_DATA (comp) - && CLASS_DATA (comp)->attr.dimension)) + && (CLASS_DATA (comp)->attr.dimension + || CLASS_DATA (comp)->attr.codimension))) { ref->next = gfc_get_ref (); ref->next->type = REF_ARRAY; - ref->next->u.ar.type = AR_FULL; ref->next->u.ar.dimen = 0; ref->next->u.ar.as = comp->ts.type == BT_CLASS ? CLASS_DATA (comp)->as : comp->as; e->rank = ref->next->u.ar.as->rank; + ref->next->u.ar.type = e->rank ? AR_FULL : AR_ELEMENT; } /* Call DEALLOCATE (comp, stat=ignore). */ @@ -2363,7 +2364,7 @@ gfc_find_derived_vtab (gfc_symbol *derived) dst->attr.flavor = FL_VARIABLE; dst->attr.dummy = 1; dst->attr.artificial = 1; - dst->attr.intent = INTENT_OUT; + dst->attr.intent = INTENT_INOUT; gfc_set_sym_referenced (dst); copy->formal->next = gfc_get_formal_arglist (); copy->formal->next->sym = dst; @@ -2382,9 +2383,6 @@ gfc_find_derived_vtab (gfc_symbol *derived) components and the calls to finalization subroutines. Note: The actual wrapper function can only be generated at resolution time. */ - /* FIXME: Enable ABI-breaking "_final" generation. */ - if (0) - { if (!gfc_add_component (vtype, "_final", &c)) goto cleanup; c->attr.proc_pointer = 1; @@ -2392,7 +2390,6 @@ gfc_find_derived_vtab (gfc_symbol *derived) c->tb = XCNEW (gfc_typebound_proc); c->tb->ppc = 1; generate_finalization_wrapper (derived, ns, tname, c); - } /* Add procedure pointers for type-bound procedures. */ if (!derived->attr.unlimited_polymorphic) @@ -2651,7 +2648,7 @@ gfc_find_intrinsic_vtab (gfc_typespec *ts) dst->ts.kind = ts->kind; dst->attr.flavor = FL_VARIABLE; dst->attr.dummy = 1; - dst->attr.intent = INTENT_OUT; + dst->attr.intent = INTENT_INOUT; gfc_set_sym_referenced (dst); copy->formal->next = gfc_get_formal_arglist (); copy->formal->next->sym = dst; diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index e6a4cd7..9486b28 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -80,10 +80,8 @@ along with GCC; see the file COPYING3. If not see #define MODULE_EXTENSION ".mod" /* Don't put any single quote (') in MOD_VERSION, if you want it to be - recognized. - TODO: When the version is bumped, remove the extra empty line at - the beginning of module files. */ -#define MOD_VERSION "10" + recognized. */ +#define MOD_VERSION "11" /* Structure that describes a position within a module file. */ @@ -5571,7 +5569,7 @@ gfc_dump_module (const char *name, int dump_flag) FIXME: For backwards compatibility with the old uncompressed module format, write an extra empty line. When the module version is bumped, this can be removed. */ - gzprintf (module_fp, "GFORTRAN module version '%s' created from %s\n\n", + gzprintf (module_fp, "GFORTRAN module version '%s' created from %s\n", MOD_VERSION, gfc_source_file); @@ -6364,10 +6362,10 @@ gfc_use_module (gfc_use_list *module) read_module_to_tmpbuf (); gzclose (module_fp); - /* Skip the first two lines of the module, after checking that this is + /* Skip the first line of the module, after checking that this is a gfortran module file. */ line = 0; - while (line < 2) + while (line < 1) { c = module_char (); if (c == EOF) diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 6cb85d4..be3a5a0 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -300,7 +300,11 @@ gfc_conv_descriptor_token (tree desc) gcc_assert (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE); gcc_assert (gfc_option.coarray == GFC_FCOARRAY_LIB); field = gfc_advance_chain (TYPE_FIELDS (type), CAF_TOKEN_FIELD); - gcc_assert (field != NULL_TREE && TREE_TYPE (field) == prvoid_type_node); + + /* Should be a restricted pointer - except in the finalization wrapper. */ + gcc_assert (field != NULL_TREE + && (TREE_TYPE (field) == prvoid_type_node + || TREE_TYPE (field) == pvoid_type_node)); return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field), desc, field, NULL_TREE); @@ -5222,18 +5226,6 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg, gfc_add_expr_to_block (&se->pre, tmp); - if (expr->ts.type == BT_CLASS) - { - tmp = build_int_cst (unsigned_char_type_node, 0); - /* With class objects, it is best to play safe and null the - memory because we cannot know if dynamic types have allocatable - components or not. */ - tmp = build_call_expr_loc (input_location, - builtin_decl_explicit (BUILT_IN_MEMSET), - 3, pointer, tmp, size); - gfc_add_expr_to_block (&se->pre, tmp); - } - /* Update the array descriptors. */ if (dimension) gfc_conv_descriptor_offset_set (&set_descriptor_block, se->expr, offset); @@ -7699,6 +7691,10 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, { nelems = gfc_conv_descriptor_size (src_data, CLASS_DATA (c)->as->rank); + size = fold_build2_loc (input_location, MULT_EXPR, + size_type_node, size, + fold_convert (size_type_node, + nelems)); src_data = gfc_conv_descriptor_data_get (src_data); dst_data = gfc_conv_descriptor_data_get (dst_data); } @@ -7707,11 +7703,8 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, gfc_init_block (&tmpblock); - /* We need to use CALLOC as _copy might try to free allocatable - components of the destination. */ - ftn_tree = builtin_decl_explicit (BUILT_IN_CALLOC); - tmp = build_call_expr_loc (input_location, ftn_tree, 2, nelems, - size); + ftn_tree = builtin_decl_explicit (BUILT_IN_MALLOC); + tmp = build_call_expr_loc (input_location, ftn_tree, 1, size); gfc_add_modify (&tmpblock, dst_data, fold_convert (TREE_TYPE (dst_data), tmp)); diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index de851a2..f8d99fd 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -835,10 +835,24 @@ static tree gfc_trans_class_array_init_assign (gfc_expr *rhs, gfc_expr *lhs, gfc_expr *obj) { gfc_actual_arglist *actual; + gfc_expr *final_expr; + gfc_expr *vptr_size; gfc_expr *ppc; gfc_code *ppc_code; tree res; + final_expr = gfc_copy_expr (obj); + gfc_add_vptr_component (final_expr); + gfc_add_component_ref (final_expr, "_final"); + + vptr_size = gfc_copy_expr (obj); + gfc_add_vptr_component (vptr_size); + gfc_add_component_ref (vptr_size, "_size"); + + gfc_build_final_call (obj->ts, final_expr, obj, false, vptr_size); + gfc_free_expr (final_expr); + gfc_free_expr (vptr_size); + actual = gfc_get_actual_arglist (); actual->expr = gfc_copy_expr (rhs); actual->next = gfc_get_actual_arglist (); diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 1b65f2c..6c5f557 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -5071,16 +5071,6 @@ gfc_trans_allocate (gfc_code * code) tmp = gfc_nullify_alloc_comp (expr->ts.u.derived, tmp, 0); gfc_add_expr_to_block (&se.pre, tmp); } - else if (al->expr->ts.type == BT_CLASS) - { - /* With class objects, it is best to play safe and null the - memory because we cannot know if dynamic types have allocatable - components or not. */ - tmp = build_call_expr_loc (input_location, - builtin_decl_explicit (BUILT_IN_MEMSET), - 3, se.expr, integer_zero_node, memsz); - gfc_add_expr_to_block (&se.pre, tmp); - } } gfc_add_block_to_block (&block, &se.pre); diff --git a/gcc/testsuite/gfortran.dg/auto_dealloc_2.f90 b/gcc/testsuite/gfortran.dg/auto_dealloc_2.f90 index e607b6a..d261973 100644 --- a/gcc/testsuite/gfortran.dg/auto_dealloc_2.f90 +++ b/gcc/testsuite/gfortran.dg/auto_dealloc_2.f90 @@ -25,5 +25,5 @@ contains end program -! { dg-final { scan-tree-dump-times "__builtin_free" 3 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_free" 5 "original" } } ! { dg-final { cleanup-tree-dump "original" } } diff --git a/gcc/testsuite/gfortran.dg/class_19.f03 b/gcc/testsuite/gfortran.dg/class_19.f03 index 63b8e06..6dcd99c 100644 --- a/gcc/testsuite/gfortran.dg/class_19.f03 +++ b/gcc/testsuite/gfortran.dg/class_19.f03 @@ -39,5 +39,5 @@ program main end program main -! { dg-final { scan-tree-dump-times "__builtin_free" 11 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_free" 15 "original" } } ! { dg-final { cleanup-tree-dump "original" } }