From patchwork Fri Mar 26 16:30:23 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Paul Richard Thomas X-Patchwork-Id: 1458885 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=8.43.85.97; helo=sourceware.org; envelope-from=gcc-patches-bounces@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.a=rsa-sha256 header.s=default header.b=lp6DrWNs; dkim-atps=neutral Received: from sourceware.org (server2.sourceware.org [8.43.85.97]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (4096 bits) server-digest SHA256) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4F6SBs5q71z9sR4 for ; Sat, 27 Mar 2021 03:30:44 +1100 (AEDT) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id BC1AE384402B; Fri, 26 Mar 2021 16:30:41 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org BC1AE384402B DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1616776241; bh=FkKsw2v6rUhH+hY1u8N6IxbPvvO2TyYqI7WOTw9Z6Ks=; h=Date:Subject:To:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:From; b=lp6DrWNsCVE6O9VcMexgoMIR1CdtZDuE85ihscYT5qHf80tnx4qeiwWNkGYz83cA+ ubQzv4THOMM92NRzbwwTmfFQ/PyFB5Y+QkTQmlrdUJZQJj2A9kn/Ir5Kn8ChfOFMZj Hw1/r1NFgQQ9uxCg+zuhUm0gyr1HOpDodpzY7k+k= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-lf1-x134.google.com (mail-lf1-x134.google.com [IPv6:2a00:1450:4864:20::134]) by sourceware.org (Postfix) with ESMTPS id 21DE53846075; Fri, 26 Mar 2021 16:30:37 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org 21DE53846075 Received: by mail-lf1-x134.google.com with SMTP id m12so8513149lfq.10; Fri, 26 Mar 2021 09:30:37 -0700 (PDT) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:mime-version:from:date:message-id:subject:to; bh=lUcL3VfjelGs3/Qz57NMIEcEiMULBzIrZ1JujUvx++4=; b=K3Yj3uU+AlecRQyQ3AYhZFQe/TXKsGpis6kSbvJPUsrYlrJi27GGb9DyBfudJ7lvxJ sUfP98VNihqlZdVoFOtngGIdxVkhHxkvlcuWLOt5Jvb0B4DR4lUbcbVmQ2VR1jYtERTk dZ36BepEGYrelivBQT2nZkZvwU91VRaMcko8gM2sP1xC4ICdEt7iL3SWnq36b/IHbfxb SFpTEKbKhCC2zFDCuXGTJrga+6Uz7YhuHo9c9Z2OLltlBa0n7Yh3UrwEGjByweh1flMr nceo+hx7IDrkUze0COpOwC8iuJ7GrUMXbBgIFKKoQNS9HCeLN4yesJb7uSlJNLG4iwdK lwWg== X-Gm-Message-State: AOAM532Oc3AmrEE1GAOy6C6DApmCdofNsCbCvnYyDrLbxu6zyMwaOy0N k84MRIELXj06bZVR++SuDWPvlGEGyg+ite6j/6hePdHu X-Google-Smtp-Source: ABdhPJzDDxYjLdX5uQsmrZwORSZjgMsxH2yZYP79onT+a6oPNWhuvrVNmhGGXwx14Fw+qihA1rToPSixSuj6yyBQdyM= X-Received: by 2002:a05:6512:1310:: with SMTP id x16mr8313326lfu.19.1616776235045; Fri, 26 Mar 2021 09:30:35 -0700 (PDT) MIME-Version: 1.0 Date: Fri, 26 Mar 2021 16:30:23 +0000 Message-ID: Subject: [Patch, fortran] 99307 - FAIL: gfortran.dg/class_assign_4.f90 execution test To: "fortran@gcc.gnu.org" , gcc-patches X-Spam-Status: No, score=-8.7 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, FREEMAIL_FROM, GIT_PATCH_0, HTML_MESSAGE, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.2 X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on server2.sourceware.org X-Content-Filtered-By: Mailman/MimeDel 2.1.29 X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-Patchwork-Original-From: Paul Richard Thomas via Gcc-patches From: Paul Richard Thomas Reply-To: Paul Richard Thomas Errors-To: gcc-patches-bounces@gcc.gnu.org Sender: "Gcc-patches" This patch comes in two versions: submit.diff with Change.Logs or submit2.diff with Change2.Logs. The first fixes the problem by changing array temporaries from class expressions into class temporaries. This permits the use of gfc_get_class_from_expr to obtain the vptr for these temporaries and all the good things that come with that when handling dynamic types. The second part of the fix is to use the array element length from the class descriptor, when reallocating on assignment. This is needed because the vptr is being set too early. I will set about trying to track down why this is happening and fix it after release. The second version does the same as the first but puts in place a load of tidying up that is permitted by the fix to class array temporaries. I couldn't readily see how to prepare a testcase - ideas? Both regtest on FC33/x86_64. The first was tested by Dominique (see the PR). OK for master? Regards Paul diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index be5eb89350f..ca90142530c 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -1403,9 +1403,6 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss, desc = gfc_create_var (type, "atmp"); GFC_DECL_PACKED_ARRAY (desc) = 1; - info->descriptor = desc; - size = gfc_index_one_node; - /* Emit a DECL_EXPR for the variable sized array type in GFC_TYPE_ARRAY_DATAPTR_TYPE so the gimplification of its type sizes works correctly. */ @@ -1416,9 +1413,40 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss, gfc_add_expr_to_block (pre, build1 (DECL_EXPR, arraytype, TYPE_NAME (arraytype))); - /* Fill in the array dtype. */ - tmp = gfc_conv_descriptor_dtype (desc); - gfc_add_modify (pre, tmp, gfc_get_dtype (TREE_TYPE (desc))); + if (class_expr != NULL_TREE) + { + tree class_data; + tree dtype; + + /* Create a class temporary. */ + tmp = gfc_create_var (TREE_TYPE (class_expr), "ctmp"); + gfc_add_modify (pre, tmp, class_expr); + + /* Assign the new descriptor to the _data field. This allows the + vptr _copy to be used for scalarized assignment since the class + temporary can be found from the descriptor. */ + class_data = gfc_class_data_get (tmp); + tmp = fold_build1_loc (input_location, VIEW_CONVERT_EXPR, + TREE_TYPE (desc), desc); + gfc_add_modify (pre, class_data, tmp); + + /* Take the dtype from the class expression. */ + dtype = gfc_conv_descriptor_dtype (gfc_class_data_get (class_expr)); + tmp = gfc_conv_descriptor_dtype (class_data); + gfc_add_modify (pre, tmp, dtype); + + /* Point desc to the class _data field. */ + desc = class_data; + } + else + { + /* Fill in the array dtype. */ + tmp = gfc_conv_descriptor_dtype (desc); + gfc_add_modify (pre, tmp, gfc_get_dtype (TREE_TYPE (desc))); + } + + info->descriptor = desc; + size = gfc_index_one_node; /* Fill in the bounds and stride. This is a packed array, so: @@ -3424,134 +3452,73 @@ conv_array_index_offset (gfc_se * se, gfc_ss * ss, int dim, int i, static bool build_class_array_ref (gfc_se *se, tree base, tree index) { - tree type; tree size; - tree offset; tree decl = NULL_TREE; tree tmp; gfc_expr *expr = se->ss->info->expr; - gfc_ref *ref; - gfc_ref *class_ref = NULL; + gfc_expr *class_expr; gfc_typespec *ts; + gfc_symbol *sym; - if (se->expr && DECL_P (se->expr) && DECL_LANG_SPECIFIC (se->expr) - && GFC_DECL_SAVED_DESCRIPTOR (se->expr) - && GFC_CLASS_TYPE_P (TREE_TYPE (GFC_DECL_SAVED_DESCRIPTOR (se->expr)))) - decl = se->expr; + tmp = !VAR_P (base) ? gfc_get_class_from_expr (base) : NULL_TREE; + + if (tmp != NULL_TREE) + decl = tmp; else { - if (expr == NULL + /* The base expression does not contain a class component, either + because it is a temporary array or array descriptor. Class + array functions are correctly resolved above. */ + if (!expr || (expr->ts.type != BT_CLASS - && !gfc_is_class_array_function (expr) && !gfc_is_class_array_ref (expr, NULL))) return false; - if (expr->symtree && expr->symtree->n.sym->ts.type == BT_CLASS) - ts = &expr->symtree->n.sym->ts; - else - ts = NULL; - - for (ref = expr->ref; ref; ref = ref->next) - { - if (ref->type == REF_COMPONENT - && ref->u.c.component->ts.type == BT_CLASS - && ref->next && ref->next->type == REF_COMPONENT - && strcmp (ref->next->u.c.component->name, "_data") == 0 - && ref->next->next - && ref->next->next->type == REF_ARRAY - && ref->next->next->u.ar.type != AR_ELEMENT) - { - ts = &ref->u.c.component->ts; - class_ref = ref; - break; - } - } + /* Obtain the expression for the class entity or component that is + followed by an array reference, which is not an element, so that + the span of the array can be obtained. */ + class_expr = gfc_find_and_cut_at_last_class_ref (expr, false, &ts); - if (ts == NULL) + if (!ts) return false; - } - if (class_ref == NULL && expr && expr->symtree->n.sym->attr.function - && expr->symtree->n.sym == expr->symtree->n.sym->result - && expr->symtree->n.sym->backend_decl == current_function_decl) - { - decl = gfc_get_fake_result_decl (expr->symtree->n.sym, 0); - } - else if (expr && gfc_is_class_array_function (expr)) - { - size = NULL_TREE; - decl = NULL_TREE; - for (tmp = base; tmp; tmp = TREE_OPERAND (tmp, 0)) - { - tree type; - type = TREE_TYPE (tmp); - while (type) - { - if (GFC_CLASS_TYPE_P (type)) - decl = tmp; - if (type != TYPE_CANONICAL (type)) - type = TYPE_CANONICAL (type); - else - type = NULL_TREE; - } - if (VAR_P (tmp)) - break; + sym = (!class_expr && expr) ? expr->symtree->n.sym : NULL; + if (sym && sym->attr.function + && sym == sym->result + && sym->backend_decl == current_function_decl) + /* The temporary is the data field of the class data component + of the current function. */ + decl = gfc_get_fake_result_decl (sym, 0); + else if (sym) + { + if (decl == NULL_TREE) + decl = expr->symtree->n.sym->backend_decl; + /* For class arrays the tree containing the class is stored in + GFC_DECL_SAVED_DESCRIPTOR of the sym's backend_decl. + For all others it's sym's backend_decl directly. */ + if (DECL_LANG_SPECIFIC (decl) && GFC_DECL_SAVED_DESCRIPTOR (decl)) + decl = GFC_DECL_SAVED_DESCRIPTOR (decl); } + else + decl = gfc_get_class_from_gfc_expr (class_expr); - if (decl == NULL_TREE) - return false; + if (POINTER_TYPE_P (TREE_TYPE (decl))) + decl = build_fold_indirect_ref_loc (input_location, decl); - se->class_vptr = gfc_evaluate_now (gfc_class_vptr_get (decl), &se->pre); - } - else if (class_ref == NULL) - { - if (decl == NULL_TREE) - decl = expr->symtree->n.sym->backend_decl; - /* For class arrays the tree containing the class is stored in - GFC_DECL_SAVED_DESCRIPTOR of the sym's backend_decl. - For all others it's sym's backend_decl directly. */ - if (DECL_LANG_SPECIFIC (decl) && GFC_DECL_SAVED_DESCRIPTOR (decl)) - decl = GFC_DECL_SAVED_DESCRIPTOR (decl); - } - else - { - /* Remove everything after the last class reference, convert the - expression and then recover its tailend once more. */ - gfc_se tmpse; - ref = class_ref->next; - class_ref->next = NULL; - gfc_init_se (&tmpse, NULL); - gfc_conv_expr (&tmpse, expr); - gfc_add_block_to_block (&se->pre, &tmpse.pre); - decl = tmpse.expr; - class_ref->next = ref; + if (!GFC_CLASS_TYPE_P (TREE_TYPE (decl))) + return false; } - if (POINTER_TYPE_P (TREE_TYPE (decl))) - decl = build_fold_indirect_ref_loc (input_location, decl); - - if (!GFC_CLASS_TYPE_P (TREE_TYPE (decl))) - return false; + se->class_vptr = gfc_evaluate_now (gfc_class_vptr_get (decl), &se->pre); size = gfc_class_vtab_size_get (decl); - /* For unlimited polymorphic entities then _len component needs to be multiplied with the size. */ size = gfc_resize_class_size_with_len (&se->pre, decl, size); - size = fold_convert (TREE_TYPE (index), size); - /* Build the address of the element. */ - type = TREE_TYPE (TREE_TYPE (base)); - offset = fold_build2_loc (input_location, MULT_EXPR, - gfc_array_index_type, - index, size); - tmp = gfc_build_addr_expr (pvoid_type_node, base); - tmp = fold_build_pointer_plus_loc (input_location, tmp, offset); - tmp = fold_convert (build_pointer_type (type), tmp); - /* Return the element in the se expression. */ - se->expr = build_fold_indirect_ref_loc (input_location, tmp); + se->expr = gfc_build_spanned_array_ref (base, index, size); return true; } @@ -10280,23 +10247,10 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, } else if (expr1->ts.type == BT_CLASS) { - tmp = expr1->rank ? gfc_get_class_from_expr (desc) : NULL_TREE; - if (tmp == NULL_TREE) - tmp = gfc_get_class_from_gfc_expr (expr1); - - if (tmp != NULL_TREE) - { - tmp2 = gfc_class_vptr_get (tmp); - cond = fold_build2_loc (input_location, NE_EXPR, - logical_type_node, tmp2, - build_int_cst (TREE_TYPE (tmp2), 0)); - elemsize1 = gfc_class_vtab_size_get (tmp); - elemsize1 = fold_build3_loc (input_location, COND_EXPR, - gfc_array_index_type, cond, - elemsize1, gfc_index_zero_node); - } - else - elemsize1 = TYPE_SIZE_UNIT (gfc_typenode_for_spec (&CLASS_DATA (expr1)->ts)); + /* Unfortunately, the lhs vptr is set too early in many cases. + Play it safe by using the descriptor element length. */ + tmp = gfc_conv_descriptor_elem_len (desc); + elemsize1 = fold_convert (gfc_array_index_type, tmp); } else elemsize1 = NULL_TREE; @@ -10770,11 +10724,11 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, /* We already set the dtype in the case of deferred character - length arrays and unlimited polymorphic arrays. */ + length arrays and class lvalues. */ if (!(GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)) && ((expr1->ts.type == BT_CHARACTER && expr1->ts.deferred) || coarray)) - && !UNLIMITED_POLY (expr1)) + && expr1->ts.type != BT_CLASS) { tmp = gfc_conv_descriptor_dtype (desc); gfc_add_modify (&alloc_block, tmp, gfc_get_dtype (TREE_TYPE (desc))); diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index f6ef5c023bf..2e4b4808e08 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -385,10 +385,13 @@ gfc_vptr_size_get (tree vptr) to class.c::gfc_add_component_ref (), is there a significant difference: gfc_add_component_ref () concentrates on an array ref to be the last ref in the chain. This routine is oblivious to the kind - of refs following. */ + of refs following. If ts is non-null the cut is at the class entity + or component that is followed by an array reference, which is not + an element. */ gfc_expr * -gfc_find_and_cut_at_last_class_ref (gfc_expr *e, bool is_mold) +gfc_find_and_cut_at_last_class_ref (gfc_expr *e, bool is_mold, + gfc_typespec **ts) { gfc_expr *base_expr; gfc_ref *ref, *class_ref, *tail = NULL, *array_ref; @@ -396,8 +399,34 @@ gfc_find_and_cut_at_last_class_ref (gfc_expr *e, bool is_mold) /* Find the last class reference. */ class_ref = NULL; array_ref = NULL; + + if (ts) + { + if (e->symtree + && e->symtree->n.sym->ts.type == BT_CLASS) + *ts = &e->symtree->n.sym->ts; + else + *ts = NULL; + } + for (ref = e->ref; ref; ref = ref->next) { + if (ts && ref->type == REF_COMPONENT + && ref->u.c.component->ts.type == BT_CLASS + && ref->next && ref->next->type == REF_COMPONENT + && strcmp (ref->next->u.c.component->name, "_data") == 0 + && ref->next->next + && ref->next->next->type == REF_ARRAY + && ref->next->next->u.ar.type != AR_ELEMENT) + { + *ts = &ref->u.c.component->ts; + class_ref = ref; + break; + } + + if (ts && *ts == NULL) + return NULL; + if (ref->type == REF_ARRAY && ref->u.ar.type != AR_ELEMENT) array_ref = ref; @@ -9983,17 +10012,20 @@ gfc_trans_scalar_assign (gfc_se * lse, gfc_se * rse, gfc_typespec ts, gfc_add_modify (&block, lse->expr, tmp); } /* If possible use the rhs vptr copy with trans_scalar_class_assign.... */ - else if (ts.type == BT_CLASS - && !trans_scalar_class_assign (&block, lse, rse)) + else if (ts.type == BT_CLASS) { gfc_add_block_to_block (&block, &lse->pre); gfc_add_block_to_block (&block, &rse->pre); - /* ...otherwise assignment suffices. Note the use of VIEW_CONVERT_EXPR - for the lhs which ensures that class data rhs cast as a string assigns - correctly. */ - tmp = fold_build1_loc (input_location, VIEW_CONVERT_EXPR, - TREE_TYPE (rse->expr), lse->expr); - gfc_add_modify (&block, tmp, rse->expr); + + if (!trans_scalar_class_assign (&block, lse, rse)) + { + /* ...otherwise assignment suffices. Note the use of VIEW_CONVERT_EXPR + for the lhs which ensures that class data rhs cast as a string assigns + correctly. */ + tmp = fold_build1_loc (input_location, VIEW_CONVERT_EXPR, + TREE_TYPE (rse->expr), lse->expr); + gfc_add_modify (&block, tmp, rse->expr); + } } else if (ts.type != BT_CLASS) { diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c index ab53fc5f441..9e8e8619ff8 100644 --- a/gcc/fortran/trans.c +++ b/gcc/fortran/trans.c @@ -422,6 +422,9 @@ get_array_span (tree type, tree decl) return NULL_TREE; } span = gfc_class_vtab_size_get (decl); + /* For unlimited polymorphic entities then _len component needs + to be multiplied with the size. */ + span = gfc_resize_class_size_with_len (NULL, decl, span); } else if (GFC_DECL_PTR_ARRAY_P (decl)) { @@ -439,13 +442,31 @@ get_array_span (tree type, tree decl) } +tree +gfc_build_spanned_array_ref (tree base, tree offset, tree span) +{ + tree type; + tree tmp; + type = TREE_TYPE (TREE_TYPE (base)); + offset = fold_build2_loc (input_location, MULT_EXPR, + gfc_array_index_type, + offset, span); + tmp = gfc_build_addr_expr (pvoid_type_node, base); + tmp = fold_build_pointer_plus_loc (input_location, tmp, offset); + tmp = fold_convert (build_pointer_type (type), tmp); + if ((TREE_CODE (type) != INTEGER_TYPE && TREE_CODE (type) != ARRAY_TYPE) + || !TYPE_STRING_FLAG (type)) + tmp = build_fold_indirect_ref_loc (input_location, tmp); + return tmp; +} + + /* Build an ARRAY_REF with its natural type. */ tree gfc_build_array_ref (tree base, tree offset, tree decl, tree vptr) { tree type = TREE_TYPE (base); - tree tmp; tree span = NULL_TREE; if (GFC_ARRAY_TYPE_P (type) && GFC_TYPE_ARRAY_RANK (type) == 0) @@ -488,18 +509,7 @@ gfc_build_array_ref (tree base, tree offset, tree decl, tree vptr) /* If a non-null span has been generated reference the element with pointer arithmetic. */ if (span != NULL_TREE) - { - offset = fold_build2_loc (input_location, MULT_EXPR, - gfc_array_index_type, - offset, span); - tmp = gfc_build_addr_expr (pvoid_type_node, base); - tmp = fold_build_pointer_plus_loc (input_location, tmp, offset); - tmp = fold_convert (build_pointer_type (type), tmp); - if ((TREE_CODE (type) != INTEGER_TYPE && TREE_CODE (type) != ARRAY_TYPE) - || !TYPE_STRING_FLAG (type)) - tmp = build_fold_indirect_ref_loc (input_location, tmp); - return tmp; - } + return gfc_build_spanned_array_ref (base, offset, span); /* Otherwise use a straightforward array reference. */ else return build4_loc (input_location, ARRAY_REF, type, base, offset, diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 44cbfb63f39..8c6f82ff1b1 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -424,7 +424,8 @@ tree gfc_class_vptr_get (tree); tree gfc_class_len_get (tree); tree gfc_class_len_or_zero_get (tree); tree gfc_resize_class_size_with_len (stmtblock_t *, tree, tree); -gfc_expr * gfc_find_and_cut_at_last_class_ref (gfc_expr *, bool is_mold = false); +gfc_expr * gfc_find_and_cut_at_last_class_ref (gfc_expr *, bool is_mold = false, + gfc_typespec **ts = NULL); /* Get an accessor to the class' vtab's * field, when a class handle is available. */ tree gfc_class_vtab_hash_get (tree); @@ -622,6 +623,9 @@ tree gfc_build_addr_expr (tree, tree); /* Build an ARRAY_REF. */ tree gfc_build_array_ref (tree, tree, tree, tree vptr = NULL_TREE); +/* Build an array ref using pointer arithmetic. */ +tree gfc_build_spanned_array_ref (tree base, tree offset, tree span); + /* Creates a label. Decl is artificial if label_id == NULL_TREE. */ tree gfc_build_label_decl (tree);