* 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
+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
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
-- 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
with Ada.Streams; use Ada.Streams;
with Ada.Exceptions; use Ada.Exceptions;
+with Ada.Finalization;
with Ada.Unchecked_Conversion;
with Interfaces.C.Strings;
use type C.int;
- Finalized : Boolean := False;
- Initialized : Boolean := False;
-
ENOERROR : constant := 0;
Empty_Socket_Set : Socket_Set_Type;
-- 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);
+
---------
-- "+" --
---------
-- 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;
---------
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;
(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
Index := Index + Socket_Img'Length;
end;
end loop;
+
return "[" & Last_Img & "]" & Buffer (1 .. Index - 1);
end;
end Image;
-- 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;
"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;
----------------
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;
--------------
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;
-- 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
-- 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,
-- General
"SVRname#" &
+ "SVRproject_dir#" &
"lVmain#" &
"LVlanguages#" &
"SVmain_language#" &
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;
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;
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
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
Add_Attributes
(Project,
Name,
+ Name_Id (Processed_Data.Directory.Name),
In_Tree,
Processed_Data.Decl,
Prj.Attr.Attribute_First,
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);
-- 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.
"pretty_printer#" &
"prefix#" &
"project#" &
+ "project_dir#" &
"roots#" &
"required_switches#" &
"run_path_option#" &
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 --
OSDN Git Service
