[multiple changes]

2011-08-31  Robert Dewar  <dewar@adacore.com>

	* exp_ch5.adb, exp_ch7.ads, sem_ch5.adb, put_scos.adb, s-rannum.adb,
	a-rbtgbo.adb, exp_intr.adb, a-cbdlli.adb, a-cbdlli.ads: Minor
	reformatting.

2011-08-31  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_util.adb (Find_Protection_Type): Do not look for fields _object
	if the corresponding type is malformed due to restriction violations.

2011-08-31  Robert Dewar  <dewar@adacore.com>

	* s-ransee.ads, s-ransee.adb: Minor reformatting.

2011-08-31  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch4.adb (Expand_N_Allocator): Correct faulty condition which
	would cause the generation of Set_Finalize_Address if the target is a
	VM and the designated type is not derived from [Limited_]Controlled.

2011-08-31  Arnaud Charlet  <charlet@adacore.com>

	* comperr.adb, comperr.ads, gnat1drv.adb (Delete_SCIL_Files): New
	subprogram.
	(Compiler_Abort, Gnat1drv): Call Delete_SCIL_Files in codepeer mode in
	case of a compilation error.

2011-08-31  Hristian Kirtchev  <kirtchev@adacore.com>

	* init.c (__gnat_error_handler): Standardize the stack overflow or
	erroneous memory access message.
	* seh_init.c (__gnat_SEH_error_handler): Standardize the stack overflow
	or erroneous memory access message.

From-SVN: r178368

gcc/ada/ChangeLog

 2011-08-31  Robert Dewar  <dewar@adacore.com>
 
+	* exp_ch5.adb, exp_ch7.ads, sem_ch5.adb, put_scos.adb, s-rannum.adb,
+	a-rbtgbo.adb, exp_intr.adb, a-cbdlli.adb, a-cbdlli.ads: Minor
+	reformatting.
+
+2011-08-31  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_util.adb (Find_Protection_Type): Do not look for fields _object
+	if the corresponding type is malformed due to restriction violations.
+
+2011-08-31  Robert Dewar  <dewar@adacore.com>
+
+	* s-ransee.ads, s-ransee.adb: Minor reformatting.
+
+2011-08-31  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_ch4.adb (Expand_N_Allocator): Correct faulty condition which
+	would cause the generation of Set_Finalize_Address if the target is a
+	VM and the designated type is not derived from [Limited_]Controlled.
+
+2011-08-31  Arnaud Charlet  <charlet@adacore.com>
+
+	* comperr.adb, comperr.ads, gnat1drv.adb (Delete_SCIL_Files): New
+	subprogram.
+	(Compiler_Abort, Gnat1drv): Call Delete_SCIL_Files in codepeer mode in
+	case of a compilation error.
+
+2011-08-31  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* init.c (__gnat_error_handler): Standardize the stack overflow or
+	erroneous memory access message.
+	* seh_init.c (__gnat_SEH_error_handler): Standardize the stack overflow
+	or erroneous memory access message.
+
+2011-08-31  Robert Dewar  <dewar@adacore.com>
+
 	* sem_ch4.adb: Minor reformatting.
 	* sem_ch6.adb: Minor code reorganization (use Ekind_In).
 

gcc/ada/a-cbdlli.adb

@@ -1046,6 +1046,7 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
             Process (Cursor'(Container'Unrestricted_Access, Node));
             Node := Container.Nodes (Node).Next;
          end loop;
+
       exception
          when others =>
             B := B - 1;
@@ -1055,8 +1056,9 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
       B := B - 1;
    end Iterate;
 
-   function Iterate (Container : List)
-     return List_Iterator_Interfaces.Reversible_Iterator'class
+   function Iterate
+     (Container : List)
+      return List_Iterator_Interfaces.Reversible_Iterator'class
    is
    begin
       if Container.Length = 0 then
@@ -1066,8 +1068,10 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
       end if;
    end Iterate;
 
