-- S.MG, 2018 -- prototype implementation of S.MG communication protocol with GNAT.Sockets; use GNAT.Sockets; with Ada.Text_IO; use Ada.Text_IO; with Ada.Streams; use Ada.Streams; with Interfaces; use Interfaces; with SMG_comms_types; use SMG_comms_types; procedure test_comms is Port_No : constant := 2222; task type Client is entry Send; end Client; task type Server is entry Listen; entry Ready; end Server; task body Client is Sock: Socket_Type; Address: Sock_Addr_Type; Data: Ada.Streams.Stream_Element_Array(1..10) := (others => 42); Last: Ada.Streams.Stream_Element_Offset; N : Integer_8 := -36; begin accept Send; -- task WILL block here until asked to send Address.Port := Port_No; Address.Addr := Inet_Addr("127.0.0.1"); Create_Socket(Sock, Family_Inet, Socket_Datagram); ToNetworkFormat( N, Data(1..1)); Send_Socket(Sock, Data, Last, Address); Put_Line("Client sent data " & "last: " & Last'Img); end Client; task body Server is Sock: Socket_Type; Address, From: Sock_Addr_Type; Data: Ada.Streams.Stream_Element_Array(1..512); Last: Ada.Streams.Stream_Element_Offset; N : Integer_8; begin accept Listen; -- wait to be started! Put_Line("Server started!"); -- create UDP socket Create_Socket( Sock, Family_Inet, Socket_Datagram ); -- set options on UDP socket Set_Socket_Option( Sock, Socket_Level, (Reuse_Address, True)); Set_Socket_Option( Sock, Socket_Level, (Receive_Timeout, Timeout => 10.0)); -- set address and bind Address.Addr := Any_Inet_Addr; Address.Port := Port_No; Bind_Socket( Sock, Address ); accept Ready; -- server IS ready, when here -- receive on socket begin Receive_Socket( Sock, Data, Last, From ); Put_Line("last: " & Last'Img); Put_Line("from: " & Image(From.Addr)); Put_Line("data is:"); for I in Data'First .. Last loop FromNetworkFormat(Data(I..I), N); Put_Line(N'Image); end loop; exception when Socket_Error => Put_Line("Socket error! (timeout?)"); end; -- end of receive end Server; S: Server; C: Client; begin S.Listen; S.Ready; -- WAIT for server to be ready! C.Send; -- client is started only after server! end test_comms;