2013-04-11 Doug Rupp <rupp@adacore.com>

	* gnatlink.adb: Fold program basename to lower case on VMS for
	consistency.

2013-04-11  Matthew Heaney  <heaney@adacore.com>

	* a-rbtgbo.adb (Generic_Equal): Initialize Result variable before
	entering loop.

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

	* xgnatugn.adb: Remove dead code (handling of @ifset/@ifclear).

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

	* gnat_ugn.texi: Remove some use of ifset in menus. Not strictly
	needed, and seems to confuse some versions of makeinfo.

2013-04-11  Javier Miranda  <miranda@adacore.com>

	* einfo.adb (Is_Thunk): Remove assertion.
	(Set_Is_Thunk): Add assertion.
	* einfo.ads (Is_Thunk): Complete documentation.
	* exp_ch11.adb (Expand_N_Handled_Sequence_Of_Statements): Code cleanup.
	* exp_ch3.ad[sb] (Is_Variable_Size_Array): Moved to sem_util
	(Is_Variable_Size_Record): Moved to sem_util
	* exp_ch6.adb (Expand_Call): Code cleanup.
	(Expand_N_Extended_Return_Statement): Code cleanup.
	(Expand_Simple_Function_Return): Code cleanup.
	* exp_disp.adb Remove dependency on exp_ch3
	(Expand_Interface_Thunk): Add minimum decoration needed to set
	attribute Is_Thunk.
	* sem_ch3.ad[sb] (Is_Constant_Bound): moved to sem_util
	* sem_util.ad[sb] (Is_Constant_Bound): Moved from
	sem_ch3 (Is_Variable_Size_Array): Moved from exp_ch3
	(Is_Variable_Size_Record): Moved from exp_ch3



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

16 files changed, 207 insertions, 455 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index be71cdf9529..232c8181d65 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,41 @@
+2013-04-11  Doug Rupp  <rupp@adacore.com>
+
+	* gnatlink.adb: Fold program basename to lower case on VMS for
+	consistency.
+
+2013-04-11  Matthew Heaney  <heaney@adacore.com>
+
+	* a-rbtgbo.adb (Generic_Equal): Initialize Result variable before
+	entering loop.
+
+2013-04-11  Arnaud Charlet  <charlet@adacore.com>
+
+	* xgnatugn.adb: Remove dead code (handling of @ifset/@ifclear).
+
+2013-04-11  Arnaud Charlet  <charlet@adacore.com>
+
+	* gnat_ugn.texi: Remove some use of ifset in menus. Not strictly
+	needed, and seems to confuse some versions of makeinfo.
+
+2013-04-11  Javier Miranda  <miranda@adacore.com>
+
+	* einfo.adb (Is_Thunk): Remove assertion.
+	(Set_Is_Thunk): Add assertion.
+	* einfo.ads (Is_Thunk): Complete documentation.
+	* exp_ch11.adb (Expand_N_Handled_Sequence_Of_Statements): Code cleanup.
+	* exp_ch3.ad[sb] (Is_Variable_Size_Array): Moved to sem_util
+	(Is_Variable_Size_Record): Moved to sem_util
+	* exp_ch6.adb (Expand_Call): Code cleanup.
+	(Expand_N_Extended_Return_Statement): Code cleanup.
+	(Expand_Simple_Function_Return): Code cleanup.
+	* exp_disp.adb Remove dependency on exp_ch3
+	(Expand_Interface_Thunk): Add minimum decoration needed to set
+	attribute Is_Thunk.
+	* sem_ch3.ad[sb] (Is_Constant_Bound): moved to sem_util
+	* sem_util.ad[sb] (Is_Constant_Bound): Moved from
+	sem_ch3 (Is_Variable_Size_Array): Moved from exp_ch3
+	(Is_Variable_Size_Record): Moved from exp_ch3
+
 2013-04-11  Javier Miranda  <miranda@adacore.com>
 
 	* exp_ch11.adb (Expand_N_Handled_Sequence_Of_Statements): Do
diff --git a/gcc/ada/a-rbtgbo.adb b/gcc/ada/a-rbtgbo.adb
index d1c26778128..d6df756e363 100644
--- a/gcc/ada/a-rbtgbo.adb
+++ b/gcc/ada/a-rbtgbo.adb
@@ -637,6 +637,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Bounded_Operations is
 
       L_Node := Left.First;
       R_Node := Right.First;
