2013-04-11 Eric Botcazou <ebotcazou@adacore.com>

	* init.c (RETURN_ADDR_OFFSET): Delete as unused.

2013-04-11  Robert Dewar  <dewar@adacore.com>

	* a-crbtgk.adb, a-ciorse.adb, a-crbtgo.adb, a-coorse.adb, a-rbtgbo.adb,
	a-cborse.adb, a-rbtgso.adb, exp_ch3.adb: Minor reformatting.

2013-04-11  Yannick Moy  <moy@adacore.com>

	* exp_ch4.adb (Expand_N_Selected_Component): Do not expand
	discriminant check for Unchecked_Union.
	* sem_res.adb (Resolve_Selected_Component): Set flag
	Do_Discriminant_Check even when expansion is not performed.
	* sinfo.ads (Do_Discriminant_Check): Update documentation for the case
	of Unchecked_Union.

2013-04-11  Thomas Quinot  <quinot@adacore.com>

	* sem_ch13.adb (Same_Representation): Two types with different scalar
	storage order never have the same representation.

2013-04-11  Arnaud Charlet  <charlet@adacore.com>

	* xgnatugn.adb (Push_Conditional): Simplify handling,
	no longer need to keep track of "excluding" sections.
	(Currently_Excluding): Removed.
	(Process_Source_File):
	Set unw/vms flag so that texinfo can do the whole handling of
	@ifset/@ifclear sections.  Fix handling of nested @ifset/@ifclear
	sections.
	* gnat_ugn.texi: Add a section on performing unassisted install
	on Windows.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@197785 138bc75d-0d04-0410-961f-82ee72b054a4

16 files changed, 226 insertions, 110 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 19a47005d3f..e1125f7a567 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,38 @@
+2013-04-11  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* init.c (RETURN_ADDR_OFFSET): Delete as unused.
+
+2013-04-11  Robert Dewar  <dewar@adacore.com>
+
+	* a-crbtgk.adb, a-ciorse.adb, a-crbtgo.adb, a-coorse.adb, a-rbtgbo.adb,
+	a-cborse.adb, a-rbtgso.adb, exp_ch3.adb: Minor reformatting.
+
+2013-04-11  Yannick Moy  <moy@adacore.com>
+
+	* exp_ch4.adb (Expand_N_Selected_Component): Do not expand
+	discriminant check for Unchecked_Union.
+	* sem_res.adb (Resolve_Selected_Component): Set flag
+	Do_Discriminant_Check even when expansion is not performed.
+	* sinfo.ads (Do_Discriminant_Check): Update documentation for the case
+	of Unchecked_Union.
+
+2013-04-11  Thomas Quinot  <quinot@adacore.com>
+
+	* sem_ch13.adb (Same_Representation): Two types with different scalar
+	storage order never have the same representation.
+
+2013-04-11  Arnaud Charlet  <charlet@adacore.com>
+
+	* xgnatugn.adb (Push_Conditional): Simplify handling,
+	no longer need to keep track of "excluding" sections.
+	(Currently_Excluding): Removed.
+	(Process_Source_File):
+	Set unw/vms flag so that texinfo can do the whole handling of
+	@ifset/@ifclear sections.  Fix handling of nested @ifset/@ifclear
+	sections.
+	* gnat_ugn.texi: Add a section on performing unassisted install
+	on Windows.
+
 2013-04-11  Johannes Kanig  <kanig@adacore.com>
 
 	* debug.adb: Document usage of -gnatd.Q switch.
diff --git a/gcc/ada/a-cborse.adb b/gcc/ada/a-cborse.adb
index ed34b69195a..64220f91ef2 100644
--- a/gcc/ada/a-cborse.adb
+++ b/gcc/ada/a-cborse.adb
@@ -1768,6 +1768,7 @@ package body Ada.Containers.Bounded_Ordered_Sets is
 
          L := L - 1;
          B := B - 1;
+
       exception
          when others =>
             L := L - 1;
@@ -1776,6 +1777,7 @@ package body Ada.Containers.Bounded_Ordered_Sets is
       end;
 
       if Compare then
+
          --  Item is equivalent to the node's element, so we will not have to
          --  move the node.
 
