2010-10-26 Robert Dewar <dewar@adacore.com>

	* einfo.ads, einfo.adb (Is_Base_Type): New function, use it where
	appropriate.
	* exp_ch6.adb, exp_dbug.adb, exp_disp.adb, freeze.adb, lib-xref.adb,
	sem_aux.adb, sem_ch3.adb, sem_ch7.adb, sem_ch8.adb (Is_Base_Type): Use
	this new abstraction where appropriate.

2010-10-26  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch12.adb: Code clean up.

2010-10-26  Paul Hilfinger  <hilfinger@adacore.com>

	* exp_dbug.ads: Document effect of 'pragma Unchecked_Union' on
	debugging data.

2010-10-26  Ed Schonberg  <schonberg@adacore.com>

	* sem_util.adb (Note_Possible_Modification): If the target of an
	assignment is the bound variable in an iterator, the domain of
	iteration, i.e. array or container, is modified as well.

2010-10-26  Bob Duff  <duff@adacore.com>

	* Make-generated.in: Make the relevant make targets depend on
	ceinfo.adb and csinfo.adb.
	* csinfo.adb, ceinfo.adb: Make sure it raises an exception on failure,
	so when called from xeinfo, the failure will be noticed.
	* sinfo.ads: Update comments to reflect the fact that xsinfo runs csinfo
	* xsinfo.adb, xeinfo.adb: Run ceinfo to check for errors. Close files.

2010-10-26  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch4.adb: Set properly parent field of operands of concatenation.

2010-10-26  Ed Schonberg  <schonberg@adacore.com>

	* sem_res.adb (Check_Infinite_Recursion): A recursive call within a
	conditional expression or a case expression should not generate an
	infinite recursion warning.



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

23 files changed, 217 insertions, 94 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index b979f650676..2bb9022bf41 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,45 @@
+2010-10-26  Robert Dewar  <dewar@adacore.com>
+
+	* einfo.ads, einfo.adb (Is_Base_Type): New function, use it where
+	appropriate.
+	* exp_ch6.adb, exp_dbug.adb, exp_disp.adb, freeze.adb, lib-xref.adb,
+	sem_aux.adb, sem_ch3.adb, sem_ch7.adb, sem_ch8.adb (Is_Base_Type): Use
+	this new abstraction where appropriate.
+
+2010-10-26  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch12.adb: Code clean up.
+
+2010-10-26  Paul Hilfinger  <hilfinger@adacore.com>
+
+	* exp_dbug.ads: Document effect of 'pragma Unchecked_Union' on
+	debugging data.
+
+2010-10-26  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_util.adb (Note_Possible_Modification): If the target of an
+	assignment is the bound variable in an iterator, the domain of
+	iteration, i.e. array or container, is modified as well.
+
+2010-10-26  Bob Duff  <duff@adacore.com>
+
+	* Make-generated.in: Make the relevant make targets depend on
+	ceinfo.adb and csinfo.adb.
+	* csinfo.adb, ceinfo.adb: Make sure it raises an exception on failure,
+	so when called from xeinfo, the failure will be noticed.
+	* sinfo.ads: Update comments to reflect the fact that xsinfo runs csinfo
+	* xsinfo.adb, xeinfo.adb: Run ceinfo to check for errors. Close files.
+
+2010-10-26  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_ch4.adb: Set properly parent field of operands of concatenation.
+
+2010-10-26  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_res.adb (Check_Infinite_Recursion): A recursive call within a
+	conditional expression or a case expression should not generate an
+	infinite recursion warning.
+
 2010-10-26  Javier Miranda  <miranda@adacore.com>
 
 	* einfo.ads, einfo.adb (Is_Overriding_Operation): Removed.
diff --git a/gcc/ada/Make-generated.in b/gcc/ada/Make-generated.in
index 6942d7a5fcc..30ce14e916d 100644
--- a/gcc/ada/Make-generated.in
+++ b/gcc/ada/Make-generated.in
@@ -29,13 +29,13 @@ $(ADA_GEN_SUBDIR)/treeprs.ads : $(ADA_GEN_SUBDIR)/treeprs.adt $(ADA_GEN_SUBDIR)/
 	$(CP) $^ $(ADA_GEN_SUBDIR)/bldtools/treeprs
 	(cd $(ADA_GEN_SUBDIR)/bldtools/treeprs; gnatmake -q xtreeprs ; ./xtreeprs ../../treeprs.ads )
 
