2009-04-08 Robert Dewar <dewar@adacore.com>

	* checks.adb (Enable_Overflow_Check): Do not enable if overflow checks
	suppressed.
	
	* exp_ch4.adb (Expand_Concatenate): Make sure checks are off for all
	resolution steps.

2009-04-08  Robert Dewar  <dewar@adacore.com>

	* sem_ch12.adb (Analyze_Package_Instantiation): Remove test for
	No_Local_Allocators restriction preventing local instantiation.

2009-04-08  Thomas Quinot  <quinot@adacore.com>

	* sem_eval.adb: Minor comment fix

2009-04-08  Thomas Quinot  <quinot@adacore.com>

	* g-socket.adb, g-socket.ads (GNAT.Sockets.Sockets_Library_Controller):
	New limited controlled type used to automate the initialization and
	finalization of the sockets implementation.
	(GNAT.Sockets.Initialize, Finalize): Make these no-ops

2009-04-08  Vincent Celier  <celier@adacore.com>

	* prj-attr.adb: New read-only project-level attribute Project_Dir

	* prj-proc.adb (Add_Attributes): New parameter Project_Dir, value of
	read-only attribute of the same name.
	(Process_Declarative_Items): Call Add_Attributes with Project_Dir
	(Recursive_Process): Ditto

	* snames.adb: Add new standard name Project_Dir

	* snames.ads: Add new standard name Project_Dir



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

11 files changed, 173 insertions, 64 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 3a6edf9783e..baa8423ae8b 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,40 @@
+2009-04-08  Robert Dewar  <dewar@adacore.com>
+
+	* checks.adb (Enable_Overflow_Check): Do not enable if overflow checks
+	suppressed.
+	
+	* exp_ch4.adb (Expand_Concatenate): Make sure checks are off for all
+	resolution steps.
+
+2009-04-08  Robert Dewar  <dewar@adacore.com>
+
+	* sem_ch12.adb (Analyze_Package_Instantiation): Remove test for
+	No_Local_Allocators restriction preventing local instantiation.
+
+2009-04-08  Thomas Quinot  <quinot@adacore.com>
+
+	* sem_eval.adb: Minor comment fix
+
+2009-04-08  Thomas Quinot  <quinot@adacore.com>
+
+	* g-socket.adb, g-socket.ads (GNAT.Sockets.Sockets_Library_Controller):
+	New limited controlled type used to automate the initialization and
+	finalization of the sockets implementation.
+	(GNAT.Sockets.Initialize, Finalize): Make these no-ops
+
+2009-04-08  Vincent Celier  <celier@adacore.com>
+
+	* prj-attr.adb: New read-only project-level attribute Project_Dir
+
+	* prj-proc.adb (Add_Attributes): New parameter Project_Dir, value of
+	read-only attribute of the same name.
+	(Process_Declarative_Items): Call Add_Attributes with Project_Dir
+	(Recursive_Process): Ditto
+
+	* snames.adb: Add new standard name Project_Dir
+
+	* snames.ads: Add new standard name Project_Dir
+
 2009-04-08  Thomas Quinot  <quinot@adacore.com>
 
 	* checks.adb: Minor reformatting
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index 549d1b61b94..cb32cc2ef87 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -3560,12 +3560,19 @@ package body Checks is
          pg (Union_Id (N));
       end if;
 
+      --  No check if overflow checks suppressed for type of node
+
+      if Present (Etype (N))
+        and then Overflow_Checks_Suppressed (Etype (N))
+      then
+         return;
+
       --  Nothing to do if the range of the result is known OK. We skip this
       --  for conversions, since the caller already did the check, and in any
       --  case the condition for deleting the check for a type conversion is
       --  different.
 
-      if Nkind (N) /= N_Type_Conversion then
+      elsif Nkind (N) /= N_Type_Conversion then
          Determine_Range (N, OK, Lo, Hi, Assume_Valid => True);
 
          --  Note in the test below that we assume that the range is not OK
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 190baa62373..78c4285f521 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -2287,7 +2287,7 @@ package body Exp_Ch4 is
             --  we analyzed and resolved the expression.
 
             Set_Parent (X, Cnode);
-            Analyze_And_Resolve (X, Artyp);
+            Analyze_And_Resolve (X, Artyp, Suppress => All_Checks);
 
             if Compile_Time_Compare
                  (X, Type_High_Bound (Istyp), Assume_Valid => False) = GT
