diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 14 | ||||
| -rw-r--r-- | gcc/ada/g-socket.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/gnatcmd.adb | 1 | ||||
| -rw-r--r-- | gcc/ada/sem_eval.adb | 7 | ||||
| -rw-r--r-- | gcc/ada/sem_res.adb | 17 | ||||
| -rw-r--r-- | gcc/ada/sem_util.adb | 11 | ||||
| -rw-r--r-- | gcc/ada/sem_util.ads | 4 |
7 files changed, 53 insertions, 5 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 434bdb7..0b6bcc3 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -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. diff --git a/gcc/ada/g-socket.adb b/gcc/ada/g-socket.adb index 0122c5a..a364cb2 100644 --- a/gcc/ada/g-socket.adb +++ b/gcc/ada/g-socket.adb @@ -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 diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb index 10cf345..041c82a 100644 --- a/gcc/ada/gnatcmd.adb +++ b/gcc/ada/gnatcmd.adb @@ -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, diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index c9054f3..13751d2 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -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); diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 14c0210..feee853 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -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; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index ffcc28e..1cfa423 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -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 -- ----------------- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index ed36cf8..9e74357 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -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 |