-   function Iterate (Container : List; Start : Cursor)
-     return List_Iterator_Interfaces.Reversible_Iterator'class
+   function Iterate
+     (Container : List;
+      Start     : Cursor)
+      return List_Iterator_Interfaces.Reversible_Iterator'class
    is
       It : constant Iterator := (Container'Unrestricted_Access, Start.Node);
    begin

gcc/ada/a-cbdlli.ads

@@ -44,8 +44,7 @@ package Ada.Containers.Bounded_Doubly_Linked_Lists is
    pragma Pure;
    pragma Remote_Types;
 
-   type List (Capacity : Count_Type) is tagged private
-   with
+   type List (Capacity : Count_Type) is tagged private with
       Constant_Indexing => Constant_Reference,
       Variable_Indexing => Reference,
       Default_Iterator  => Iterate,
@@ -59,6 +58,7 @@ package Ada.Containers.Bounded_Doubly_Linked_Lists is
    Empty_List : constant List;
 
    No_Element : constant Cursor;
+
    function Has_Element (Position : Cursor) return Boolean;
 
    package List_Iterator_Interfaces is new
@@ -140,10 +140,13 @@ package Ada.Containers.Bounded_Doubly_Linked_Lists is
 
    procedure Reverse_Elements (Container : in out List);
 
-   function Iterate (Container : List)
+   function Iterate
+     (Container : List)
       return List_Iterator_Interfaces.Reversible_Iterator'class;
 
-   function Iterate (Container : List; Start : Cursor)
+   function Iterate
+     (Container : List;
+      Start     : Cursor)
       return List_Iterator_Interfaces.Reversible_Iterator'class;
 
    procedure Swap

gcc/ada/a-rbtgbo.adb

@@ -63,8 +63,11 @@ package body Ada.Containers.Red_Black_Trees.Generic_Bounded_Operations is
       Tree.Last   := 0;
       Tree.Root   := 0;
       Tree.Length := 0;
+
+      --  Why are the following commented out with no explanation ???
       --  Tree.Busy
       --  Tree.Lock
+
       Tree.Free   := -1;
    end Clear_Tree;
 
@@ -76,7 +79,6 @@ package body Ada.Containers.Red_Black_Trees.Generic_Bounded_Operations is
      (Tree : in out Tree_Type'Class;
       Node : Count_Type)
    is
-
       --  CLR p. 274
 
       X : Count_Type;
@@ -143,7 +145,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Bounded_Operations is
             end if;
 
             if (Left (N (W))  = 0 or else Color (N (Left (N (W)))) = Black)
-                  and then
+                 and then
                (Right (N (W)) = 0 or else Color (N (Right (N (W)))) = Black)
             then
                Set_Color (N (W), Red);

gcc/ada/comperr.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, 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- --
@@ -27,20 +27,23 @@
 --  error is detected. Calls to these routines cause termination of the
 --  current compilation with appropriate error output.
 
-with Atree;    use Atree;
-with Debug;    use Debug;
-with Errout;   use Errout;
-with Gnatvsn;  use Gnatvsn;
-with Namet;    use Namet;
-with Opt;      use Opt;
-with Osint;    use Osint;
-with Output;   use Output;
-with Sinput;   use Sinput;
-with Sprint;   use Sprint;
-with Sdefault; use Sdefault;
-with Targparm; use Targparm;
-with Treepr;   use Treepr;
-with Types;    use Types;
+with Atree;         use Atree;
+with Debug;         use Debug;
+with Errout;        use Errout;
+with Gnatvsn;       use Gnatvsn;
+with Lib;           use Lib;
+with Namet;         use Namet;
+with Opt;           use Opt;
+with Osint;         use Osint;
+with Output;        use Output;
+with Sinfo;         use Sinfo;
+with Sinput;        use Sinput;
+with Sprint;        use Sprint;
+with Sdefault;      use Sdefault;
+with System.OS_Lib; use System.OS_Lib;
+with Targparm;      use Targparm;
+with Treepr;        use Treepr;
+with Types;         use Types;
 
 with Ada.Exceptions; use Ada.Exceptions;
 
@@ -144,6 +147,10 @@ package body Comperr is
          end if;
       end if;
 
+      if CodePeer_Mode then
+         Delete_SCIL_Files;
+      end if;
+
       --  If any errors have already occurred, then we guess that the abort
       --  may well be caused by previous errors, and we don't make too much
       --  fuss about it, since we want to let programmer fix the errors first.
@@ -422,9 +429,40 @@ package body Comperr is
          Source_Dump;
          raise Unrecoverable_Error;
       end if;
-
    end Compiler_Abort;
 
+   -----------------------
+   -- Delete_SCIL_Files --
+   -----------------------
+
+   procedure Delete_SCIL_Files is
+      Main    : Node_Id;
+      Success : Boolean;
+      pragma Unreferenced (Success);
+   begin
+      --  If parsing was not successful, no Main_Unit is available, so return
+      --  immediately.
+
+      if Main_Source_File = No_Source_File then
+         return;
+      end if;
+
+      --  Retrieve unit name, and remove old versions of SCIL/<unit>.scil and
+      --  SCIL/<unit>__body.scil
+
+      Main := Unit (Cunit (Main_Unit));
+
+      if Nkind (Main) = N_Subprogram_Body then
+         Get_Name_String (Chars (Defining_Unit_Name (Specification (Main))));
+      else
+         Get_Name_String (Chars (Defining_Unit_Name (Main)));
+      end if;
+
+      Delete_File ("SCIL/" & Name_Buffer (1 .. Name_Len) & ".scil", Success);
+      Delete_File
+        ("SCIL/" & Name_Buffer (1 .. Name_Len) & "__body.scil", Success);
+   end Delete_SCIL_Files;
+
    -----------------
    -- Repeat_Char --
    -----------------

gcc/ada/comperr.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, 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- --
@@ -50,6 +50,9 @@ package Comperr is
    --  end exception (with possible message stored in TSD.Current_Excep,
    --  and negative (an unused value) for a GCC abort.
 
+   procedure Delete_SCIL_Files;
+   --  Delete SCIL files associated with the main unit
+
    ------------------------------
    -- Use of gnat_bug.box File --
    ------------------------------

gcc/ada/exp_ch4.adb

@@ -3949,13 +3949,13 @@ package body Exp_Ch4 is
                      --  Types derived from [Limited_]Controlled are the only
                      --  ones considered since they have fields Prev and Next.
 
-                     if VM_Target /= No_VM
-                       and then Is_Controlled (T)
-                     then
-                        Insert_Action (N,
-                          Make_Attach_Call
-                            (Obj_Ref => New_Copy_Tree (Init_Arg1),
-                             Ptr_Typ => PtrT));
+                     if VM_Target /= No_VM then
+                        if Is_Controlled (T) then
+                           Insert_Action (N,
+                             Make_Attach_Call
+                               (Obj_Ref => New_Copy_Tree (Init_Arg1),
+                                Ptr_Typ => PtrT));
+                        end if;
 
                      --  Default case, generate:
 

gcc/ada/exp_ch5.adb

@@ -3249,7 +3249,7 @@ package body Exp_Ch5 is
                    Subtype_Mark  => New_Occurrence_Of (Iter_Type, Loc),
                    Name          => Relocate_Node (Name (I_Spec)));
 
-               --  Create declaration for cursor.
+               --  Create declaration for cursor
 
                Decl2 :=
                  Make_Object_Declaration (Loc,

gcc/ada/exp_ch7.ads

@@ -41,33 +41,34 @@ package Exp_Ch7 is
    --  that take care of finalization management at run-time.
 
    --  Support of exceptions from user finalization procedures
-   --
+
    --  There is a specific mechanism to handle these exceptions, continue
-   --  finalization and then raise PE.
-   --  This mechanism is used by this package but also by exp_intr for
-   --  Ada.Unchecked_Deallocation.
+   --  finalization and then raise PE. This mechanism is used by this package
+   --  but also by exp_intr for Ada.Unchecked_Deallocation.
+
    --  There are 3 subprograms to use this mechanism, and the type
    --  Finalization_Exception_Data carries internal data between these
    --  subprograms:
    --
-   --  1. Build_Object_Declaration: create the variables for the next two
-   --  subprograms.
-   --  2. Build_Exception_Handler: create the exception handler for a call to
-   --  a user finalization procedure.
-   --  3. Build_Raise_Stmt: create the code to potentially raise a PE exception
-   --  if am exception was raise in a user finalization procedure.
+   --    1. Build_Object_Declaration: create the variables for the next two
+   --       subprograms.
+   --    2. Build_Exception_Handler: create the exception handler for a call
+   --       to a user finalization procedure.
+   --    3. Build_Raise_Stmt: create code to potentially raise a PE exception
+   --       if an exception was raise in a user finalization procedure.
+
    type Finalization_Exception_Data is record
-      Loc         : Source_Ptr;
+      Loc : Source_Ptr;
       --  Sloc for the added nodes
 
-      Abort_Id    : Entity_Id;
+      Abort_Id : Entity_Id;
       --  Boolean variable set to true if the finalization was triggered by
       --  an abort.
 
-      E_Id        : Entity_Id;
+      E_Id : Entity_Id;
       --  Variable containing the exception occurrence raised by user code
 
-      Raised_Id   : Entity_Id;
+      Raised_Id : Entity_Id;
       --  Boolean variable set to true if an exception was raised in user code
    end record;
 

gcc/ada/exp_intr.adb

@@ -964,19 +964,15 @@ package body Exp_Intr is
            Make_Block_Statement (Loc,
              Handled_Statement_Sequence =>
                Make_Handled_Sequence_Of_Statements (Loc,
-                 Statements => New_List (
-                   Make_Final_Call (
-                     Obj_Ref => Deref,
-                     Typ     => Desig_T)),
+                 Statements         => New_List (
+                   Make_Final_Call (Obj_Ref => Deref, Typ => Desig_T)),
                  Exception_Handlers => New_List (
                    Build_Exception_Handler (Finalizer_Data)))));
 
          --  For .NET/JVM, detach the object from the containing finalization
          --  collection before finalizing it.
 
-         if VM_Target /= No_VM
-           and then Is_Controlled (Desig_T)
-         then
+         if VM_Target /= No_VM and then Is_Controlled (Desig_T) then
             Prepend_To (Final_Code,
               Make_Detach_Call (New_Copy_Tree (Arg)));
          end if;

gcc/ada/exp_util.adb

@@ -2313,6 +2313,15 @@ package body Exp_Util is
          Typ := Corresponding_Record_Type (Typ);
       end if;
 
+      --  Since restriction violations are not considered serious errors, the
+      --  expander remains active, but may leave the corresponding record type
+      --  malformed. In such cases, component _object is not available so do
+      --  not look for it.
+
+      if not Analyzed (Typ) then
+         return Empty;
+      end if;
+
       Comp := First_Component (Typ);
       while Present (Comp) loop
          if Chars (Comp) = Name_uObject then

gcc/ada/gnat1drv.adb

@@ -842,6 +842,10 @@ begin
             Tree_Gen;
          end if;
 
+         if CodePeer_Mode then
+            Comperr.Delete_SCIL_Files;
+         end if;
+
          Errout.Finalize (Last_Call => True);
          Exit_Program (E_Errors);
       end if;

gcc/ada/init.c

@@ -358,7 +358,7 @@ __gnat_error_handler (int sig, siginfo_t *si, void *ucontext)
 	  ((volatile char *)
 	   ((long) si->si_addr & - getpagesize ()))[getpagesize ()];
 	  exception = &storage_error;
-	  msg = "stack overflow (or erroneous memory access)";
+	  msg = "stack overflow or erroneous memory access";
 	}
       break;
 