-$(ADA_GEN_SUBDIR)/einfo.h : $(ADA_GEN_SUBDIR)/einfo.ads $(ADA_GEN_SUBDIR)/einfo.adb $(ADA_GEN_SUBDIR)/xeinfo.adb
+$(ADA_GEN_SUBDIR)/einfo.h : $(ADA_GEN_SUBDIR)/einfo.ads $(ADA_GEN_SUBDIR)/einfo.adb $(ADA_GEN_SUBDIR)/xeinfo.adb $(ADA_GEN_SUBDIR)/ceinfo.adb
 	-$(MKDIR) $(ADA_GEN_SUBDIR)/bldtools/einfo
 	$(RM) $(addprefix $(ADA_GEN_SUBDIR)/bldtools/einfo/,$(notdir $^))
 	$(CP) $^ $(ADA_GEN_SUBDIR)/bldtools/einfo
 	(cd $(ADA_GEN_SUBDIR)/bldtools/einfo; gnatmake -q xeinfo ; ./xeinfo ../../einfo.h )
 
-$(ADA_GEN_SUBDIR)/sinfo.h : $(ADA_GEN_SUBDIR)/sinfo.ads $(ADA_GEN_SUBDIR)/xsinfo.adb
+$(ADA_GEN_SUBDIR)/sinfo.h : $(ADA_GEN_SUBDIR)/sinfo.ads $(ADA_GEN_SUBDIR)/sinfo.adb $(ADA_GEN_SUBDIR)/xsinfo.adb $(ADA_GEN_SUBDIR)/csinfo.adb
 	-$(MKDIR) $(ADA_GEN_SUBDIR)/bldtools/sinfo
 	$(RM) $(addprefix $(ADA_GEN_SUBDIR)/bldtools/sinfo/,$(notdir $^))
 	$(CP) $^ $(ADA_GEN_SUBDIR)/bldtools/sinfo
diff --git a/gcc/ada/ceinfo.adb b/gcc/ada/ceinfo.adb
index 78e3faeb8cd..47f134a37e2 100644
--- a/gcc/ada/ceinfo.adb
+++ b/gcc/ada/ceinfo.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1998-2008, Free Software Foundation, Inc.         --
+--          Copyright (C) 1998-2010, 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- --
@@ -23,8 +23,12 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  Program to check consistency of einfo.ads and einfo.adb. Checks that
---  field name usage is consistent, including comments mentioning fields.
+--  Check consistency of einfo.ads and einfo.adb. Checks that field name usage
+--  is consistent, including comments mentioning fields.
+
+--  Note that this is used both as a standalone program, and as a procedure
+--  called by XEinfo. This raises an unhandled exception if it finds any
+--  errors; we don't attempt any sophisticated error recovery.
 
 with Ada.Strings.Unbounded;         use Ada.Strings.Unbounded;
 with Ada.Strings.Unbounded.Text_IO; use Ada.Strings.Unbounded.Text_IO;
@@ -42,6 +46,9 @@ procedure CEinfo is
    Infil  : File_Type;
    Lineno : Natural := 0;
 
+   Err : exception;
+   --  Raised on error
+
    Fieldnm    : VString;
    Accessfunc : VString;
    Line       : VString;
@@ -126,6 +133,7 @@ begin
                Put_Line
                  ("*** unknown field name " & Fieldnm & " at line " & Lineno);
             end if;
+            raise Err;
          end if;
       end if;
    end loop;
@@ -153,6 +161,7 @@ begin
             Put_Line
               ("*** unknown field name " & Fieldnm & " at line " & Lineno);
          end if;
+            raise Err;
       end if;
    end loop;
 
@@ -172,6 +181,7 @@ begin
          Put_Line ("*** incorrect field at line " & Lineno);
          Put_Line ("      found field " & Accessfunc);
          Put_Line ("      expecting field " & Get (Fields, Fieldnm));
+         raise Err;
       end if;
    end loop;
 
@@ -196,9 +206,12 @@ begin
          Put_Line ("*** incorrect field at line " & Lineno);
          Put_Line ("      found field " & Accessfunc);
          Put_Line ("      expecting field " & Get (Fields, Fieldnm));
+         raise Err;
       end if;
    end loop;
 
+   Close (Infil);
+
    Put_Line ("All tests completed successfully, no errors detected");
 
 end CEinfo;
diff --git a/gcc/ada/csinfo.adb b/gcc/ada/csinfo.adb
index 6808dbef27e..ef319cff9e5 100644
--- a/gcc/ada/csinfo.adb
+++ b/gcc/ada/csinfo.adb
@@ -23,10 +23,13 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  Program to check consistency of sinfo.ads and sinfo.adb. Checks that field
---  name usage is consistent and that assertion cross-reference lists are
---  correct, as well as making sure that all the comments on field name usage
---  are consistent.
+--  Check consistency of sinfo.ads and sinfo.adb. Checks that field name usage
+--  is consistent and that assertion cross-reference lists are correct, as well
+--  as making sure that all the comments on field name usage are consistent.
+
+--  Note that this is used both as a standalone program, and as a procedure
+--  called by XSinfo. This raises an unhandled exception if it finds any
+--  errors; we don't attempt any sophisticated error recovery.
 
 with Ada.Strings.Unbounded;         use Ada.Strings.Unbounded;
 with Ada.Strings.Unbounded.Text_IO; use Ada.Strings.Unbounded.Text_IO;