diff --git a/gcc/ada/g-socket.adb b/gcc/ada/g-socket.adb
index e586a2d03d8..55629d2c46a 100644
--- a/gcc/ada/g-socket.adb
+++ b/gcc/ada/g-socket.adb
@@ -33,6 +33,7 @@
 
 with Ada.Streams;              use Ada.Streams;
 with Ada.Exceptions;           use Ada.Exceptions;
+with Ada.Finalization;
 with Ada.Unchecked_Conversion;
 
 with Interfaces.C.Strings;
@@ -53,9 +54,6 @@ package body GNAT.Sockets is
 
    use type C.int;
 
-   Finalized   : Boolean := False;
-   Initialized : Boolean := False;
-
    ENOERROR : constant := 0;
 
    Empty_Socket_Set : Socket_Set_Type;
@@ -242,6 +240,15 @@ package body GNAT.Sockets is
    --  it is added to the write set. If no selector is provided, a local one is
    --  created for this call and destroyed prior to returning.
 
+   type Sockets_Library_Controller is new Ada.Finalization.Limited_Controlled
+     with null record;
+   --  This type is used to generate automatic calls to Initialize and Finalize
+   --  during the elaboration and finalization of this package. A single object
+   --  of this type must exist at library level.
+
+   procedure Initialize (X : in out Sockets_Library_Controller);
+   procedure Finalize   (X : in out Sockets_Library_Controller);
+
    ---------
    -- "+" --
    ---------
@@ -793,14 +800,24 @@ package body GNAT.Sockets is
    -- Finalize --
    --------------
 
+   procedure Finalize (X : in out Sockets_Library_Controller) is
+      pragma Unreferenced (X);
+   begin
+      --  Finalization operation for the GNAT.Sockets package
+
+      Thin.Finalize;
+   end Finalize;
+
+   --------------
+   -- Finalize --
+   --------------
+
    procedure Finalize is
    begin
-      if not Finalized
-        and then Initialized
-      then
-         Finalized := True;
-         Thin.Finalize;
-      end if;
+      --  This is a dummy placeholder for an obsolete API.
+      --  The real finalization actions are in Initialize primitive operation
+      --  of Sockets_Library_Controller.
+      null;
    end Finalize;
 
    ---------
@@ -1218,6 +1235,7 @@ package body GNAT.Sockets is
 
    function Image (Item : Socket_Set_Type) return String is
       Socket_Set : Socket_Set_Type := Item;
+
    begin
       declare
          Last_Img : constant String := Socket_Set.Last'Img;
