aws_21.0.0_57fddf8f/regtests/0284_poll/poll.adb

------------------------------------------------------------------------------
--                              Ada Web Server                              --
--                                                                          --
--                        Copyright (C) 2016, AdaCore                       --
--                                                                          --
--  This is free software;  you can redistribute it  and/or modify it       --
--  under terms of the  GNU General Public License as published  by the     --
--  Free Software  Foundation;  either version 3,  or (at your option) any  --
--  later version.  This software is distributed in the hope  that it will  --
--  be useful, but WITHOUT ANY WARRANTY;  without even the implied warranty --
--  of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU     --
--  General Public License for  more details.                               --
--                                                                          --
--  You should have  received  a copy of the GNU General  Public  License   --
--  distributed  with  this  software;   see  file COPYING3.  If not, go    --
--  to http://www.gnu.org/licenses for a complete copy of the license.      --
------------------------------------------------------------------------------

with Ada.Characters.Handling;
with Ada.Streams;         use Ada.Streams;
with Ada.Text_IO;         use Ada.Text_IO;
with AWS.Net.Poll_Events; use AWS.Net;
with AWS.Net.Std;
with AWS.OS_Lib;
with AWS.Utils;
with Interfaces.C.Strings;

procedure Poll is
   Set : Poll_Events.Set (45); -- Have to be odd
   Ss  : array (1 .. Set.Size) of Std.Socket_Type;
   Local : constant String := Localhost (IPv6_Available);
   Count : Integer;
   Idx   : Positive;
   State : Event_Set;
   Data  : Stream_Element_Array (1 .. 32);
   Last  : Stream_Element_Offset;
   More  : constant Stream_Element_Offset := 8;
   Rest  : Natural := 0;

   function Error_Message (Errno : Integer) return String;

   function Image_State return String;
   --  Returns image of State array in format like eIo or eiO or Eio

   -------------------
   -- Error_Message --
   -------------------

   function Error_Message (Errno : Integer) return String is
      use AWS;
      use Interfaces.C.Strings;
      Ptr  : constant chars_ptr := OS_Lib.Socket_StrError (Errno);
      Code : constant String    := '[' & Utils.Image (Errno) & "] ";
   begin
      if Ptr = Null_Ptr then
         return Code & "Unknown error";
      else
         return Code & Value (Ptr);
      end if;
   end Error_Message;

   -----------------
   -- Image_State --
   -----------------

   function Image_State return String is
      Result : String (1 .. 3);
      Idx : Positive := Result'First;
   begin
      for J in State'Range loop
         Result (Idx) := J'Img (1);

         if not State (J) then
            Result (Idx) := Ada.Characters.Handling.To_Lower (Result (Idx));
         end if;

         Idx := Idx + 1;
      end loop;

      return Result;
   end Image_State;

begin
   Ss (1).Bind (Host => Local, Port => 0);
   Ss (1).Listen (Queue_Size => Set.Size);
   Set.Add (Ss (1).Get_FD, (Input => True, others => False));

   ------------------
   -- Connect loop --
   ------------------

   for J in 2 .. Set.Size / 2 + 1 loop
      Ss (J).Connect (Local, Port => Ss (1).Get_Port, Wait => False);
      Set.Add (Ss (J).Get_FD, (Output => True, others => False));
   end loop;

   Put_Line ("Connection");

   -----------------
   -- Accept loop --
   -----------------

   loop
      Set.Wait (0.5, Count);

      Idx := 1;

      while Count > 0 loop
         Set.Next (Idx);
         exit when Idx > Set.Length;
         Count := Count - 1;

         State := Set.Status (Idx);

         if State (Error) then
            Put_Line
              ("Unexpected error on accept " & Error_Message (Ss (Idx).Errno)
               & Idx'Img);
            return;

         elsif State (Input) and then State (Output) then
            Put_Line ("Unexpected state on accept " & Image_State & Idx'Img);
            return;

         elsif State (Output) then
            Set.Set_Mode (Idx, (Input => True, others => False));

         elsif State (Input) then
            if Idx /= 1 then
               Put_Line ("Unexpected input index" & Idx'Img);
            end if;

            Std.Accept_Socket (Ss (1), Ss (Set.Length + 1));
            Set.Add
              (Ss (Set.Length + 1).Get_FD, (Input => True, others => False));
         end if;

         Idx := Idx + 1;
      end loop;

      if Count /= 0 then
         Put_Line ("Wrong sockets event count " & Count'Img);
         exit;
      end if;

      exit when Set.Length = Ss'Length;
   end loop;

   Put_Line ("Connected");

   ----------------------------------
   -- Write over whole sockets set --
   ----------------------------------

   for J in 2 .. Ss'Last loop
      Ss (J).Send ((1 => Stream_Element (J)));

      Set.Wait (0.5, Count);

      if Count /= 1 then
         Put_Line ("Unexpected number of activated sockets" & Count'Img);
      end if;

      Idx := 1;
      Set.Next (Idx);

      State := Set.Status (Idx);

      if State /= (Input => True, Output => False, Error => False) then
         Put_Line ("Unexpected state on send loop " & Image_State);

         if State (Error) then
            Put_Line
              ("Unexpected error on send loop "
               & Error_Message (Ss (Idx).Errno) & Idx'Img);
         end if;

         return;
      end if;

      Ss (Idx).Receive (Data, Last);

      if Last /= Data'First then
         Put_Line ("Unexpected received data length" & Last'Img);
      end if;

      if Integer (Data (Data'First)) /= J then
         Put_Line ("Unexpected received content");
      end if;
   end loop;

   Put_Line ("Transmitted");

   for J in 2 .. Ss'Last loop
      Ss (J).Send ((1 .. Data'Length + More => Stream_Element (J)));
      Ss (J).Set_Timeout (2.0);
   end loop;

   -------------------------------------------
   -- Test waiting neither Input nor Output --
   -------------------------------------------

   loop
      Set.Wait (0.25, Count);

      exit when Count = 0;

      Idx := 1;

      while Count > 0 loop
         Set.Next (Idx);
         exit when Idx > Set.Length;
         Count := Count - 1;

         State := Set.Status (Idx);

         if State /= (Input => True, Output => False, Error => False) then
            Put_Line ("Unexpected state on test " & Image_State);

            if State (Error) then
               Put_Line
                 ("Unexpected error on test " & Error_Message (Ss (Idx).Errno)
                  & Idx'Img);
            end if;

            return;
         end if;

         Ss (Idx).Receive (Data, Last);

         if Last = Data'Last then
            Put ('@');

            if Idx rem 2 = 0 then
               Set.Set_Event (Idx, Input, False);
            end if;

         elsif Last = More then
            Rest := Rest + 1;
         else
            Put (" Wrong additional size" & Last'Img);
            exit;
         end if;

         Idx := Idx + 1;
      end loop;

      if Count /= 0 then
         Put ("Wrong rest count" & Count'Img);
         exit;
      end if;
   end loop;

   Put_Line (Rest'Img);
end Poll;