@@ -635,8 +638,4 @@ begin
    New_Line;
    Put_Line ("All tests completed successfully, no errors detected");
 
-exception
-   when Done =>
-      null;
-
 end CSinfo;
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index e7f0b4f217d..d8b24a3d83a 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -2996,7 +2996,7 @@ package body Einfo is
 
    procedure Set_Access_Disp_Table (Id : E; V : L) is
    begin
-      pragma Assert (Is_Tagged_Type (Id) and then Id = Base_Type (Id));
+      pragma Assert (Is_Tagged_Type (Id) and then Is_Base_Type (Id));
       Set_Elist16 (Id, V);
    end Set_Access_Disp_Table;
 
@@ -3018,7 +3018,7 @@ package body Einfo is
 
    procedure Set_Associated_Storage_Pool (Id : E; V : E) is
    begin
-      pragma Assert (Is_Access_Type (Id) and then Id = Base_Type (Id));
+      pragma Assert (Is_Access_Type (Id) and then Is_Base_Type (Id));
       Set_Node22 (Id, V);
    end Set_Associated_Storage_Pool;
 
@@ -3082,7 +3082,7 @@ package body Einfo is
 
    procedure Set_C_Pass_By_Copy (Id : E; V : B := True) is
    begin
-      pragma Assert (Is_Record_Type (Id) and then Id = Base_Type (Id));
+      pragma Assert (Is_Record_Type (Id) and then Is_Base_Type (Id));
       Set_Flag125 (Id, V);
    end Set_C_Pass_By_Copy;
 
@@ -3122,13 +3122,13 @@ package body Einfo is
 
    procedure Set_Component_Size (Id : E; V : U) is
    begin
-      pragma Assert (Is_Array_Type (Id) and then Id = Base_Type (Id));
+      pragma Assert (Is_Array_Type (Id) and then Is_Base_Type (Id));
       Set_Uint22 (Id, V);
    end Set_Component_Size;
 
    procedure Set_Component_Type (Id : E; V : E) is
    begin
-      pragma Assert (Is_Array_Type (Id) and then Id = Base_Type (Id));
+      pragma Assert (Is_Array_Type (Id) and then Is_Base_Type (Id));
       Set_Node20 (Id, V);
    end Set_Component_Type;
 
@@ -3302,7 +3302,7 @@ package body Einfo is
 
    procedure Set_Dispatch_Table_Wrappers (Id : E; V : L) is
    begin
-      pragma Assert (Is_Tagged_Type (Id) and then Id = Base_Type (Id));
+      pragma Assert (Is_Tagged_Type (Id) and then Is_Base_Type (Id));
       Set_Elist26 (Id, V);
    end Set_Dispatch_Table_Wrappers;
 
@@ -3477,8 +3477,7 @@ package body Einfo is
    procedure Set_Can_Use_Internal_Rep (Id : E; V : B := True) is
    begin
       pragma Assert
-        (Is_Access_Subprogram_Type (Id)
-          and then Id = Base_Type (Id));
+        (Is_Access_Subprogram_Type (Id) and then Is_Base_Type (Id));
       Set_Flag229 (Id, V);
    end Set_Can_Use_Internal_Rep;
 
@@ -3489,7 +3488,7 @@ package body Einfo is
 
    procedure Set_Finalize_Storage_Only (Id : E; V : B := True) is
    begin
-      pragma Assert (Is_Type (Id) and then Id = Base_Type (Id));
+      pragma Assert (Is_Type (Id) and then Is_Base_Type (Id));
       Set_Flag158 (Id, V);
    end Set_Finalize_Storage_Only;
 
@@ -3597,7 +3596,7 @@ package body Einfo is
 
    procedure Set_Has_Atomic_Components (Id : E; V : B := True) is
    begin
-      pragma Assert (not Is_Type (Id) or else Id = Base_Type (Id));
+      pragma Assert (not Is_Type (Id) or else Is_Base_Type (Id));
       Set_Flag86 (Id, V);
    end Set_Has_Atomic_Components;
 
@@ -3995,7 +3994,7 @@ package body Einfo is
 
    procedure Set_Has_Volatile_Components (Id : E; V : B := True) is
    begin
-      pragma Assert (not Is_Type (Id) or else Id = Base_Type (Id));
+      pragma Assert (not Is_Type (Id) or else Is_Base_Type (Id));
       Set_Flag87 (Id, V);
    end Set_Has_Volatile_Components;
 
@@ -4118,7 +4117,7 @@ package body Einfo is
    procedure Set_Is_Bit_Packed_Array (Id : E; V : B := True) is
    begin
       pragma Assert ((not V)
-        or else (Is_Array_Type (Id) and then Id = Base_Type (Id)));
+        or else (Is_Array_Type (Id) and then Is_Base_Type (Id)));
 
       Set_Flag122 (Id, V);
    end Set_Is_Bit_Packed_Array;
