[multiple changes]

2013-09-10  Hristian Kirtchev  <kirtchev@adacore.com>

	* aspects.adb: Add entries in the Has_Aspect_Specifications_Flag
	table for package body and body stubs.
	(Move_Or_Merge_Aspects): New routine.
	(Remove_Aspects): New routine.
	* aspects.ads (Move_Aspects): Update comment on usage.
	(Move_Or_Merge_Aspects): New routine.
	(Remove_Aspects): New routine.
	* par-ch3.adb: Update the grammar of private_type_declaration,
	private_extension_declaration, object_renaming_declaration,
	and exception_renaming_declaration.
	(P_Subprogram): Parse the
	aspect specifications that apply to a body stub.
	* par-ch6.adb: Update the grammar of subprogram_body_stub and
	generic_instantiation.
	* par-ch7.adb: Update the grammar of package_declaration,
	package_specification, package_body, package_renaming_declaration,
	package_body_stub.
	(P_Package): Parse the aspect specifications
	that apply to a body, a body stub and package renaming.
	* par-ch9.adb: Update the grammar of entry_declaration,
	protected_body, protected_body_stub, task_body,
	and task_body_stub.
	(P_Protected): Add local variable
	Aspect_Sloc. Add local constant Dummy_Node.  Parse the aspect
	specifications that apply to a protected body and a protected
	body stub.
	(P_Task): Add local variable Aspect_Sloc. Add local
	constant Dummy_Node. Parse the aspect specifications that apply
	to a task body and a task body stub.
	* par-ch12.adb: Update the grammar of
	generic_renaming_declaration.
	(P_Generic): Parse the aspect
	specifications that apply to a generic renaming.
	* sem_ch6.adb (Analyze_Subprogram_Body_Helper): Do not emit
	an error when analyzing aspects that apply to a body stub. Such
	aspects are relocated to the proper body.
	* sem_ch7.adb (Analyze_Package_Body_Helper): Analyze the aspect
	specifications that apply to a body.
	* sem_ch9.adb (Analyze_Protected_Body): Warn about user-defined
	aspects not being supported on protected bodies. Remove the
	aspect specifications.	(Analyze_Single_Protected_Declaration):
	Analyze the aspects that apply to a single protected declaration.
	(Analyze_Task_Body): Warn about user-defined aspects not being
	supported on task bodies. Remove the aspect specifications.
	* sem_ch10.adb: Add with and use clause for Aspects.
	(Analyze_Package_Body_Stub): Propagate the aspect specifications
	from the stub to the proper body.
	* sem_ch13.adb (Analyze_Aspect_Specifications): Insert the
	corresponding pragma of an aspect that applies to a body in the
	declarations of the body.
	* sinfo.ads: Update the gramma of expression_function,
	private_type_declaration, private_extension_declaration,
	object_renaming_declaration, exception_renaming_declaration,
	package_renaming_declaration, subprogram_renaming_declaration,
	generic_renaming_declaration, entry_declaration,
	subprogram_body_stub, package_body_stub, task_body_stub,
	generic_subprogram_declaration.

2013-09-10  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_prag.adb (Analyze_Pragma): Add processing
	for aspect/pragma SPARK_Mode when it applies to a [library-level]
	subprogram or package [body].

2013-09-10  Robert Dewar  <dewar@adacore.com>

	* gnat_ugn.texi: Document that -gnatc and -gnatR cannot be
	given together.
	* switch-c.adb (Scan_Front_End_Switches): Give error if both
	-gnatR and -gnatc given.

2013-09-10  Robert Dewar  <dewar@adacore.com>

	* g-table.ads, g-table.adb (For_Each): New generic procedure
	(Sort_Table): New generic procedure.

From-SVN: r202460

1 files changed, 95 insertions, 12 deletions

diff --git a/gcc/ada/g-table.adb b/gcc/ada/g-table.adb
index eeaa59b..9b3692b 100644
--- a/gcc/ada/g-table.adb
+++ b/gcc/ada/g-table.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                     Copyright (C) 1998-2010, AdaCore                     --
+--                     Copyright (C) 1998-2013, AdaCore                     --
 --                                                                          --
 -- 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- --
@@ -29,6 +29,8 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with GNAT.Heap_Sort_G;
+
 with System;        use System;
 with System.Memory; use System.Memory;
 