+      Result := True;
       while L_Node /= 0 loop
          if not Is_Equal (Left.Nodes (L_Node), Right.Nodes (R_Node)) then
             Result := False;
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index b81a1c69b06..cd384516b18 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -2271,7 +2271,6 @@ package body Einfo is
 
    function Is_Thunk (Id : E) return B is
    begin
-      pragma Assert (Is_Subprogram (Id));
       return Flag225 (Id);
    end Is_Thunk;
 
@@ -4880,6 +4879,7 @@ package body Einfo is
 
    procedure Set_Is_Thunk (Id : E; V : B := True) is
    begin
+      pragma Assert (Is_Subprogram (Id));
       Set_Flag225 (Id, V);
    end Set_Is_Thunk;
 
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 9b32e8b62c3..6b56b9e45e1 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -2843,14 +2843,17 @@ package Einfo is
 --       Applies to all entities. True for task types and subtypes
 
 --    Is_Thunk (Flag225)
---       Defined in all entities for subprograms (functions, procedures, and
---       operators). True for subprograms that are thunks, that is small
---       subprograms built by the expander for tagged types that cover
---       interface types. At run-time thunks displace the pointer to the object
---       (pointer named "this" in the C++ terminology) from a secondary
---       dispatch table to the primary dispatch table associated with a given
---       tagged type. Set by Expand_Interface_Thunk and used by Expand_Call to
---       handle extra actuals associated with accessibility level.
+--       Applies to all entities. True for subprograms that are thunks: that is
+--       small subprograms built by the expander for tagged types that cover
+--       interface types. As part of the runtime call to an interface, thunks
+--       displace the pointer to the object (pointer named "this" in the C++
+--       terminology) from a secondary dispatch table to the primary dispatch
+--       table associated with a given tagged type; if the thunk is a function
+--       that returns an object which covers an interface type then the thunk
+--       displaces the pointer to the object from the primary dispatch table to
+--       the secondary dispatch table associated with the interface type. Set
+--       by Expand_Interface_Thunk and used by Expand_Call to handle extra
+--       actuals associated with accessibility level.
 
 --    Is_Trivial_Subprogram (Flag235)
 --       Defined in all entities. Set in subprograms where either the body
diff --git a/gcc/ada/exp_ch11.adb b/gcc/ada/exp_ch11.adb
index 7378885c7c2..2f2506918e8 100644
--- a/gcc/ada/exp_ch11.adb
+++ b/gcc/ada/exp_ch11.adb
@@ -1410,8 +1410,7 @@ package body Exp_Ch11 is
         --  No cleanup action needed in thunks associated with interfaces
         --  because they only displace the pointer to the object.
 
-        and then not (Is_Subprogram (Current_Scope)
-                       and then Is_Thunk (Current_Scope))
+        and then not Is_Thunk (Current_Scope)
       then
          Expand_Cleanup_Actions (Parent (N));
       else
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 6369d44e4df..5637c2ff754 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -229,9 +229,6 @@ package body Exp_Ch3 is
    function Is_User_Defined_Equality (Prim : Node_Id) return Boolean;
    --  Returns true if Prim is a user defined equality function
 
-   function Is_Variable_Size_Array (E : Entity_Id) return Boolean;
-   --  Returns true if E has variable size components
-
    function Make_Eq_Body
      (Typ     : Entity_Id;
       Eq_Name : Name_Id) return Node_Id;
@@ -8311,69 +8308,6 @@ package body Exp_Ch3 is
         and then Base_Type (Etype (Prim)) = Standard_Boolean;
    end Is_User_Defined_Equality;
 
