[multiple changes]
authorPierre-Marie de Rodat <pmderodat@gcc.gnu.org>
Fri, 29 Sep 2017 13:22:45 +0000 (13:22 +0000)
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>
Fri, 29 Sep 2017 13:22:45 +0000 (13:22 +0000)
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

gcc/ada/exp_ch5.adb
gcc/ada/libgnat/s-resfil.ads
gcc/ada/make.adb
gcc/ada/sem_aggr.adb
gcc/ada/sem_ch3.adb
gcc/ada/sem_ch8.adb
gcc/testsuite/gnat.dg/unchecked_union2.adb [new file with mode: 0644]
gcc/testsuite/gnat.dg/unchecked_union3.adb [new file with mode: 0644]

index c987038..933d33b 100644 (file)
@@ -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
 
index fbb7f7a..1a24a99 100644 (file)
@@ -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.
index 75048d2..6f12539 100644 (file)
@@ -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.
 
index c885ce9..ad6e1ea 100644 (file)
@@ -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);
index 7e451fe..f6705d6 100644 (file)
@@ -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
index 77df1c8..a51cc63 100644 (file)
@@ -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
@@ -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
@@ -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;