From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1285) id 6CD2E398BC25; Thu, 3 Jun 2021 11:34:01 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 6CD2E398BC25 MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset="utf-8" From: Eric Botcazou To: gcc-cvs@gcc.gnu.org Subject: [gcc r11-8509] Fix miscompilation of predicate on bit-packed array types X-Act-Checkin: gcc X-Git-Author: Eric Botcazou X-Git-Refname: refs/heads/releases/gcc-11 X-Git-Oldrev: 8b1190d527d01dc74ee53e47b0366d01270c330c X-Git-Newrev: 68eca1bc523f7dd5ff2c3c333cb73e37f4a6606d Message-Id: <20210603113401.6CD2E398BC25@sourceware.org> Date: Thu, 3 Jun 2021 11:34:01 +0000 (GMT) X-BeenThere: gcc-cvs@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-cvs mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Thu, 03 Jun 2021 11:34:01 -0000 https://gcc.gnu.org/g:68eca1bc523f7dd5ff2c3c333cb73e37f4a6606d commit r11-8509-g68eca1bc523f7dd5ff2c3c333cb73e37f4a6606d Author: Eric Botcazou Date: Thu Jun 3 13:29:32 2021 +0200 Fix miscompilation of predicate on bit-packed array types This is a regression present on the mainline and 11 branch in the form of a miscompilation by the new mod/ref IPA pass of code that passes constrained bit-packed array objets in a call to a subprograms taking unconstrained bit-packed array parameters, which occurs for predicate on bit-packed array types for example. gcc/ada/ * gcc-interface/decl.c (gnat_to_gnu_entity) : Add PAT local constant and use it throughout. If it is set, use a ref-all pointer type for the pointer-to-array field of the fat pointer type. : Add PAT local constant and use it throughout. gcc/testsuite/ * gnat.dg/bit_packed_array6.adb: New test. * gnat.dg/bit_packed_array6_pkg.ads: New helper. Diff: --- gcc/ada/gcc-interface/decl.c | 37 +++++++++++++++---------- gcc/testsuite/gnat.dg/bit_packed_array6.adb | 10 +++++++ gcc/testsuite/gnat.dg/bit_packed_array6_pkg.ads | 13 +++++++++ 3 files changed, 45 insertions(+), 15 deletions(-) diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 2d64675595f..07f021415e9 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -2109,6 +2109,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) case E_Array_Type: { + const Entity_Id PAT = Packed_Array_Impl_Type (gnat_entity); const bool convention_fortran_p = (Convention (gnat_entity) == Convention_Fortran); const int ndim = Number_Dimensions (gnat_entity); @@ -2212,16 +2213,16 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) } /* If the GNAT encodings are used, give the fat pointer type a name. - If this is a packed array, tell the debugger how to interpret the - underlying bits by fetching that of the implementation type. But - in any case, mark it as artificial so the debugger can skip it. */ + If this is a packed type implemented specially, tell the debugger + how to interpret the underlying bits by fetching the name of the + implementation type. But, in any case, mark it as artificial so + the debugger can skip it. */ const Entity_Id gnat_name - = (Present (Packed_Array_Impl_Type (gnat_entity)) - && gnat_encodings != DWARF_GNAT_ENCODINGS_MINIMAL) - ? Packed_Array_Impl_Type (gnat_entity) + = Present (PAT) && gnat_encodings != DWARF_GNAT_ENCODINGS_MINIMAL + ? PAT : gnat_entity; tree xup_name - = (gnat_encodings != DWARF_GNAT_ENCODINGS_MINIMAL) + = gnat_encodings != DWARF_GNAT_ENCODINGS_MINIMAL ? create_concat_name (gnat_name, "XUP") : gnu_entity_name; create_type_decl (xup_name, gnu_fat_type, true, debug_info_p, @@ -2356,9 +2357,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) /* If this is a packed type implemented specially, then process the implementation type so it is elaborated in the proper scope. */ - if (Present (Packed_Array_Impl_Type (gnat_entity))) - gnat_to_gnu_entity (Packed_Array_Impl_Type (gnat_entity), NULL_TREE, - false); + if (Present (PAT)) + gnat_to_gnu_entity (PAT, NULL_TREE, false); /* Otherwise, if an alignment is specified, use it if valid and, if the alignment was requested with an explicit clause, state so. */ @@ -2383,8 +2383,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) tem = change_qualified_type (tem, TYPE_QUAL_VOLATILE); /* Adjust the type of the pointer-to-array field of the fat pointer - and record the aliasing relationships if necessary. */ - TREE_TYPE (TYPE_FIELDS (gnu_fat_type)) = build_pointer_type (tem); + and record the aliasing relationships if necessary. If this is + a packed type implemented specially, then use a ref-all pointer + type since the implementation type may vary between constrained + subtypes and unconstrained base type. */ + if (Present (PAT)) + TREE_TYPE (TYPE_FIELDS (gnu_fat_type)) + = build_pointer_type_for_mode (tem, ptr_mode, true); + else + TREE_TYPE (TYPE_FIELDS (gnu_fat_type)) = build_pointer_type (tem); if (TYPE_ALIAS_SET_KNOWN_P (gnu_fat_type)) record_component_aliases (gnu_fat_type); @@ -2448,6 +2455,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) ; else { + const Entity_Id PAT = Packed_Array_Impl_Type (gnat_entity); Entity_Id gnat_index, gnat_base_index; const bool convention_fortran_p = (Convention (gnat_entity) == Convention_Fortran); @@ -2853,7 +2861,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) /* If this is a packed type implemented specially, then replace our type with the implementation type. */ - if (Present (Packed_Array_Impl_Type (gnat_entity))) + if (Present (PAT)) { /* First finish the type we had been making so that we output debugging information for it. */ @@ -2878,8 +2886,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) this type again. */ save_gnu_tree (gnat_entity, gnu_tmp_decl, false); - gnu_type - = gnat_to_gnu_type (Packed_Array_Impl_Type (gnat_entity)); + gnu_type = gnat_to_gnu_type (PAT); save_gnu_tree (gnat_entity, NULL_TREE, false); /* Set the ___XP suffix for GNAT encodings. */ diff --git a/gcc/testsuite/gnat.dg/bit_packed_array6.adb b/gcc/testsuite/gnat.dg/bit_packed_array6.adb new file mode 100644 index 00000000000..84f7a4ba4a1 --- /dev/null +++ b/gcc/testsuite/gnat.dg/bit_packed_array6.adb @@ -0,0 +1,10 @@ +-- { dg-do run } +-- { dg-options "-O2 -gnata -gnatVa" } + +with Bit_Packed_Array6_Pkg; use Bit_Packed_Array6_Pkg; + +procedure Bit_Packed_Array6 is + B : constant Boolean := Everywhere (K_Configuration); +begin + null; +end; diff --git a/gcc/testsuite/gnat.dg/bit_packed_array6_pkg.ads b/gcc/testsuite/gnat.dg/bit_packed_array6_pkg.ads new file mode 100644 index 00000000000..4eb1516a472 --- /dev/null +++ b/gcc/testsuite/gnat.dg/bit_packed_array6_pkg.ads @@ -0,0 +1,13 @@ +package Bit_Packed_Array6_Pkg is + + type Project_Kind is + (K_Configuration, K_Abstract, + K_Standard, K_Library, K_Aggregate, K_Aggregate_Library); + + type Projects_Kind is array (Project_Kind) of Boolean + with Pack, + Dynamic_Predicate => Projects_Kind /= (Project_Kind => False); + + Everywhere : constant Projects_Kind := (others => True); + +end Bit_Packed_Array6_Pkg;