[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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 434bdb7..0b6bcc3 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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