@@ -4736,7 +4735,7 @@ package body Einfo is
 
    procedure Set_No_Pool_Assigned (Id : E; V : B := True) is
    begin
-      pragma Assert (Is_Access_Type (Id) and then Id = Base_Type (Id));
+      pragma Assert (Is_Access_Type (Id) and then Is_Base_Type (Id));
       Set_Flag131 (Id, V);
    end Set_No_Pool_Assigned;
 
@@ -4749,13 +4748,13 @@ package body Einfo is
 
    procedure Set_No_Strict_Aliasing (Id : E; V : B := True) is
    begin
-      pragma Assert (Is_Access_Type (Id) and then Id = Base_Type (Id));
+      pragma Assert (Is_Access_Type (Id) and then Is_Base_Type (Id));
       Set_Flag136 (Id, V);
    end Set_No_Strict_Aliasing;
 
    procedure Set_Non_Binary_Modulus (Id : E; V : B := True) is
    begin
-      pragma Assert (Is_Type (Id) and then Id = Base_Type (Id));
+      pragma Assert (Is_Type (Id) and then Is_Base_Type (Id));
       Set_Flag58 (Id, V);
    end Set_Non_Binary_Modulus;
 
@@ -4800,7 +4799,7 @@ package body Einfo is
    procedure Set_OK_To_Reorder_Components (Id : E; V : B := True) is
    begin
       pragma Assert
-        (Is_Record_Type (Id) and then Id = Base_Type (Id));
+        (Is_Record_Type (Id) and then Is_Base_Type (Id));
       Set_Flag239 (Id, V);
    end Set_OK_To_Reorder_Components;
 
@@ -4974,7 +4973,7 @@ package body Einfo is
 
    procedure Set_Relative_Deadline_Variable (Id : E; V : E) is
    begin
-      pragma Assert (Is_Task_Type (Id) and then Id = Base_Type (Id));
+      pragma Assert (Is_Task_Type (Id) and then Is_Base_Type (Id));
       Set_Node26 (Id, V);
    end Set_Relative_Deadline_Variable;
 
@@ -5023,7 +5022,7 @@ package body Einfo is
    procedure Set_Reverse_Bit_Order (Id : E; V : B := True) is
    begin
       pragma Assert
-        (Is_Record_Type (Id) and then Id = Base_Type (Id));
+        (Is_Record_Type (Id) and then Is_Base_Type (Id));
       Set_Flag164 (Id, V);
    end Set_Reverse_Bit_Order;
 
@@ -5209,7 +5208,7 @@ package body Einfo is
 
    procedure Set_Universal_Aliasing (Id : E; V : B := True) is
    begin
-      pragma Assert (Is_Type (Id) and then Id = Base_Type (Id));
+      pragma Assert (Is_Type (Id) and then Is_Base_Type (Id));
       Set_Flag216 (Id, V);
    end Set_Universal_Aliasing;
 
@@ -6167,6 +6166,15 @@ package body Einfo is
       end if;
    end Invariant_Procedure;
 
+   ------------------
+   -- Is_Base_Type --
+   ------------------
+
+   function Is_Base_Type (Id : E) return Boolean is
+   begin
+      return Id = Base_Type (Id);
+   end Is_Base_Type;
+
    ---------------------
    -- Is_Boolean_Type --
    ---------------------
@@ -6977,7 +6985,7 @@ package body Einfo is
    procedure Set_Component_Alignment (Id : E; V : C) is
    begin
       pragma Assert ((Is_Array_Type (Id) or else Is_Record_Type (Id))
-                       and then Id = Base_Type (Id));
+                       and then Is_Base_Type (Id));
 
       case V is
          when Calign_Default          =>
@@ -7264,7 +7272,7 @@ package body Einfo is
 
    begin
       if (Is_Array_Type (Id) or else Is_Record_Type (Id))
-        and then Id = Base_Type (Id)
+        and then Is_Base_Type (Id)
       then
          Write_Str (Prefix);
          Write_Str ("Component_Alignment = ");
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 026c1b2db42..e69dcea5cac 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -1992,6 +1992,9 @@ package Einfo is
 --       Present in all type entities and in procedure entities. Set
 --       if a pragma Asynchronous applies to the entity.
 