-   ----------------------------
-   -- Is_Variable_Size_Array --
-   ----------------------------
-
-   function Is_Variable_Size_Array (E : Entity_Id) return Boolean is
-      Idx : Node_Id;
-
-   begin
-      pragma Assert (Is_Array_Type (E));
-
-      --  Check if some index is initialized with a non-constant value
-
-      Idx := First_Index (E);
-      while Present (Idx) loop
-         if Nkind (Idx) = N_Range then
-            if not Is_Constant_Bound (Low_Bound (Idx))
-              or else not Is_Constant_Bound (High_Bound (Idx))
-            then
-               return True;
-            end if;
-         end if;
-
-         Idx := Next_Index (Idx);
-      end loop;
-
-      return False;
-   end Is_Variable_Size_Array;
-
-   -----------------------------
-   -- Is_Variable_Size_Record --
-   -----------------------------
-
-   function Is_Variable_Size_Record (E : Entity_Id) return Boolean is
-      Comp     : Entity_Id;
-      Comp_Typ : Entity_Id;
-
-   begin
-      pragma Assert (Is_Record_Type (E));
-
-      Comp := First_Entity (E);
-      while Present (Comp) loop
-         Comp_Typ := Etype (Comp);
-
-         --  Recursive call if the record type has discriminants
-
-         if Is_Record_Type (Comp_Typ)
-           and then Has_Discriminants (Comp_Typ)
-           and then Is_Variable_Size_Record (Comp_Typ)
-         then
-            return True;
-
-         elsif Is_Array_Type (Comp_Typ)
-           and then Is_Variable_Size_Array (Comp_Typ)
-         then
-            return True;
-         end if;
-
-         Next_Entity (Comp);
-      end loop;
-
-      return False;
-   end Is_Variable_Size_Record;
-
    ----------------------------------------
    -- Make_Controlling_Function_Wrappers --
    ----------------------------------------
diff --git a/gcc/ada/exp_ch3.ads b/gcc/ada/exp_ch3.ads
index 6ad53ad60ca..de767fcaa6b 100644
--- a/gcc/ada/exp_ch3.ads
+++ b/gcc/ada/exp_ch3.ads
@@ -104,9 +104,6 @@ package Exp_Ch3 is
    --  then tags components located at variable positions of Target are
    --  initialized.
 
-   function Is_Variable_Size_Record (E : Entity_Id) return Boolean;
-   --  Returns true if E has variable size components (move to sem_util???)
-
    function Needs_Simple_Initialization
      (T           : Entity_Id;
       Consider_IS : Boolean := True) return Boolean;
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 931782a57e5..eccdf211d03 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -2691,9 +2691,7 @@ package body Exp_Ch6 is
             --  Ada 2005 (AI-251): Thunks must propagate the extra actuals of
             --  accessibility levels.
 
-            if Ekind (Current_Scope) in Subprogram_Kind
-              and then Is_Thunk (Current_Scope)
-            then
+            if Is_Thunk (Current_Scope) then
                declare
                   Parm_Ent : Entity_Id;
 
@@ -5493,8 +5491,7 @@ package body Exp_Ch6 is
       --  the pointer to the object) they are always handled by means of
       --  simple return statements.
 
-      pragma Assert (not Is_Subprogram (Current_Scope)
-                      or else not Is_Thunk (Current_Scope));
+      pragma Assert (not Is_Thunk (Current_Scope));
 
       if Nkind (Ret_Obj_Decl) = N_Object_Declaration then
          Exp := Expression (Ret_Obj_Decl);
@@ -7144,8 +7141,7 @@ package body Exp_Ch6 is
          --  handled by means of simple return statements. This leaves their
          --  expansion simple and clean.
 
-        and then not (Is_Subprogram (Current_Scope)
-                       and then Is_Thunk (Current_Scope))
+        and then not Is_Thunk (Current_Scope)
       then
          declare
             Return_Object_Entity : constant Entity_Id :=
@@ -7225,8 +7221,7 @@ package body Exp_Ch6 is
       --  the object is returned by reference and the maximum functionality
       --  required is just to displace the pointer.
 
-      elsif Is_Subprogram (Current_Scope)
-        and then Is_Thunk (Current_Scope)
+      elsif Is_Thunk (Current_Scope)
         and then Is_Interface (Exptyp)
       then
          null;
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index 2df3a94b4e4..52047d7f876 100644
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -30,7 +30,6 @@ with Einfo;    use Einfo;
 with Elists;   use Elists;
 with Errout;   use Errout;
 with Exp_Atag; use Exp_Atag;
-with Exp_Ch3;  use Exp_Ch3;
 with Exp_Ch6;  use Exp_Ch6;
 with Exp_CG;   use Exp_CG;
 with Exp_Dbug; use Exp_Dbug;
@@ -1884,6 +1883,7 @@ package body Exp_Disp is
       end loop;
 
       Thunk_Id := Make_Temporary (Loc, 'T');
+      Set_Ekind (Thunk_Id, Ekind (Prim));
       Set_Is_Thunk (Thunk_Id);
       Set_Convention (Thunk_Id, Convention (Prim));
 
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index 519890f1764..6d6376a717e 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -212,10 +212,8 @@ AdaCore@*
 * Conditional Compilation::
 * Inline Assembler::
 * Compatibility and Porting Guide::