@@ -1808,6 +1810,7 @@ package body Ada.Containers.Bounded_Ordered_Sets is
 
             L := L - 1;
             B := B - 1;
+
          exception
             when others =>
                L := L - 1;
@@ -1815,7 +1818,10 @@ package body Ada.Containers.Bounded_Ordered_Sets is
                raise;
          end;
 
-         if not Compare then  -- Item is equivalent to Nodes (Hint).Element
+         --  Item is equivalent to Nodes (Hint).Element
+
+         if not Compare then
+
             --  Ceiling returns an element that is equivalent or greater than
             --  Item. If Item is "not less than" the element, then by
             --  elimination we know that Item is equivalent to the element.
diff --git a/gcc/ada/a-ciorse.adb b/gcc/ada/a-ciorse.adb
index 4d918a5b45d..3b1ffb43022 100644
--- a/gcc/ada/a-ciorse.adb
+++ b/gcc/ada/a-ciorse.adb
@@ -494,14 +494,13 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
 
    procedure Delete (Container : in out Set; Item : Element_Type) is
       X : Node_Access := Element_Keys.Find (Container.Tree, Item);
-
    begin
       if X = null then
          raise Constraint_Error with "attempt to delete element not in set";
+      else
+         Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
+         Free (X);
       end if;
-
-      Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
-      Free (X);
    end Delete;
 
    ------------------
@@ -1924,6 +1923,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
 
          L := L - 1;
          B := B - 1;
+
       exception
          when others =>
             L := L - 1;
@@ -1975,6 +1975,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
 
             L := L - 1;
             B := B - 1;
+
          exception
             when others =>
                L := L - 1;
@@ -1982,10 +1983,13 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
                raise;
          end;
 
-         if not Compare then  -- Item >= Hint.Element
-            --  Ceiling returns an element that is equivalent or greater than
-            --  Item. If Item is "not less than" the element, then by
-            --  elimination we know that Item is equivalent to the element.
+         --  Item >= Hint.Element
+
+         if not Compare then
+
+            --  Ceiling returns an element that is equivalent or greater
+            --  than Item. If Item is "not less than" the element, then
+            --  by elimination we know that Item is equivalent to the element.
 
             --  But this means that it is not possible to assign the value of
             --  Item to the specified element (on Node), because a different
diff --git a/gcc/ada/a-coorse.adb b/gcc/ada/a-coorse.adb
index 3f2537367bb..43d4ec9a3e8 100644
--- a/gcc/ada/a-coorse.adb
+++ b/gcc/ada/a-coorse.adb
@@ -1757,6 +1757,7 @@ package body Ada.Containers.Ordered_Sets is
 
          L := L - 1;
          B := B - 1;
+
       exception
          when others =>
             L := L - 1;
@@ -1797,6 +1798,7 @@ package body Ada.Containers.Ordered_Sets is
 
             L := L - 1;
             B := B - 1;
+
          exception
             when others =>
                L := L - 1;
@@ -1804,10 +1806,13 @@ package body Ada.Containers.Ordered_Sets is
                raise;
          end;
 
-         if not Compare then  -- Item >= Hint.Element
-            --  Ceiling returns an element that is equivalent or greater than
-            --  Item. If Item is "not less than" the element, then by
-            --  elimination we know that Item is equivalent to the element.
+         --  Item >= Hint.Element
+
+         if not Compare then
+
+            --  Ceiling returns an element that is equivalent or greater
+            --  than Item. If Item is "not less than" the element, then
+            --  by elimination we know that Item is equivalent to the element.
 
             --  But this means that it is not possible to assign the value of
             --  Item to the specified element (on Node), because a different
diff --git a/gcc/ada/a-crbtgk.adb b/gcc/ada/a-crbtgk.adb
index 0e27e0a46de..f1762f8be83 100644
--- a/gcc/ada/a-crbtgk.adb
+++ b/gcc/ada/a-crbtgk.adb
@@ -65,6 +65,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is
       L := L - 1;
 
       return Y;
+
    exception
       when others =>
          B := B - 1;
@@ -116,6 +117,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is
       L := L - 1;
 
       return Result;
+
    exception
       when others =>
          B := B - 1;
