From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 92587 invoked by alias); 29 Sep 2017 13:24:54 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Received: (qmail 92441 invoked by uid 89); 29 Sep 2017 13:24:53 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-11.2 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=Hx-languages-length:3138 X-HELO: rock.gnat.com Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Fri, 29 Sep 2017 13:24:52 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id A5EE956070; Fri, 29 Sep 2017 09:24:50 -0400 (EDT) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id tzSH9n8wBDJI; Fri, 29 Sep 2017 09:24:50 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [205.232.38.10]) by rock.gnat.com (Postfix) with ESMTP id 952D956054; Fri, 29 Sep 2017 09:24:50 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4862) id 940AC16F; Fri, 29 Sep 2017 09:24:50 -0400 (EDT) Date: Fri, 29 Sep 2017 13:24:00 -0000 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Cc: Javier Miranda Subject: [Ada] Copy of Unchecked_Union derived discriminated types Message-ID: <20170929132450.GA145288@adacore.com> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="WIyZ46R2i8wDzkSu" Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) X-IsSubscribed: yes X-SW-Source: 2017-09/txt/msg01947.txt.bz2 --WIyZ46R2i8wDzkSu Content-Type: text/plain; charset=us-ascii Content-Disposition: inline Content-length: 1539 The compiler crashes processing an assignment to a discriminated record type that has pragma Unchecked_Union and Convention C and is a derivation of a non-tagged record type with discriminants. After this patch the following test compiles silently. procedure Conversion is type small_array is array (0 .. 2) of Integer; type big_array is array (0 .. 3) of Integer; type small_record is record field1 : aliased Integer := 0; field2 : aliased small_array := (0, 0, 0); end record; type big_record is record field1 : aliased Integer := 0; field2 : aliased big_array := (0, 0, 0, 0); end record; type myUnion (discr : Integer := 0) is record case discr is when 0 => record1 : aliased small_record; when others => record2 : aliased big_record; end case; end record; type UU_myUnion1 is new myUnion; pragma Unchecked_Union (UU_myUnion1); pragma Convention (C, UU_myUnion1); procedure Convert (A : in myUnion; B : out UU_myUnion1) is L : UU_myUnion1 := UU_myUnion1 (A); -- Test begin B := L; end Convert; begin null; end Conversion; Tested on x86_64-pc-linux-gnu, committed on trunk gcc/ada/ 2017-09-29 Javier Miranda * exp_ch5.adb (Expand_Assign_Record): Do not generate code to copy discriminants if the target is an Unchecked_Union record type. gcc/testsuite/ 2017-09-29 Javier Miranda * gnat.dg/unchecked_union3.adb: New testcase. --WIyZ46R2i8wDzkSu Content-Type: text/plain; charset=us-ascii Content-Disposition: attachment; filename=difs Content-length: 1915 Index: exp_ch5.adb =================================================================== --- exp_ch5.adb (revision 253283) +++ exp_ch5.adb (working copy) @@ -1577,7 +1577,14 @@ -- suppressed in this case). It is unnecessary but harmless in -- other cases. - if Has_Discriminants (L_Typ) then + -- Special case: no copy if the target has no discriminants. + + if Has_Discriminants (L_Typ) + and then Is_Unchecked_Union (Base_Type (L_Typ)) + then + null; + + elsif Has_Discriminants (L_Typ) then F := First_Discriminant (R_Typ); while Present (F) loop Index: ../testsuite/gnat.dg/unchecked_union3.adb =================================================================== --- ../testsuite/gnat.dg/unchecked_union3.adb (revision 0) +++ ../testsuite/gnat.dg/unchecked_union3.adb (revision 0) @@ -0,0 +1,38 @@ +-- { dg-do compile } + +procedure Unchecked_Union3 is + type small_array is array (0 .. 2) of Integer; + type big_array is array (0 .. 3) of Integer; + + type small_record is record + field1 : aliased Integer := 0; + field2 : aliased small_array := (0, 0, 0); + end record; + + type big_record is record + field1 : aliased Integer := 0; + field2 : aliased big_array := (0, 0, 0, 0); + end record; + + type myUnion (discr : Integer := 0) is record + case discr is + when 0 => + record1 : aliased small_record; + when others => + record2 : aliased big_record; + end case; + end record; + + type UU_myUnion1 is new myUnion; + pragma Unchecked_Union (UU_myUnion1); + pragma Convention (C, UU_myUnion1); + + procedure Convert (A : in myUnion; B : out UU_myUnion1) is + L : UU_myUnion1 := UU_myUnion1 (A); -- Test + begin + B := L; + end Convert; + +begin + null; +end Unchecked_Union3; --WIyZ46R2i8wDzkSu--