-@ifset unw
 * Microsoft Windows Topics::
 * Mac OS Topics::
-@end ifset
 * GNU Free Documentation License::
 * Index::
 
@@ -652,7 +650,6 @@ Compatibility and Porting Guide
 * Transitioning to 64-Bit GNAT for OpenVMS::
 @end ifset
 
-@ifset unw
 Microsoft Windows Topics
 
 @ifclear FSFEDITION
@@ -675,7 +672,6 @@ Microsoft Windows Topics
 Mac OS Topics
 
 * Codesigning the Debugger::
-@end ifset
 
 * Index::
 @end menu
@@ -29083,7 +29079,6 @@ without sacrificing the capabilities of the 64-bit architecture.
 @end ifset
 
 @c ************************************************
-@ifset unw
 @node Microsoft Windows Topics
 @appendix Microsoft Windows Topics
 @cindex Windows NT
@@ -31203,8 +31198,6 @@ codesign -f -s  "gdb-cert"  <gnat_install_prefix>/bin/gdb
 name chosen above, and <gnat_install_prefix> should be replaced by
 the location where you installed GNAT.
 
-@end ifset
-
 @c **********************************
 @c * GNU Free Documentation License *
 @c **********************************
diff --git a/gcc/ada/gnatlink.adb b/gcc/ada/gnatlink.adb
index 87ad072f7a5..503c2f7b152 100644
--- a/gcc/ada/gnatlink.adb
+++ b/gcc/ada/gnatlink.adb
@@ -153,6 +153,8 @@ procedure Gnatlink is
    Binder_Ali_File      : String_Access;
    Binder_Obj_File      : String_Access;
 
+   Base_Command_Name    : String_Access;
+
    Tname    : Temp_File_Name;
    Tname_FD : File_Descriptor := Invalid_FD;
    --  Temporary file used by linker to pass list of object files on
@@ -226,6 +228,12 @@ procedure Gnatlink is
    procedure Process_Binder_File (Name : String);
    --  Reads the binder file and extracts linker arguments
 
+   function To_Lower (A : Character) return Character;
+   --  Fold a character to lower case;
+
+   procedure To_Lower (A : in out String);
+   --  Fold a string to lower case;
+
    procedure Usage;
    --  Display usage
 
@@ -314,7 +322,7 @@ procedure Gnatlink is
 
    procedure Error_Msg (Message : String) is
    begin
-      Write_Str (Base_Name (Command_Name));
+      Write_Str (Base_Command_Name.all);
       Write_Str (": ");
       Write_Str (Message);
       Write_Eol;
@@ -1406,6 +1414,31 @@ procedure Gnatlink is
       Status := fclose (Fd);
    end Process_Binder_File;
 
+   --------------
+   -- To_Lower --
+   --------------
+
+   function To_Lower (A : Character) return Character is
+      A_Val : constant Natural := Character'Pos (A);
+
+   begin
+      if A in 'A' .. 'Z'
+        or else A_Val in 16#C0# .. 16#D6#
+        or else A_Val in 16#D8# .. 16#DE#
+      then
+         return Character'Val (A_Val + 16#20#);
+      else
+         return A;
+      end if;
+   end To_Lower;
+
+   procedure To_Lower (A : in out String) is
+   begin
+      for J in A'Range loop
+         A (J) := To_Lower (A (J));
+      end loop;
+   end To_Lower;
+
    -----------
    -- Usage --
    -----------
@@ -1413,7 +1446,7 @@ procedure Gnatlink is
    procedure Usage is
    begin
       Write_Str ("Usage: ");
-      Write_Str (Base_Name (Command_Name));
+      Write_Str (Base_Command_Name.all);
       Write_Str (" switches mainprog.ali [non-Ada-objects] [linker-options]");
       Write_Eol;
       Write_Eol;
@@ -1501,6 +1534,15 @@ begin
       end;
    end if;
 
+   Base_Command_Name := new String'(Base_Name (Command_Name));
+
+   --  Fold to lower case "GNATLINK" on VMS to be consistent with output
+   --  from other GNAT utilities.
+
+   if Hostparm.OpenVMS then
+      To_Lower (Base_Command_Name.all);
+   end if;
+
    Process_Args;
 
    if Argument_Count = 0
@@ -1737,7 +1779,7 @@ begin
 
    --  Assume this is a cross tool if the executable name is not gnatlink
 
