[multiple changes]
2010-06-14 Ed Schonberg <schonberg@adacore.com> * sem_util (Is_VMS_Operator): New predicate to determine whether an operator is an intrinsic operator declared in the DEC system extension. * sem_res.adb (Resolve_Logical_Op): operation is legal on signed types if the operator is a VMS intrinsic. * sem_eval.adb (Eval_Logical_Op): Operation is legal and be constant-folded if the operands are signed and the operator is a VMS intrinsic. 2010-06-14 Robert Dewar <dewar@adacore.com> * g-socket.adb, gnatcmd.adb: Minor reformatting From-SVN: r160734
This commit is contained in:
parent
ee81cbe977
commit
001c7783c4
@ -1,3 +1,17 @@
|
||||
2010-06-14 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* sem_util (Is_VMS_Operator): New predicate to determine whether an
|
||||
operator is an intrinsic operator declared in the DEC system extension.
|
||||
* sem_res.adb (Resolve_Logical_Op): operation is legal on signed types
|
||||
if the operator is a VMS intrinsic.
|
||||
* sem_eval.adb (Eval_Logical_Op): Operation is legal and be
|
||||
constant-folded if the operands are signed and the operator is a VMS
|
||||
intrinsic.
|
||||
|
||||
2010-06-14 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* g-socket.adb, gnatcmd.adb: Minor reformatting
|
||||
|
||||
2010-06-14 Pascal Obry <obry@adacore.com>
|
||||
|
||||
* s-finimp.adb: Fix typo.
|
||||
|
@ -900,6 +900,7 @@ package body GNAT.Sockets is
|
||||
|
||||
begin
|
||||
Netdb_Lock;
|
||||
|
||||
if C_Gethostbyaddr (HA'Address, HA'Size / 8, SOSC.AF_INET,
|
||||
Res'Access, Buf'Address, Buflen, Err'Access) /= 0
|
||||
then
|
||||
@ -935,6 +936,7 @@ package body GNAT.Sockets is
|
||||
|
||||
begin
|
||||
Netdb_Lock;
|
||||
|
||||
if C_Gethostbyname
|
||||
(HN, Res'Access, Buf'Address, Buflen, Err'Access) /= 0
|
||||
then
|
||||
@ -986,6 +988,7 @@ package body GNAT.Sockets is
|
||||
|
||||
begin
|
||||
Netdb_Lock;
|
||||
|
||||
if C_Getservbyname (SN, SP, Res'Access, Buf'Address, Buflen) /= 0 then
|
||||
Netdb_Unlock;
|
||||
raise Service_Error with "Service not found";
|
||||
@ -1015,6 +1018,7 @@ package body GNAT.Sockets is
|
||||
|
||||
begin
|
||||
Netdb_Lock;
|
||||
|
||||
if C_Getservbyport
|
||||
(C.int (Short_To_Network (C.unsigned_short (Port))), SP,
|
||||
Res'Access, Buf'Address, Buflen) /= 0
|
||||
|
@ -900,7 +900,6 @@ procedure GNATCmd is
|
||||
|
||||
function Mapping_File return Path_Name_Type is
|
||||
Result : Path_Name_Type;
|
||||
|
||||
begin
|
||||
Prj.Env.Create_Mapping_File
|
||||
(Project => Project,
|
||||
|
@ -2069,7 +2069,12 @@ package body Sem_Eval is
|
||||
Right_Int : constant Uint := Expr_Value (Right);
|
||||
|
||||
begin
|
||||
if Is_Modular_Integer_Type (Etype (N)) then
|
||||
|
||||
-- VMS includes bitwise operations on signed types.
|
||||
|
||||
if Is_Modular_Integer_Type (Etype (N))
|
||||
or else Is_VMS_Operator (Entity (N))
|
||||
then
|
||||
declare
|
||||
Left_Bits : Bits (0 .. UI_To_Int (Esize (Etype (N))) - 1);
|
||||
Right_Bits : Bits (0 .. UI_To_Int (Esize (Etype (N))) - 1);
|
||||
|
@ -4769,12 +4769,15 @@ package body Sem_Res is
|
||||
-- Returns True if the subprogram entity S is the same as E or else
|
||||
-- S is an alias of E.
|
||||
|
||||
---------------------------------
|
||||
-- Same_Or_Aliased_Subprograms --
|
||||
---------------------------------
|
||||
|
||||
function Same_Or_Aliased_Subprograms
|
||||
(S : Entity_Id;
|
||||
E : Entity_Id) return Boolean
|
||||
is
|
||||
Subp_Alias : constant Entity_Id := Alias (S);
|
||||
|
||||
begin
|
||||
return S = E
|
||||
or else (Present (Subp_Alias) and then Subp_Alias = E);
|
||||
@ -6762,13 +6765,18 @@ package body Sem_Res is
|
||||
B_Typ := Base_Type (Typ);
|
||||
end if;
|
||||
|
||||
-- OK if this is a VMS-specific intrinsic operation
|
||||
|
||||
if Is_VMS_Operator (Entity (N)) then
|
||||
null;
|
||||
|
||||
-- The following test is required because the operands of the operation
|
||||
-- may be literals, in which case the resulting type appears to be
|
||||
-- compatible with a signed integer type, when in fact it is compatible
|
||||
-- only with modular types. If the context itself is universal, the
|
||||
-- operation is illegal.
|
||||
|
||||
if not Valid_Boolean_Arg (Typ) then
|
||||
elsif not Valid_Boolean_Arg (Typ) then
|
||||
Error_Msg_N ("invalid context for logical operation", N);
|
||||
Set_Etype (N, Any_Type);
|
||||
return;
|
||||
@ -7312,9 +7320,12 @@ package body Sem_Res is
|
||||
B_Typ := Base_Type (Typ);
|
||||
end if;
|
||||
|
||||
if Is_VMS_Operator (Entity (N)) then
|
||||
null;
|
||||
|
||||
-- Straightforward case of incorrect arguments
|
||||
|
||||
if not Valid_Boolean_Arg (Typ) then
|
||||
elsif not Valid_Boolean_Arg (Typ) then
|
||||
Error_Msg_N ("invalid operand type for operator&", N);
|
||||
Set_Etype (N, Any_Type);
|
||||
return;
|
||||
|
@ -7045,6 +7045,17 @@ package body Sem_Util is
|
||||
and then Get_Name_String (Chars (T)) = "valuetype";
|
||||
end Is_Value_Type;
|
||||
|
||||
---------------------
|
||||
-- Is_VMS_Operator --
|
||||
---------------------
|
||||
|
||||
function Is_VMS_Operator (Op : Entity_Id) return Boolean is
|
||||
begin
|
||||
return Ekind (Op) = E_Function
|
||||
and then Is_Intrinsic_Subprogram (Op)
|
||||
and then Scope (Op) = System_Aux_Id;
|
||||
end Is_VMS_Operator;
|
||||
|
||||
-----------------
|
||||
-- Is_Delegate --
|
||||
-----------------
|
||||
|
@ -800,6 +800,10 @@ package Sem_Util is
|
||||
-- object that is accessed directly, as opposed to the other CIL objects
|
||||
-- that are accessed through managed pointers.
|
||||
|
||||
function Is_VMS_Operator (Op : Entity_Id) return Boolean;
|
||||
-- Determine whether an operator is one of the intrinsics defined
|
||||
-- in the DEC system extension.
|
||||
|
||||
function Is_Delegate (T : Entity_Id) return Boolean;
|
||||
-- Returns true if type T represents a delegate. A Delegate is the CIL
|
||||
-- object used to represent access-to-subprogram types. This is only
|
||||
|
Loading…
Reference in New Issue
Block a user