+--    Is_Base_Type (synthesized)
+--       Applies to type and subtype entities. True if entity is a base type
+
 --    Is_Bit_Packed_Array (Flag122) [implementation base type only]
 --       Present in all entities. This flag is set for a packed array type that
 --       is bit packed (i.e. the component size is known by the front end and
@@ -6341,6 +6344,7 @@ package Einfo is
    function Has_Private_Ancestor                (Id : E) return B;
    function Has_Private_Declaration             (Id : E) return B;
    function Implementation_Base_Type            (Id : E) return E;
+   function Is_Base_Type                        (Id : E) return B;
    function Is_Boolean_Type                     (Id : E) return B;
    function Is_Constant_Object                  (Id : E) return B;
    function Is_Discriminal                      (Id : E) return B;
@@ -7976,6 +7980,7 @@ package Einfo is
    --  things here which are small, but not of the canonical attribute
    --  access/set format that can be handled by xeinfo.
 
+   pragma Inline (Is_Base_Type);
    pragma Inline (Is_Package_Or_Generic_Package);
    pragma Inline (Is_Volatile);
    pragma Inline (Is_Wrapper_Package);
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index cfea0d6d6b6..cbd8a2eef3a 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -2493,9 +2493,11 @@ package body Exp_Ch4 is
          Opnd_Typ := Etype (Opnd);
 
          --  The parent got messed up when we put the operands in a list,
-         --  so now put back the proper parent for the saved operand.
+         --  so now put back the proper parent for the saved operand, that
+         --  is to say the concatenation node, to make sure that each operand
+         --  is seen as a subexpression, e.g. if actions must be inserted.
 
-         Set_Parent (Opnd, Parent (Cnode));
+         Set_Parent (Opnd, Cnode);
 
          --  Set will be True when we have setup one entry in the array
 
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 82a11d321ce..d4b5781a5e8 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -600,7 +600,7 @@ package body Exp_Ch6 is
       if Is_Derived_Type (Typ)
         and then not Is_Private_Type (Typ)
         and then In_Open_Scopes (Scope (Etype (Typ)))
-        and then Typ = Base_Type (Typ)
+        and then Is_Base_Type (Typ)
       then
          --  Subp overrides an inherited private operation if there is an
          --  inherited operation with a different name than Subp (see
diff --git a/gcc/ada/exp_dbug.adb b/gcc/ada/exp_dbug.adb
index 610ac0e5520..ca36f14ad87 100644
--- a/gcc/ada/exp_dbug.adb
+++ b/gcc/ada/exp_dbug.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1996-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1996-2010, 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- --
@@ -529,8 +529,7 @@ package body Exp_Dbug is
 
       --  Or if this is an enumeration base type
 
-        or else (Is_Enumeration_Type (E)
-                   and then E = Base_Type (E))
+        or else (Is_Enumeration_Type (E) and then Is_Base_Type (E))
 
       --  Or if this is a dummy type for a renaming
 
diff --git a/gcc/ada/exp_dbug.ads b/gcc/ada/exp_dbug.ads
index b4cf44b6d1d..711795730f1 100644
--- a/gcc/ada/exp_dbug.ads
+++ b/gcc/ada/exp_dbug.ads
@@ -1323,9 +1323,8 @@ package Exp_Dbug is
 
    --  where discrim is the unqualified name of the variant. This field name is
    --  built by gigi (not by code in this unit). For Unchecked_Union record,
-   --  this discriminant will not appear in the record, and the debugger must
-   --  proceed accordingly (basically it can treat this case as it would a C
-   --  union).
+   --  this discriminant will not appear in the record (see Unchecked Unions,
+   --  below).
 
    --  The type corresponding to this field has a name that is obtained by
    --  concatenating the type name with the above string and is similar to a C
@@ -1338,7 +1337,7 @@ package Exp_Dbug is
    --  The name of the union member is encoded to indicate the choices, and
    --  is a string given by the following grammar:
 
-   --    union_name ::= {choice} | others_choice
+   --    member_name ::= {choice} | others_choice
    --    choice ::= simple_choice | range_choice
    --    simple_choice ::= S number
    --    range_choice  ::= R number T number
@@ -1377,12 +1376,34 @@ package Exp_Dbug is
 
    --    V1 : Var;
 
-   --  In this case, the type var is represented as a struct with three fields,
-   --  the first two are "disc" and "m", representing the values of these
-   --  record components.
-
-   --  The third field is a union of two types, with field names S1 and O. S1
-   --  is a struct with fields "r" and "s", and O is a struct with fields "t".
+   --  In this case, the type var is represented as a struct with three fields.
+   --  The first two are "disc" and "m", representing the values of these
+   --  record components. The third field is a union of two types, with field
+   --  names S1 and O. S1 is a struct with fields "r" and "s", and O is a
+   --  struct with field "t".
+
+   ----------------------
+   -- Unchecked Unions --
+   ----------------------
+
+   --  The encoding for variant records changes somewhat under the influence
+   --  of a "pragma Unchecked_Union" clause:
+
+   --     1. The discriminant will not be present in the record, although its
+   --        name is still used in the encodings.
+   --     2. Variants containing a single component named "x" of type "T" may
+   --        be encoded, as in ordinary C unions, as a single field of the
+   --        enclosing union type named "x" of type "T", dispensing with the
+   --        enclosing struct. In this case, of course, the discriminant values
+   --        corresponding to the variant are unavailable. As for normal
+   --        variants, the field name "x" may be suffixed with ___XVL if it
+   --        has dynamic size.
+
+   --  For example, the type Var in the preceding section, if followed by
+   --  "pragma Unchecked_Union (Var);" may be encoded as a struct with two
+   --  fields. The first is "m". The second field is a union of two types,
+   --  with field names S1 and "t". As before, S1 is a struct with fields
+   --  "r" and "s". "t" is a field of type Integer.
 
    ------------------------------------------------
    -- Subprograms for Handling Variant Encodings --
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index a4eccd61738..0395282f604 100644
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -7359,7 +7359,7 @@ package body Exp_Disp is
                         (Nkind (Parent (Typ)) = N_Private_Extension_Declaration
                           and then Is_Generic_Type (Typ)))
            and then In_Open_Scopes (Scope (Etype (Typ)))
-           and then Typ = Base_Type (Typ)
+           and then Is_Base_Type (Typ)
          then
             Handle_Inherited_Private_Subprograms (Typ);
          end if;
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index e9c715ef2b1..f7b40527395 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -2062,9 +2062,7 @@ package body Freeze is
 
          --  Set OK_To_Reorder_Components depending on debug flags
 
-         if Rec = Base_Type (Rec)
-           and then Convention (Rec) = Convention_Ada
-         then
+         if Is_Base_Type (Rec) and then Convention (Rec) = Convention_Ada then
             if (Has_Discriminants (Rec) and then Debug_Flag_Dot_V)
                   or else
                (not Has_Discriminants (Rec) and then Debug_Flag_Dot_R)
@@ -3818,9 +3816,7 @@ package body Freeze is
             --  these till the freeze-point since we need the small and range
             --  values. We only do these checks for base types
 
-            if Is_Ordinary_Fixed_Point_Type (E)
-              and then E = Base_Type (E)
-            then
+            if Is_Ordinary_Fixed_Point_Type (E) and then Is_Base_Type (E) then
                if Small_Value (E) < Ureal_2_M_80 then
                   Error_Msg_Name_1 := Name_Small;
                   Error_Msg_N
@@ -3865,7 +3861,7 @@ package body Freeze is
             --  only to base types.
 
             if Present (Default_Pool)
-              and then E = Base_Type (E)
+              and then Is_Base_Type (E)
               and then not Has_Storage_Size_Clause (E)
               and then No (Associated_Storage_Pool (E))
             then
diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb
index b055304e589..81b724103f4 100644
--- a/gcc/ada/lib-xref.adb
+++ b/gcc/ada/lib-xref.adb
@@ -1172,7 +1172,7 @@ package body Lib.Xref is
 
             if Is_Type (Ent)
               and then Is_Tagged_Type (Ent)
-              and then Ent = Base_Type (Ent)
+              and then Is_Base_Type (Ent)
               and then In_Extended_Main_Source_Unit (Ent)
             then
                Generate_Prim_Op_References (Ent);
@@ -1281,7 +1281,7 @@ package body Lib.Xref is
             if Is_Type (Ent)
               and then Is_Tagged_Type (Ent)
               and then Is_Derived_Type (Ent)
-              and then Ent = Base_Type (Ent)
+              and then Is_Base_Type (Ent)
               and then In_Extended_Main_Source_Unit (Ent)
             then
                declare
diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb
index f19ead7117d..813ede844fb 100755
--- a/gcc/ada/sem_aux.adb
+++ b/gcc/ada/sem_aux.adb
@@ -48,7 +48,7 @@ package body Sem_Aux is
       --  If this is first subtype, or is a base type, then there is no
       --  ancestor subtype, so we return Empty to indicate this fact.
 
-      if Is_First_Subtype (Typ) or else Typ = Base_Type (Typ) then
+      if Is_First_Subtype (Typ) or else Is_Base_Type (Typ) then
          return Empty;
       end if;
 
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 32058f0971c..cd66772d40b 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -5501,6 +5501,7 @@ package body Sem_Ch12 is
            and then Is_Private_Type (Designated_Type (T))
            and then not Has_Private_View (N)
            and then Present (Full_View (Designated_Type (T)))
+           and then Used_As_Generic_Actual (T)
          then
             Switch_View (Designated_Type (T));
 
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 76d60a42640..f208be484b1 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -11716,7 +11716,7 @@ package body Sem_Ch3 is
          Set_Direct_Primitive_Operations (Full,
            Direct_Primitive_Operations (Priv));
 
-         if Priv = Base_Type (Priv) then
+         if Is_Base_Type (Priv) then
             Set_Class_Wide_Type      (Full, Class_Wide_Type         (Priv));
          end if;
       end if;
diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb
index ce6184f270b..3c13d991466 100644
--- a/gcc/ada/sem_ch7.adb
+++ b/gcc/ada/sem_ch7.adb
@@ -1500,7 +1500,7 @@ package body Sem_Ch7 is
                  (Nkind (Parent (E)) = N_Private_Extension_Declaration
                    and then Is_Generic_Type (E)))
            and then In_Open_Scopes (Scope (Etype (E)))