-   if Base_Name (Command_Name) = "gnatlink"
+   if Base_Command_Name.all = "gnatlink"
      and then Output_File_Name.all = "test"
    then
       Error_Msg ("warning: executable name """ & Output_File_Name.all
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 2e0cdf7643b..fc74beeb5e6 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -16332,31 +16332,6 @@ package body Sem_Ch3 is
    end Inherit_Components;
 
    -----------------------
-   -- Is_Constant_Bound --
-   -----------------------
-
-   function Is_Constant_Bound (Exp : Node_Id) return Boolean is
-   begin
-      if Compile_Time_Known_Value (Exp) then
-         return True;
-
-      elsif Is_Entity_Name (Exp)
-        and then Present (Entity (Exp))
-      then
-         return Is_Constant_Object (Entity (Exp))
-           or else Ekind (Entity (Exp)) = E_Enumeration_Literal;
-
-      elsif Nkind (Exp) in N_Binary_Op then
-         return Is_Constant_Bound (Left_Opnd (Exp))
-           and then Is_Constant_Bound (Right_Opnd (Exp))
-           and then Scope (Entity (Exp)) = Standard_Standard;
-
-      else
-         return False;
-      end if;
-   end Is_Constant_Bound;
-
-   -----------------------
    -- Is_Null_Extension --
    -----------------------
 
diff --git a/gcc/ada/sem_ch3.ads b/gcc/ada/sem_ch3.ads
index 98a8dbc8ce3..a0b37ea0a5b 100644
--- a/gcc/ada/sem_ch3.ads
+++ b/gcc/ada/sem_ch3.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-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- --
@@ -174,12 +174,6 @@ package Sem_Ch3 is
    --  Given a discriminant somewhere in the Typ_For_Constraint tree and a
    --  Constraint, return the value of that discriminant.
 
-   function Is_Constant_Bound (Exp : Node_Id) return Boolean;
-   --  Exp is the expression for an array bound. Determines whether the
-   --  bound is a compile-time known value, or a constant entity, or an
-   --  enumeration literal, or an expression composed of constant-bound
-   --  subexpressions which are evaluated by means of standard operators.
-
    function Is_Null_Extension (T : Entity_Id) return Boolean;
    --  Returns True if the tagged type T has an N_Full_Type_Declaration that
    --  is a null extension, meaning that it has an extension part without any
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 1be6c84da44..6cba0601864 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -7747,6 +7747,31 @@ package body Sem_Util is
                or else Is_Task_Interface (T));
    end Is_Concurrent_Interface;
 
+   -----------------------
+   -- Is_Constant_Bound --
+   -----------------------
+
+   function Is_Constant_Bound (Exp : Node_Id) return Boolean is
+   begin
+      if Compile_Time_Known_Value (Exp) then
+         return True;
+
+      elsif Is_Entity_Name (Exp)
+        and then Present (Entity (Exp))
+      then
+         return Is_Constant_Object (Entity (Exp))
+           or else Ekind (Entity (Exp)) = E_Enumeration_Literal;
+
+      elsif Nkind (Exp) in N_Binary_Op then
+         return Is_Constant_Bound (Left_Opnd (Exp))
+           and then Is_Constant_Bound (Right_Opnd (Exp))
+           and then Scope (Entity (Exp)) = Standard_Standard;
+
+      else
+         return False;
+      end if;
+   end Is_Constant_Bound;
+
    --------------------------------------
    -- Is_Controlling_Limited_Procedure --
    --------------------------------------
@@ -9481,6 +9506,69 @@ package body Sem_Util is
         and then Get_Name_String (Chars (T)) = "valuetype";
    end Is_Value_Type;
 