@@ -644,7 +644,7 @@ __gnat_error_handler (int sig, siginfo_t *si ATTRIBUTE_UNUSED, void *ucontext)
 	 that this is quite acceptable, since a "real" SIGSEGV can only
 	 occur as the result of an erroneous program.  */
       exception = &storage_error;
-      msg = "stack overflow (or erroneous memory access)";
+      msg = "stack overflow or erroneous memory access";
       break;
 
     case SIGBUS:
@@ -824,7 +824,7 @@ __gnat_error_handler (int sig, siginfo_t *reason, void *uc ATTRIBUTE_UNUSED)
 		 the stack into a guard page, not an attempt to
 		 write to .text or something.  */
 	  exception = &storage_error;
-	  msg = "SIGSEGV: (stack overflow or erroneous memory access)";
+	  msg = "SIGSEGV: stack overflow or erroneous memory access";
 	}
       else
 	{
@@ -1022,7 +1022,7 @@ __gnat_error_handler (int sig, siginfo_t *si, void *ucontext ATTRIBUTE_UNUSED)
 	  ((volatile char *)
 	   ((long) si->si_addr & - getpagesize ()))[getpagesize ()];
 	  exception = &storage_error;
-	  msg = "stack overflow (or erroneous memory access)";
+	  msg = "stack overflow or erroneous memory access";
 	}
       break;
 