@@ -1225,9 +1243,11 @@ package body GNAT.Sockets is
                       (1 .. (Integer (Socket_Set.Last) + 1) * Last_Img'Length);
          Index    : Positive := 1;
          Socket   : Socket_Type;
+
       begin
          while not Is_Empty (Socket_Set) loop
             Get (Socket_Set, Socket);
+
             declare
                Socket_Img : constant String := Socket'Img;
             begin
@@ -1235,6 +1255,7 @@ package body GNAT.Sockets is
                Index := Index + Socket_Img'Length;
             end;
          end loop;
+
          return "[" & Last_Img & "]" & Buffer (1 .. Index - 1);
       end;
    end Image;
@@ -1281,6 +1302,20 @@ package body GNAT.Sockets is
    -- Initialize --
    ----------------
 
+   procedure Initialize (X : in out Sockets_Library_Controller) is
+      pragma Unreferenced (X);
+   begin
+      --  Initialization operation for the GNAT.Sockets package
+
+      Empty_Socket_Set.Last := No_Socket;
+      Reset_Socket_Set (Empty_Socket_Set.Set'Access);
+      Thin.Initialize;
+   end Initialize;
+
+   ----------------
+   -- Initialize --
+   ----------------
+
    procedure Initialize (Process_Blocking_IO : Boolean) is
       Expected : constant Boolean := not SOSC.Thread_Blocking_IO;
 
@@ -1290,7 +1325,11 @@ package body GNAT.Sockets is
            "incorrect Process_Blocking_IO setting, expected " & Expected'Img;
       end if;
 
-      Initialize;
+      --  This is a dummy placeholder for an obsolete API.
+      --  Real initialization actions are in Initialize primitive operation
+      --  of Sockets_Library_Controller.
+
+      null;
    end Initialize;
 
    ----------------
@@ -1299,12 +1338,10 @@ package body GNAT.Sockets is
 
    procedure Initialize is
    begin
-      if not Initialized then
-         Initialized := True;
-         Empty_Socket_Set.Last := No_Socket;
-         Reset_Socket_Set (Empty_Socket_Set.Set'Access);
-         Thin.Initialize;
-      end if;
+      --  This is a dummy placeholder for an obsolete API.
+      --  Real initialization actions are in Initialize primitive operation
+      --  of Sockets_Library_Controller.
+      null;
    end Initialize;
 
    --------------
@@ -2330,4 +2367,9 @@ package body GNAT.Sockets is
       end if;
    end Write;
 
+   Sockets_Library_Controller_Object : Sockets_Library_Controller;
+   pragma Unreferenced (Sockets_Library_Controller_Object);
+   --  The elaboration and finalization of this object perform the required
+   --  initialization and cleanup actions for the sockets library.
+
 end GNAT.Sockets;
diff --git a/gcc/ada/g-socket.ads b/gcc/ada/g-socket.ads
index 7dddd3decea..9ea9ecc56b6 100644
--- a/gcc/ada/g-socket.ads
+++ b/gcc/ada/g-socket.ads
@@ -383,6 +383,8 @@ package GNAT.Sockets is
    --  Note that this operation is a no-op on UNIX platforms, but applications
    --  should make sure to call it if portability is expected: some platforms
    --  (such as Windows) require initialization before any socket operation.
+   --  This is now a no-op (initialization and finalization are done
+   --  automatically).
 
    procedure Initialize (Process_Blocking_IO : Boolean);
    pragma Obsolescent
@@ -394,10 +396,14 @@ package GNAT.Sockets is
    --  is built. The old version of Initialize, taking a parameter, is kept
    --  for compatibility reasons, but this interface is obsolete (and if the
    --  value given is wrong, an exception will be raised at run time).
+   --  This is now a no-op (initialization and finalization are done
+   --  automatically).
 
    procedure Finalize;
    --  After Finalize is called it is not possible to use any routines
    --  exported in by this package. This procedure is idempotent.
+   --  This is now a no-op (initialization and finalization are done
+   --  automatically).
 
    type Socket_Type is private;
    --  Sockets are used to implement a reliable bi-directional point-to-point,
diff --git a/gcc/ada/prj-attr.adb b/gcc/ada/prj-attr.adb
index 250a412e58d..1096743be71 100644
--- a/gcc/ada/prj-attr.adb
+++ b/gcc/ada/prj-attr.adb
@@ -68,6 +68,7 @@ package body Prj.Attr is
    --  General
 
    "SVRname#" &
+   "SVRproject_dir#" &
    "lVmain#" &
    "LVlanguages#" &
    "SVmain_language#" &
diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb
index 03e7327b82e..5cd2fa222c4 100644
--- a/gcc/ada/prj-proc.adb
+++ b/gcc/ada/prj-proc.adb
@@ -66,6 +66,7 @@ package body Prj.Proc is
    procedure Add_Attributes
      (Project       : Project_Id;
       Project_Name  : Name_Id;
+      Project_Dir   : Name_Id;
       In_Tree       : Project_Tree_Ref;
       Decl          : in out Declarations;
       First         : Attribute_Node_Id;
@@ -183,6 +184,7 @@ package body Prj.Proc is
    procedure Add_Attributes
      (Project       : Project_Id;
       Project_Name  : Name_Id;
+      Project_Dir   : Name_Id;
       In_Tree       : Project_Tree_Ref;
       Decl          : in out Declarations;
       First         : Attribute_Node_Id;
@@ -217,13 +219,20 @@ package body Prj.Proc is
                         Value    => Empty_String,
                         Index    => 0);
 
-                     --  Special case of <project>'Name
+                     --  Special cases of <project>'Name and
+                     --  <project>'Project_Dir.
 
-                     if Project_Level
-                       and then Attribute_Name_Of (The_Attribute) =
-                                  Snames.Name_Name
-                     then
-                        New_Attribute.Value := Project_Name;
+                     if Project_Level then
+                        if Attribute_Name_Of (The_Attribute) =
+                          Snames.Name_Name
+                        then
+                           New_Attribute.Value := Project_Name;
+
+                        elsif Attribute_Name_Of (The_Attribute) =
+                          Snames.Name_Project_Dir
+                        then
+                           New_Attribute.Value := Project_Dir;
+                        end if;
                      end if;
 
                   --  List attributes have a default value of nil list
@@ -1372,6 +1381,8 @@ package body Prj.Proc is
                         Add_Attributes
                           (Project,
                            In_Tree.Projects.Table (Project).Name,
+                           Name_Id
+                             (In_Tree.Projects.Table (Project).Directory.Name),
                            In_Tree,
                            In_Tree.Packages.Table (New_Pkg).Decl,
                            First_Attribute_Of
@@ -2607,6 +2618,7 @@ package body Prj.Proc is
             Add_Attributes
               (Project,
                Name,
+               Name_Id (Processed_Data.Directory.Name),
                In_Tree,
                Processed_Data.Decl,
                Prj.Attr.Attribute_First,
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 63e810d2b75..acacec591de 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -3435,14 +3435,16 @@ package body Sem_Ch12 is
 
       Validate_Categorization_Dependency (N, Act_Decl_Id);
 
-      --  Check restriction, but skip this if something went wrong in the above
-      --  analysis, indicated by Act_Decl_Id being void.
-
-      if Ekind (Act_Decl_Id) /= E_Void
-        and then not Is_Library_Level_Entity (Act_Decl_Id)
-      then
-         Check_Restriction (No_Local_Allocators, N);
-      end if;
+      --  There used to be a check here to prevent instantiations in local
+      --  contexts if the No_Local_Allocators restriction was active. This
+      --  check was removed by a binding interpretation in AI-95-00130/07,
+      --  but we retain the code for documentation purposes.
+
+      --  if Ekind (Act_Decl_Id) /= E_Void
+      --    and then not Is_Library_Level_Entity (Act_Decl_Id)
+      --  then
+      --     Check_Restriction (No_Local_Allocators, N);
+      --  end if;
 
       if Inline_Now then
          Inline_Instance_Body (N, Gen_Unit, Act_Decl);
diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index dece5445be4..b29417153ab 100644
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -189,7 +189,7 @@ package body Sem_Eval is
    --  it is not technically static (e.g. the static lower bound of a range
    --  whose upper bound is non-static).
    --
-   --  If Stat is set False on return, then Expression_Is_Foldable makes a
+   --  If Stat is set False on return, then Test_Expression_Is_Foldable makes a
    --  call to Check_Non_Static_Context on the operand. If Fold is False on
    --  return, then all processing is complete, and the caller should
    --  return, since there is nothing else to do.
diff --git a/gcc/ada/snames.adb b/gcc/ada/snames.adb
index 7d9f04fcd4e..29a6b0d904d 100644
--- a/gcc/ada/snames.adb
+++ b/gcc/ada/snames.adb
@@ -790,6 +790,7 @@ package body Snames is
      "pretty_printer#" &
      "prefix#" &
      "project#" &
+     "project_dir#" &
      "roots#" &
      "required_switches#" &
      "run_path_option#" &
diff --git a/gcc/ada/snames.ads b/gcc/ada/snames.ads
index 0b7f9b733cf..8c44e8a08a8 100644
--- a/gcc/ada/snames.ads
+++ b/gcc/ada/snames.ads
@@ -1114,49 +1114,50 @@ package Snames is
    Name_Pretty_Printer                 : constant Name_Id := N + 729;
    Name_Prefix                         : constant Name_Id := N + 730;
    Name_Project                        : constant Name_Id := N + 731;
-   Name_Roots                          : constant Name_Id := N + 732;
-   Name_Required_Switches              : constant Name_Id := N + 733;
-   Name_Run_Path_Option                : constant Name_Id := N + 734;
-   Name_Runtime_Project                : constant Name_Id := N + 735;
-   Name_Shared_Library_Minimum_Switches : constant Name_Id := N + 736;
-   Name_Shared_Library_Prefix          : constant Name_Id := N + 737;
-   Name_Shared_Library_Suffix          : constant Name_Id := N + 738;
-   Name_Separate_Suffix                : constant Name_Id := N + 739;
-   Name_Source_Dirs                    : constant Name_Id := N + 740;
-   Name_Source_Files                   : constant Name_Id := N + 741;
-   Name_Source_List_File               : constant Name_Id := N + 742;
-   Name_Spec                           : constant Name_Id := N + 743;
-   Name_Spec_Suffix                    : constant Name_Id := N + 744;
-   Name_Specification                  : constant Name_Id := N + 745;
-   Name_Specification_Exceptions       : constant Name_Id := N + 746;
-   Name_Specification_Suffix           : constant Name_Id := N + 747;
-   Name_Stack                          : constant Name_Id := N + 748;
-   Name_Switches                       : constant Name_Id := N + 749;
-   Name_Symbolic_Link_Supported        : constant Name_Id := N + 750;
-   Name_Sync                           : constant Name_Id := N + 751;
-   Name_Synchronize                    : constant Name_Id := N + 752;
-   Name_Toolchain_Description          : constant Name_Id := N + 753;
-   Name_Toolchain_Version              : constant Name_Id := N + 754;
-   Name_Runtime_Library_Dir            : constant Name_Id := N + 755;
+   Name_Project_Dir                    : constant Name_Id := N + 732;
+   Name_Roots                          : constant Name_Id := N + 733;
+   Name_Required_Switches              : constant Name_Id := N + 734;
+   Name_Run_Path_Option                : constant Name_Id := N + 735;
+   Name_Runtime_Project                : constant Name_Id := N + 736;
+   Name_Shared_Library_Minimum_Switches : constant Name_Id := N + 737;
+   Name_Shared_Library_Prefix          : constant Name_Id := N + 738;
+   Name_Shared_Library_Suffix          : constant Name_Id := N + 739;
+   Name_Separate_Suffix                : constant Name_Id := N + 740;
+   Name_Source_Dirs                    : constant Name_Id := N + 741;
+   Name_Source_Files                   : constant Name_Id := N + 742;
+   Name_Source_List_File               : constant Name_Id := N + 743;
+   Name_Spec                           : constant Name_Id := N + 744;
+   Name_Spec_Suffix                    : constant Name_Id := N + 745;
+   Name_Specification                  : constant Name_Id := N + 746;
+   Name_Specification_Exceptions       : constant Name_Id := N + 747;
+   Name_Specification_Suffix           : constant Name_Id := N + 748;
+   Name_Stack                          : constant Name_Id := N + 749;
+   Name_Switches                       : constant Name_Id := N + 750;
+   Name_Symbolic_Link_Supported        : constant Name_Id := N + 751;
+   Name_Sync                           : constant Name_Id := N + 752;
+   Name_Synchronize                    : constant Name_Id := N + 753;
+   Name_Toolchain_Description          : constant Name_Id := N + 754;
+   Name_Toolchain_Version              : constant Name_Id := N + 755;
+   Name_Runtime_Library_Dir            : constant Name_Id := N + 756;
 
    --  Other miscellaneous names used in front end
 
-   Name_Unaligned_Valid                : constant Name_Id := N + 756;
+   Name_Unaligned_Valid                : constant Name_Id := N + 757;
 
    --  Ada 2005 reserved words
 
-   First_2005_Reserved_Word            : constant Name_Id := N + 757;
-   Name_Interface                      : constant Name_Id := N + 757;
-   Name_Overriding                     : constant Name_Id := N + 758;
-   Name_Synchronized                   : constant Name_Id := N + 759;
-   Last_2005_Reserved_Word             : constant Name_Id := N + 759;
+   First_2005_Reserved_Word            : constant Name_Id := N + 758;
+   Name_Interface                      : constant Name_Id := N + 758;
+   Name_Overriding                     : constant Name_Id := N + 759;
+   Name_Synchronized                   : constant Name_Id := N + 760;
+   Last_2005_Reserved_Word             : constant Name_Id := N + 760;
 
    subtype Ada_2005_Reserved_Words is
      Name_Id range First_2005_Reserved_Word .. Last_2005_Reserved_Word;
 
    --  Mark last defined name for consistency check in Snames body
 
-   Last_Predefined_Name                : constant Name_Id := N + 759;
+   Last_Predefined_Name                : constant Name_Id := N + 760;
 
    ---------------------------------------
    -- Subtypes Defining Name Categories --