+   ----------------------------
+   -- Is_Variable_Size_Array --
+   ----------------------------
+
+   function Is_Variable_Size_Array (E : Entity_Id) return Boolean is
+      Idx : Node_Id;
+
+   begin
+      pragma Assert (Is_Array_Type (E));
+
+      --  Check if some index is initialized with a non-constant value
+
+      Idx := First_Index (E);
+      while Present (Idx) loop
+         if Nkind (Idx) = N_Range then
+            if not Is_Constant_Bound (Low_Bound (Idx))
+              or else not Is_Constant_Bound (High_Bound (Idx))
+            then
+               return True;
+            end if;
+         end if;
+
+         Idx := Next_Index (Idx);
+      end loop;
+
+      return False;
+   end Is_Variable_Size_Array;
+
+   -----------------------------
+   -- Is_Variable_Size_Record --
+   -----------------------------
+
+   function Is_Variable_Size_Record (E : Entity_Id) return Boolean is
+      Comp     : Entity_Id;
+      Comp_Typ : Entity_Id;
+
+   begin
+      pragma Assert (Is_Record_Type (E));
+
+      Comp := First_Entity (E);
+      while Present (Comp) loop
+         Comp_Typ := Etype (Comp);
+
+         --  Recursive call if the record type has discriminants
+
+         if Is_Record_Type (Comp_Typ)
+           and then Has_Discriminants (Comp_Typ)
+           and then Is_Variable_Size_Record (Comp_Typ)
+         then
+            return True;
+
+         elsif Is_Array_Type (Comp_Typ)
+           and then Is_Variable_Size_Array (Comp_Typ)
+         then
+            return True;
+         end if;
+
+         Next_Entity (Comp);
+      end loop;
+
+      return False;
+   end Is_Variable_Size_Record;
+
    ---------------------
    -- Is_VMS_Operator --
    ---------------------
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 11fe6548432..5cd1ab678b8 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -853,6 +853,12 @@ package Sem_Util is
    --  True if T is a bounded string type. Used to make sure "=" composes
    --  properly for bounded string types.
 
+   function Is_Constant_Bound (Exp : Node_Id) return Boolean;
+   --  Exp is the expression for an array bound. Determines whether the
+   --  bound is a compile-time known value, or a constant entity, or an
+   --  enumeration literal, or an expression composed of constant-bound
+   --  subexpressions which are evaluated by means of standard operators.
+
    function Is_Controlling_Limited_Procedure
      (Proc_Nam : Entity_Id) return Boolean;
    --  Ada 2005 (AI-345): Determine whether Proc_Nam is a primitive procedure
@@ -1044,6 +1050,12 @@ package Sem_Util is
    --  object that is accessed directly, as opposed to the other CIL objects
    --  that are accessed through managed pointers.
 
+   function Is_Variable_Size_Array (E : Entity_Id) return Boolean;
+   --  Returns true if E has variable size components
+
+   function Is_Variable_Size_Record (E : Entity_Id) return Boolean;
+   --  Returns true if E has variable size components
+
    function Is_VMS_Operator (Op : Entity_Id) return Boolean;
    --  Determine whether an operator is one of the intrinsics defined
    --  in the DEC system extension.
diff --git a/gcc/ada/xgnatugn.adb b/gcc/ada/xgnatugn.adb
index 3403ad4d871..e1dc7ef835a 100644
--- a/gcc/ada/xgnatugn.adb
+++ b/gcc/ada/xgnatugn.adb
@@ -149,10 +149,6 @@ procedure Xgnatugn is
      (Input        : Input_File;
       At_Character : Natural;
       Message      : String);
-   procedure Warning
-     (Input        : Input_File;
-      Message      : String);
-   --  Like Error, but just print a warning message
 
    Dictionary_File : aliased Input_File;
    procedure Read_Dictionary_File;
@@ -181,7 +177,6 @@ procedure Xgnatugn is
    --  Conditional commands for edition are passed through unchanged
 
    subtype Target_Type is Flag_Type range UNW .. VMS;
-   subtype Edition_Type is Flag_Type range FSFEDITION .. GPLEDITION;
 
    Target : Target_Type;
    --  The Target variable is initialized using the command line
@@ -237,42 +232,6 @@ procedure Xgnatugn is
    --  This subprogram takes a line and rewrites it according to Target.
    --  It relies on information in Source_File to generate error messages.
 
-   type Conditional is (Set, Clear);
-   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 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
-   --  Target.
-
-   function In_VMS_Section return Boolean;
-   --  Returns True if in an "@ifset vms" section
-
-   procedure Check_No_Pending_Conditional;
-   --  Checks that all preprocessing directives have been properly matched by
-   --  their @end counterpart. If this is not the case, print an error
-   --  message.
-
-   --  The following definitions implement a stack to track the conditional
-   --  preprocessing context.
-
-   type Conditional_Context is record
-      Starting_Line : Positive;
-      Cond          : Conditional;
-      Flag          : Flag_Type;
-   end record;
-
-   Conditional_Stack_Depth : constant := 3;
-
-   Conditional_Stack :
-     array (1 .. Conditional_Stack_Depth) of Conditional_Context;
-
-   Conditional_TOS : Natural := 0;
-   --  Pointer to the Top Of Stack for Conditional_Stack
-
    -----------
    -- Usage --
    -----------