@@ -155,6 +157,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is
       L := L - 1;
 
       return Y;
+
    exception
       when others =>
          B := B - 1;
@@ -214,6 +217,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is
 
          L := L - 1;
          B := B - 1;
+
       exception
          when others =>
             L := L - 1;
@@ -258,6 +262,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is
 
          L := L - 1;
          B := B - 1;
+
       exception
          when others =>
             L := L - 1;
@@ -321,11 +326,12 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is
             B := B + 1;
             L := L + 1;
 
-            Compare := Tree.Last = null
-                         or else Is_Greater_Key_Node (Key, Tree.Last);
+            Compare :=
+              Tree.Last = null or else Is_Greater_Key_Node (Key, Tree.Last);
 
             L := L - 1;
             B := B - 1;
+
          exception
             when others =>
                L := L - 1;
@@ -370,6 +376,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is
 
          L := L - 1;
          B := B - 1;
+
       exception
          when others =>
             L := L - 1;
@@ -395,6 +402,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is
 
             L := L - 1;
             B := B - 1;
+
          exception
             when others =>
                L := L - 1;
@@ -418,11 +426,11 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is
          return;
       end if;
 
-      --  We know that Key isn't less than the hint so we try again,
-      --  this time to see if it's greater than the hint. If so we
-      --  compare Key to the node that follows the hint. If Key is both
-      --  greater than the hint and less than the hint's next neighbor,
-      --  then we're done; otherwise we must search.
+      --  We know that Key isn't less than the hint so we try again, this time
+      --  to see if it's greater than the hint. If so we compare Key to the
+      --  node that follows the hint. If Key is both greater than the hint and
+      --  less than the hint's next neighbor, then we're done; otherwise we
+      --  must search.
 
       begin
          B := B + 1;
@@ -432,6 +440,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is
 
          L := L - 1;
          B := B - 1;
+
       exception
          when others =>
             L := L - 1;
@@ -457,6 +466,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is
 
             L := L - 1;
             B := B - 1;
+
          exception
             when others =>
                L := L - 1;
@@ -480,10 +490,9 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is
          return;
       end if;
 
-      --  We know that Key is neither less than the hint nor greater
-      --  than the hint, and that's the definition of equivalence.
-      --  There's nothing else we need to do, since a search would just
-      --  reach the same conclusion.
+      --  We know that Key is neither less than the hint nor greater than the
+      --  hint, and that's the definition of equivalence. There's nothing else
+      --  we need to do, since a search would just reach the same conclusion.
 
       Node := Position;
       Inserted := False;
diff --git a/gcc/ada/a-crbtgo.adb b/gcc/ada/a-crbtgo.adb
index adc9ab27966..6cce55d25ab 100644
--- a/gcc/ada/a-crbtgo.adb
+++ b/gcc/ada/a-crbtgo.adb
@@ -675,6 +675,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Operations is
       LR := LR - 1;
 
       return Result;
+
    exception
       when others =>
          BL := BL - 1;
diff --git a/gcc/ada/a-rbtgbo.adb b/gcc/ada/a-rbtgbo.adb
index 27106205fba..d1c26778128 100644
--- a/gcc/ada/a-rbtgbo.adb
+++ b/gcc/ada/a-rbtgbo.adb
@@ -654,6 +654,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Bounded_Operations is
       LR := LR - 1;
 
       return Result;
+
    exception
       when others =>
          BL := BL - 1;
diff --git a/gcc/ada/a-rbtgso.adb b/gcc/ada/a-rbtgso.adb
index 700832e710e..06a78e922c3 100644
--- a/gcc/ada/a-rbtgso.adb
+++ b/gcc/ada/a-rbtgso.adb
@@ -149,6 +149,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Set_Operations is
 
             BS := BS - 1;
             LS := LS - 1;
+
          exception
             when others =>
                BT := BT - 1;
@@ -265,6 +266,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Set_Operations is
          LR := LR - 1;
 
          return Tree;
+
       exception
          when others =>
             BL := BL - 1;
@@ -340,6 +342,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Set_Operations is
 
             BS := BS - 1;
             LS := LS - 1;
+
          exception
             when others =>
                BT := BT - 1;
