ada-libraries
/
zeromq-Ada
mirror of https://github.com/persan/zeromq-Ada
1
0
Fork 0
Code Issues Releases Wiki Activity

Enabled layout checks 

Added convinience functions
Igonore outputs
This commit is contained in:
Per Sandberg 2010-04-08 07:12:44 +02:00
parent 48a3c5bd3f
commit 6698d0eec4
15 changed files with 386 additions and 183 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
helpers/.gitignore vendored
View File

@ -1,4 +1,4 @@
.obj
~*
*~
getinfo

62
helpers/getinfo.adb
View File

@ -1,6 +1,62 @@
with ZMQ;
with ada.Text_IO;
with Ada.Text_IO;
with Ada.Directories;
with Ada.Command_Line;
with GNAT.Command_Line;
procedure getinfo is
use GNAT.Command_Line;
use Ada.Text_IO;
command_Name : constant String :=
Ada.Directories.Base_Name (Ada.Command_Line.Command_Name);
procedure help;
procedure help is
use ASCII;
begin
Put_Line
(command_Name & " [options]" & LF &
"Options:" & LF &
" --binding-version Print Binding version" & LF &
" --library-version Print version of the 0mq library." & LF &
" -? | -h | --help Print this text");
end help;
begin
ada.Text_IO.Put_Line (zmq.image (zmq.Binding_Version));
end;
loop
case Getopt ("-binding-version " &
"-library-version " &
"h ? -help") is -- Accepts '-a', '-ad', or '-b argument'
when ASCII.NUL => exit;
when 'h' | '?' =>
help;
return;
when '-' =>
if Full_Switch = "-binding-version" then
Put_Line (ZMQ.image (ZMQ.Binding_Version));
elsif Full_Switch = "-library-version" then
Put_Line (ZMQ.image (ZMQ.Library_Version));
elsif Full_Switch = "-help" then
help;
return;
end if;
when others =>
raise Program_Error; -- cannot occur!
end case;
end loop;
loop
declare
S : constant String := Get_Argument (Do_Expansion => True);
begin
exit when S'Length = 0;
Put_Line ("Got " & S);
end;
end loop;
exception
when Invalid_Switch => Put_Line ("Invalid Switch " & Full_Switch);
when Invalid_Parameter => Put_Line ("No parameter for " & Full_Switch);
end getinfo;

33
src/zmq-contexts.adb
View File

@ -12,55 +12,56 @@ package body ZMQ.Contexts is
----------------
not overriding procedure Initialize
(this : in out Context;
app_threads : Positive;
io_threads : Positive;
flags : Context_Flags := No_Flags)
(This : in out Context;
App_Threads : Positive;
IO_Threads : Positive;
Flags : Context_Flags := No_Flags)
is
begin
if This.c /= Null_Address then
raise ZMQ_Error with "Alredy Initialized";
end if;
this.c := Low_Level.zmq_init (int (app_threads), int (io_threads), int (flags));
if this.c = Null_Address then
This.c := Low_Level.zmq_init
(int (App_Threads), int (IO_Threads), int (Flags));
if This.c = Null_Address then
raise ZMQ_Error with Error_Message (GNAT.OS_Lib.Errno) & " in " &
GNAT.Source_Info.Enclosing_Entity;
end if;
end Initialize;
overriding
procedure Initialize (this : in out Context) is
procedure Initialize (This : in out Context) is
begin
This.c := Null_Address;
end;
end Initialize;
--------------
-- Finalize --
--------------
overriding procedure Finalize
(this : in out Context)
(This : in out Context)
is
rc : int;
begin
if This.c /= Null_Address then
rc := Low_Level.zmq_term (this.c);
rc := Low_Level.zmq_term (This.c);
This.c := Null_Address;
if rc /= 0 then
raise ZMQ_Error with Error_Message (GNAT.OS_Lib.Errno) & " in " &
GNAT.Source_Info.Enclosing_Entity;
raise ZMQ_Error with Error_Message (GNAT.OS_Lib.Errno) & " in " &
GNAT.Source_Info.Enclosing_Entity;
end if;
end if;
end Finalize;
function is_Connected (this : Context) return boolean is
function Is_Connected (This : Context) return Boolean is
begin
return This.c /= Null_Address;
end;
end Is_Connected;
function getImpl (This : Context) return System.Address is
function GetImpl (This : Context) return System.Address is
begin
return This.c;
end getImpl;
end GetImpl;
end ZMQ.Contexts;