@@ -411,16 +370,6 @@ procedure Xgnatugn is
    -------------
 
    procedure Warning
-     (Input   : Input_File;
-      Message : String)
-   is
-   begin
-      if Warnings_Enabled then
-         Warning (Input, 0, Message);
-      end if;
-   end Warning;
-
-   procedure Warning
      (Input        : Input_File;
       At_Character : Natural;
       Message      : String)
@@ -883,17 +832,6 @@ procedure Xgnatugn is
                Maybe_Rewrite_Extension;
 
             when VMS_Alternative =>
-               if VMS_Context_Determined then
-                  if (not In_VMS_Section)
-                    or else
-                    Line (Token.VMS.First .. Token.VMS.Last) /=
-                    Line (Token.Non_VMS.First .. Token.Non_VMS.Last)
-                  then
-                     Warning (Source_File, Token.First,
-                              "VMS alternative already determined "
-                                & "by conditionals");
-                  end if;
-               end if;
                if Target = VMS then
                   Append (Rewritten_Line, Line (Token.VMS.First
                                                 .. Token.VMS.Last));
@@ -917,11 +855,6 @@ procedure Xgnatugn is
    -------------------------
 
    procedure Process_Source_File is
-      Ifset       : constant String := "@ifset ";
-      Ifclear     : constant String := "@ifclear ";
-      Endsetclear : constant String := "@end ";
-      --  Strings to be recognized for conditional processing
-
    begin
       while not End_Of_File (Source_File.Data) loop
          declare
@@ -931,152 +864,17 @@ procedure Xgnatugn is
             --  syntax of all lines, and not only those which are actually
             --  included in the output.
 
-            Have_Conditional : Boolean := False;
-            --  True if we have encountered a conditional preprocessing
-            --  directive.
-
-            Cond : Conditional;
-            --  The kind of the directive
-
-            Flag : Flag_Type;
-            --  Its flag
-
          begin
