-- --
-- S p e c --
-- --
--- Copyright (C) 2001-2009, AdaCore --
+-- Copyright (C) 2001-2010, 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- --
-- with a socket. Options may exist at multiple protocol levels in the
-- communication stack. Socket_Level is the uppermost socket level.
- type Level_Type is (
- Socket_Level,
- IP_Protocol_For_IP_Level,
- IP_Protocol_For_UDP_Level,
- IP_Protocol_For_TCP_Level);
+ type Level_Type is
+ (Socket_Level,
+ IP_Protocol_For_IP_Level,
+ IP_Protocol_For_UDP_Level,
+ IP_Protocol_For_TCP_Level);
-- There are several options available to manipulate sockets. Each option
-- has a name and several values available. Most of the time, the value is
-- a boolean to enable or disable this option.
- type Option_Name is (
- Keep_Alive, -- Enable sending of keep-alive messages
- Reuse_Address, -- Allow bind to reuse local address
- Broadcast, -- Enable datagram sockets to recv/send broadcasts
- Send_Buffer, -- Set/get the maximum socket send buffer in bytes
- Receive_Buffer, -- Set/get the maximum socket recv buffer in bytes
- Linger, -- Shutdown wait for msg to be sent or timeout occur
- Error, -- Get and clear the pending socket error
- No_Delay, -- Do not delay send to coalesce data (TCP_NODELAY)
- Add_Membership, -- Join a multicast group
- Drop_Membership, -- Leave a multicast group
- Multicast_If, -- Set default out interface for multicast packets
- Multicast_TTL, -- Set the time-to-live of sent multicast packets
- Multicast_Loop, -- Sent multicast packets are looped to local socket
- Receive_Packet_Info, -- Receive low level packet info as ancillary data
- Send_Timeout, -- Set timeout value for output
- Receive_Timeout); -- Set timeout value for input
+ type Option_Name is
+ (Keep_Alive, -- Enable sending of keep-alive messages
+ Reuse_Address, -- Allow bind to reuse local address
+ Broadcast, -- Enable datagram sockets to recv/send broadcasts
+ Send_Buffer, -- Set/get the maximum socket send buffer in bytes
+ Receive_Buffer, -- Set/get the maximum socket recv buffer in bytes
+ Linger, -- Shutdown wait for msg to be sent or timeout occur
+ Error, -- Get and clear the pending socket error
+ No_Delay, -- Do not delay send to coalesce data (TCP_NODELAY)
+ Add_Membership, -- Join a multicast group
+ Drop_Membership, -- Leave a multicast group
+ Multicast_If, -- Set default out interface for multicast packets
+ Multicast_TTL, -- Set the time-to-live of sent multicast packets
+ Multicast_Loop, -- Sent multicast packets are looped to local socket
+ Receive_Packet_Info, -- Receive low level packet info as ancillary data
+ Send_Timeout, -- Set timeout value for output
+ Receive_Timeout); -- Set timeout value for input
type Option_Type (Name : Option_Name := Keep_Alive) is record
case Name is
-- socket options in that they are not specific to sockets but are
-- available for any device.
- type Request_Name is (
- Non_Blocking_IO, -- Cause a caller not to wait on blocking operations.
+ type Request_Name is
+ (Non_Blocking_IO, -- Cause a caller not to wait on blocking operations
N_Bytes_To_Read); -- Return the number of bytes available to read
type Request_Type (Name : Request_Name := Non_Blocking_IO) is record
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, 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- --
or else Modification_Comes_From_Source
then
if Has_Pragma_Unmodified (Ent) then
- Error_Msg_NE ("?pragma Unmodified given for &!", N, Ent);
+ Error_Msg_NE -- CODEFIX???
+ ("?pragma Unmodified given for &!", N, Ent);
end if;
Set_Never_Set_In_Source (Ent, False);
and then Is_Entity_Name (Prefix (Exp))
then
Error_Msg_Sloc := Sloc (A);
- Error_Msg_NE
+ Error_Msg_NE -- CODEFIX???
("constant& may be modified via address clause#?",
N, Entity (Prefix (Exp)));
end if;
then
return Object_Access_Level (Expression (Obj));
- -- Function results are objects, so we get either the access level of
- -- the function or, in the case of an indirect call, the level of the
- -- access-to-subprogram type.
-
elsif Nkind (Obj) = N_Function_Call then
- if Is_Entity_Name (Name (Obj)) then
- return Subprogram_Access_Level (Entity (Name (Obj)));
+
+ -- Function results are objects, so we get either the access level of
+ -- the function or, in the case of an indirect call, the level of the
+ -- access-to-subprogram type. (This code is used for Ada 95, but it
+ -- looks wrong, because it seems that we should be checking the level
+ -- of the call itself, even for Ada 95. However, using the Ada 2005
+ -- version of the code causes regressions in several tests that are
+ -- compiled with -gnat95. ???)
+
+ if Ada_Version < Ada_05 then
+ if Is_Entity_Name (Name (Obj)) then
+ return Subprogram_Access_Level (Entity (Name (Obj)));
+ else
+ return Type_Access_Level (Etype (Prefix (Name (Obj))));
+ end if;
+
+ -- For Ada 2005, the level of the result object of a function call is
+ -- defined to be the level of the call's innermost enclosing master.
+ -- We determine that by querying the depth of the innermost enclosing
+ -- dynamic scope.
+
else
- return Type_Access_Level (Etype (Prefix (Name (Obj))));
+ Return_Master_Scope_Depth_Of_Call : declare
+
+ function Innermost_Master_Scope_Depth
+ (N : Node_Id) return Uint;
+ -- Returns the scope depth of the given node's innermost
+ -- enclosing dynamic scope (effectively the accessibility
+ -- level of the innermost enclosing master).
+
+ ----------------------------------
+ -- Innermost_Master_Scope_Depth --
+ ----------------------------------
+
+ function Innermost_Master_Scope_Depth
+ (N : Node_Id) return Uint
+ is
+ Node_Par : Node_Id := Parent (N);
+
+ begin
+ -- Locate the nearest enclosing node (by traversing Parents)
+ -- that Defining_Entity can be applied to, and return the
+ -- depth of that entity's nearest enclosing dynamic scope.
+
+ while Present (Node_Par) loop
+ case Nkind (Node_Par) is
+ when N_Component_Declaration |
+ N_Entry_Declaration |
+ N_Formal_Object_Declaration |
+ N_Formal_Type_Declaration |
+ N_Full_Type_Declaration |
+ N_Incomplete_Type_Declaration |
+ N_Loop_Parameter_Specification |
+ N_Object_Declaration |
+ N_Protected_Type_Declaration |
+ N_Private_Extension_Declaration |
+ N_Private_Type_Declaration |
+ N_Subtype_Declaration |
+ N_Function_Specification |
+ N_Procedure_Specification |
+ N_Task_Type_Declaration |
+ N_Body_Stub |
+ N_Generic_Instantiation |
+ N_Proper_Body |
+ N_Implicit_Label_Declaration |
+ N_Package_Declaration |
+ N_Single_Task_Declaration |
+ N_Subprogram_Declaration |
+ N_Generic_Declaration |
+ N_Renaming_Declaration |
+ N_Block_Statement |
+ N_Formal_Subprogram_Declaration |
+ N_Abstract_Subprogram_Declaration |
+ N_Entry_Body |
+ N_Exception_Declaration |
+ N_Formal_Package_Declaration |
+ N_Number_Declaration |
+ N_Package_Specification |
+ N_Parameter_Specification |
+ N_Single_Protected_Declaration |
+ N_Subunit =>
+
+ return Scope_Depth
+ (Nearest_Dynamic_Scope
+ (Defining_Entity (Node_Par)));
+
+ when others =>
+ null;
+ end case;
+
+ Node_Par := Parent (Node_Par);
+ end loop;
+
+ pragma Assert (False);
+
+ -- Should never reach the following return
+
+ return Scope_Depth (Current_Scope) + 1;
+ end Innermost_Master_Scope_Depth;
+
+ -- Start of processing for Return_Master_Scope_Depth_Of_Call
+
+ begin
+ return Innermost_Master_Scope_Depth (Obj);
+ end Return_Master_Scope_Depth_Of_Call;
end if;
-- For convenience we handle qualified expressions, even though
and then Covers
(Designated_Type (Expec_Type), Designated_Type (Found_Type))
then
- Error_Msg_N ("result must be general access type!", Expr);
- Error_Msg_NE ("add ALL to }!", Expr, Expec_Type);
+ Error_Msg_N -- CODEFIX
+ ("result must be general access type!", Expr);
+ Error_Msg_NE -- CODEFIX
+ ("add ALL to }!", Expr, Expec_Type);
-- Another special check, if the expected type is an integer type,
-- but the expression is of type System.Address, and the parent is
Error_Msg_N
("address arithmetic not predefined in package System",
Parent (Expr));
- Error_Msg_N
+ Error_Msg_N -- CODEFIX???
("\possible missing with/use of System.Storage_Elements",
Parent (Expr));
return;
if From_With_Type (Found_Type) then
Error_Msg_NE ("\\found incomplete}!", Expr, Found_Type);
Error_Msg_Qual_Level := 99;
- Error_Msg_NE ("\\missing `WITH &;", Expr, Scope (Found_Type));
+ Error_Msg_NE -- CODEFIX
+ ("\\missing `WITH &;", Expr, Scope (Found_Type));
Error_Msg_Qual_Level := 0;
else
Error_Msg_NE ("found}!", Expr, Found_Type);
Ekind (Entity (Expr)) = E_Generic_Procedure)
then
if Ekind (Expec_Type) = E_Access_Subprogram_Type then
- Error_Msg_N
+ Error_Msg_N -- CODEFIX???
("found procedure name, possibly missing Access attribute!",
Expr);
else
and then Etype (Designated_Type (Expec_Type)) = Etype (Expr)
and then No (Parameter_Associations (Expr))
then
- Error_Msg_N
+ Error_Msg_N -- CODEFIX???
("found function name, possibly missing Access attribute!",
Expr);
and then not In_Use (Expec_Type)
and then Has_Compatible_Type (Right_Opnd (Expr), Expec_Type)
then
- Error_Msg_N
+ Error_Msg_N -- CODEFIX???
("operator of the type is not directly visible!", Expr);
elsif Ekind (Found_Type) = E_Void
projects / platform / upstream / linaro-gcc.git / commitdiff