@@ -1421,7 +1421,7 @@ __gnat_handle_vms_condition (int *sigargs, void *mechargs)
 	else
 	  {
 	    exception = &storage_error;
-	    msg = "stack overflow (or erroneous memory access)";
+	    msg = "stack overflow or erroneous memory access";
 	  }
 	__gnat_adjust_context_for_raise (SS$_ACCVIO, (void *)mechargs);
 	break;

gcc/ada/put_scos.adb

@@ -82,6 +82,7 @@ procedure Put_SCOs is
 
    procedure Write_SCO_Initiate (SU : SCO_Unit_Index) is
       SUT : SCO_Unit_Table_Entry renames SCO_Unit_Table.Table (SU);
+
    begin
       if Current_SCO_Unit /= SU then
          Write_Info_Initiate ('C');
@@ -126,7 +127,7 @@ begin
                T            : SCO_Table_Entry renames SCO_Table.Table (Start);
                Continuation : Boolean;
 
-               Ctr          : Nat;
+               Ctr : Nat;
                --  Counter for statement entries
 
             begin

gcc/ada/s-rannum.adb

@@ -87,6 +87,7 @@
 ------------------------------------------------------------------------------
 
 with Ada.Unchecked_Conversion;
+
 with System.Random_Seed;
 
 with Interfaces; use Interfaces;