-           and then E = Base_Type (E)
+           and then Is_Base_Type (E)
          then
             if Is_Tagged_Type (E) then
                Op_List := Primitive_Operations (E);
@@ -2010,7 +2010,7 @@ package body Sem_Ch7 is
       ------------------------------
 
       procedure Preserve_Full_Attributes (Priv, Full : Entity_Id) is
-         Priv_Is_Base_Type : constant Boolean := Priv = Base_Type (Priv);
+         Priv_Is_Base_Type : constant Boolean := Is_Base_Type (Priv);
 
       begin
          Set_Size_Info (Priv, (Full));
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index 0fbd49a6c32..2abee094488 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -6001,9 +6001,8 @@ package body Sem_Ch8 is
       while Present (Id)
         and then Id /= Priv_Id
       loop
-         if Is_Standard_Character_Type (Id)
-           and then Id = Base_Type (Id)
-         then
+         if Is_Standard_Character_Type (Id) and then Is_Base_Type (Id) then
+
             --  We replace the node with the literal itself, resolve as a
             --  character, and set the type correctly.
 
@@ -6164,9 +6163,7 @@ package body Sem_Ch8 is
 
          when Name_Op_And | Name_Op_Not | Name_Op_Or  | Name_Op_Xor =>
             while Id  /= Priv_Id loop