@@ -114,6 +116,19 @@ package body GNAT.Table is
       Last_Val := Last_Val - 1;
    end Decrement_Last;
 
+   --------------
+   -- For_Each --
+   --------------
+
+   procedure For_Each is
+      Quit : Boolean := False;
+   begin
+      for Index in Table_Low_Bound .. Table_Index_Type (Last_Val) loop
+         Action (Index, Table (Index), Quit);
+         exit when Quit;
+      end loop;
+   end For_Each;
+
    ----------
    -- Free --
    ----------
@@ -259,17 +274,17 @@ package body GNAT.Table is
       pragma Import (Ada, Allocated_Table);
       pragma Suppress (Range_Check, On => Allocated_Table);
       for Allocated_Table'Address use Allocated_Table_Address;
-      --  Allocated_Table represents the currently allocated array, plus
-      --  one element (the supplementary element is used to have a
-      --  convenient way of computing the address just past the end of the
-      --  current allocation). Range checks are suppressed because this unit
-      --  uses direct calls to System.Memory for allocation, and this can
-      --  yield misaligned storage (and we cannot rely on the bootstrap
-      --  compiler supporting specifically disabling alignment checks, so we
-      --  need to suppress all range checks). It is safe to suppress this check
-      --  here because we know that a (possibly misaligned) object of that type
-      --  does actually exist at that address.
-      --  ??? We should really improve the allocation circuitry here to
+      --  Allocated_Table represents the currently allocated array, plus one
+      --  element (the supplementary element is used to have a convenient
+      --  way of computing the address just past the end of the current
+      --  allocation). Range checks are suppressed because this unit uses
+      --  direct calls to System.Memory for allocation, and this can yield
+      --  misaligned storage (and we cannot rely on the bootstrap compiler
+      --  supporting specifically disabling alignment checks, so we need to
+      --  suppress all range checks). It is safe to suppress this check here
+      --  because we know that a (possibly misaligned) object of that type
+      --  does actually exist at that address. ??? We should really improve
+      --  the allocation circuitry here to
       --  guarantee proper alignment.
 
       Need_Realloc : constant Boolean := Integer (Index) > Max;
@@ -324,6 +339,74 @@ package body GNAT.Table is
       end if;
    end Set_Last;
 
+   ----------------
+   -- Sort_Table --
+   ----------------
+
+   procedure Sort_Table is
+
+      Temp : Table_Component_Type;
+      --  A temporary position to simulate index 0
+
+      --  Local subprograms
+
+      function Index_Of (Idx : Natural) return Table_Index_Type;
+      --  Return index of Idx'th element of table
+
+      function Lower_Than (Op1, Op2 : Natural) return Boolean;
+      --  Compare two components
+
+      procedure Move (From : Natural; To : Natural);
+      --  Move one component
+
+      package Heap_Sort is new GNAT.Heap_Sort_G (Move, Lower_Than);
+
+      --------------
+      -- Index_Of --
+      --------------
+
+      function Index_Of (Idx : Natural) return Table_Index_Type is
+         J : constant Integer'Base := Table_Index_Type'Pos (First) + Idx - 1;
+      begin
+         return Table_Index_Type'Val (J);
+      end Index_Of;
+
+      ----------
+      -- Move --
+      ----------
+
+      procedure Move (From : Natural; To : Natural) is
+      begin
+         if From = 0 then
+            Table (Index_Of (To)) := Temp;
+         elsif To = 0 then
+            Temp := Table (Index_Of (From));
+         else
+            Table (Index_Of (To)) := Table (Index_Of (From));
+         end if;
+      end Move;
+
+      ----------------
+      -- Lower_Than --
+      ----------------
+
+      function Lower_Than (Op1, Op2 : Natural) return Boolean is
+      begin
+         if Op1 = 0 then
+            return Lt (Temp, Table (Index_Of (Op2)));
+         elsif Op2 = 0 then
+            return Lt (Table (Index_Of (Op1)), Temp);
+         else
+            return Lt (Table (Index_Of (Op1)), Table (Index_Of (Op2)));
+         end if;
+      end Lower_Than;
+
+   --  Start of processing for Sort_Table
+
+   begin
+      Heap_Sort.Sort (Natural (Last - First) + 1);
+   end Sort_Table;
+
 begin
    Init;
 end GNAT.Table;