@@ -447,6 +450,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Set_Operations is
          LR := LR - 1;
 
          return Tree;
+
       exception
          when others =>
             BL := BL - 1;
@@ -532,6 +536,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Set_Operations is
          LR := LR - 1;
 
          return Result;
+
       exception
          when others =>
             BL := BL - 1;
@@ -605,6 +610,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Set_Operations is
          LR := LR - 1;
 
          return Result;
+
       exception
          when others =>
             BL := BL - 1;
@@ -689,6 +695,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Set_Operations is
 
             BS := BS - 1;
             LS := LS - 1;
+
          exception
             when others =>
                BT := BT - 1;
@@ -826,6 +833,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Set_Operations is
          LR := LR - 1;
 
          return Tree;
+
       exception
          when others =>
             BL := BL - 1;
@@ -886,6 +894,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Set_Operations is
 
          BS := BS - 1;
          LS := LS - 1;
+
       exception
          when others =>
             BS := BS - 1;
@@ -957,6 +966,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Set_Operations is
          LR := LR - 1;
 
          return Tree;
+
       exception
          when others =>
             BL := BL - 1;
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 35d7a9f3029..980cc3cd489 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -4846,9 +4846,8 @@ package body Exp_Ch3 is
 
       begin
          Full_Type := Typ;
-         if Is_Private_Type (Typ)
-           and then Present (Full_View (Typ))
-         then
+
+         if Is_Private_Type (Typ) and then Present (Full_View (Typ)) then
             Full_Type := Full_View (Typ);
          end if;
 
@@ -5169,9 +5168,9 @@ package body Exp_Ch3 is
                     (N, New_Copy_Tree (Init_Expr, New_Scope => Current_Scope));
                   return;
 
-               --  If type has discriminants, try to build equivalent
-               --  aggregate using discriminant values from the declaration.
-               --  This is a useful optimization, in particular if restriction
+               --  If type has discriminants, try to build equivalent aggregate
+               --  using discriminant values from the declaration. This
+               --  is a useful optimization, in particular if restriction
                --  No_Elaboration_Code is active.
 
                elsif Build_Equivalent_Aggregate then
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index be5d17f2960..3a701838185 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -9198,6 +9198,7 @@ package body Exp_Ch4 is
       Loc   : constant Source_Ptr := Sloc (N);
       Par   : constant Node_Id    := Parent (N);
       P     : constant Node_Id    := Prefix (N);
+      S     : constant Node_Id    := Selector_Name (N);
       Ptyp  : Entity_Id           := Underlying_Type (Etype (P));
       Disc  : Entity_Id;
       New_N : Node_Id;
@@ -9273,18 +9274,27 @@ package body Exp_Ch4 is
       --  Deal with discriminant check required
 
       if Do_Discriminant_Check (N) then
+         if Present (Discriminant_Checking_Func
+                      (Original_Record_Component (Entity (S))))
+         then
+            --  Present the discriminant checking function to the backend, so
+            --  that it can inline the call to the function.
+
+            Add_Inlined_Body
+              (Discriminant_Checking_Func
+                (Original_Record_Component (Entity (S))));
 
-         --  Present the discriminant checking function to the backend, so that
-         --  it can inline the call to the function.
+            --  Now reset the flag and generate the call
 
-         Add_Inlined_Body
-           (Discriminant_Checking_Func
-             (Original_Record_Component (Entity (Selector_Name (N)))));
+            Set_Do_Discriminant_Check (N, False);
+            Generate_Discriminant_Check (N);
 
-         --  Now reset the flag and generate the call
+         --  In the case of Unchecked_Union, no discriminant checking is
+         --  actually performed.
 
-         Set_Do_Discriminant_Check (N, False);
-         Generate_Discriminant_Check (N);
+         else
+            Set_Do_Discriminant_Check (N, False);
+         end if;
       end if;
 
       --  Ada 2005 (AI-318-02): If the prefix is a call to a build-in-place
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index dadf4d1ad27..519890f1764 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -655,7 +655,11 @@ Compatibility and Porting Guide
 @ifset unw
 Microsoft Windows Topics
 