-               if Valid_Boolean_Arg (Id)
-                 and then Id = Base_Type (Id)
-               then
+               if Valid_Boolean_Arg (Id) and then Is_Base_Type (Id) then
                   Add_Implicit_Operator (Id);
                   return True;
                end if;
@@ -6180,7 +6177,7 @@ package body Sem_Ch8 is
             while Id  /= Priv_Id loop
                if Is_Type (Id)
                  and then not Is_Limited_Type (Id)
-                 and then Id = Base_Type (Id)
+                 and then Is_Base_Type (Id)
                then
                   Add_Implicit_Operator (Standard_Boolean, Id);
                   return True;
@@ -6194,9 +6191,9 @@ package body Sem_Ch8 is
          when Name_Op_Lt | Name_Op_Le | Name_Op_Gt | Name_Op_Ge =>
             while Id  /= Priv_Id loop
                if (Is_Scalar_Type (Id)
-                 or else (Is_Array_Type (Id)
-                           and then Is_Scalar_Type (Component_Type (Id))))
-                 and then Id = Base_Type (Id)
+                    or else (Is_Array_Type (Id)
+                              and then Is_Scalar_Type (Component_Type (Id))))
+                 and then Is_Base_Type (Id)
                then
                   Add_Implicit_Operator (Standard_Boolean, Id);
                   return True;
@@ -6216,9 +6213,7 @@ package body Sem_Ch8 is
               Name_Op_Divide   |
               Name_Op_Expon    =>
             while Id  /= Priv_Id loop
-               if Is_Numeric_Type (Id)
-                 and then Id = Base_Type (Id)
-               then
+               if Is_Numeric_Type (Id) and then Is_Base_Type (Id) then
                   Add_Implicit_Operator (Id);
                   return True;
                end if;
@@ -6230,8 +6225,9 @@ package body Sem_Ch8 is
 
          when Name_Op_Concat =>
             while Id  /= Priv_Id loop
-               if Is_Array_Type (Id) and then Number_Dimensions (Id) = 1
-                 and then Id = Base_Type (Id)
+               if Is_Array_Type (Id)
+                 and then Number_Dimensions (Id) = 1
+                 and then Is_Base_Type (Id)
                then
                   Add_Implicit_Operator (Id);
                   return True;
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 784f6bd98c6..0358ade3616 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -819,8 +819,10 @@ package body Sem_Res is
 
          if Nkind_In (P, N_Or_Else,
                          N_And_Then,
-                         N_If_Statement,
-                         N_Case_Statement)
+                         N_Case_Expression,
+                         N_Case_Statement,
+                         N_Conditional_Expression,
+                         N_If_Statement)
          then
             return False;
 
@@ -5277,7 +5279,7 @@ package body Sem_Res is
            and then Check_Infinite_Recursion (N)
          then
             --  Here we detected and flagged an infinite recursion, so we do
-            --  not need to test the case below for further warnings. Also if
+            --  not need to test the case below for further warnings. Also, if
             --  we now have a raise SE node, we are all done.
 
             if Nkind (N) = N_Raise_Storage_Error then
@@ -10095,7 +10097,7 @@ package body Sem_Res is
          --  this situation can arise in source code.
 
          elsif In_Instance or else In_Inlined_Body then
-               return True;
+            return True;
 
          --  Otherwise we need the conversion check
 
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 29826c0b6f7..6962018dea7 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -9648,6 +9648,29 @@ package body Sem_Util is
 
                if Modification_Comes_From_Source then
                   Generate_Reference (Ent, Exp, 'm');
