diff gcc/ada/libgnat/g-socket.adb @ 131:84e7813d76e9

gcc-8.2
author mir3636
date Thu, 25 Oct 2018 07:37:49 +0900
parents 04ced10e8804
children 1830386684a0
line wrap: on
line diff
--- a/gcc/ada/libgnat/g-socket.adb	Fri Oct 27 22:46:09 2017 +0900
+++ b/gcc/ada/libgnat/g-socket.adb	Thu Oct 25 07:37:49 2018 +0900
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                     Copyright (C) 2001-2017, AdaCore                     --
+--                     Copyright (C) 2001-2018, 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- --
@@ -144,8 +144,8 @@
    --  Symmetric operation
 
    function Image
-     (Val :  Inet_Addr_VN_Type;
-      Hex :  Boolean := False) return String;
+     (Val : Inet_Addr_Bytes;
+      Hex : Boolean := False) return String;
    --  Output an array of inet address components in hex or decimal mode
 
    function Is_IP_Address (Name : String) return Boolean;
@@ -275,6 +275,15 @@
    --  Create_Selector has been called and Close_Selector has not been called,
    --  or the null selector.
 
+   function Create_Address
+     (Family : Family_Type; Bytes : Inet_Addr_Bytes) return Inet_Addr_Type
+     with Inline;
+   --  Creates address from family and Inet_Addr_Bytes array.
+
+   function Get_Bytes (Addr : Inet_Addr_Type) return Inet_Addr_Bytes
+     with Inline;
+   --  Extract bytes from address
+
    ---------
    -- "+" --
    ---------
@@ -1314,7 +1323,7 @@
    -----------
 
    function Image
-     (Val : Inet_Addr_VN_Type;
+     (Val : Inet_Addr_Bytes;
       Hex : Boolean := False) return String
    is
       --  The largest Inet_Addr_Comp_Type image occurs with IPv4. It
@@ -1381,9 +1390,9 @@
    function Image (Value : Inet_Addr_Type) return String is
    begin
       if Value.Family = Family_Inet then
-         return Image (Inet_Addr_VN_Type (Value.Sin_V4), Hex => False);
+         return Image (Inet_Addr_Bytes (Value.Sin_V4), Hex => False);
       else
-         return Image (Inet_Addr_VN_Type (Value.Sin_V6), Hex => True);
+         return Image (Inet_Addr_Bytes (Value.Sin_V6), Hex => True);
       end if;
    end Image;
 
@@ -2782,4 +2791,121 @@
    --  The elaboration and finalization of this object perform the required
    --  initialization and cleanup actions for the sockets library.
 
+   --------------------
+   -- Create_Address --
+   --------------------
+
+   function Create_Address
+     (Family : Family_Type; Bytes : Inet_Addr_Bytes) return Inet_Addr_Type
+   is
+     (case Family is
+         when Family_Inet => (Family_Inet, Bytes),
+         when Family_Inet6 => (Family_Inet6, Bytes));
+
+   ---------------
+   -- Get_Bytes --
+   ---------------
+
+   function Get_Bytes (Addr : Inet_Addr_Type) return Inet_Addr_Bytes is
+     (case Addr.Family is
+         when Family_Inet => Addr.Sin_V4,
+         when Family_Inet6 => Addr.Sin_V6);
+
+   ----------
+   -- Mask --
+   ----------
+
+   function Mask
+     (Family : Family_Type;
+      Length : Natural;
+      Host   : Boolean := False) return Inet_Addr_Type
+   is
+      Addr_Len : constant Natural := Inet_Addr_Bytes_Length (Family);
+   begin
+      if Length > 8 * Addr_Len then
+         raise Constraint_Error with
+           "invalid mask length for address family " & Family'Img;
+      end if;
+
+      declare
+         B    : Inet_Addr_Bytes (1 ..  Addr_Len);
+         Part : Inet_Addr_Comp_Type;
+      begin
+         for J in 1 .. Length / 8 loop
+            B (J) := (if Host then 0 else 255);
+         end loop;
+
+         if Length < 8 * Addr_Len then
+            Part := 2 ** (8 - Length mod 8) - 1;
+            B (Length / 8 + 1) := (if Host then Part else not Part);
+
+            for J in Length / 8 + 2 .. B'Last loop
+               B (J) := (if Host then 255 else 0);
+            end loop;
+         end if;
+
+         return Create_Address (Family, B);
+      end;
+   end Mask;
+
+   -----------
+   -- "and" --
+   -----------
+
+   function "and" (Addr, Mask : Inet_Addr_Type) return Inet_Addr_Type is
+   begin
+      if Addr.Family /= Mask.Family then
+         raise Constraint_Error with "incompatible address families";
+      end if;
+
+      declare
+         A : constant Inet_Addr_Bytes := Get_Bytes (Addr);
+         M : constant Inet_Addr_Bytes := Get_Bytes (Mask);
+         R : Inet_Addr_Bytes (A'Range);
+
+      begin
+         for J in A'Range loop
+            R (J) := A (J) and M (J);
+         end loop;
+         return Create_Address (Addr.Family, R);
+      end;
+   end "and";
+
+   ----------
+   -- "or" --
+   ----------
+
+   function "or" (Net, Host : Inet_Addr_Type) return Inet_Addr_Type is
+   begin
+      if Net.Family /= Host.Family then
+         raise Constraint_Error with "incompatible address families";
+      end if;
+
+      declare
+         N : constant Inet_Addr_Bytes := Get_Bytes (Net);
+         H : constant Inet_Addr_Bytes := Get_Bytes (Host);
+         R : Inet_Addr_Bytes (N'Range);
+
+      begin
+         for J in N'Range loop
+            R (J) := N (J) or H (J);
+         end loop;
+         return Create_Address (Net.Family, R);
+      end;
+   end "or";
+
+   -----------
+   -- "not" --
+   -----------
+
+   function "not" (Mask : Inet_Addr_Type) return Inet_Addr_Type is
+      M : constant Inet_Addr_Bytes := Get_Bytes (Mask);
+      R : Inet_Addr_Bytes (M'Range);
+   begin
+      for J in R'Range loop
+         R (J) := not M (J);
+      end loop;
+      return Create_Address (Mask.Family, R);
+   end "not";
+
 end GNAT.Sockets;