16
src/zmq-contexts.ads
View File

@ -12,19 +12,19 @@ package ZMQ.Contexts is
No_Flags : constant Context_Flags := 0;
not overriding
procedure Initialize (this : in out Context;
app_threads : Positive;
io_threads : Positive;
flags : Context_Flags := No_Flags);
procedure Initialize (This : in out Context;
App_Threads : Positive;
IO_Threads : Positive;
Flags : Context_Flags := No_Flags);
overriding
procedure Initialize (this : in out Context);
procedure Initialize (This : in out Context);
overriding
procedure Finalize (this : in out Context);
procedure Finalize (This : in out Context);
function is_Connected (this : Context) return boolean;
function Is_Connected (This : Context) return Boolean;
function getImpl (This : Context) return System.Address;
function GetImpl (This : Context) return System.Address;
private
type Context is new Ada.Finalization.Limited_Controlled with record
c : System.Address := System.Null_Address;

2
src/zmq-low_level.ads
View File

@ -3,7 +3,7 @@ with Interfaces.C.Strings;
with System;
package ZMQ.Low_Level is
pragma Warnings (off);
package defs is
ZMQ_HAUSNUMERO : constant := 156384712; -- zmq.h:48

143
src/zmq-messages.adb
View File

@ -1,7 +1,6 @@
with Interfaces.C;
with GNAT.OS_Lib;
with GNAT.Source_Info;
with System.Address_To_Access_Conversions;
package body ZMQ.Messages is
use Interfaces.C;
@ -12,21 +11,21 @@ package body ZMQ.Messages is
procedure Initialize (Self : in out Message) is
ret : int;
begin
ret := Low_Level.zmq_msg_init (Self.msg'Access);
ret := Low_Level.zmq_msg_init (Self.Msg'Access);
if ret /= 0 then
raise ZMQ_Error with Error_Message (GNAT.OS_Lib.Errno) & " in " &
GNAT.Source_Info.Enclosing_Entity;
end if;
end Initialize;
-- =========================================================================
-- ========================================================================
-- Initialize with size
-- =========================================================================
-- ========================================================================
procedure Initialize (Self : in out Message; Size : Natural) is
ret : int;
begin
ret := Low_Level.zmq_msg_init_size (Self.msg'Access, size);
ret := Low_Level.zmq_msg_init_size (Self.Msg'Access, Size);
if ret /= 0 then
raise ZMQ_Error with Error_Message (GNAT.OS_Lib.Errno) & " in " &
GNAT.Source_Info.Enclosing_Entity;
@ -38,37 +37,37 @@ package body ZMQ.Messages is
Size : Ada.Streams.Stream_Element_Offset)
is
begin
self.Initialize (natural (size));
Self.Initialize (Natural (Size));
end Initialize;
-- =========================================================================
-- ========================================================================
-- Initialize with data
-- =========================================================================
-- ========================================================================
procedure Initialize (Self : in out Message;
Data : System.Address;
Size : Natural) is
type data_Type is new string (1 .. Size);
package conv is new System.Address_To_Access_Conversions (data_type);
type data_Type is new String (1 .. Size);
package conv is new System.Address_To_Access_Conversions (data_Type);
begin
self.Initialize (size);
conv.to_pointer ((self.getData)).all := conv.to_pointer (Data).all;
end;
Self.Initialize (Size);
conv.To_Pointer ((Self.getData)).all := conv.To_Pointer (Data).all;
end Initialize;
procedure Initialize (Self : in out Message; Data : String) is
begin
self.Initialize (Data'Address, Data'length);
Self.Initialize (Data'Address, Data'Length);
end Initialize;
procedure Initialize
(Self : in out Message;
Data : Ada.Streams.Stream_Element_Array) is
begin
self.Initialize (Data'Address, Data'length);
Self.Initialize (Data'Address, Data'Length);
end Initialize;
-- =========================================================================
-- ========================================================================
-- Initialize with data ref and free
-- =========================================================================
-- ========================================================================
procedure Initialize
(Self : in out Message;
Message : System.Address;
@ -78,69 +77,97 @@ package body ZMQ.Messages is
is
ret : int;
begin
ret := Low_Level.zmq_msg_init_data (Self.msg'Access,
ret := Low_Level.zmq_msg_init_data (Self.Msg'Access,
Message,
Size,
Free,
hint);
Hint);
if ret /= 0 then
raise ZMQ_Error with Error_Message (GNAT.OS_Lib.Errno) & " in " &
GNAT.Source_Info.Enclosing_Entity;
end if;
end Initialize;
--#TODO implement
-- ------------------------
-- -- Initialize_Generic --
-- ------------------------
--
-- procedure Initialize_Generic
-- (Self : in out Message;
-- Data : conv.Object_Pointer)
-- is
-- begin
-- self.Initialize;
-- -- Generated stub: replace with real body!
-- pragma Compile_Time_Warning (True, "Initialize_Generic unimplemented");
-- raise Program_Error with "Unimplemented procedure Initialize_Generic";
-- end Initialize_Generic;
--
-- ----------------------------------
-- -- Initialize_Generic_With_Hint --
-- ----------------------------------
--
-- procedure Initialize_Generic_With_Hint
-- (Self : in out Message;
-- Data : conv.Object_Pointer;
-- Hint : Hint_Access)
-- is
-- begin
-- -- Generated stub: replace with real body!
-- pragma Compile_Time_Warning (True, "Initialize_Generic_With_Hint unimplemented");
-- raise Program_Error with "Unimplemented procedure Initialize_Generic_With_Hint";
-- end Initialize_Generic_With_Hint;
------------------------
-- Initialize_Generic --
------------------------
procedure Initialize_Generic
(Self : in out Message;
Data : conv.Object_Pointer)
is
begin
Self.Initialize;
-- Generated stub: replace with real body!
pragma Compile_Time_Warning
(True, "Initialize_Generic unimplemented");
raise Program_Error with "Unimplemented procedure Initialize_Generic";
end Initialize_Generic;
----------------------------------
-- Initialize_Generic_With_Hint --
----------------------------------
procedure Initialize_Generic_With_Hint
(Self : in out Message;
Data : conv.Object_Pointer;
Hint : Hint_Access)
is
begin
-- Generated stub: replace with real body!
pragma Compile_Time_Warning
(True, "Initialize_Generic_With_Hint unimplemented");
raise Program_Error with
"Unimplemented procedure Initialize_Generic_With_Hint";
end Initialize_Generic_With_Hint;
-- =========================================================================
-- ========================================================================
-- GetData / GetSize
-- =========================================================================
-- ========================================================================
function getData (Self : Message) return System.Address is
begin
return Low_Level.zmq_msg_data (self.Msg'Unrestricted_Access);
return Low_Level.zmq_msg_data (Self.Msg'Unrestricted_Access);
end getData;
function getData (Self : Message) return String is
type data_type is new string (1 .. self.getSize);
type data_type is new String (1 .. Self.getSize);
package conv is new System.Address_To_Access_Conversions (data_type);
begin
return String (conv.to_pointer (self.getData).all);
return String (conv.To_Pointer (Self.getData).all);
end getData;
function getData (Self : Message)
return Ada.Streams.Stream_Element_Array is
type data_type is new Ada.Streams.Stream_Element_Array
(1 .. Ada.Streams.Stream_Element_Offset (Self.getSize));
package conv is new System.Address_To_Access_Conversions (data_type);
begin
return Ada.Streams.Stream_Element_Array
(conv.To_Pointer (Self.getData).all);
end getData;
function getData (Self : Message)
return Ada.Strings.Unbounded.Unbounded_String is
type data_type is new String (1 .. Self.getSize);
package conv is new System.Address_To_Access_Conversions (data_type);
begin
return Ada.Strings.Unbounded.To_Unbounded_String
(String (conv.To_Pointer (Self.getData).all));
end getData;
function getData_Generic (Self : Message)
return Element is
package conv is new System.Address_To_Access_Conversions (Element);
begin
return conv.To_Pointer (Self.getData).all;
end getData_Generic;
function getSize (Self : Message) return Natural is
begin
return Low_Level.zmq_msg_size (self.Msg'Unrestricted_Access);
return Low_Level.zmq_msg_size (Self.Msg'Unrestricted_Access);
end getSize;
@ -151,7 +178,7 @@ package body ZMQ.Messages is
procedure Finalize (Self : in out Message) is
ret : int;
begin
ret := Low_Level.zmq_msg_close (Self.msg'Access);
ret := Low_Level.zmq_msg_close (Self.Msg'Access);
if ret /= 0 then
raise ZMQ_Error with Error_Message (GNAT.OS_Lib.Errno) & " in " &
GNAT.Source_Info.Enclosing_Entity;
@ -164,7 +191,7 @@ package body ZMQ.Messages is
function getImpl (Self : Message) return not null zmq_msg_t_Access is
begin
return self.Msg'Unrestricted_Access;
return Self.Msg'Unrestricted_Access;
end getImpl;
end ZMQ.Messages;

72
src/zmq-messages.ads
View File

@ -1,7 +1,9 @@
with ZMQ.Low_Level;
with Ada.Streams;
with System;
-- with System.Address_To_Access_Conversions;
with System.Address_To_Access_Conversions;
with Ada.Strings.Unbounded;
package ZMQ.Messages is
type Message is tagged limited private;
@ -13,8 +15,9 @@ package ZMQ.Messages is
-- This function is most useful when called before receiving a message.
procedure Initialize (Self : in out Message; Size : Natural);
procedure Initialize (Self : in out Message; Size : Ada.Streams.Stream_Element_Offset);
pragma Inline(Initialize);
procedure Initialize
(Self : in out Message; Size : Ada.Streams.Stream_Element_Offset);
pragma Inline (Initialize);
-- Initialize 0MQ message of a specified size
-- Allocate resources required to store a message size bytes long
-- and initialize the message object referenced by msg to represent
@ -25,11 +28,11 @@ package ZMQ.Messages is
Data : String);
procedure Initialize (Self : in out Message;
Data : Ada.Streams.Stream_Element_Array);
pragma Inline(Initialize);
pragma Inline (Initialize);
procedure Initialize (Self : in out Message;
Data : System.Address;
Size : Natural);
pragma Inline(Initialize);
pragma Inline (Initialize);
-- Initialize 0MQ message of a specified size
-- Allocate resources required to store the data
-- and initialize the message object referenced by msg to represent
@ -37,44 +40,63 @@ package ZMQ.Messages is
-- The Data is copied into the message.
type Free_Proc is not null access procedure (data : System.Address; Hint : System.Address);
type Free_Proc is not null access
procedure (data : System.Address; Hint : System.Address);
procedure Null_Free (data : System.Address; Hint : System.Address) is null;
procedure Initialize (Self : in out Message;
Message : System.Address;
Size : Natural;
Free : Free_Proc;
Hint : System.Address := System.Null_Address);
-- initialise 0MQ message from a supplied buffer
-- initialise 0MQ message from a supplied buffer
--#TODO
-- generic
-- type Element (<>) is private;
-- with package conv is new System.Address_To_Access_Conversions (element);
-- with procedure free (data : in out conv.Object_Pointer);
-- procedure Initialize_Generic (Self : in out Message;
-- Data : conv.Object_Pointer);
--
-- generic
-- type Element (<>) is private;
-- with package conv is new System.Address_To_Access_Conversions (element);
-- type Hint_Type (<>) is private;
-- type Hint_Access is access Hint_Type;
-- with procedure free (data : in out conv.Object_Pointer; hint : Hint_Access);
-- procedure Initialize_Generic_With_Hint (Self : in out Message;
-- Data : conv.Object_Pointer;
-- Hint : Hint_Access);
--
function getData (Self : Message) return String;
generic
type Element (<>) is private;
with package conv is new System.Address_To_Access_Conversions (Element);
with procedure free (data : in out conv.Object_Pointer);
procedure Initialize_Generic (Self : in out Message;
Data : conv.Object_Pointer);
generic
type Element (<>) is private;
with package conv is new System.Address_To_Access_Conversions (Element);
type Hint_Type (<>) is private;
type Hint_Access is access Hint_Type;
with procedure free
(data : in out conv.Object_Pointer; hint : Hint_Access);
procedure Initialize_Generic_With_Hint (Self : in out Message;
Data : conv.Object_Pointer;
Hint : Hint_Access);
procedure Finalize (Self : in out Message);
type zmq_msg_t_Access is access all ZMQ.Low_Level.zmq_msg_t;
function getImpl (Self : Message) return not null zmq_msg_t_Access;
function getData (Self : Message)
return String;
function getData (Self : Message)
return Ada.Streams.Stream_Element_Array;
function getData (Self : Message)
return Ada.Strings.Unbounded.Unbounded_String;
generic
type Element is private;
function getData_Generic (Self : Message)
return Element;
function getData (Self : Message) return System.Address;
function getSize (Self : Message) return Natural;
private
type Message is tagged limited record
Msg : aliased ZMQ.Low_Level.zmq_msg_t;

156
src/zmq-sockets.adb
View File

@ -4,21 +4,43 @@ with GNAT.OS_Lib;
with GNAT.Source_Info;
package body ZMQ.Sockets is
use Interfaces.C.Strings;
use Interfaces.c;
use Interfaces.C;
use System;
use Ada.Streams;
map : constant array (Socket_Opt) of int :=
(HWM => Low_Level.Defs.ZMQ_HWM, -- Set high water mark
LWM => Low_Level.Defs.ZMQ_LWM, -- Set low water mark
SWAP => Low_Level.Defs.ZMQ_SWAP,
AFFINITY => Low_Level.Defs.ZMQ_AFFINITY,
IDENTITY => Low_Level.Defs.ZMQ_IDENTITY,
SUBSCRIBE => Low_Level.Defs.ZMQ_SUBSCRIBE,
UNSUBSCRIBE => Low_Level.Defs.ZMQ_UNSUBSCRIBE,
RATE => Low_Level.Defs.ZMQ_RATE,
RECOVERY_IVL => Low_Level.Defs.ZMQ_RECOVERY_IVL,
MCAST_LOOP => Low_Level.Defs.ZMQ_MCAST_LOOP,
SNDBUF => Low_Level.Defs.ZMQ_SNDBUF,
RCVBUF => Low_Level.Defs.ZMQ_RCVBUF);
(HWM => Low_Level.defs.ZMQ_HWM, -- Set high water mark
LWM => Low_Level.defs.ZMQ_LWM, -- Set low water mark
SWAP => Low_Level.defs.ZMQ_SWAP,
AFFINITY => Low_Level.defs.ZMQ_AFFINITY,
IDENTITY => Low_Level.defs.ZMQ_IDENTITY,
SUBSCRIBE => Low_Level.defs.ZMQ_SUBSCRIBE,
UNSUBSCRIBE => Low_Level.defs.ZMQ_UNSUBSCRIBE,
RATE => Low_Level.defs.ZMQ_RATE,
RECOVERY_IVL => Low_Level.defs.ZMQ_RECOVERY_IVL,
MCAST_LOOP => Low_Level.defs.ZMQ_MCAST_LOOP,
SNDBUF => Low_Level.defs.ZMQ_SNDBUF,
RCVBUF => Low_Level.defs.ZMQ_RCVBUF);
function img (item : Ada.Streams.Stream_Element_Array) return String is
ret : String (1 .. item'Length * 2);
cursor : Natural := 1;
type map_string is array (Stream_Element (0) ..
Stream_Element (15)) of Character;
hex : constant map_string := ('0', '1', '2', '3',
'4', '5', '6', '7',
'8', '9', 'A', 'B',
'C', 'D', 'E', 'F');
begin
for i in item'Range loop
ret (cursor) := hex (item (i) / 16);
cursor := cursor + 1;
ret (cursor) := hex (item (i) mod 16);
cursor := cursor + 1;
end loop;
return ret;
end img;
----------------
-- Initialize --
----------------
@ -28,14 +50,14 @@ package body ZMQ.Sockets is
Kind : Socket_Type)
is
begin
if With_Context.getImpl = Null_Address then
if With_Context.GetImpl = Null_Address then
raise ZMQ_Error with "Contecxt Not Initialized";
end if;
if This.c /= Null_Address then
raise ZMQ_Error with "Socket Initialized";
end if;
This.c := Low_Level.zmq_socket (With_Context.getImpl,
This.c := Low_Level.zmq_socket (With_Context.GetImpl,
Socket_Type'Pos (Kind));
if This.c = Null_Address then
raise ZMQ_Error with "Unable to initialize";
@ -51,9 +73,9 @@ package body ZMQ.Sockets is
Address : String)
is
addr : chars_ptr := Interfaces.C.Strings.New_String (Address);
ret : Int;
ret : int;
begin
ret := Low_Level.zmq_bind (this.c, addr);
ret := Low_Level.zmq_bind (This.c, addr);
Free (addr);
if ret /= 0 then
raise ZMQ_Error with Error_Message (GNAT.OS_Lib.Errno) & " in " &
@ -65,10 +87,10 @@ package body ZMQ.Sockets is
Option : Socket_Opt;
Value : System.Address;
Value_Size : Natural) is
ret : Int;
ret : int;
begin
ret := Low_Level.zmq_setsockopt
(this.c,
(This.c,
map (Option),
Value,
Value_Size);
@ -85,10 +107,10 @@ package body ZMQ.Sockets is
not overriding procedure setsockopt
(This : in out Socket;
Option : Socket_Opt;
Value : String)
Value : String)
is
begin
This.setsockopt (Option,Value (Value'First)'Address, Value'Length);
This.setsockopt (Option, Value (Value'First)'Address, Value'Length);
end setsockopt;
----------------
@ -101,7 +123,7 @@ package body ZMQ.Sockets is
Value : Boolean)
is
begin
This.setsockopt (Option,Value'Address, 1);
This.setsockopt (Option, Value'Address, 1);
end setsockopt;
----------------
@ -114,34 +136,19 @@ package body ZMQ.Sockets is
Value : Natural)
is
begin
This.setsockopt (Option,Value'Address, 4);
This.setsockopt (Option, Value'Address, 4);
end setsockopt;
----------------
-- setsockopt --
----------------
-- function img ( item : Ada.Streams.Stream_Element_Array) return String is
-- ret : String (1 .. item'length * 2);
-- cursor : natural := 1;
-- use type ada.Streams.Stream_Element;
-- hex : constant array (ada.Streams.Stream_Element (0) .. ada.Streams.Stream_Element (15)) of Character := ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F');
-- begin
-- for i in item'range loop
-- ret (cursor) := hex (item (i) / 16);
-- cursor := cursor + 1;
-- ret (cursor) := hex (item (i) mod 16);
-- cursor := cursor + 1;
-- end loop;
-- return ret;
-- end;
not overriding procedure setsockopt
(This : in out Socket;
Option : Socket_Opt;
Value : Ada.Streams.Stream_Element_Array)
is
begin
This.setsockopt (Option,Value (Value'First)'Address, Value'Length);
This.setsockopt (Option, Value (Value'First)'Address, Value'Length);
end setsockopt;
-------------
@ -153,9 +160,9 @@ package body ZMQ.Sockets is
Address : String)
is
addr : chars_ptr := Interfaces.C.Strings.New_String (Address);
ret : Int;
ret : int;
begin
ret := Low_Level.zmq_connect (this.c, addr);
ret := Low_Level.zmq_connect (This.c, addr);
Free (addr);
if ret /= 0 then
raise ZMQ_Error with Error_Message (GNAT.OS_Lib.Errno) & " in " &
@ -172,11 +179,12 @@ package body ZMQ.Sockets is
Msg : Messages.Message'Class;
Flags : Integer := 0)
is
ret : Int;
ret : int;
begin
ret := Low_Level.zmq_send (this.c, msg.getImpl, int (Flags));
ret := Low_Level.zmq_send (This.c, Msg.getImpl, int (Flags));
if ret /= 0 then
raise ZMQ_Error with Error_Message (GNAT.OS_Lib.Errno) & " in " & GNAT.Source_Info.Enclosing_Entity;
raise ZMQ_Error with Error_Message (GNAT.OS_Lib.Errno) & " in " &
GNAT.Source_Info.Enclosing_Entity;
end if;
end Send;
@ -184,25 +192,59 @@ package body ZMQ.Sockets is
procedure Send (This : in out Socket;
Msg : String;
Flags : Integer := 0) is
m : Messages.Message;
begin
null;
end;
m.Initialize (Msg);
This.Send (m, Flags);
m.Finalize;
end Send;
not overriding
procedure Send (This : in out Socket;
Msg : Ada.Streams.Stream_Element_Array;
Flags : Integer := 0) is
m : Messages.Message;
begin
null;
end;
m.Initialize (Msg);
This.Send (m, Flags);
m.Finalize;
end Send;
not overriding
procedure Send (This : in out Socket;
Msg : Ada.Strings.Unbounded.Unbounded_String;
Flags : Integer := 0) is
m : Messages.Message;
begin
m.Initialize (Ada.Strings.Unbounded.To_String (Msg));
This.Send (m, Flags);
m.Finalize;
end Send;
procedure Send_Generic (This : in out Socket;
Msg : Element;
Flags : Integer := 0) is
begin
This.Send
(Msg'Address,
(Msg'Size + Ada.Streams.Stream_Element'Size - 1) /
Ada.Streams.Stream_Element'Size,
Flags);
end Send_Generic;
not overriding
procedure Send (This : in out Socket;
Msg_Addres : System.Address;
Msg_Length : Natural;
Flags : Integer := 0) is
M : Messages.Message;
begin
null;
end;
M.Initialize (Msg_Addres, Msg_Length);
This.Send (M, Flags);
M.Finalize;
end Send;
-----------
@ -212,11 +254,12 @@ package body ZMQ.Sockets is
not overriding procedure flush
(This : in out Socket)
is
ret : Int;
ret : int;
begin
ret := Low_Level.zmq_flush (this.c);
ret := Low_Level.zmq_flush (This.c);
if ret /= 0 then
raise ZMQ_Error with Error_Message (GNAT.OS_Lib.Errno) & " in " & GNAT.Source_Info.Enclosing_Entity;
raise ZMQ_Error with Error_Message (GNAT.OS_Lib.Errno) & " in "
& GNAT.Source_Info.Enclosing_Entity;
end if;
end flush;
@ -229,14 +272,15 @@ package body ZMQ.Sockets is
Msg : Messages.Message'Class;
Flags : Integer := 0)
is
ret : Int;
ret : int;
begin
ret := Low_Level.zmq_recv (This.c,
Msg.GetImpl,
Msg.getImpl,
int (Flags));
if ret /= 0 then
raise ZMQ_Error with Error_Message (GNAT.OS_Lib.Errno) & " in " & GNAT.Source_Info.Enclosing_Entity;
raise ZMQ_Error with Error_Message (GNAT.OS_Lib.Errno) & " in "
& GNAT.Source_Info.Enclosing_Entity;
end if;
end recv;

22
src/zmq-sockets.ads
View File

@ -1,5 +1,6 @@
with Ada.Streams;
with Ada.Finalization;
with Ada.Strings.Unbounded;
with System;
with ZMQ.Messages;
with ZMQ.Contexts;
@ -77,18 +78,32 @@ package ZMQ.Sockets is
Msg : String;
Flags : Integer := 0);
not overriding
procedure Send (This : in out Socket;
Msg : Ada.Strings.Unbounded.Unbounded_String;
Flags : Integer := 0);
not overriding
procedure Send (This : in out Socket;
Msg : Ada.Streams.Stream_Element_Array;
Flags : Integer := 0);
not overriding
procedure Send (This : in out Socket;
Msg_Addres : System.Address;
Msg_Length : Natural;
Flags : Integer := 0);
-- Creates a Message and sends it over the socket.
-- Send the message over the socet
-- Creates a Message and sends it over the socket.
generic
type Element is private;
procedure Send_Generic (This : in out Socket;
Msg : Element;
Flags : Integer := 0);
-- Send the message over the socet
not overriding
procedure flush (This : in out Socket);
@ -103,10 +118,11 @@ package ZMQ.Sockets is
procedure Finalize (this : in out Socket);
-- function "=" (Left, Right : in Context) return Boolean;
-- function "=" (Left, Right : in Context) return Boolean;
private
type Socket is new Ada.Finalization.Limited_Controlled with record
c : System.Address := System.Null_Address;
end record;
function img (item : Ada.Streams.Stream_Element_Array) return String;
end ZMQ.Sockets;

27
src/zmq.adb
View File

@ -1,22 +1,33 @@
with interfaces.C.Strings;
with Interfaces.C.Strings;
with ZMQ.Low_Level;
package body ZMQ is
use interfaces.C;
use Interfaces.C;
-------------------
-- Error_Message --
-------------------
function Error_Message (no : integer) return string is
function Error_Message (no : Integer) return String is
s : constant String := no'Img;
begin
return "[" & S (S'FIRST + 1 .. S'Last) & "] " & interfaces.C.Strings.value (Low_Level.zmq_strerror (int (no)));
end;
return "[" & s (s'First + 1 .. s'Last) & "] " &
Interfaces.C.Strings.Value (Low_Level.zmq_strerror (int (no)));
end Error_Message;
function Library_Version return Version_Type is
begin
return ret :Version_Type do
ret := (2, 0, 0); --#TODO fetch from library
return ret : Version_Type do
ret := (2, 0, 6); --#TODO fetch from library
end return;
end;
end Library_Version;
function image (item : Version_Type) return String is
s1 : constant String := item.Major'Img;
s2 : constant String := item.Minor'Img;
s3 : constant String := item.Patch'Img;
begin
return s1 (s1'First + 1 .. s1'Last) & "." &
s2 (s2'First + 1 .. s2'Last) & "." &
s3 (s3'First + 1 .. s3'Last);
end image;
end ZMQ;

3
src/zmq.ads
View File

@ -7,9 +7,10 @@ package ZMQ is
Patch : Natural;
end record;
Binding_Version : constant Version_Type := (0, 0, 2);
Binding_Version : constant Version_Type := (0, 0, 1);
function Library_Version return Version_Type;
function image (item : Version_Type) return string;
private
pragma Linker_Options ("-lzmq");
function Error_Message (no : integer) return string;

22
tests/testcases/zmq-tests-testcases-test_pubsub.adb
View File

@ -5,6 +5,22 @@ package body Zmq.Tests.Testcases.Test_Pubsub is
-- Fixture elements
MSG_STRING : constant string := "test.data.kalle saldhfhsfkhsafkhsadjfhsdjhfsajkhsdajksadjksadjhfsdkjasdlhfsldjsajsdajkhsdjhdsajkhsdfjhds";
task body server is -- (self : not null access Test_Case) is
begin
loop
select
accept read;
or
accept stop;
or
terminate;
end select;
end loop;
end server;
----------
-- Name --
----------
@ -13,7 +29,7 @@ package body Zmq.Tests.Testcases.Test_Pubsub is
return AUnit.Message_String is
pragma Unreferenced (T);
begin
return Format (GNAT.Source_Info.File & ":(no description)");
return Format (GNAT.Source_Info.File);
end Name;
@ -37,8 +53,11 @@ package body Zmq.Tests.Testcases.Test_Pubsub is
T : Test_Case renames Test_Case (Test);
msg : ZMQ.Messages.Message;
begin
t.s.read;
delay 0.001;
msg.Initialize (MSG_STRING);
T.pub.send (msg);
end Send;
-------------------------
@ -52,6 +71,7 @@ package body Zmq.Tests.Testcases.Test_Pubsub is
T.Sub.recv (msg);
T.Assert (STring'(msg.getData) = MSG_STRING, "Wrong Data");
end Recieve;
procedure Finalize (Test : in out AUnit.Test_Cases.Test_Case'Class) is
T : Test_Case renames Test_Case (Test);
begin

6
tests/testcases/zmq-tests-testcases-test_pubsub.ads
View File

@ -3,11 +3,17 @@ with AUnit.Test_Cases;
with ZMQ.Contexts;
with ZMQ.Sockets;
package Zmq.Tests.Testcases.Test_Pubsub is
type Test_Case;
task type server (self : not null access Test_Case) is
entry read;
entry stop;
end server;
type Test_Case is new AUnit.Test_Cases.Test_Case with record
Ctx : ZMQ.Contexts.context;
pub : ZMQ.Sockets.Socket;
Sub : ZMQ.Sockets.Socket;
s : server (Test_Case'Access);
end record;
procedure Register_Tests (T : in out Test_Case);

2
zmq.gpr
View File

@ -23,7 +23,7 @@ project Zmq is
end case;
package Compiler is
for Default_Switches ("ada") use ("-g", "-O2", "-gnatf", "-gnat05","-gnatwa");
for Default_Switches ("ada") use ("-g", "-O2", "-gnatf", "-gnat05","-gnatwa","-gnaty");
end Compiler;

1
zmq.gpr.inst
View File

@ -1,6 +1,5 @@
project Zmq is
for Languages use ("Ada");
Version := "2.0.0";
type ZMQ_Kind_Type is ("static", "relocatable");
ZMQ_Kind : ZMQ_Kind_Type := external ("LIBRARY_TYPE", "static");