[multiple changes]

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.

From-SVN: r253288

diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
index c987038b95d7e17ca0132018af1bc40ab7a4698c..933d33bd32a7588249d82b9c63cd6eeaa4d6970d 100644 (file)
--- 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 fbb7f7af09f898aeeca5470ecbbd1f05af54c63d..1a24a99b63969faecec43f86e84ca5eb5fa79fbb 100644 (file)
--- 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 75048d24e5e6d436f39e40fc648257678144549c..6f1253911957a8e469d855800fff040e6d8e1da1 100644 (file)
--- 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 c885ce914515cbd8db204898724e5ff70f4c8232..ad6e1ea9a3ea98153518c1f570c82e32425b7505 100644 (file)
--- 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 7e451fed0db133786b55d184034d790f21b6e018..f6705d672327d13db0d1713167222a50c4ef319c 100644 (file)
--- 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 77df1c850100498855f3f99e6617016136629e05..a51cc636298f429fbcc74e82c0eb16ecba30fbde 100644 (file)
--- 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 (file)
index 0000000..ccb6e60
--- /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 (file)
index 0000000..638861a
--- /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;