From ccd0ed95a86f0034daa452b0bb82b15ab47b284a Mon Sep 17 00:00:00 2001 From: Pierre-Marie de Rodat Date: Fri, 29 Sep 2017 13:22:45 +0000 Subject: [PATCH] [multiple changes] 2017-09-29 Justin Squirek * sem_ch8.adb (Analyze_Use_Package): Add sanity check to avoid circularities in the use-clause chain. 2017-09-29 Javier Miranda * sem_ch3.adb (Replace_Components): Update references to discriminants located in variant parts inherited from the parent type. 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. 2017-09-29 Ed Schonberg * sem_aggr.adb (Resolve_Record_Aggregate): Reject the use of an iterated component association in an aggregate for a record type. 2017-09-29 Piotr Trojanek * make.adb: Minor whitespace fixes. * libgnat/s-resfil.ads: Minor reformatting. From-SVN: r253288 --- gcc/ada/exp_ch5.adb | 9 ++++- gcc/ada/libgnat/s-resfil.ads | 4 +-- gcc/ada/make.adb | 4 +-- gcc/ada/sem_aggr.adb | 23 ++++++++----- gcc/ada/sem_ch3.adb | 11 +++++++ gcc/ada/sem_ch8.adb | 7 ++-- gcc/testsuite/gnat.dg/unchecked_union2.adb | 35 ++++++++++++++++++++ gcc/testsuite/gnat.dg/unchecked_union3.adb | 38 ++++++++++++++++++++++ 8 files changed, 115 insertions(+), 16 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/unchecked_union2.adb create mode 100644 gcc/testsuite/gnat.dg/unchecked_union3.adb diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index c987038b95d..933d33bd32a 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -1577,7 +1577,14 @@ package body Exp_Ch5 is -- 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 diff --git a/gcc/ada/libgnat/s-resfil.ads b/gcc/ada/libgnat/s-resfil.ads index fbb7f7af09f..1a24a99b639 100644 --- a/gcc/ada/libgnat/s-resfil.ads +++ b/gcc/ada/libgnat/s-resfil.ads @@ -29,8 +29,8 @@ -- -- ------------------------------------------------------------------------------ --- This package provides facilities for getting command line arguments --- from a text file, called a "response file". +-- This package provides facilities for getting command-line arguments from +-- a text file, called a "response file". -- -- Using a response file allow passing a set of arguments to an executable -- longer than the maximum allowed by the system on the command line. diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index 75048d24e5e..6f125391195 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -1772,7 +1772,7 @@ package body Make is (Data : out Compilation_Data; OK : out Boolean) is - Pid : Process_Id; + Pid : Process_Id; begin pragma Assert (Outstanding_Compiles > 0); @@ -1790,7 +1790,7 @@ package body Make is for J in Running_Compile'First .. Outstanding_Compiles loop if Pid = Running_Compile (J).Pid then - Data := Running_Compile (J); + Data := Running_Compile (J); -- If a mapping file was used by this compilation, get its file -- name for reuse by a subsequent compilation. diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index c885ce91451..ad6e1ea9a3e 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -4108,15 +4108,22 @@ package body Sem_Aggr is begin Assoc := First (Component_Associations (N)); while Present (Assoc) loop - if List_Length (Choices (Assoc)) > 1 then - Check_SPARK_05_Restriction - ("component association in record aggregate must " - & "contain a single choice", Assoc); - end if; + if Nkind (Assoc) = N_Iterated_Component_Association then + Error_Msg_N ("iterated component association can only " + & "appear in an array aggregate", N); + raise Unrecoverable_Error; - if Nkind (First (Choices (Assoc))) = N_Others_Choice then - Check_SPARK_05_Restriction - ("record aggregate cannot contain OTHERS", Assoc); + else + if List_Length (Choices (Assoc)) > 1 then + Check_SPARK_05_Restriction + ("component association in record aggregate must " + & "contain a single choice", Assoc); + end if; + + if Nkind (First (Choices (Assoc))) = N_Others_Choice then + Check_SPARK_05_Restriction + ("record aggregate cannot contain OTHERS", Assoc); + end if; end if; Assoc := Next (Assoc); diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 7e451fed0db..f6705d67232 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -21932,6 +21932,17 @@ package body Sem_Ch3 is Next_Discriminant (Comp); end loop; + elsif Nkind (N) = N_Variant_Part then + Comp := First_Discriminant (Typ); + while Present (Comp) loop + if Chars (Comp) = Chars (Name (N)) then + Set_Entity (Name (N), Comp); + exit; + end if; + + Next_Component (Comp); + end loop; + elsif Nkind (N) = N_Component_Declaration then Comp := First_Component (Typ); while Present (Comp) loop diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 77df1c85010..a51cc636298 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -3782,9 +3782,10 @@ package body Sem_Ch8 is -- before setting its previous use clause. if Ekind (Pack) = E_Package - and then Present (Current_Use_Clause (Pack)) - and then Current_Use_Clause (Pack) /= N - and then No (Prev_Use_Clause (N)) + and then Present (Current_Use_Clause (Pack)) + and then Current_Use_Clause (Pack) /= N + and then No (Prev_Use_Clause (N)) + and then Prev_Use_Clause (Current_Use_Clause (Pack)) /= N then Set_Prev_Use_Clause (N, Current_Use_Clause (Pack)); end if; diff --git a/gcc/testsuite/gnat.dg/unchecked_union2.adb b/gcc/testsuite/gnat.dg/unchecked_union2.adb new file mode 100644 index 00000000000..ccb6e60e7bc --- /dev/null +++ b/gcc/testsuite/gnat.dg/unchecked_union2.adb @@ -0,0 +1,35 @@ +-- { dg-do compile } + +procedure Unchecked_Union2 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_myUnion3 (discr : Integer := 0) is new myUnion (discr); -- Test + pragma Unchecked_Union (UU_myUnion3); + pragma Convention (C, UU_myUnion3); + + procedure Convert (A : in UU_myUnion3; B : out UU_myUnion3); + pragma Import (C, Convert); + +begin + null; +end Unchecked_Union2; diff --git a/gcc/testsuite/gnat.dg/unchecked_union3.adb b/gcc/testsuite/gnat.dg/unchecked_union3.adb new file mode 100644 index 00000000000..638861a2854 --- /dev/null +++ b/gcc/testsuite/gnat.dg/unchecked_union3.adb @@ -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; -- 2.30.2