+@ifclear FSFEDITION
+* Installing from the Command Line::
+@end ifclear
 * Using GNAT on Windows::
+* Using a network installation of GNAT::
 * CONSOLE and WINDOWS subsystems::
 * Temporary Files::
 * Mixed-Language Programming on Windows::
@@ -29091,6 +29095,9 @@ This chapter describes topics that are specific to the Microsoft Windows
 platforms (NT, 2000, and XP Professional).
 
 @menu
+@ifclear FSFEDITION
+* Installing from the Command Line::
+@end ifclear
 * Using GNAT on Windows::
 * Using a network installation of GNAT::
 * CONSOLE and WINDOWS subsystems::
@@ -29108,6 +29115,54 @@ platforms (NT, 2000, and XP Professional).
 * Setting Heap Size from gnatlink::
 @end menu
 
+@ifclear FSFEDITION
+@node Installing from the Command Line
+@section Installing from the Command Line
+@cindex Batch installation
+@cindex Silent installation
+@cindex Unassisted installation
+
+@noindent
+By default the @value{EDITION} installers display a GUI that prompts the user
+to enter installation path and similar information, and guide him through the
+installation process. It is also possible to perform silent installations
+using the command-line interface.
+
+In order to install one of the @value{EDITION} installers from the command
+line you should pass parameter @code{/S} (and, optionally,
+@code{/D=<directory>}) as command-line arguments.
+
+@ifset PROEDITION
+For example, for an unattended installation of
+@value{EDITION} 7.0.2 into the default directory
+@code{C:\GNATPRO\7.0.2} you would run:
+
+@smallexample
+gnatpro-7.0.2-i686-pc-mingw32-bin.exe /S
+@end smallexample
+
+To install into a custom directory, say, @code{C:\TOOLS\GNATPRO\7.0.2}:
+
+@smallexample
+gnatpro-7.0.2-i686-pc-mingw32-bin /S /D=C:\TOOLS\GNATPRO\7.0.2
+@end smallexample
+@end ifset
+
+@ifset GPLEDITION
+For example, for an unattended installation of
+@value{EDITION} 2012 into @code{C:\GNAT\2012}:
+
+@smallexample
+gnat-gpl-2012-i686-pc-mingw32-bin /S /D=C:\GNAT\2012
+@end smallexample
+@end ifset
+
+You can use the same syntax for all installers.
+
+Note that unattended installations don't modify system path, nor create file
+associations, so such activities need to be done by hand.
+@end ifclear
+
 @node Using GNAT on Windows
 @section Using GNAT on Windows
 
diff --git a/gcc/ada/init.c b/gcc/ada/init.c
index ef9087c63c4..8473ff03ff2 100644
--- a/gcc/ada/init.c
+++ b/gcc/ada/init.c
@@ -711,15 +711,6 @@ __gnat_install_handler(void)
 #include <sys/ucontext.h>
 #include <sys/regset.h>
 