@@ -480,7 +481,7 @@ package body System.Random_Numbers is
 
    procedure Reset (Gen : Generator) is
       X : constant Unsigned_32 :=
-           Unsigned_32'Mod (Unsigned_64 (Random_Seed.Get_Seed) * 64);
+            Unsigned_32'Mod (Unsigned_64 (Random_Seed.Get_Seed) * 64);
       --  Why * 64 ???
 
    begin

gcc/ada/s-ransee.adb

@@ -29,6 +29,8 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+--  Version used on all systems except Ravenscar where Calendar is unavailable
+
 with Ada.Calendar; use Ada.Calendar;
 
 package body System.Random_Seed is

gcc/ada/s-ransee.ads

@@ -31,11 +31,13 @@
 
 --  This package provide a seed for pseudo-random number generation using
 --  the clock.
+
 --  There are two separate implementations of this package:
 --  o  one based on Ada.Calendar
 --  o  one based on Ada.Real_Time
+
 --  This is required because Ada.Calendar cannot be used on ravenscar, but
---  Ada.Real_Time drags the tasking runtime on regular platforms.
+--  Ada.Real_Time drags in the whole tasking runtime on regular platforms.
 
 package System.Random_Seed is
 

gcc/ada/seh_init.c

@@ -99,7 +99,7 @@ __gnat_SEH_error_handler (struct _EXCEPTION_RECORD* ExceptionRecord,
 	{
 	  /* otherwise it is a stack overflow  */
 	  exception = &storage_error;
-	  msg = "stack overflow (or erroneous memory access)";
+	  msg = "stack overflow or erroneous memory access";
 	}
       break;
 

gcc/ada/sem_ch5.adb

@@ -2244,9 +2244,8 @@ package body Sem_Ch5 is
       Typ : Entity_Id;
 
    begin
-      --  In semantics mode, introduce loop variable so that
-      --  loop body can be properly analyzed. Otherwise this
-      --  is one after expansion.
+      --  In semantics mode, introduce loop variable so that loop body can be
+      --  properly analyzed. Otherwise this is one after expansion.
 
       if Operating_Mode = Check_Semantics then
          Enter_Name (Def_Id);
@@ -2335,7 +2334,7 @@ package body Sem_Ch5 is
             Error_Msg_N
               ("to iterate over the elements of an array, use OF", N);
 
-            --  Prevent cascaded errors.
+            --  Prevent cascaded errors
 
             Set_Ekind (Def_Id, E_Constant);
             Set_Etype (Def_Id, Etype (First_Index (Typ)));
@@ -2496,11 +2495,11 @@ package body Sem_Ch5 is
         or else not Expander_Active
       then
          if Present (Iter)
-           and then  Present (Iterator_Specification (Iter))
+           and then Present (Iterator_Specification (Iter))
          then
             declare
                Id : constant Entity_Id :=
-                  Defining_Identifier (Iterator_Specification (Iter));
+                      Defining_Identifier (Iterator_Specification (Iter));
             begin
                if Scope (Id) /= Current_Scope then
                   Enter_Name (Id);