summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorpmderodat <pmderodat@138bc75d-0d04-0410-961f-82ee72b054a4>2017-09-29 13:22:45 +0000
committerpmderodat <pmderodat@138bc75d-0d04-0410-961f-82ee72b054a4>2017-09-29 13:22:45 +0000
commit2110b8e6e3220401ae76f40f74b49c69bcae6878 (patch)
tree0f01c43173a6cfa0996666eeddc9f0b3163f4a3f
parent3255ff6773ce5ad0fe6291d1c39ef11c080d114b (diff)
downloadgcc-2110b8e6e3220401ae76f40f74b49c69bcae6878.tar.gz
2017-09-29 Justin Squirek <squirek@adacore.com>
* sem_ch8.adb (Analyze_Use_Package): Add sanity check to avoid circularities in the use-clause chain. 2017-09-29 Javier Miranda <miranda@adacore.com> * sem_ch3.adb (Replace_Components): Update references to discriminants located in variant parts inherited from the parent type. 2017-09-29 Javier Miranda <miranda@adacore.com> * 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 <schonberg@adacore.com> * 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 <trojanek@adacore.com> * make.adb: Minor whitespace fixes. * libgnat/s-resfil.ads: Minor reformatting. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@253288 138bc75d-0d04-0410-961f-82ee72b054a4
-rw-r--r--gcc/ada/exp_ch5.adb9
-rw-r--r--gcc/ada/libgnat/s-resfil.ads4
-rw-r--r--gcc/ada/make.adb4
-rw-r--r--gcc/ada/sem_aggr.adb23
-rw-r--r--gcc/ada/sem_ch3.adb11
-rw-r--r--gcc/ada/sem_ch8.adb7
-rw-r--r--gcc/testsuite/gnat.dg/unchecked_union2.adb35
-rw-r--r--gcc/testsuite/gnat.dg/unchecked_union3.adb38
8 files changed, 115 insertions, 16 deletions
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;