From patchwork Tue Jul 17 10:12:43 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Eric Botcazou X-Patchwork-Id: 944864 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-481714-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=adacore.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="QErLBb72"; 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 41VGLj2JbYz9s4c for ; Tue, 17 Jul 2018 20:12:59 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:subject:date:message-id:mime-version:content-type :content-transfer-encoding; q=dns; s=default; b=JGdtoXvOk2rdB1zW AOQcJxsLLMjOHdrES9VwQZwSM/ynsUd7NPyve0vM/YsACWqXBgijccTe6vl0MG2d ZCMNkPnfXwwgDzp0cuyr70iLKex5fiCvzQQdHZoPwUEtwb5yGAm75EwWcDhd2d5v WX5J1GdphODmJrwbQLFM3BowjWw= 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:from :to:subject:date:message-id:mime-version:content-type :content-transfer-encoding; s=default; bh=a0DvxojJKPhd3T7eBx/l4e O4zlw=; b=QErLBb72DUH49nzIbYKgty5pRdf5zYwL4fcv4Gxa9u1XM9awGNz3Ly ECvQryDPr5DSof4RDzjfvoB3AwCOwcb+OsBIw633nkTGKTtSkW7p08mYnTton+UM edo4xEXbpyQgc1x0Ht5UNpqKboeBzrg+CFdnQEbmX4fAMp7OwIsOw= Received: (qmail 129559 invoked by alias); 17 Jul 2018 10:12:52 -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 129544 invoked by uid 89); 17 Jul 2018 10:12:51 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-10.4 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_2, GIT_PATCH_3, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.2 spammy=ri, Everything, debug11adb, sk:maybe_c X-HELO: smtp.eu.adacore.com Received: from mel.act-europe.fr (HELO smtp.eu.adacore.com) (194.98.77.210) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Tue, 17 Jul 2018 10:12:49 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id 768CB81395 for ; Tue, 17 Jul 2018 12:12:46 +0200 (CEST) Received: from smtp.eu.adacore.com ([127.0.0.1]) by localhost (smtp.eu.adacore.com [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id LYcikgwT7a72 for ; Tue, 17 Jul 2018 12:12:46 +0200 (CEST) Received: from polaris.localnet (bon31-6-88-161-99-133.fbx.proxad.net [88.161.99.133]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by smtp.eu.adacore.com (Postfix) with ESMTPSA id 35AC481393 for ; Tue, 17 Jul 2018 12:12:46 +0200 (CEST) From: Eric Botcazou To: gcc-patches@gcc.gnu.org Subject: [Ada] Fix spurious check failure for Character discriminant Date: Tue, 17 Jul 2018 12:12:43 +0200 Message-ID: <2535907.KZUAb1vBsS@polaris> MIME-Version: 1.0 This is a regression present on the mainline, 8 and 7 branches. The compiler generates a spurious check failure for a Character discriminant declared in a discriminated record type with variant part if one of the variants is selected by a range of values which contains at least the values at position 127 & 128. It's also indirectly responsible for failure of gnat.dg/debug11.adb on RISC-V. Tested on x86-64/Linux, applied on the mainline, 8 and 7 branches. 2018-07-17 Eric Botcazou * gcc-interface/decl.c (choices_to_gnu): Rename parameters. Deal with an operand of Character type. Factor out range generation to the end. Check that the bounds are literals and convert them to the type of the operand before building the ranges. * gcc-interface/utils.c (make_dummy_type): Minor tweak. (make_packable_type): Propagate TYPE_DEBUG_TYPE. (maybe_pad_type): Likewise. 2018-07-17 Eric Botcazou * gnat.dg/discr55.adb: New test. Index: gcc-interface/decl.c =================================================================== --- gcc-interface/decl.c (revision 262803) +++ gcc-interface/decl.c (working copy) @@ -6705,65 +6705,44 @@ elaborate_reference (tree ref, Entity_Id the value passed against the list of choices. */ static tree -choices_to_gnu (tree operand, Node_Id choices) +choices_to_gnu (tree gnu_operand, Node_Id gnat_choices) { - Node_Id choice; - Node_Id gnat_temp; - tree result = boolean_false_node; - tree this_test, low = 0, high = 0, single = 0; + tree gnu_result = boolean_false_node, gnu_type; - for (choice = First (choices); Present (choice); choice = Next (choice)) + gnu_operand = maybe_character_value (gnu_operand); + gnu_type = TREE_TYPE (gnu_operand); + + for (Node_Id gnat_choice = First (gnat_choices); + Present (gnat_choice); + gnat_choice = Next (gnat_choice)) { - switch (Nkind (choice)) + tree gnu_low = NULL_TREE, gnu_high = NULL_TREE; + tree gnu_test; + + switch (Nkind (gnat_choice)) { case N_Range: - low = gnat_to_gnu (Low_Bound (choice)); - high = gnat_to_gnu (High_Bound (choice)); - - this_test - = build_binary_op (TRUTH_ANDIF_EXPR, boolean_type_node, - build_binary_op (GE_EXPR, boolean_type_node, - operand, low, true), - build_binary_op (LE_EXPR, boolean_type_node, - operand, high, true), - true); - + gnu_low = gnat_to_gnu (Low_Bound (gnat_choice)); + gnu_high = gnat_to_gnu (High_Bound (gnat_choice)); break; case N_Subtype_Indication: - gnat_temp = Range_Expression (Constraint (choice)); - low = gnat_to_gnu (Low_Bound (gnat_temp)); - high = gnat_to_gnu (High_Bound (gnat_temp)); - - this_test - = build_binary_op (TRUTH_ANDIF_EXPR, boolean_type_node, - build_binary_op (GE_EXPR, boolean_type_node, - operand, low, true), - build_binary_op (LE_EXPR, boolean_type_node, - operand, high, true), - true); + gnu_low = gnat_to_gnu (Low_Bound (Range_Expression + (Constraint (gnat_choice)))); + gnu_high = gnat_to_gnu (High_Bound (Range_Expression + (Constraint (gnat_choice)))); break; case N_Identifier: case N_Expanded_Name: - /* This represents either a subtype range, an enumeration - literal, or a constant Ekind says which. If an enumeration - literal or constant, fall through to the next case. */ - if (Ekind (Entity (choice)) != E_Enumeration_Literal - && Ekind (Entity (choice)) != E_Constant) + /* This represents either a subtype range or a static value of + some kind; Ekind says which. */ + if (Is_Type (Entity (gnat_choice))) { - tree type = gnat_to_gnu_type (Entity (choice)); + tree gnu_type = get_unpadded_type (Entity (gnat_choice)); - low = TYPE_MIN_VALUE (type); - high = TYPE_MAX_VALUE (type); - - this_test - = build_binary_op (TRUTH_ANDIF_EXPR, boolean_type_node, - build_binary_op (GE_EXPR, boolean_type_node, - operand, low, true), - build_binary_op (LE_EXPR, boolean_type_node, - operand, high, true), - true); + gnu_low = TYPE_MIN_VALUE (gnu_type); + gnu_high = TYPE_MAX_VALUE (gnu_type); break; } @@ -6771,27 +6750,49 @@ choices_to_gnu (tree operand, Node_Id ch case N_Character_Literal: case N_Integer_Literal: - single = gnat_to_gnu (choice); - this_test = build_binary_op (EQ_EXPR, boolean_type_node, operand, - single, true); + gnu_low = gnat_to_gnu (gnat_choice); break; case N_Others_Choice: - this_test = boolean_true_node; break; default: gcc_unreachable (); } - if (result == boolean_false_node) - result = this_test; + /* Everything should be folded into constants at this point. */ + gcc_assert (!gnu_low || TREE_CODE (gnu_low) == INTEGER_CST); + gcc_assert (!gnu_high || TREE_CODE (gnu_high) == INTEGER_CST); + + if (gnu_low && TREE_TYPE (gnu_low) != gnu_type) + gnu_low = convert (gnu_type, gnu_low); + if (gnu_high && TREE_TYPE (gnu_high) != gnu_type) + gnu_high = convert (gnu_type, gnu_high); + + if (gnu_low && gnu_high) + gnu_test + = build_binary_op (TRUTH_ANDIF_EXPR, boolean_type_node, + build_binary_op (GE_EXPR, boolean_type_node, + gnu_operand, gnu_low, true), + build_binary_op (LE_EXPR, boolean_type_node, + gnu_operand, gnu_high, true), + true); + else if (gnu_low) + gnu_test + = build_binary_op (EQ_EXPR, boolean_type_node, gnu_operand, gnu_low, + true); + else + gnu_test = boolean_true_node; + + if (gnu_result == boolean_false_node) + gnu_result = gnu_test; else - result = build_binary_op (TRUTH_ORIF_EXPR, boolean_type_node, result, - this_test, true); + gnu_result + = build_binary_op (TRUTH_ORIF_EXPR, boolean_type_node, gnu_result, + gnu_test, true); } - return result; + return gnu_result; } /* Adjust PACKED setting as passed to gnat_to_gnu_field for a field of Index: gcc-interface/utils.c =================================================================== --- gcc-interface/utils.c (revision 262803) +++ gcc-interface/utils.c (working copy) @@ -391,15 +391,13 @@ make_dummy_type (Entity_Id gnat_type) SET_DUMMY_NODE (gnat_equiv, gnu_type); - /* Create a debug type so that debug info consumers only see an unspecified - type. */ + /* Create a debug type so that debuggers only see an unspecified type. */ if (Needs_Debug_Info (gnat_type)) { debug_type = make_node (LANG_TYPE); - SET_TYPE_DEBUG_TYPE (gnu_type, debug_type); - TYPE_NAME (debug_type) = TYPE_NAME (gnu_type); TYPE_ARTIFICIAL (debug_type) = TYPE_ARTIFICIAL (gnu_type); + SET_TYPE_DEBUG_TYPE (gnu_type, debug_type); } return gnu_type; @@ -1073,7 +1071,9 @@ make_packable_type (tree type, bool in_r finish_record_type (new_type, nreverse (new_field_list), 2, false); relate_alias_sets (new_type, type, ALIAS_SET_COPY); - if (TYPE_STUB_DECL (type)) + if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL) + SET_TYPE_DEBUG_TYPE (new_type, TYPE_DEBUG_TYPE (type)); + else if (TYPE_STUB_DECL (type)) SET_DECL_PARALLEL_TYPE (TYPE_STUB_DECL (new_type), DECL_PARALLEL_TYPE (TYPE_STUB_DECL (type))); @@ -1417,7 +1417,7 @@ maybe_pad_type (tree type, tree size, un } if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL) - SET_TYPE_DEBUG_TYPE (record, type); + SET_TYPE_DEBUG_TYPE (record, maybe_debug_type (type)); /* Unless debugging information isn't being written for the input type, write a record that shows what we are a subtype of and also make a