-            --  If the line starts with @ifset or @ifclear, we try to convert
-            --  the following flag to one of our flag types. If we fail,
-            --  Have_Conditional remains False.
-
-            if Line'Length >= Ifset'Length
-              and then Line (1 .. Ifset'Length) = Ifset
-            then
-               Cond := Set;
-
-               declare
-                  Arg : constant String :=
-                          Trim (Line (Ifset'Length + 1 .. Line'Last), Both);
-
-               begin
-                  Flag := Flag_Type'Value (Arg);
-                  Have_Conditional := True;
-
-                  case Flag is
-                     when Target_Type =>
-                        if Translate (Target_Type'Image (Flag),
-                                      Lower_Case_Map)
-                                                      /= Arg
-                        then
-                           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;
-               exception
-                  when Constraint_Error =>
-                     Error (Source_File, "unknown flag for '@ifset'");
-               end;
-
-            elsif Line'Length >= Ifclear'Length
-              and then Line (1 .. Ifclear'Length) = Ifclear
+            if First_Time
+              and then Line'Length > 3 and then Line (1 .. 3) = "@if"
             then
-               Cond := Clear;
-
-               declare
-                  Arg : constant String :=
-                          Trim (Line (Ifclear'Length + 1 .. Line'Last), Both);
-
-               begin
-                  Flag := Flag_Type'Value (Arg);
-                  Have_Conditional := True;
-
-                  case Flag is
-                     when Target_Type =>
-                        if Translate (Target_Type'Image (Flag),
-                                      Lower_Case_Map)
-                                                      /= Arg
-                        then
-                           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;
-               exception
-                  when Constraint_Error =>
-                     Error (Source_File, "unknown flag for '@ifclear'");
-               end;
+               Put_Line (Output_File, "@set " & Argument (1));
+               First_Time := False;
             end if;
 
-            if Have_Conditional then
-               --  We create a new conditional context and suppress the
-               --  directive in the output.
-
-               Push_Conditional (Cond, Flag);
-
-            elsif Line'Length >= Endsetclear'Length
-              and then Line (1 .. Endsetclear'Length) = Endsetclear
-            then
-               --  The '@end ifset'/'@end ifclear' case is handled here. We
-               --  have to pop the conditional context.
-
-               declare
-                  First, Last : Natural;
-
-               begin
-                  Find_Token (Source => Line (Endsetclear'Length + 1
-                                              .. Line'Length),
-                              Set    => Letter_Set,
-                              Test   => Inside,
-                              First  => First,
-                              Last   => Last);
-
-                  if Last = 0 then
-                     Error (Source_File, "'@end' without argument");
-                  else
-                     if Line (First .. Last) = "ifset" then
-                        Have_Conditional := True;
-                        Cond := Set;
-                     elsif Line (First .. Last) = "ifclear" then
-                        Have_Conditional := True;
-                        Cond := Clear;
-                     end if;
-
-                     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
-                     --  directives.
-
-                  end if;               --  @end without argument
-               end;
-            end if;                     --  Have_Conditional
-
             Put_Line (Output_File, Rewritten);
          end;
       end loop;
-
-      Check_No_Pending_Conditional;
    end Process_Source_File;
 
    ---------------------------
@@ -1159,123 +957,6 @@ procedure Xgnatugn is
       return S (Get (Ug_Words, Word));
    end Get_Replacement_Word;
 
-   ----------------------
-   -- Push_Conditional --
-   ----------------------
-
-   procedure Push_Conditional (Cond : Conditional; Flag : Flag_Type) is
-   begin
-      if Flag in Target_Type then
-
-         --  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;
-      end if;
-
-      Conditional_TOS := Conditional_TOS + 1;
-      Conditional_Stack (Conditional_TOS) :=
-        (Starting_Line => Source_File.Line,
-         Cond          => Cond,
-         Flag          => Flag);
-   end Push_Conditional;
-
-   ---------------------
-   -- Pop_Conditional --
-   ---------------------
-
-   procedure Pop_Conditional (Cond : Conditional) is
-   begin
-      if Conditional_TOS > 0 then
-         case Cond is
-            when Set =>
-               if Conditional_Stack (Conditional_TOS).Cond /= Set then
-                  Error (Source_File,
-                         "'@end ifset' does not match '@ifclear' at line"
-                         & Integer'Image (Conditional_Stack
-                                          (Conditional_TOS).Starting_Line));
-               end if;
-
-            when Clear =>
-               if Conditional_Stack (Conditional_TOS).Cond /= Clear then
-                  Error (Source_File,
-                         "'@end ifclear' does not match '@ifset' at line"
-                         & Integer'Image (Conditional_Stack
-                                          (Conditional_TOS).Starting_Line));
-               end if;
-         end case;
-
-         Conditional_TOS := Conditional_TOS - 1;
-
-      else
-         case Cond is
-            when Set =>
-               Error (Source_File,
-                      "'@end ifset' without corresponding '@ifset'");
-
-            when Clear =>
-               Error (Source_File,
-                      "'@end ifclear' without corresponding '@ifclear'");
-         end case;
-      end if;
-   end Pop_Conditional;
-
-   ----------------------------
-   -- VMS_Context_Determined --
-   ----------------------------
-
-   function VMS_Context_Determined return Boolean is
-   begin
-      for J in 1 .. Conditional_TOS loop
-         if Conditional_Stack (J).Flag = VMS then
-            return True;
-         end if;
-      end loop;
-
-      return False;
-   end VMS_Context_Determined;
-
-   --------------------
-   -- In_VMS_Section --
-   --------------------
-
-   function In_VMS_Section return Boolean is
-   begin
-      for J in 1 .. Conditional_TOS loop
-         if Conditional_Stack (J).Flag = VMS then
-            return Conditional_Stack (J).Cond = Set;
-         end if;
-      end loop;
-
-      return False;
-   end In_VMS_Section;
-
-   ----------------------------------
-   -- Check_No_Pending_Conditional --
-   ----------------------------------
-
-   procedure Check_No_Pending_Conditional is
-   begin
-      for J in 1 .. Conditional_TOS loop
-         case Conditional_Stack (J).Cond is
-            when Set =>
-               Error (Source_File, "Missing '@end ifset' for '@ifset' at line"
-                      & Integer'Image (Conditional_Stack (J).Starting_Line));
-
-            when Clear =>
-               Error (Source_File,
-                      "Missing '@end ifclear' for '@ifclear' at line"
-                      & Integer'Image (Conditional_Stack (J).Starting_Line));
-         end case;
-      end loop;
-   end Check_No_Pending_Conditional;
-
 --  Start of processing for Xgnatugn
 
    Valid_Command_Line : Boolean;