-/* The code below is common to SPARC and x86.  Beware of the delay slot
-   differences for signal context adjustments.  */
-
-#if defined (__sparc)
-#define RETURN_ADDR_OFFSET 8
-#else
-#define RETURN_ADDR_OFFSET 0
-#endif
-
 static void
 __gnat_error_handler (int sig, siginfo_t *si, void *ucontext ATTRIBUTE_UNUSED)
 {
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 6c19a551408..832e7c24aa4 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -9448,12 +9448,16 @@ package body Sem_Ch13 is
          return False;
       end if;
 
-      --  Representations are different if component alignments differ
+      --  Representations are different if component alignments or scalar
+      --  storage orders differ.
 
       if (Is_Record_Type (T1) or else Is_Array_Type (T1))
         and then
          (Is_Record_Type (T2) or else Is_Array_Type (T2))
-        and then Component_Alignment (T1) /= Component_Alignment (T2)
+        and then
+         (Component_Alignment (T1) /= Component_Alignment (T2)
+            or else
+          Reverse_Storage_Order (T1) /= Reverse_Storage_Order (T2))
       then
          return False;
       end if;
@@ -9530,7 +9534,7 @@ package body Sem_Ch13 is
 
                function Same_Rep return Boolean;
                --  CD1 and CD2 are either components or discriminants. This
-               --  function tests whether the two have the same representation
+               --  function tests whether they have the same representation.
 
                --------------
                -- Same_Rep --
@@ -9540,8 +9544,11 @@ package body Sem_Ch13 is
                begin
                   if No (Component_Clause (CD1)) then
                      return No (Component_Clause (CD2));
-
                   else
+                     --  Note: at this point, component clauses have been
+                     --  normalized to the default bit order, so that the
+                     --  comparison of Component_Bit_Offsets is meaningful.
+
                      return
                         Present (Component_Clause (CD2))
                           and then
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index c93b7528b15..c6e8dca4820 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -8798,8 +8798,6 @@ package body Sem_Res is
         and then Ekind_In (Entity (S), E_Component, E_Discriminant)
         and then Present (Original_Record_Component (Entity (S)))
         and then Ekind (Original_Record_Component (Entity (S))) = E_Component
-        and then Present (Discriminant_Checking_Func
-                           (Original_Record_Component (Entity (S))))
         and then not Discriminant_Checks_Suppressed (T)
         and then not Init_Component
       then
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index 59c60b9644b..3be0f5833f2 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -807,7 +807,10 @@ package Sinfo is
    --    This flag is set on N_Selected_Component nodes to indicate that a
    --    discriminant check is required using the discriminant check routine
    --    associated with the selector. The actual check is generated by the
-   --    expander when processing selected components.
+   --    expander when processing selected components. In the case of
+   --    Unchecked_Union, the flag is also set, but no discriminant check
+   --    routine is associated with the selector, and the expander does not
+   --    generate a check.
 
    --  Do_Division_Check (Flag13-Sem)
    --    This flag is set on a division operator (/ mod rem) to indicate
diff --git a/gcc/ada/xgnatugn.adb b/gcc/ada/xgnatugn.adb
index ab168170f0c..3403ad4d871 100644
--- a/gcc/ada/xgnatugn.adb
+++ b/gcc/ada/xgnatugn.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2003-2008, Free Software Foundation, Inc.         --
+--          Copyright (C) 2003-2013, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -129,6 +129,7 @@ procedure Xgnatugn is
    procedure Put_Line (F : Sfile; S : String);
    --  Local version of Put_Line ensures Unix style line endings
 
+   First_Time         : Boolean := True;
    Number_Of_Warnings : Natural := 0;
    Number_Of_Errors   : Natural := 0;
    Warnings_Enabled   : Boolean;
@@ -237,15 +238,11 @@ procedure Xgnatugn is
    --  It relies on information in Source_File to generate error messages.
 
    type Conditional is (Set, Clear);
-   procedure Push_Conditional (Cond : Conditional; Flag : Target_Type);
+   procedure Push_Conditional (Cond : Conditional; Flag : Flag_Type);
    procedure Pop_Conditional  (Cond : Conditional);
    --  These subprograms deal with conditional processing (@ifset/@ifclear).
    --  They rely on information in Source_File to generate error messages.
 
-   function Currently_Excluding return Boolean;
-   --  Returns true if conditional processing directives imply that the
-   --  current line should not be included in the output.
-
    function VMS_Context_Determined return Boolean;
    --  Returns true if, in the current conditional preprocessing context, we
    --  always have a VMS or a non-VMS version, regardless of the value of
@@ -266,7 +263,6 @@ procedure Xgnatugn is
       Starting_Line : Positive;
       Cond          : Conditional;
       Flag          : Flag_Type;
-      Excluding     : Boolean;
    end record;
 
    Conditional_Stack_Depth : constant := 3;
@@ -972,6 +968,14 @@ procedure Xgnatugn is
                            Error (Source_File, "flag has to be lowercase");
                         end if;
 
+                        --  Set unw/vms flag in the output file so that
+                        --  @ifset/@ifclear will work as expected.
+
+                        if First_Time then
+                           Put_Line (Output_File, "@set " & Argument (1));
+                           First_Time := False;
+                        end if;
+
                      when Edition_Type =>
                         null;
                   end case;
@@ -1002,6 +1006,14 @@ procedure Xgnatugn is
                            Error (Source_File, "flag has to be lowercase");
                         end if;
 
+                        --  Set unw/vms flag in the output file so that
+                        --  @ifset/@ifclear will work as expected.
+
+                        if First_Time then
+                           Put_Line (Output_File, "@set " & Argument (1));
+                           First_Time := False;
+                        end if;
+
                      when Edition_Type =>
                         null;
                   end case;
@@ -1011,8 +1023,7 @@ procedure Xgnatugn is
                end;
             end if;
 
-            if Have_Conditional and (Flag in Target_Type) then
-
+            if Have_Conditional then
                --  We create a new conditional context and suppress the
                --  directive in the output.
 
@@ -1020,7 +1031,6 @@ procedure Xgnatugn is
 
             elsif Line'Length >= Endsetclear'Length
               and then Line (1 .. Endsetclear'Length) = Endsetclear
-              and then (Flag in Target_Type)
             then
                --  The '@end ifset'/'@end ifclear' case is handled here. We
                --  have to pop the conditional context.
@@ -1049,6 +1059,10 @@ procedure Xgnatugn is
 
                      if Have_Conditional then
                         Pop_Conditional (Cond);
+
+                        if Conditional_TOS > 0 then
+                           Flag := Conditional_Stack (Conditional_TOS).Flag;
+                        end if;
                      end if;
 
                      --  We fall through to the ordinary case for other @end
@@ -1058,14 +1072,7 @@ procedure Xgnatugn is
                end;
             end if;                     --  Have_Conditional
 
-            if (not Have_Conditional) or (Flag in Edition_Type) then
-
-               --  The ordinary case
-
-               if not Currently_Excluding then
-                  Put_Line (Output_File, Rewritten);
-               end if;
-            end if;
+            Put_Line (Output_File, Rewritten);
          end;
       end loop;
 
@@ -1156,42 +1163,27 @@ procedure Xgnatugn is
    -- Push_Conditional --
    ----------------------
 
-   procedure Push_Conditional (Cond : Conditional; Flag : Target_Type) is
-      Will_Exclude : Boolean;
-
+   procedure Push_Conditional (Cond : Conditional; Flag : Flag_Type) is
    begin
-      --  If we are already in an excluding context, inherit this property,
-      --  otherwise calculate it from scratch.
+      if Flag in Target_Type then
 
-      if Conditional_TOS > 0
-        and then Conditional_Stack (Conditional_TOS).Excluding
-      then
-         Will_Exclude := True;
-      else
-         case Cond is
-            when Set =>
-               Will_Exclude := Flag /= Target;
-            when Clear =>
-               Will_Exclude := Flag = Target;
-         end case;
-      end if;
+         --  Check if the current directive is pointless because of a previous,
+         --  enclosing directive.
 
-      --  Check if the current directive is pointless because of a previous,
-      --  enclosing directive.
-
-      for J in 1 .. Conditional_TOS loop
-         if Conditional_Stack (J).Flag = Flag then
-            Warning (Source_File, "directive without effect because of line"
-                     & Integer'Image (Conditional_Stack (J).Starting_Line));
-         end if;
-      end loop;
+         for J in 1 .. Conditional_TOS loop
+            if Conditional_Stack (J).Flag = Flag then
+               Warning
+                 (Source_File, "directive without effect because of line"
+                 & Integer'Image (Conditional_Stack (J).Starting_Line));
+            end if;
+         end loop;
+      end if;
 
       Conditional_TOS := Conditional_TOS + 1;
       Conditional_Stack (Conditional_TOS) :=
         (Starting_Line => Source_File.Line,
          Cond          => Cond,
-         Flag          => Flag,
-         Excluding     => Will_Exclude);
+         Flag          => Flag);
    end Push_Conditional;
 
    ---------------------
@@ -1234,16 +1226,6 @@ procedure Xgnatugn is
       end if;
    end Pop_Conditional;
 
-   -------------------------
-   -- Currently_Excluding --
-   -------------------------
-
-   function Currently_Excluding return Boolean is
-   begin
-      return Conditional_TOS > 0
-        and then Conditional_Stack (Conditional_TOS).Excluding;
-   end Currently_Excluding;
-
    ----------------------------
    -- VMS_Context_Determined --
    ----------------------------