+
+                  --  If the target of the assignment is the bound variable
+                  --  in an iterator, indicate that the corresponding array
+                  --  or container is also modified.
+
+                  if Ada_Version >= Ada_2012
+                    and then
+                      Nkind (Parent (Ent)) = N_Iterator_Specification
+                  then
+                     declare
+                        Domain : constant Node_Id := Name (Parent (Ent));
+
+                     begin
+                        --  TBD : in the full version of the construct, the
+                        --  domain of iteration can be given by an expression.
+
+                        if Is_Entity_Name (Domain) then
+                           Generate_Reference      (Entity (Domain), Exp, 'm');
+                           Set_Is_True_Constant    (Entity (Domain), False);
+                           Set_Never_Set_In_Source (Entity (Domain), False);
+                        end if;
+                     end;
+                  end if;
                end if;
 
                Check_Nested_Access (Ent);
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index 4a267fc852b..295b25a1f6c 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -100,10 +100,10 @@ package Sinfo is
 
    --  Finally, four utility programs must be run:
 
-   --    Run CSinfo to check that you have made the changes consistently. It
-   --     checks most of the rules given above, with clear error messages. This
-   --     utility reads sinfo.ads and sinfo.adb and generates a report to
-   --     standard output.
+   --    (Optional.) Run CSinfo to check that you have made the changes
+   --     consistently. It checks most of the rules given above. This utility
+   --     reads sinfo.ads and sinfo.adb and generates a report to standard
+   --     output. This step is optional because XSinfo runs CSinfo.
 
    --    Run XSinfo to create sinfo.h, the corresponding C header. This
    --     utility reads sinfo.ads and generates sinfo.h. Note that it does
@@ -120,8 +120,8 @@ package Sinfo is
    --     spec of the Nmake package which contains functions for constructing
    --     nodes.
 
-   --  All of the above steps except CSinfo are done automatically by the
-   --  build scripts when you do a full bootstrap.
+   --  The above steps are done automatically by the build scripts when you do
+   --  a full bootstrap.
 
    --  Note: sometime we could write a utility that actually generated the body
    --  of sinfo from the spec instead of simply checking it, since, as noted
diff --git a/gcc/ada/xeinfo.adb b/gcc/ada/xeinfo.adb
index 1c76c316ed0..ba9ded9d5cc 100644
--- a/gcc/ada/xeinfo.adb
+++ b/gcc/ada/xeinfo.adb
@@ -57,6 +57,8 @@ with GNAT.Spitbol;                  use GNAT.Spitbol;
 with GNAT.Spitbol.Patterns;         use GNAT.Spitbol.Patterns;
 with GNAT.Spitbol.Table_Boolean;    use GNAT.Spitbol.Table_Boolean;
 
+with CEinfo;
+
 procedure XEinfo is
 
    package TB renames GNAT.Spitbol.Table_Boolean;
@@ -241,6 +243,11 @@ procedure XEinfo is
 --  Start of processing for XEinfo
 
 begin
+   --  First run CEinfo to check for errors. Note that CEinfo is also a
+   --  stand-alone program that can be run separately.
+
+   CEinfo;
+
    Anchored_Mode := True;
 
    if Argument_Count > 0 then
@@ -489,6 +496,9 @@ begin
      (Ofile,
       "/* End of einfo.h (C version of Einfo package specification) */");
 
+   Close (InF);
+   Close (Ofile);
+
 exception
    when Err =>
       Put_Line (Standard_Error, Lineno & ".  " & Line);
diff --git a/gcc/ada/xsinfo.adb b/gcc/ada/xsinfo.adb
index 691e9016b69..e3917a639b8 100644
--- a/gcc/ada/xsinfo.adb
+++ b/gcc/ada/xsinfo.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2008, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2010, 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- --
@@ -35,10 +35,6 @@
 
 --       sinfo.h       Corresponding c header file
 
---  Note: this program assumes that sinfo.ads has passed the error checks
---  which are carried out by the CSinfo utility, so it does not duplicate
---  these checks and assumes the source is correct.
-
 --  An optional argument allows the specification of an output file name to
 --  override the default sinfo.h file name for the generated output file.
 
@@ -50,6 +46,8 @@ with Ada.Text_IO;                   use Ada.Text_IO;
 with GNAT.Spitbol;                  use GNAT.Spitbol;
 with GNAT.Spitbol.Patterns;         use GNAT.Spitbol.Patterns;
 
+with CSinfo;
+
 procedure XSinfo is
 
    Done : exception;
@@ -115,6 +113,11 @@ procedure XSinfo is
 --  Start of processing for XSinfo
 
 begin
+   --  First run CSinfo to check for errors. Note that CSinfo is also a
+   --  stand-alone program that can be run separately.
+
+   CSinfo;
+
    Set_Exit_Status (1);
    Anchored_Mode := True;
 
@@ -238,10 +241,13 @@ begin
 
       Getline;
    end loop;
+   --  Can't get here; above loop only left via raise
 
 exception
    when Done =>
+      Close (InS);
       Put_Line (Ofile, "");
+      Close (Ofile);
       Set_Exit_Status (0);
 
 end XSinfo;