From patchwork Wed Dec 4 13:37:55 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 1204186 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=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-515128-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="e7hwlYag"; dkim-atps=neutral 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 47Sg0W0mG8z9s4Y for ; Thu, 5 Dec 2019 00:38:17 +1100 (AEDT) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:to :from:subject:message-id:date:mime-version:content-type; q=dns; s=default; b=i6S+096niVyGZNTFg+tR1Eo8qDt0MsvcF4zpEW+dG1b2CEZ5Px XV5ppSK3jrrUODbnhz/+QOOWsVv1PVAI6XH425okBaH1gwHNb9xfyFoa3u61rSKJ YrATQByNTnRoBFv6jAfkl6isB9ObvPMwdB6lWgCpNxA/Byw5A9uaTjcAo= 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:to :from:subject:message-id:date:mime-version:content-type; s= default; bh=QA+ln4rbrLZ0panVxcoWL39Ws/o=; b=e7hwlYagdguGqngrs4ww a7vSm2OV07/Bd8v6MNMp10hXbN5BmULXRid5S1vCzvJuD7ryZj0+dP5cNf2yX6eT Y0qV4HtjwpBb9/GYcgW6XKHYGN4WNUldR86mdrE98Pk/z8hGRgsxpt57hXS/wafx Uap3BRCsWqYMlEWGpgtevRs= Received: (qmail 97583 invoked by alias); 4 Dec 2019 13:38:08 -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 97556 invoked by uid 89); 4 Dec 2019 13:38:08 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-20.3 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_0, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3 autolearn=ham version=3.3.1 spammy=msgid, gang, fold_convert X-HELO: esa4.mentor.iphmx.com Received: from esa4.mentor.iphmx.com (HELO esa4.mentor.iphmx.com) (68.232.137.252) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Wed, 04 Dec 2019 13:38:04 +0000 IronPort-SDR: q10d3BHvObHZuN+KoM3tyPUFtFOeDztLVPOf/s3FN+7WGNR8l362RFqiAgf6EydvGOY2jxQ47G wucYEQ2/dxsCbE4PLDKvKvVe6VpCNiEU/Kkc7CMLnWZQooi5IDb7hVP+jvDKosP31a9o73x1bs d8kPI3l/3GW3utRqY2OKkhh9sjq4/r11Z9nf8TfRDzXYKR5UhrhFOI7wtdpe6TOIQtgLWPs+Bw cEbmp3wrYiQmJBK43Pbxt5XrPafLr51y09byOmVpIA7Mg4JqWFgU2YdJlo18Q23vKeljbYlsdc 6VA= Received: from orw-gwy-02-in.mentorg.com ([192.94.38.167]) by esa4.mentor.iphmx.com with ESMTP; 04 Dec 2019 05:38:02 -0800 IronPort-SDR: DQ1AwvgPr0rc9e0x3QjizFvH3Le0ugUuEpXSH5fBwSlFZkPfOkkSvGtQbofE5xb2XHqt2SQFHJ VponbdB603f6s1hWDDQQZE8UqNIgPmQfZ94KfLldXH/6MyTnkFzur4CUs1nctoxbfXRky1fAes XqFRDdjxVRvcB4/8V9l6LZu/PZ7/l6Rro4ihHLYHPe2xblo4ycOJEmZUTwv8k8psRqO3uua1AP VXFpVkCir8vj45vOBmX9tlC8U7iRZ6qfrCVcTfp/6E/jzIk7TfAjw0RW12a0YnnubUcopgE505 ABk= To: gcc-patches , fortran From: Tobias Burnus Subject: [Patch, Fortran] PR 92793 - fix column used for error diagnostic Message-ID: <2f70a48d-ba2e-bc37-314b-7758a9ac1e0a@codesourcery.com> Date: Wed, 4 Dec 2019 14:37:55 +0100 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:68.0) Gecko/20100101 Thunderbird/68.2.2 MIME-Version: 1.0 X-IsSubscribed: yes As reported internally by Frederik, gfortran currently passes LOCATION_COLUMN == 0 to the middle end. The reason for that is how parsing works – gfortran reads the input line by line. For internal error diagnostic (fortran/error.c), the column location was corrected –  but not for locations passed to the middle end. Hence, the diagnostic there wasn't optimal. Fixed by introducing a new function; now one only needs to make sure that no new code will re-introduce "lb->location" :-) Build and regtested on x86-64-gnu-linux. OK for the trunk? Tobias 2019-12-04 Tobias Burnus PR fortran/92793 * trans.c (gfc_get_location): Declare. * trans.c (gfc_get_location): Define; returns column-corrected location. (trans_runtime_error_vararg, gfc_trans_runtime_check, gfc_generate_module_code): Use new function. * trans-array.c (gfc_trans_auto_array_allocation): Likewise. * trans-common.c (build_field, get_init_field, create_common): Likewise. * trans-decl.c (gfc_build_label_decl, gfc_get_symbol_decl): Likewise. * trans-openmp.c (gfc_trans_omp_reduction_list, gfc_trans_omp_clauses): Likewise. * trans-stmt.c (gfc_trans_if_1): Likewise. gcc/fortran/trans-array.c | 4 +- gcc/fortran/trans-common.c | 6 +-- gcc/fortran/trans-decl.c | 4 +- gcc/fortran/trans-openmp.c | 103 +++++++++++++++++++++++---------------------- gcc/fortran/trans-stmt.c | 19 +++++---- gcc/fortran/trans.c | 22 +++++++--- gcc/fortran/trans.h | 4 ++ 7 files changed, 91 insertions(+), 71 deletions(-) diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 685f8c5a874..3bae49d85db 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -6364,7 +6364,7 @@ gfc_trans_auto_array_allocation (tree decl, gfc_symbol * sym, if (flag_stack_arrays) { gcc_assert (TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE); - space = build_decl (sym->declared_at.lb->location, + space = build_decl (gfc_get_location (&sym->declared_at), VAR_DECL, create_tmp_var_name ("A"), TREE_TYPE (TREE_TYPE (decl))); gfc_trans_vla_type_sizes (sym, &init); @@ -6406,7 +6406,7 @@ gfc_trans_auto_array_allocation (tree decl, gfc_symbol * sym, tmp = fold_build1_loc (input_location, DECL_EXPR, TREE_TYPE (space), space); gfc_add_expr_to_block (&init, tmp); - addr = fold_build1_loc (sym->declared_at.lb->location, + addr = fold_build1_loc (gfc_get_location (&sym->declared_at), ADDR_EXPR, TREE_TYPE (decl), space); gfc_add_modify (&init, decl, addr); gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE); diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c index 18ad60fd657..95d6395470c 100644 --- a/gcc/fortran/trans-common.c +++ b/gcc/fortran/trans-common.c @@ -282,7 +282,7 @@ build_field (segment_info *h, tree union_type, record_layout_info rli) unsigned HOST_WIDE_INT desired_align, known_align; name = get_identifier (h->sym->name); - field = build_decl (h->sym->declared_at.lb->location, + field = build_decl (gfc_get_location (&h->sym->declared_at), FIELD_DECL, name, h->field); known_align = (offset & -offset) * BITS_PER_UNIT; if (known_align == 0 || known_align > BIGGEST_ALIGNMENT) @@ -559,7 +559,7 @@ get_init_field (segment_info *head, tree union_type, tree *field_init, tmp = build_range_type (gfc_array_index_type, gfc_index_zero_node, tmp); tmp = build_array_type (type, tmp); - field = build_decl (gfc_current_locus.lb->location, + field = build_decl (gfc_get_location (&gfc_current_locus), FIELD_DECL, NULL_TREE, tmp); known_align = BIGGEST_ALIGNMENT; @@ -711,7 +711,7 @@ create_common (gfc_common_head *com, segment_info *head, bool saw_equiv) { tree var_decl; - var_decl = build_decl (s->sym->declared_at.lb->location, + var_decl = build_decl (gfc_get_location (&s->sym->declared_at), VAR_DECL, DECL_NAME (s->field), TREE_TYPE (s->field)); TREE_STATIC (var_decl) = TREE_STATIC (decl); diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index e7424477427..8a5ce39acab 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -307,7 +307,7 @@ gfc_build_label_decl (tree label_id) void gfc_set_decl_location (tree decl, locus * loc) { - DECL_SOURCE_LOCATION (decl) = loc->lb->location; + DECL_SOURCE_LOCATION (decl) = gfc_get_location (loc); } @@ -1757,7 +1757,7 @@ gfc_get_symbol_decl (gfc_symbol * sym) } /* Create the decl for the variable. */ - decl = build_decl (sym->declared_at.lb->location, + decl = build_decl (gfc_get_location (&sym->declared_at), VAR_DECL, gfc_sym_identifier (sym), gfc_sym_type (sym)); /* Add attributes to variables. Functions are handled elsewhere. */ diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index 3a4f96222cb..440d59dcd0b 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -1854,7 +1854,7 @@ gfc_trans_omp_reduction_list (gfc_omp_namelist *namelist, tree list, tree t = gfc_trans_omp_variable (namelist->sym, false); if (t != error_mark_node) { - tree node = build_omp_clause (where.lb->location, + tree node = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_REDUCTION); OMP_CLAUSE_DECL (node) = t; if (mark_addressable) @@ -2596,7 +2596,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, if_var = gfc_evaluate_now (se.expr, block); gfc_add_block_to_block (block, &se.post); - c = build_omp_clause (where.lb->location, OMP_CLAUSE_IF); + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_IF); OMP_CLAUSE_IF_MODIFIER (c) = ERROR_MARK; OMP_CLAUSE_IF_EXPR (c) = if_var; omp_clauses = gfc_trans_add_clause (c, omp_clauses); @@ -2612,7 +2612,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, if_var = gfc_evaluate_now (se.expr, block); gfc_add_block_to_block (block, &se.post); - c = build_omp_clause (where.lb->location, OMP_CLAUSE_IF); + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_IF); switch (ifc) { case OMP_IF_PARALLEL: @@ -2656,7 +2656,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, final_var = gfc_evaluate_now (se.expr, block); gfc_add_block_to_block (block, &se.post); - c = build_omp_clause (where.lb->location, OMP_CLAUSE_FINAL); + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_FINAL); OMP_CLAUSE_FINAL_EXPR (c) = final_var; omp_clauses = gfc_trans_add_clause (c, omp_clauses); } @@ -2671,7 +2671,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, num_threads = gfc_evaluate_now (se.expr, block); gfc_add_block_to_block (block, &se.post); - c = build_omp_clause (where.lb->location, OMP_CLAUSE_NUM_THREADS); + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NUM_THREADS); OMP_CLAUSE_NUM_THREADS_EXPR (c) = num_threads; omp_clauses = gfc_trans_add_clause (c, omp_clauses); } @@ -2688,7 +2688,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, if (clauses->sched_kind != OMP_SCHED_NONE) { - c = build_omp_clause (where.lb->location, OMP_CLAUSE_SCHEDULE); + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SCHEDULE); OMP_CLAUSE_SCHEDULE_CHUNK_EXPR (c) = chunk_size; switch (clauses->sched_kind) { @@ -2725,7 +2725,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, if (clauses->default_sharing != OMP_DEFAULT_UNKNOWN) { - c = build_omp_clause (where.lb->location, OMP_CLAUSE_DEFAULT); + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_DEFAULT); switch (clauses->default_sharing) { case OMP_DEFAULT_NONE: @@ -2751,13 +2751,13 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, if (clauses->nowait) { - c = build_omp_clause (where.lb->location, OMP_CLAUSE_NOWAIT); + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NOWAIT); omp_clauses = gfc_trans_add_clause (c, omp_clauses); } if (clauses->ordered) { - c = build_omp_clause (where.lb->location, OMP_CLAUSE_ORDERED); + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_ORDERED); OMP_CLAUSE_ORDERED_EXPR (c) = clauses->orderedc ? build_int_cst (integer_type_node, clauses->orderedc) : NULL_TREE; @@ -2766,19 +2766,19 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, if (clauses->untied) { - c = build_omp_clause (where.lb->location, OMP_CLAUSE_UNTIED); + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_UNTIED); omp_clauses = gfc_trans_add_clause (c, omp_clauses); } if (clauses->mergeable) { - c = build_omp_clause (where.lb->location, OMP_CLAUSE_MERGEABLE); + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_MERGEABLE); omp_clauses = gfc_trans_add_clause (c, omp_clauses); } if (clauses->collapse) { - c = build_omp_clause (where.lb->location, OMP_CLAUSE_COLLAPSE); + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_COLLAPSE); OMP_CLAUSE_COLLAPSE_EXPR (c) = build_int_cst (integer_type_node, clauses->collapse); omp_clauses = gfc_trans_add_clause (c, omp_clauses); @@ -2786,13 +2786,13 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, if (clauses->inbranch) { - c = build_omp_clause (where.lb->location, OMP_CLAUSE_INBRANCH); + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_INBRANCH); omp_clauses = gfc_trans_add_clause (c, omp_clauses); } if (clauses->notinbranch) { - c = build_omp_clause (where.lb->location, OMP_CLAUSE_NOTINBRANCH); + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NOTINBRANCH); omp_clauses = gfc_trans_add_clause (c, omp_clauses); } @@ -2801,26 +2801,26 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, case OMP_CANCEL_UNKNOWN: break; case OMP_CANCEL_PARALLEL: - c = build_omp_clause (where.lb->location, OMP_CLAUSE_PARALLEL); + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_PARALLEL); omp_clauses = gfc_trans_add_clause (c, omp_clauses); break; case OMP_CANCEL_SECTIONS: - c = build_omp_clause (where.lb->location, OMP_CLAUSE_SECTIONS); + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SECTIONS); omp_clauses = gfc_trans_add_clause (c, omp_clauses); break; case OMP_CANCEL_DO: - c = build_omp_clause (where.lb->location, OMP_CLAUSE_FOR); + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_FOR); omp_clauses = gfc_trans_add_clause (c, omp_clauses); break; case OMP_CANCEL_TASKGROUP: - c = build_omp_clause (where.lb->location, OMP_CLAUSE_TASKGROUP); + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_TASKGROUP); omp_clauses = gfc_trans_add_clause (c, omp_clauses); break; } if (clauses->proc_bind != OMP_PROC_BIND_UNKNOWN) { - c = build_omp_clause (where.lb->location, OMP_CLAUSE_PROC_BIND); + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_PROC_BIND); switch (clauses->proc_bind) { case OMP_PROC_BIND_MASTER: @@ -2848,7 +2848,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, safelen_var = gfc_evaluate_now (se.expr, block); gfc_add_block_to_block (block, &se.post); - c = build_omp_clause (where.lb->location, OMP_CLAUSE_SAFELEN); + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SAFELEN); OMP_CLAUSE_SAFELEN_EXPR (c) = safelen_var; omp_clauses = gfc_trans_add_clause (c, omp_clauses); } @@ -2857,7 +2857,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, { if (declare_simd) { - c = build_omp_clause (where.lb->location, OMP_CLAUSE_SIMDLEN); + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SIMDLEN); OMP_CLAUSE_SIMDLEN_EXPR (c) = gfc_conv_constant_to_tree (clauses->simdlen_expr); omp_clauses = gfc_trans_add_clause (c, omp_clauses); @@ -2872,7 +2872,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, simdlen_var = gfc_evaluate_now (se.expr, block); gfc_add_block_to_block (block, &se.post); - c = build_omp_clause (where.lb->location, OMP_CLAUSE_SIMDLEN); + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SIMDLEN); OMP_CLAUSE_SIMDLEN_EXPR (c) = simdlen_var; omp_clauses = gfc_trans_add_clause (c, omp_clauses); } @@ -2888,7 +2888,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, num_teams = gfc_evaluate_now (se.expr, block); gfc_add_block_to_block (block, &se.post); - c = build_omp_clause (where.lb->location, OMP_CLAUSE_NUM_TEAMS); + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NUM_TEAMS); OMP_CLAUSE_NUM_TEAMS_EXPR (c) = num_teams; omp_clauses = gfc_trans_add_clause (c, omp_clauses); } @@ -2903,7 +2903,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, device = gfc_evaluate_now (se.expr, block); gfc_add_block_to_block (block, &se.post); - c = build_omp_clause (where.lb->location, OMP_CLAUSE_DEVICE); + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_DEVICE); OMP_CLAUSE_DEVICE_ID (c) = device; omp_clauses = gfc_trans_add_clause (c, omp_clauses); } @@ -2918,7 +2918,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, thread_limit = gfc_evaluate_now (se.expr, block); gfc_add_block_to_block (block, &se.post); - c = build_omp_clause (where.lb->location, OMP_CLAUSE_THREAD_LIMIT); + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_THREAD_LIMIT); OMP_CLAUSE_THREAD_LIMIT_EXPR (c) = thread_limit; omp_clauses = gfc_trans_add_clause (c, omp_clauses); } @@ -2935,7 +2935,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, if (clauses->dist_sched_kind != OMP_SCHED_NONE) { - c = build_omp_clause (where.lb->location, OMP_CLAUSE_DIST_SCHEDULE); + c = build_omp_clause (gfc_get_location (&where), + OMP_CLAUSE_DIST_SCHEDULE); OMP_CLAUSE_DIST_SCHEDULE_CHUNK_EXPR (c) = chunk_size; omp_clauses = gfc_trans_add_clause (c, omp_clauses); } @@ -2950,7 +2951,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, grainsize = gfc_evaluate_now (se.expr, block); gfc_add_block_to_block (block, &se.post); - c = build_omp_clause (where.lb->location, OMP_CLAUSE_GRAINSIZE); + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_GRAINSIZE); OMP_CLAUSE_GRAINSIZE_EXPR (c) = grainsize; omp_clauses = gfc_trans_add_clause (c, omp_clauses); } @@ -2965,7 +2966,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, num_tasks = gfc_evaluate_now (se.expr, block); gfc_add_block_to_block (block, &se.post); - c = build_omp_clause (where.lb->location, OMP_CLAUSE_NUM_TASKS); + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NUM_TASKS); OMP_CLAUSE_NUM_TASKS_EXPR (c) = num_tasks; omp_clauses = gfc_trans_add_clause (c, omp_clauses); } @@ -2980,7 +2981,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, priority = gfc_evaluate_now (se.expr, block); gfc_add_block_to_block (block, &se.post); - c = build_omp_clause (where.lb->location, OMP_CLAUSE_PRIORITY); + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_PRIORITY); OMP_CLAUSE_PRIORITY_EXPR (c) = priority; omp_clauses = gfc_trans_add_clause (c, omp_clauses); } @@ -2995,43 +2996,43 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, hint = gfc_evaluate_now (se.expr, block); gfc_add_block_to_block (block, &se.post); - c = build_omp_clause (where.lb->location, OMP_CLAUSE_HINT); + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_HINT); OMP_CLAUSE_HINT_EXPR (c) = hint; omp_clauses = gfc_trans_add_clause (c, omp_clauses); } if (clauses->simd) { - c = build_omp_clause (where.lb->location, OMP_CLAUSE_SIMD); + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SIMD); omp_clauses = gfc_trans_add_clause (c, omp_clauses); } if (clauses->threads) { - c = build_omp_clause (where.lb->location, OMP_CLAUSE_THREADS); + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_THREADS); omp_clauses = gfc_trans_add_clause (c, omp_clauses); } if (clauses->nogroup) { - c = build_omp_clause (where.lb->location, OMP_CLAUSE_NOGROUP); + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NOGROUP); omp_clauses = gfc_trans_add_clause (c, omp_clauses); } if (clauses->defaultmap) { - c = build_omp_clause (where.lb->location, OMP_CLAUSE_DEFAULTMAP); + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_DEFAULTMAP); OMP_CLAUSE_DEFAULTMAP_SET_KIND (c, OMP_CLAUSE_DEFAULTMAP_TOFROM, OMP_CLAUSE_DEFAULTMAP_CATEGORY_SCALAR); omp_clauses = gfc_trans_add_clause (c, omp_clauses); } if (clauses->depend_source) { - c = build_omp_clause (where.lb->location, OMP_CLAUSE_DEPEND); + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_DEPEND); OMP_CLAUSE_DEPEND_KIND (c) = OMP_CLAUSE_DEPEND_SOURCE; omp_clauses = gfc_trans_add_clause (c, omp_clauses); } if (clauses->async) { - c = build_omp_clause (where.lb->location, OMP_CLAUSE_ASYNC); + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_ASYNC); if (clauses->async_expr) OMP_CLAUSE_ASYNC_EXPR (c) = gfc_convert_expr_to_tree (block, clauses->async_expr); @@ -3041,27 +3042,27 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, } if (clauses->seq) { - c = build_omp_clause (where.lb->location, OMP_CLAUSE_SEQ); + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SEQ); omp_clauses = gfc_trans_add_clause (c, omp_clauses); } if (clauses->par_auto) { - c = build_omp_clause (where.lb->location, OMP_CLAUSE_AUTO); + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_AUTO); omp_clauses = gfc_trans_add_clause (c, omp_clauses); } if (clauses->if_present) { - c = build_omp_clause (where.lb->location, OMP_CLAUSE_IF_PRESENT); + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_IF_PRESENT); omp_clauses = gfc_trans_add_clause (c, omp_clauses); } if (clauses->finalize) { - c = build_omp_clause (where.lb->location, OMP_CLAUSE_FINALIZE); + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_FINALIZE); omp_clauses = gfc_trans_add_clause (c, omp_clauses); } if (clauses->independent) { - c = build_omp_clause (where.lb->location, OMP_CLAUSE_INDEPENDENT); + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_INDEPENDENT); omp_clauses = gfc_trans_add_clause (c, omp_clauses); } if (clauses->wait_list) @@ -3070,7 +3071,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, for (el = clauses->wait_list; el; el = el->next) { - c = build_omp_clause (where.lb->location, OMP_CLAUSE_WAIT); + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_WAIT); OMP_CLAUSE_DECL (c) = gfc_convert_expr_to_tree (block, el->expr); OMP_CLAUSE_CHAIN (c) = omp_clauses; omp_clauses = c; @@ -3080,7 +3081,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, { tree num_gangs_var = gfc_convert_expr_to_tree (block, clauses->num_gangs_expr); - c = build_omp_clause (where.lb->location, OMP_CLAUSE_NUM_GANGS); + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NUM_GANGS); OMP_CLAUSE_NUM_GANGS_EXPR (c) = num_gangs_var; omp_clauses = gfc_trans_add_clause (c, omp_clauses); } @@ -3088,7 +3089,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, { tree num_workers_var = gfc_convert_expr_to_tree (block, clauses->num_workers_expr); - c = build_omp_clause (where.lb->location, OMP_CLAUSE_NUM_WORKERS); + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NUM_WORKERS); OMP_CLAUSE_NUM_WORKERS_EXPR (c) = num_workers_var; omp_clauses = gfc_trans_add_clause (c, omp_clauses); } @@ -3096,7 +3097,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, { tree vector_length_var = gfc_convert_expr_to_tree (block, clauses->vector_length_expr); - c = build_omp_clause (where.lb->location, OMP_CLAUSE_VECTOR_LENGTH); + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_VECTOR_LENGTH); OMP_CLAUSE_VECTOR_LENGTH_EXPR (c) = vector_length_var; omp_clauses = gfc_trans_add_clause (c, omp_clauses); } @@ -3110,7 +3111,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, for (el = clauses->tile_list; el; el = el->next) vec_safe_push (tvec, gfc_convert_expr_to_tree (block, el->expr)); - c = build_omp_clause (where.lb->location, OMP_CLAUSE_TILE); + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_TILE); OMP_CLAUSE_TILE_LIST (c) = build_tree_list_vec (tvec); omp_clauses = gfc_trans_add_clause (c, omp_clauses); tvec->truncate (0); @@ -3121,13 +3122,13 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, { tree vector_var = gfc_convert_expr_to_tree (block, clauses->vector_expr); - c = build_omp_clause (where.lb->location, OMP_CLAUSE_VECTOR); + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_VECTOR); OMP_CLAUSE_VECTOR_EXPR (c) = vector_var; omp_clauses = gfc_trans_add_clause (c, omp_clauses); } else { - c = build_omp_clause (where.lb->location, OMP_CLAUSE_VECTOR); + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_VECTOR); omp_clauses = gfc_trans_add_clause (c, omp_clauses); } } @@ -3137,20 +3138,20 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, { tree worker_var = gfc_convert_expr_to_tree (block, clauses->worker_expr); - c = build_omp_clause (where.lb->location, OMP_CLAUSE_WORKER); + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_WORKER); OMP_CLAUSE_WORKER_EXPR (c) = worker_var; omp_clauses = gfc_trans_add_clause (c, omp_clauses); } else { - c = build_omp_clause (where.lb->location, OMP_CLAUSE_WORKER); + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_WORKER); omp_clauses = gfc_trans_add_clause (c, omp_clauses); } } if (clauses->gang) { tree arg; - c = build_omp_clause (where.lb->location, OMP_CLAUSE_GANG); + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_GANG); omp_clauses = gfc_trans_add_clause (c, omp_clauses); if (clauses->gang_num_expr) { diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index bce353eafe9..3275cb4858c 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -1454,7 +1454,8 @@ gfc_trans_if_1 (gfc_code * code) elsestmt = build_empty_stmt (input_location); /* Build the condition expression and add it to the condition block. */ - loc = code->expr1->where.lb ? code->expr1->where.lb->location : input_location; + loc = code->expr1->where.lb ? gfc_get_location (&code->expr1->where) + : input_location; stmt = fold_build3_loc (loc, COND_EXPR, void_type_node, if_se.expr, stmt, elsestmt); @@ -2328,7 +2329,7 @@ gfc_trans_simple_do (gfc_code * code, stmtblock_t *pblock, tree dovar, type = TREE_TYPE (dovar); bool is_step_positive = tree_int_cst_sgn (step) > 0; - loc = code->ext.iterator->start->where.lb->location; + loc = gfc_get_location (&code->ext.iterator->start->where); /* Initialize the DO variable: dovar = from. */ gfc_add_modify_loc (loc, pblock, dovar, @@ -2507,7 +2508,7 @@ gfc_trans_do (gfc_code * code, tree exit_cond) gfc_start_block (&block); - loc = code->ext.iterator->start->where.lb->location; + loc = gfc_get_location (&code->ext.iterator->start->where); /* Evaluate all the expressions in the iterator. */ gfc_init_se (&se, NULL); @@ -2801,15 +2802,17 @@ gfc_trans_do_while (gfc_code * code) gfc_init_se (&cond, NULL); gfc_conv_expr_val (&cond, code->expr1); gfc_add_block_to_block (&block, &cond.pre); - cond.expr = fold_build1_loc (code->expr1->where.lb->location, - TRUTH_NOT_EXPR, TREE_TYPE (cond.expr), cond.expr); + cond.expr = fold_build1_loc (gfc_get_location (&code->expr1->where), + TRUTH_NOT_EXPR, TREE_TYPE (cond.expr), + cond.expr); /* Build "IF (! cond) GOTO exit_label". */ tmp = build1_v (GOTO_EXPR, exit_label); TREE_USED (exit_label) = 1; - tmp = fold_build3_loc (code->expr1->where.lb->location, COND_EXPR, + tmp = fold_build3_loc (gfc_get_location (&code->expr1->where), COND_EXPR, void_type_node, cond.expr, tmp, - build_empty_stmt (code->expr1->where.lb->location)); + build_empty_stmt (gfc_get_location ( + &code->expr1->where))); gfc_add_expr_to_block (&block, tmp); /* The main body of the loop. */ @@ -2828,7 +2831,7 @@ gfc_trans_do_while (gfc_code * code) gfc_init_block (&block); /* Build the loop. */ - tmp = fold_build1_loc (code->expr1->where.lb->location, LOOP_EXPR, + tmp = fold_build1_loc (gfc_get_location (&code->expr1->where), LOOP_EXPR, void_type_node, tmp); gfc_add_expr_to_block (&block, tmp); diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c index d9b278199b7..70c7e2d7ecd 100644 --- a/gcc/fortran/trans.c +++ b/gcc/fortran/trans.c @@ -48,6 +48,18 @@ const char gfc_msg_fault[] = N_("Array reference out of bounds"); const char gfc_msg_wrong_return[] = N_("Incorrect function return value"); +/* Return a location_t suitable for 'tree' for a gfortran locus. The way the + parser works in gfortran, loc->lb->location contains only the line number + and LOCATION_COLUMN is 0; hence, the column has to be added when generating + locations for 'tree'. Cf. error.c's gfc_format_decoder. */ + +location_t +gfc_get_location (locus *loc) +{ + return linemap_position_for_loc_and_offset (line_table, loc->lb->location, + loc->nextc - loc->lb->line); +} + /* Advance along TREE_CHAIN n times. */ tree @@ -503,7 +515,7 @@ trans_runtime_error_vararg (tree errorfunc, locus* where, const char* msgid, irectly. */ fntype = TREE_TYPE (errorfunc); - loc = where ? where->lb->location : input_location; + loc = where ? gfc_get_location (where) : input_location; tmp = fold_build_call_array_loc (loc, TREE_TYPE (fntype), fold_build1_loc (loc, ADDR_EXPR, build_pointer_type (fntype), @@ -582,14 +594,14 @@ gfc_trans_runtime_check (bool error, bool once, tree cond, stmtblock_t * pblock, else { if (once) - cond = fold_build2_loc (where->lb->location, TRUTH_AND_EXPR, + cond = fold_build2_loc (gfc_get_location (where), TRUTH_AND_EXPR, long_integer_type_node, tmpvar, cond); else cond = fold_convert (long_integer_type_node, cond); - tmp = fold_build3_loc (where->lb->location, COND_EXPR, void_type_node, + tmp = fold_build3_loc (gfc_get_location (where), COND_EXPR, void_type_node, cond, body, - build_empty_stmt (where->lb->location)); + build_empty_stmt (gfc_get_location (where))); gfc_add_expr_to_block (pblock, tmp); } } @@ -2214,7 +2226,7 @@ gfc_generate_module_code (gfc_namespace * ns) gcc_assert (ns->proc_name->backend_decl == NULL); ns->proc_name->backend_decl - = build_decl (ns->proc_name->declared_at.lb->location, + = build_decl (gfc_get_location (&ns->proc_name->declared_at), NAMESPACE_DECL, get_identifier (ns->proc_name->name), void_type_node); entry = gfc_find_module (ns->proc_name->name); diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 359c7a2561a..0a3837670f6 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -658,6 +658,10 @@ void gfc_finish_decl_attrs (tree, symbol_attribute *); /* Allocate the lang-specific part of a decl node. */ void gfc_allocate_lang_decl (tree); +/* Get the location suitable for the ME from a gfortran locus; required to get + the column number right. */ +location_t gfc_get_location (locus *); + /* Advance along a TREE_CHAIN. */ tree gfc_advance_chain (tree, int);