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

Working towards 3.2

This commit is contained in:
Per Sandberg 2012-12-29 22:54:25 +01:00
parent 0d71ff3f2e
commit e3c542c46d
31 changed files with 1900 additions and 835 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
Makefile
View File

@ -37,9 +37,14 @@ samples:
generate:
mkdir -p .temp
echo "#include <zmq.h>">.temp/x.c
(cd .temp;g++ -c -fdump-ada-spec x.c)
cat .temp/zmq_h.ads | sed "s-/usr/local/include/--" >src/zmq_h.ads
echo "#include <zmq.h>">.temp/x.cpp
gprbuild -p -c -Pgenerate.gpr x.cpp
python renames.py .temp/zmq_h.ads
gnatchop -w -gnat05 .temp/zmq_h.ads src
gnatpp -rnb -M127 src/zmq-low_level.ads -cargs -gnat05
clean:
rm -rf .obj
${MAKE} -C tests clean

2
eBindings/Makefile Normal file → Executable file
View File

@ -3,7 +3,5 @@ compile:
install:
%:
${MAKE} -C uuid ${@}
${MAKE} -C pthread ${@}
${MAKE} -C dl ${@}
${MAKE} -C zmq ${@}

2
eBindings/zmq/Makefile Normal file → Executable file
View File

@ -4,7 +4,7 @@ all:install
install:
mkdir -p ${PREFIX}/lib/gnat
cp libzmq.gpr ${PREFIX}/lib/gnat
cp -f libzmq.gpr ${PREFIX}/lib/gnat
chmod -w ${PREFIX}/lib/gnat/libzmq.gpr
clean:

56
examples/hwserver.adb Executable file
View File

@ -0,0 +1,56 @@
-------------------------------------------------------------------------------
-- Copyright (c) 2010 Per Sandberg --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files --
-- (the "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, sublicense, and / or sell copies of the Software, and to --
-- permit persons to whom the Software is furnished to do so, subject to --
-- the following conditions : --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, --
-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL --
-- THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR --
-- OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, --
-- ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR --
-- OTHER DEALINGS IN THE SOFTWARE. --
-------------------------------------------------------------------------------
-- Hello World server in Ada
-- Binds REP socket to tcp:--*:5555
-- Expects "Hello" from client, replies with "World"
with ZMQ.Sockets;
with ZMQ.Contexts;
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
procedure HWServer is
Context : ZMQ.Contexts.Context;
Socket : ZMQ.Sockets.Socket;
inbuffer : Ada.Strings.Unbounded.Unbounded_String;
begin
-- Prepare our context and socket
Context.Initialize (1);
Socket.Initialize (Context, ZMQ.Sockets.REP);
Socket.Bind ("tcp://*:5555");
loop
-- Wait for next request from client
inbuffer := Socket.recv;
Put_Line ("Received request:" & To_String (inbuffer));
-- Do some 'work'
delay 1.0;
-- Send reply back to client
Socket.Send ("World");
end loop;
end HWServer;

1
examples/zmq-examples.gpr Normal file → Executable file
View File

@ -1,5 +1,6 @@
with "../zmq.gpr";
with "xmlada.gpr";
-- with "gnatcoll.gpr";
project ZMQ.Examples is
for Main use ("zmq-examples-client.adb",

9
generate.gpr Normal file
View File

@ -0,0 +1,9 @@
with "libzmq.gpr";
project generate is
for languages use ("C++");
for object_dir use ".temp";
for source_Dirs use (".temp");
package compiler is
for Default_Switches("C++") use ("-fdump-ada-spec");
end compiler;
end generate;

4
helpers/zmq-helpers.gpr
View File

@ -1,5 +1,5 @@
with "../zmq.gpr";
project Zmq.helpers is
project ZMQ.helpers is
for Main use ("getinfo.adb");
for Object_Dir use ".obj";
for Exec_Dir use ".";
@ -8,5 +8,5 @@ project Zmq.helpers is
-- package Binder renames zmq.Binder;
package IDE renames zmq.IDE;
end Zmq.helpers;
end ZMQ.helpers;

42
renames.py Normal file
View File

@ -0,0 +1,42 @@
#!/usr/bin/env python
renames=[["with stddef_h;\n",""],
["stddef_h.size_t","size_t"],
["zmq_h","ZMQ.Low_Level"]]
import sys
import os
import re
m=re.compile("(^.*-- *)(/.*?/)(zmq\\.h.*$)")
def fix(line):
ma=m.match(line)
if ma:
line=ma.group(1)+ma.group(3)
ma=re.match("^\\s+--\\s+unsupported\\s+macro:\\s+(\\w+)\\s+.ZMQ_HAUSNUMERO\\s+\\+\\s+(\\w+).*",line)
if ma:
line=" %s : constant := ZMQ_HAUSNUMERO + %s;" % (ma.group(1), ma.group(2))
return line
def rename(p):
f=file(p)
buffer=f.read()
f.close();
for i in renames:
buffer=buffer.replace(i[0],i[1])
buffer=buffer.split("\n")
ret=[]
for line in buffer:
ret.append(fix(line))
if re.match("^package.*is",line):
ret.append(" pragma Preelaborate;")
f=file(p,"w")
f.write("\n".join(ret))
f.close()
if __name__ == "__main__":
rename(sys.argv[1])

3
src/.gitignore vendored
View File

@ -4,7 +4,4 @@ lib
*.pyc
new\ file
.temp
gen
ctest.c
zmq_h.ads

82
src/zmq-contexts.adb
View File

@ -42,20 +42,15 @@ package body ZMQ.Contexts is
-- Initialize --
----------------
not overriding procedure Initialize
(This : in out Context;
App_Threads : Natural)
overriding procedure Initialize
(This : in out Context)
is
begin
Validate_Library_Version;
if This.c /= Null_Address then
raise ZMQ_Error with "Alredy Initialized";
end if;
This.c := Low_Level.zmq_init
(int (App_Threads));
if This.c = Null_Address then
This.C := Low_Level.zmq_ctx_new;
if This.C = Null_Address then
raise ZMQ_Error with Error_Message (GNAT.OS_Lib.Errno) & " in " &
GNAT.Source_Info.Enclosing_Entity;
GNAT.Source_Info.Enclosing_Entity;
end if;
end Initialize;
@ -66,26 +61,67 @@ package body ZMQ.Contexts is
overriding procedure Finalize
(This : in out Context)
is
rc : int;
Rc : int;
begin
if This.Is_Connected then
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;
end if;
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;
end if;
end Finalize;
function Is_Connected (This : Context) return Boolean is
begin
return This.c /= Null_Address;
end Is_Connected;
function GetImpl (This : Context) return System.Address is
begin
return This.c;
return This.C;
end GetImpl;
procedure Set_Number_Of_IO_Threads
(This : Context; Number_Of_IO_Threads : Positive := IO_THREADS_DFLT) is
Rc : int;
begin
Rc := Low_Level.zmq_ctx_set
(context => This.GetImpl,
option => Low_Level.ZMQ_IO_THREADS,
optval => int (Number_Of_IO_Threads));
if Rc /= 0 then
raise ZMQ_Error with Error_Message (GNAT.OS_Lib.Errno) & " in " &
GNAT.Source_Info.Enclosing_Entity;
end if;
end Set_Number_Of_IO_Threads;
procedure Set_Maximum_Number_Of_Sockets
(This : Context; Number_Of_Sockets : Positive := MAX_SOCKETS_DFLT) is
Rc : int;
begin
Rc := Low_Level.zmq_ctx_set
(context => This.GetImpl,
option => Low_Level.ZMQ_MAX_SOCKETS,
optval => int (Number_Of_Sockets));
if Rc /= 0 then
raise ZMQ_Error with Error_Message (GNAT.OS_Lib.Errno) & " in " &
GNAT.Source_Info.Enclosing_Entity;
end if;
end Set_Maximum_Number_Of_Sockets;
function Get_Number_Of_IO_Threads (This : Context) return Positive is
begin
return Ret : Positive do
Ret := Positive
(Low_Level.zmq_ctx_get (context => This.GetImpl,
option => Low_Level.ZMQ_IO_THREADS));
end return;
end Get_Number_Of_IO_Threads;
function Get_Maximum_Number_Of_Sockets (This : Context) return Positive is
begin
return Ret : Positive do
Ret := Positive
(Low_Level.zmq_ctx_get (context => This.GetImpl,
option => Low_Level.ZMQ_MAX_SOCKETS));
end return;
end Get_Maximum_Number_Of_Sockets;
end ZMQ.Contexts;

42
src/zmq-contexts.ads
View File

@ -33,23 +33,43 @@
with Ada.Finalization;
with System;
package ZMQ.Contexts is
IO_THREADS_DFLT : constant := 1;
MAX_SOCKETS_DFLT : constant := 1024;
type Context is new Ada.Finalization.Limited_Controlled with private;
type Any_Context is access all Context'Class;
not overriding
procedure Initialize (This : in out Context;
App_Threads : Natural);
procedure Set_Number_Of_IO_Threads
(This : Context; Number_Of_IO_Threads : Positive := IO_THREADS_DFLT);
-- specifies the size of the ØMQ thread pool to handle I/O operations.
-- If your application is using only the inproc transport for messaging
-- you may set this to zero, otherwise set it to at least one.
-- This option only applies before creating any sockets on the context.
procedure Set_Maximum_Number_Of_Sockets
(This : Context; Number_Of_Sockets : Positive := MAX_SOCKETS_DFLT);
-- Sets the maximum number of sockets allowed on the context.
function Get_Number_Of_IO_Threads
(This : Context) return Positive;
-- Returns the size of the ØMQ thread pool for this context.
function Get_Maximum_Number_Of_Sockets
(This : Context) return Positive;
-- Returns the maximum number of sockets allowed for this context.
function GetImpl (This : Context) return System.Address;
-- "Private" function to get lowlevel implementation handle.
private
type Context is new Ada.Finalization.Limited_Controlled with record
C : System.Address := System.Null_Address;
end record;
overriding
procedure Initialize (This : in out Context);
overriding
procedure Finalize (This : in out Context);
function Is_Connected (This : Context) return Boolean;
function GetImpl (This : Context) return System.Address;
private
type Context is new Ada.Finalization.Limited_Controlled with record
c : System.Address := System.Null_Address;
end record;
end ZMQ.Contexts;

34
src/zmq-devices.adb Normal file → Executable file
View File

@ -33,27 +33,27 @@
with ZMQ.Low_Level;
with Interfaces.C; use Interfaces.C;
package body ZMQ.devices is
package body ZMQ.Devices is
----------------
-- initialize --
----------------
map : constant array (Device_Kind) of int :=
(Streamer => Low_Level.Defs.ZMQ_STREAMER,
Forwarder => Low_Level.Defs.ZMQ_FORWARDER,
Queue => Low_Level.Defs.ZMQ_QUEUE);
procedure initialize
(this : in out device;
Kind : Device_Kind;
insocket : ZMQ.Sockets.Socket;
outsocket : ZMQ.Sockets.Socket)
type Device_Kind_map is array (Device_Kind) of int;
Map : constant Device_Kind_map :=
(Streamer => Low_Level.ZMQ_STREAMER,
Forwarder => Low_Level.ZMQ_FORWARDER,
Queue => Low_Level.ZMQ_QUEUE);
procedure Initialize
(This : in out Device;
Kind : Device_Kind;
In_Socket : ZMQ.Sockets.Socket;
Out_Ocket : ZMQ.Sockets.Socket)
is
begin
this.impl :=
Low_Level.zmq_device (map (Kind),
insocket.get_impl,
outsocket.get_impl);
end initialize;
This.Impl :=
Low_Level.Zmq_Device (Map (Kind),
In_Socket.Get_Impl,
Out_Ocket.Get_Impl);
end Initialize;
end ZMQ.devices;
end ZMQ.Devices;

22
src/zmq-devices.ads
View File

@ -33,17 +33,17 @@
private with Interfaces.C;
with ZMQ.Sockets;
package ZMQ.devices is
-- Devices are building blocks intended to serve as intermediate nodes
-- in complex messaging topologies.
type device is tagged private;
package ZMQ.Devices is
-- Devices are building blocks intended to serve as intermediate nodes
-- in complex messaging topologies.
type Device is tagged private;
type Device_Kind is (Streamer, Forwarder, Queue);
procedure initialize (this : in out device;
Kind : Device_Kind;
insocket : ZMQ.Sockets.Socket;
outsocket : ZMQ.Sockets.Socket);
procedure Initialize (This : in out Device;
Kind : Device_Kind;
In_Socket : ZMQ.Sockets.Socket;
Out_Ocket : ZMQ.Sockets.Socket);
private
type device is tagged record
impl : Interfaces.C.int;
type Device is tagged record
Impl : Interfaces.C.int;
end record;
end ZMQ.devices;
end ZMQ.Devices;

456
src/zmq-low_level.ads
View File

@ -1,139 +1,155 @@
-------------------------------------------------------------------------------
-- --
-- 0MQ Ada-binding --
-- --
-- Z M Q . L O W _ L E V E L --
-- --
-- S p e c --
-- --
-- Copyright (C) 2010-2011, per.sandberg@bredband.net --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files --
-- (the "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, sublicense, and / or sell copies of the Software, and to --
-- permit persons to whom the Software is furnished to do so, subject to --
-- the following conditions : --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, --
-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL --
-- THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR --
-- OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, --
-- ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR --
-- OTHER DEALINGS IN THE SOFTWARE. --
-------------------------------------------------------------------------------
pragma Ada_2005;
pragma Style_Checks (Off);
-- The contents of this file is derived from zmq.h using the
-- -fdump-ada-spec switch for gcc.
with Interfaces.C; use Interfaces.C;
with Interfaces.C; use Interfaces.C;
with Interfaces.C.Strings;
with System;
package ZMQ.Low_Level is
pragma Preelaborate;
pragma Warnings (Off);
package Defs is
ZMQ_VERSION_MAJOR : constant := 2; -- zmq.h:55
ZMQ_VERSION_MINOR : constant := 1; -- zmq.h:56
ZMQ_VERSION_PATCH : constant := 0; -- zmq.h:57
ZMQ_VERSION : constant := ZMQ_VERSION_MAJOR * 10000 + ZMQ_VERSION_MINOR * 100 + ZMQ_VERSION_PATCH;
ZMQ_VERSION_MAJOR : constant := 3; -- zmq.h:61
ZMQ_VERSION_MINOR : constant := 2; -- zmq.h:62
ZMQ_VERSION_PATCH : constant := 2; -- zmq.h:63
-- arg-macro: function ZMQ_MAKE_VERSION (major, minor, p((major) * 10000 + (minor) * 100 + (patch)
-- return (major) * 10000 + (minor) * 100 + (patch);
-- unsupported macro: ZMQ_VERSION ZMQ_MAKE_VERSION(ZMQ_VERSION_MAJOR, ZMQ_VERSION_MINOR, ZMQ_VERSION_PATCH)
ZMQ_HAUSNUMERO : constant := 156384712; -- zmq.h:73
EFSM : constant := (ZMQ_HAUSNUMERO + 51);
ENOCOMPATPROTO : constant := (ZMQ_HAUSNUMERO + 52);
ETERM : constant := (ZMQ_HAUSNUMERO + 53);
EMTHREAD : constant := (ZMQ_HAUSNUMERO + 54);
ZMQ_HAUSNUMERO : constant := 156384712; -- zmq.h:79
EFSM : constant := ZMQ_HAUSNUMERO + 51;
ENOCOMPATPROTO : constant := ZMQ_HAUSNUMERO + 52;
ETERM : constant := ZMQ_HAUSNUMERO + 53;
EMTHREAD : constant := ZMQ_HAUSNUMERO + 54;
ZMQ_MAX_VSM_SIZE : constant := 30; -- zmq.h:124
ZMQ_IO_THREADS : constant := 1; -- zmq.h:158
ZMQ_MAX_SOCKETS : constant := 2; -- zmq.h:159
ZMQ_DELIMITER : constant := 31; -- zmq.h:128
ZMQ_VSM : constant := 32; -- zmq.h:129
ZMQ_IO_THREADS_DFLT : constant := 1; -- zmq.h:162
ZMQ_MAX_SOCKETS_DFLT : constant := 1024; -- zmq.h:163
ZMQ_MSG_MORE : constant := 1; -- zmq.h:134
ZMQ_MSG_SHARED : constant := 128; -- zmq.h:135
ZMQ_PAIR : constant := 0; -- zmq.h:204
ZMQ_PUB : constant := 1; -- zmq.h:205
ZMQ_SUB : constant := 2; -- zmq.h:206
ZMQ_REQ : constant := 3; -- zmq.h:207
ZMQ_REP : constant := 4; -- zmq.h:208
ZMQ_DEALER : constant := 5; -- zmq.h:209
ZMQ_ROUTER : constant := 6; -- zmq.h:210
ZMQ_PULL : constant := 7; -- zmq.h:211
ZMQ_PUSH : constant := 8; -- zmq.h:212
ZMQ_XPUB : constant := 9; -- zmq.h:213
ZMQ_XSUB : constant := 10; -- zmq.h:214
-- unsupported macro: ZMQ_XREQ ZMQ_DEALER
-- unsupported macro: ZMQ_XREP ZMQ_ROUTER
ZMQ_PAIR : constant := 0; -- zmq.h:172
ZMQ_PUB : constant := 1; -- zmq.h:173
ZMQ_SUB : constant := 2; -- zmq.h:174
ZMQ_REQ : constant := 3; -- zmq.h:175
ZMQ_REP : constant := 4; -- zmq.h:176
ZMQ_XREQ : constant := 5; -- zmq.h:177
ZMQ_XREP : constant := 6; -- zmq.h:178
ZMQ_PULL : constant := 7; -- zmq.h:179
ZMQ_PUSH : constant := 8; -- zmq.h:180
ZMQ_UPSTREAM : constant := ZMQ_PULL;
ZMQ_DOWNSTREAM : constant := ZMQ_PUSH;
ZMQ_AFFINITY : constant := 4; -- zmq.h:221
ZMQ_IDENTITY : constant := 5; -- zmq.h:222
ZMQ_SUBSCRIBE : constant := 6; -- zmq.h:223
ZMQ_UNSUBSCRIBE : constant := 7; -- zmq.h:224
ZMQ_RATE : constant := 8; -- zmq.h:225
ZMQ_RECOVERY_IVL : constant := 9; -- zmq.h:226
ZMQ_SNDBUF : constant := 11; -- zmq.h:227
ZMQ_RCVBUF : constant := 12; -- zmq.h:228
ZMQ_RCVMORE : constant := 13; -- zmq.h:229
ZMQ_FD : constant := 14; -- zmq.h:230
ZMQ_EVENTS : constant := 15; -- zmq.h:231
ZMQ_TYPE : constant := 16; -- zmq.h:232
ZMQ_LINGER : constant := 17; -- zmq.h:233
ZMQ_RECONNECT_IVL : constant := 18; -- zmq.h:234
ZMQ_BACKLOG : constant := 19; -- zmq.h:235
ZMQ_RECONNECT_IVL_MAX : constant := 21; -- zmq.h:236
ZMQ_MAXMSGSIZE : constant := 22; -- zmq.h:237
ZMQ_SNDHWM : constant := 23; -- zmq.h:238
ZMQ_RCVHWM : constant := 24; -- zmq.h:239
ZMQ_MULTICAST_HOPS : constant := 25; -- zmq.h:240
ZMQ_RCVTIMEO : constant := 27; -- zmq.h:241
ZMQ_SNDTIMEO : constant := 28; -- zmq.h:242
ZMQ_IPV4ONLY : constant := 31; -- zmq.h:243
ZMQ_LAST_ENDPOINT : constant := 32; -- zmq.h:244
ZMQ_ROUTER_MANDATORY : constant := 33; -- zmq.h:245
ZMQ_TCP_KEEPALIVE : constant := 34; -- zmq.h:246
ZMQ_TCP_KEEPALIVE_CNT : constant := 35; -- zmq.h:247
ZMQ_TCP_KEEPALIVE_IDLE : constant := 36; -- zmq.h:248
ZMQ_TCP_KEEPALIVE_INTVL : constant := 37; -- zmq.h:249
ZMQ_TCP_ACCEPT_FILTER : constant := 38; -- zmq.h:250
ZMQ_DELAY_ATTACH_ON_CONNECT : constant := 39; -- zmq.h:251
ZMQ_XPUB_VERBOSE : constant := 40; -- zmq.h:252
ZMQ_HWM : constant := 1; -- zmq.h:185
ZMQ_SWAP : constant := 3; -- zmq.h:186
ZMQ_AFFINITY : constant := 4; -- zmq.h:187
ZMQ_IDENTITY : constant := 5; -- zmq.h:188
ZMQ_SUBSCRIBE : constant := 6; -- zmq.h:189
ZMQ_UNSUBSCRIBE : constant := 7; -- zmq.h:190
ZMQ_RATE : constant := 8; -- zmq.h:191
ZMQ_RECOVERY_IVL : constant := 9; -- zmq.h:192
ZMQ_MCAST_LOOP : constant := 10; -- zmq.h:193
ZMQ_SNDBUF : constant := 11; -- zmq.h:194
ZMQ_RCVBUF : constant := 12; -- zmq.h:195
ZMQ_RCVMORE : constant := 13; -- zmq.h:196
ZMQ_FD : constant := 14; -- zmq.h:197
ZMQ_EVENTS : constant := 15; -- zmq.h:198
ZMQ_TYPE : constant := 16; -- zmq.h:199
ZMQ_LINGER : constant := 17; -- zmq.h:200
ZMQ_RECONNECT_IVL : constant := 18; -- zmq.h:201
ZMQ_BACKLOG : constant := 19; -- zmq.h:202
ZMQ_MORE : constant := 1; -- zmq.h:256
ZMQ_NOBLOCK : constant := 1; -- zmq.h:205
ZMQ_SNDMORE : constant := 2; -- zmq.h:206
ZMQ_DONTWAIT : constant := 1; -- zmq.h:259
ZMQ_SNDMORE : constant := 2; -- zmq.h:260
-- unsupported macro: ZMQ_NOBLOCK ZMQ_DONTWAIT
-- unsupported macro: ZMQ_FAIL_UNROUTABLE ZMQ_ROUTER_MANDATORY
-- unsupported macro: ZMQ_ROUTER_BEHAVIOR ZMQ_ROUTER_MANDATORY
ZMQ_POLLIN : constant := 1; -- zmq.h:223
ZMQ_POLLOUT : constant := 2; -- zmq.h:224
ZMQ_POLLERR : constant := 4; -- zmq.h:225
ZMQ_EVENT_CONNECTED : constant := 1; -- zmq.h:272
ZMQ_EVENT_CONNECT_DELAYED : constant := 2; -- zmq.h:273
ZMQ_EVENT_CONNECT_RETRIED : constant := 4; -- zmq.h:274
ZMQ_STREAMER : constant := 1; -- zmq.h:245
ZMQ_FORWARDER : constant := 2; -- zmq.h:246
ZMQ_QUEUE : constant := 3; -- zmq.h:247
ZMQ_EVENT_LISTENING : constant := 8; -- zmq.h:276
ZMQ_EVENT_BIND_FAILED : constant := 16; -- zmq.h:277
ZMQ_EVENT_ACCEPTED : constant := 32; -- zmq.h:279
ZMQ_EVENT_ACCEPT_FAILED : constant := 64; -- zmq.h:280
end Defs;
ZMQ_EVENT_CLOSED : constant := 128; -- zmq.h:282
ZMQ_EVENT_CLOSE_FAILED : constant := 256; -- zmq.h:283
ZMQ_EVENT_DISCONNECTED : constant := 512; -- zmq.h:284
-- unsupported macro: ZMQ_EVENT_ALL ( ZMQ_EVENT_CONNECTED | ZMQ_EVENT_CONNECT_DELAYED | ZMQ_EVENT_CONNECT_RETRIED |
--ZMQ_EVENT_LISTENING | ZMQ_EVENT_BIND_FAILED | ZMQ_EVENT_ACCEPTED | ZMQ_EVENT_ACCEPT_FAILED | ZMQ_EVENT_CLOSED |
--ZMQ_EVENT_CLOSE_FAILED | ZMQ_EVENT_DISCONNECTED )
procedure zmq_version
(major : access int;
minor : access int;
patch : access int); -- zmq.h:65
ZMQ_POLLIN : constant := 1; -- zmq.h:366
ZMQ_POLLOUT : constant := 2; -- zmq.h:367
ZMQ_POLLERR : constant := 4; -- zmq.h:368
ZMQ_STREAMER : constant := 1; -- zmq.h:389
ZMQ_FORWARDER : constant := 2; -- zmq.h:390
ZMQ_QUEUE : constant := 3; -- zmq.h:391
procedure zmq_version (major : access int; minor : access int; patch : access int); -- zmq.h:71
pragma Import (C, zmq_version, "zmq_version");
function zmq_errno return int; -- zmq.h:111
function zmq_errno return int; -- zmq.h:147
pragma Import (C, zmq_errno, "zmq_errno");
function zmq_strerror (errnum : int) return Interfaces.C.Strings.chars_ptr; -- zmq.h:114
function zmq_strerror (errnum : int) return Interfaces.C.Strings.chars_ptr; -- zmq.h:150
pragma Import (C, zmq_strerror, "zmq_strerror");
type zmq_msg_t_vsm_data_array is array (0 .. 29) of aliased unsigned_char;
function zmq_ctx_new return System.Address; -- zmq.h:165
pragma Import (C, zmq_ctx_new, "zmq_ctx_new");
function zmq_ctx_destroy (context : System.Address) return int; -- zmq.h:166
pragma Import (C, zmq_ctx_destroy, "zmq_ctx_destroy");
function zmq_ctx_set
(context : System.Address;
option : int;
optval : int)
return int; -- zmq.h:167
pragma Import (C, zmq_ctx_set, "zmq_ctx_set");
function zmq_ctx_get (context : System.Address; option : int) return int; -- zmq.h:168
pragma Import (C, zmq_ctx_get, "zmq_ctx_get");
function zmq_init (io_threads : int) return System.Address; -- zmq.h:171
pragma Import (C, zmq_init, "zmq_init");
function zmq_term (context : System.Address) return int; -- zmq.h:172
pragma Import (C, zmq_term, "zmq_term");
type zmq_msg_t_u_u_array is array (0 .. 31) of aliased unsigned_char;
type zmq_msg_t is record
content : System.Address; -- zmq.h:142
flags : aliased unsigned_char; -- zmq.h:143
vsm_size : aliased unsigned_char; -- zmq.h:144
vsm_data : aliased zmq_msg_t_vsm_data_array; -- zmq.h:145
u_u : aliased zmq_msg_t_u_u_array; -- zmq.h:179
end record;
pragma Convention (C_Pass_By_Copy, zmq_msg_t); -- zmq.h:146
pragma Convention (C_Pass_By_Copy, zmq_msg_t); -- zmq.h:179
-- skipped function type zmq_free_fn
type zmq_free_fn is access procedure (data : System.Address; hint : System.Address);
function zmq_msg_init (msg : access zmq_msg_t) return int; -- zmq.h:150
function zmq_msg_init (msg : access zmq_msg_t) return int; -- zmq.h:183
pragma Import (C, zmq_msg_init, "zmq_msg_init");
function zmq_msg_init_size (msg : access zmq_msg_t; size : size_t) return int; -- zmq.h:151
function zmq_msg_init_size (msg : access zmq_msg_t; size : size_t) return int; -- zmq.h:184
pragma Import (C, zmq_msg_init_size, "zmq_msg_init_size");
function zmq_msg_init_data
@ -141,87 +157,255 @@ package ZMQ.Low_Level is
data : System.Address;
size : size_t;
ffn : access procedure (arg1 : System.Address; arg2 : System.Address);
hint : System.Address) return int; -- zmq.h:152
hint : System.Address)
return int; -- zmq.h:185
pragma Import (C, zmq_msg_init_data, "zmq_msg_init_data");
function zmq_msg_close (msg : access zmq_msg_t) return int; -- zmq.h:154
function zmq_msg_send
(msg : access zmq_msg_t;
s : System.Address;
flags : int)
return int; -- zmq.h:187
pragma Import (C, zmq_msg_send, "zmq_msg_send");
function zmq_msg_recv
(msg : access zmq_msg_t;
s : System.Address;
flags : int)
return int; -- zmq.h:188
pragma Import (C, zmq_msg_recv, "zmq_msg_recv");
function zmq_msg_close (msg : access zmq_msg_t) return int; -- zmq.h:189
pragma Import (C, zmq_msg_close, "zmq_msg_close");
function zmq_msg_move (dest : access zmq_msg_t; src : access zmq_msg_t) return int; -- zmq.h:155
function zmq_msg_move (dest : access zmq_msg_t; src : access zmq_msg_t) return int; -- zmq.h:190
pragma Import (C, zmq_msg_move, "zmq_msg_move");
function zmq_msg_copy (dest : access zmq_msg_t; src : access zmq_msg_t) return int; -- zmq.h:156
function zmq_msg_copy (dest : access zmq_msg_t; src : access zmq_msg_t) return int; -- zmq.h:191
pragma Import (C, zmq_msg_copy, "zmq_msg_copy");
function zmq_msg_data (msg : access zmq_msg_t) return System.Address; -- zmq.h:157
function zmq_msg_data (msg : access zmq_msg_t) return System.Address; -- zmq.h:192
pragma Import (C, zmq_msg_data, "zmq_msg_data");
function zmq_msg_size (msg : access zmq_msg_t) return size_t; -- zmq.h:158
function zmq_msg_size (msg : access zmq_msg_t) return size_t; -- zmq.h:193
pragma Import (C, zmq_msg_size, "zmq_msg_size");
function zmq_init (io_threads : int) return System.Address; -- zmq.h:164
pragma Import (C, zmq_init, "zmq_init");
function zmq_msg_more (msg : access zmq_msg_t) return int; -- zmq.h:194
pragma Import (C, zmq_msg_more, "zmq_msg_more");
function zmq_term (context : System.Address) return int; -- zmq.h:165
pragma Import (C, zmq_term, "zmq_term");
function zmq_msg_get (msg : access zmq_msg_t; option : int) return int; -- zmq.h:195
pragma Import (C, zmq_msg_get, "zmq_msg_get");
function zmq_socket (context : System.Address; c_type : int) return System.Address; -- zmq.h:208
function zmq_msg_set
(msg : access zmq_msg_t;
option : int;
optval : int)
return int; -- zmq.h:196
pragma Import (C, zmq_msg_set, "zmq_msg_set");
type anon_7;
type anon_8 is record
addr : Interfaces.C.Strings.chars_ptr; -- zmq.h:297
fd : aliased int; -- zmq.h:298
end record;
pragma Convention (C_Pass_By_Copy, anon_8);
type anon_9 is record
addr : Interfaces.C.Strings.chars_ptr; -- zmq.h:301
err : aliased int; -- zmq.h:302
end record;
pragma Convention (C_Pass_By_Copy, anon_9);
type anon_10 is record
addr : Interfaces.C.Strings.chars_ptr; -- zmq.h:305
interval : aliased int; -- zmq.h:306
end record;
pragma Convention (C_Pass_By_Copy, anon_10);
type anon_11 is record
addr : Interfaces.C.Strings.chars_ptr; -- zmq.h:309
fd : aliased int; -- zmq.h:310
end record;
pragma Convention (C_Pass_By_Copy, anon_11);
type anon_12 is record
addr : Interfaces.C.Strings.chars_ptr; -- zmq.h:313
err : aliased int; -- zmq.h:314
end record;
pragma Convention (C_Pass_By_Copy, anon_12);
type anon_13 is record
addr : Interfaces.C.Strings.chars_ptr; -- zmq.h:317
fd : aliased int; -- zmq.h:318
end record;
pragma Convention (C_Pass_By_Copy, anon_13);
type anon_14 is record
addr : Interfaces.C.Strings.chars_ptr; -- zmq.h:321
err : aliased int; -- zmq.h:322
end record;
pragma Convention (C_Pass_By_Copy, anon_14);
type anon_15 is record
addr : Interfaces.C.Strings.chars_ptr; -- zmq.h:325
fd : aliased int; -- zmq.h:326
end record;
pragma Convention (C_Pass_By_Copy, anon_15);
type anon_16 is record
addr : Interfaces.C.Strings.chars_ptr; -- zmq.h:329
err : aliased int; -- zmq.h:330
end record;
pragma Convention (C_Pass_By_Copy, anon_16);
type anon_17 is record
addr : Interfaces.C.Strings.chars_ptr; -- zmq.h:333
fd : aliased int; -- zmq.h:334
end record;
pragma Convention (C_Pass_By_Copy, anon_17);
type anon_7 (discr : unsigned := 0) is record
case discr is
when 0 =>
connected : aliased anon_8; -- zmq.h:299
when 1 =>
connect_delayed : aliased anon_9; -- zmq.h:303
when 2 =>
connect_retried : aliased anon_10; -- zmq.h:307
when 3 =>
listening : aliased anon_11; -- zmq.h:311
when 4 =>
bind_failed : aliased anon_12; -- zmq.h:315
when 5 =>
accepted : aliased anon_13; -- zmq.h:319
when 6 =>
accept_failed : aliased anon_14; -- zmq.h:323
when 7 =>
closed : aliased anon_15; -- zmq.h:327
when 8 =>
close_failed : aliased anon_16; -- zmq.h:331
when others =>
disconnected : aliased anon_17; -- zmq.h:335
end case;
end record;
pragma Convention (C_Pass_By_Copy, anon_7);
pragma Unchecked_Union (anon_7);
type zmq_event_t is record
event : aliased int; -- zmq.h:294
data : anon_7; -- zmq.h:336
end record;
pragma Convention (C_Pass_By_Copy, zmq_event_t); -- zmq.h:337
-- skipped anonymous struct anon_6
function zmq_socket (arg1 : System.Address; c_type : int) return System.Address; -- zmq.h:339
pragma Import (C, zmq_socket, "zmq_socket");
function zmq_close (s : System.Address) return int; -- zmq.h:209
function zmq_close (s : System.Address) return int; -- zmq.h:340
pragma Import (C, zmq_close, "zmq_close");
function zmq_setsockopt
(s : System.Address;
option : int;
optval : System.Address;
optvallen : size_t) return int; -- zmq.h:210
optvallen : size_t)
return int; -- zmq.h:341
pragma Import (C, zmq_setsockopt, "zmq_setsockopt");
function zmq_getsockopt
(s : System.Address;
option : int;
optval : System.Address;
optvallen : access size_t) return int; -- zmq.h:212
optvallen : access size_t)
return int; -- zmq.h:343
pragma Import (C, zmq_getsockopt, "zmq_getsockopt");
function zmq_bind (s : System.Address; addr : Interfaces.C.Strings.chars_ptr) return int; -- zmq.h:214
function zmq_bind (s : System.Address; addr : Interfaces.C.Strings.chars_ptr) return int; -- zmq.h:345
pragma Import (C, zmq_bind, "zmq_bind");
function zmq_connect (s : System.Address; addr : Interfaces.C.Strings.chars_ptr) return int; -- zmq.h:215
function zmq_connect (s : System.Address; addr : Interfaces.C.Strings.chars_ptr) return int; -- zmq.h:346
pragma Import (C, zmq_connect, "zmq_connect");
function zmq_unbind (s : System.Address; addr : Interfaces.C.Strings.chars_ptr) return int; -- zmq.h:347
pragma Import (C, zmq_unbind, "zmq_unbind");
function zmq_disconnect (s : System.Address; addr : Interfaces.C.Strings.chars_ptr) return int; -- zmq.h:348
pragma Import (C, zmq_disconnect, "zmq_disconnect");
function zmq_send
(s : System.Address;
msg : access zmq_msg_t;
flags : int) return int; -- zmq.h:216
buf : System.Address;
len : size_t;
flags : int)
return int; -- zmq.h:349
pragma Import (C, zmq_send, "zmq_send");
function zmq_recv
(s : System.Address;
msg : access zmq_msg_t;
flags : int) return int; -- zmq.h:217
buf : System.Address;
len : size_t;
flags : int)
return int; -- zmq.h:350
pragma Import (C, zmq_recv, "zmq_recv");
type zmq_pollitem_t is record
socket : System.Address; -- zmq.h:229
fd : aliased int; -- zmq.h:233
events : aliased short; -- zmq.h:235
revents : aliased short; -- zmq.h:236
end record;
pragma Convention (C_Pass_By_Copy, zmq_pollitem_t); -- zmq.h:237
function zmq_socket_monitor
(s : System.Address;
addr : Interfaces.C.Strings.chars_ptr;
events : int)
return int; -- zmq.h:351
pragma Import (C, zmq_socket_monitor, "zmq_socket_monitor");
function zmq_sendmsg
(s : System.Address;
msg : access zmq_msg_t;
flags : int)
return int; -- zmq.h:353
pragma Import (C, zmq_sendmsg, "zmq_sendmsg");
function zmq_recvmsg
(s : System.Address;
msg : access zmq_msg_t;
flags : int)
return int; -- zmq.h:354
pragma Import (C, zmq_recvmsg, "zmq_recvmsg");
-- skipped empty struct iovec
function zmq_sendiov
(s : System.Address;
iov : System.Address;
count : size_t;
flags : int)
return int; -- zmq.h:359
pragma Import (C, zmq_sendiov, "zmq_sendiov");
function zmq_recviov
(s : System.Address;
iov : System.Address;
count : access size_t;
flags : int)
return int; -- zmq.h:360
pragma Import (C, zmq_recviov, "zmq_recviov");
type zmq_pollitem_t is record
socket : System.Address; -- zmq.h:372
fd : aliased int; -- zmq.h:376
events : aliased short; -- zmq.h:378
revents : aliased short; -- zmq.h:379
end record;
pragma Convention (C_Pass_By_Copy, zmq_pollitem_t); -- zmq.h:380
-- skipped anonymous struct anon_18
function zmq_poll
(items : access zmq_pollitem_t;
nitems : int;
timeout : long) return int; -- zmq.h:239
timeout : long)
return int; -- zmq.h:382
pragma Import (C, zmq_poll, "zmq_poll");
function zmq_proxy
(frontend : System.Address;
backend : System.Address;
capture : System.Address)
return int; -- zmq.h:386
pragma Import (C, zmq_proxy, "zmq_proxy");
function zmq_device
(device : int;
insocket : System.Address;
outsocket : System.Address) return int; -- zmq.h:249
(c_type : int;
frontend : System.Address;
backend : System.Address)
return int; -- zmq.h:393
pragma Import (C, zmq_device, "zmq_device");
end ZMQ.Low_Level;

136
src/zmq-messages.adb
View File

@ -43,12 +43,12 @@ package body ZMQ.Messages is
----------------
procedure Initialize (Self : in out Message) is
ret : int;
Ret : int;
begin
ret := Low_Level.zmq_msg_init (Self.Msg'Access);
if ret /= 0 then
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;
GNAT.Source_Info.Enclosing_Entity;
end if;
end Initialize;
@ -57,12 +57,12 @@ package body ZMQ.Messages is
-- ========================================================================
procedure Initialize (Self : in out Message; Size : Natural) is
ret : int;
Ret : int;
begin
ret := Low_Level.zmq_msg_init_size (Self.Msg'Access, size_t (Size));
if ret /= 0 then
Ret := Low_Level.Zmq_Msg_Init_Size (Self.Msg'Access, size_t (Size));
if Ret /= 0 then
raise ZMQ_Error with Error_Message (GNAT.OS_Lib.Errno) & " in " &
GNAT.Source_Info.Enclosing_Entity;
GNAT.Source_Info.Enclosing_Entity;
end if;
end Initialize;
@ -80,11 +80,11 @@ package body ZMQ.Messages is
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;
Conv.To_Pointer ((Self.GetData)).all := Conv.To_Pointer (Data).all;
end Initialize;
procedure Initialize (Self : in out Message; Data : String) is
@ -109,16 +109,16 @@ package body ZMQ.Messages is
Free : Free_Proc;
Hint : System.Address := System.Null_Address)
is
ret : int;
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_t (Size),
Free,
Hint);
if ret /= 0 then
if Ret /= 0 then
raise ZMQ_Error with Error_Message (GNAT.OS_Lib.Errno) & " in " &
GNAT.Source_Info.Enclosing_Entity;
GNAT.Source_Info.Enclosing_Entity;
end if;
end Initialize;
@ -131,20 +131,20 @@ package body ZMQ.Messages is
(Self : in out Message;
Data : Element_Access)
is
function conv is new
function Conv is new
Ada.Unchecked_Conversion (Source => System.Address,
Target => Element_Access);
procedure Internal_free (Data : System.Address; Hint : System.Address);
procedure Internal_free (Data : System.Address; Hint : System.Address) is
procedure Internal_Free (Data : System.Address; Hint : System.Address);
procedure Internal_Free (Data : System.Address; Hint : System.Address) is
pragma Unreferenced (Hint);
temp : Element_Access := conv (Data);
Temp : Element_Access := Conv (Data);
begin
free (temp);
end Internal_free;
Free (Temp);
end Internal_Free;
begin
Self.Initialize (Data.all'Address,
Data.all'Size / 8,
Internal_free'Unrestricted_Access);
Internal_Free'Unrestricted_Access);
end Initialize_Generic;
----------------------------------
@ -156,24 +156,24 @@ package body ZMQ.Messages is
Data : Element_Access;
Hint : Hint_Access)
is
function convHint is new
function ConvHint is new
Ada.Unchecked_Conversion (Source => System.Address,
Target => Hint_Access);
function conv is new
function Conv is new
Ada.Unchecked_Conversion (Source => System.Address,
Target => Element_Access);
procedure Internal_free (Data : System.Address; Hint : System.Address);
procedure Internal_free (Data : System.Address; Hint : System.Address) is
Temp_Data : Element_Access := conv (Data);
Temp_Hint : constant Hint_Access := convHint (Hint);
procedure Internal_Free (Data : System.Address; Hint : System.Address);
procedure Internal_Free (Data : System.Address; Hint : System.Address) is
Temp_Data : Element_Access := Conv (Data);
Temp_Hint : constant Hint_Access := ConvHint (Hint);
begin
free (Temp_Data, Temp_Hint);
end Internal_free;
Free (Temp_Data, Temp_Hint);
end Internal_Free;
begin
Self.Initialize (Data.all'Address,
Data.all'Size / 8,
Internal_free'Unrestricted_Access,
Internal_Free'Unrestricted_Access,
Hint.all'Address);
end Initialize_Generic_With_Hint;
@ -185,65 +185,65 @@ package body ZMQ.Messages is
---------------
-- getData --
---------------
function getData (Self : Message) return System.Address is
function GetData (Self : Message) return System.Address is
begin
return Low_Level.zmq_msg_data (Self.Msg'Unrestricted_Access);
end getData;
return Low_Level.Zmq_Msg_Data (Self.Msg'Unrestricted_Access);
end GetData;
---------------
-- getData --
---------------
function getData (Self : Message) return String is
type data_type is new String (1 .. Self.getSize);
package conv is new System.Address_To_Access_Conversions (data_type);
function GetData (Self : Message) return String is
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);
end getData;
return String (Conv.To_Pointer (Self.GetData).all);
end GetData;
---------------
-- getData --
---------------
function getData (Self : Message)
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);
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;
(Conv.To_Pointer (Self.GetData).all);
end GetData;
---------------
-- getData --
---------------
function getData (Self : Message)
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);
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;
(String (Conv.To_Pointer (Self.GetData).all));
end GetData;
-----------------------
-- getData_Generic --
-----------------------
function getData_Generic (Self : Message)
function GetData_Generic (Self : Message)
return Element is
package conv is new System.Address_To_Access_Conversions (Element);
package Conv is new System.Address_To_Access_Conversions (Element);
begin
return conv.To_Pointer (Self.getData).all;
end getData_Generic;
return Conv.To_Pointer (Self.GetData).all;
end GetData_Generic;
---------------
-- getSize --
---------------
function getSize (Self : Message) return Natural is
function GetSize (Self : Message) return Natural is
begin
return Natural (Low_Level.zmq_msg_size (Self.Msg'Unrestricted_Access));
end getSize;
return Natural (Low_Level.Zmq_Msg_Size (Self.Msg'Unrestricted_Access));
end GetSize;
--------------
@ -251,12 +251,12 @@ package body ZMQ.Messages is
--------------
procedure Finalize (Self : in out Message) is
ret : int;
Ret : int;
begin
ret := Low_Level.zmq_msg_close (Self.Msg'Access);
if ret /= 0 then
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;
GNAT.Source_Info.Enclosing_Entity;
end if;
end Finalize;
@ -264,17 +264,17 @@ package body ZMQ.Messages is
-- getImpl --
-------------
function getImpl (Self : Message) return not null zmq_msg_t_Access is
function GetImpl (Self : Message) return not null Zmq_Msg_T_Access is
begin
return Self.Msg'Unrestricted_Access;
end getImpl;
end GetImpl;
procedure process_data_generic
procedure Process_Data_Generic
(Self : Message;
Handle : access procedure (item : Element)) is
package conv is new System.Address_To_Access_Conversions (Element);
Handle : access procedure (Item : Element)) is
package Conv is new System.Address_To_Access_Conversions (Element);
begin
Handle (conv.To_Pointer (Self.getData).all);
end process_data_generic;
Handle (Conv.To_Pointer (Self.GetData).all);
end Process_Data_Generic;
end ZMQ.Messages;

32
src/zmq-messages.ads
View File

@ -78,8 +78,8 @@ package ZMQ.Messages is
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 (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;
@ -91,7 +91,7 @@ package ZMQ.Messages is
generic
type Element is private;
type Element_Access is access Element;
with procedure free (data : in out Element_Access) is <>;
with procedure Free (Data : in out Element_Access) is <>;
procedure Initialize_Generic (Self : in out Message;
Data : Element_Access);
@ -101,8 +101,8 @@ package ZMQ.Messages is
type Element_Access is access Element;
type Hint_Type is private;
type Hint_Access is access Hint_Type;
with procedure free
(data : in out Element_Access; hint : Hint_Access) is <>;
with procedure Free
(Data : in out Element_Access; Hint : Hint_Access) is <>;
procedure Initialize_Generic_With_Hint (Self : in out Message;
Data : Element_Access;
Hint : Hint_Access);
@ -111,34 +111,34 @@ package ZMQ.Messages is
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;
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)
function GetData (Self : Message)
return String;
function getData (Self : Message)
function GetData (Self : Message)
return Ada.Streams.Stream_Element_Array;
function getData (Self : Message)
function GetData (Self : Message)
return Ada.Strings.Unbounded.Unbounded_String;
generic
type Element is private;
function getData_Generic (Self : Message)
function GetData_Generic (Self : Message)
return Element;
generic
type Element is private;
procedure process_data_generic
procedure Process_Data_Generic
(Self : Message;
Handle : access procedure (item : in Element));
Handle : access procedure (Item : in Element));
function getData (Self : Message) return System.Address;
function getSize (Self : Message) return Natural;
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;
Msg : aliased ZMQ.Low_Level.Zmq_Msg_T;
end record;
end ZMQ.Messages;

3
src/zmq-pollsets.adb
View File

@ -29,6 +29,7 @@ package body ZMQ.Pollsets is
------------
procedure append (this : in out Pollset; item : pollitem'Class) is
pragma Unreferenced (this, item);
begin
-- Generated stub: replace with real body!
pragma Compile_Time_Warning (Standard.True, "append unimplemented");
@ -40,6 +41,7 @@ package body ZMQ.Pollsets is
------------
procedure remove (this : in out Pollset; item : pollitem'Class) is
pragma Unreferenced (this, item);
begin
-- Generated stub: replace with real body!
pragma Compile_Time_Warning (Standard.True, "remove unimplemented");
@ -54,6 +56,7 @@ package body ZMQ.Pollsets is
(this : in out Pollset;
Timeout : Duration)
is
pragma Unreferenced (this, Timeout);
begin
-- Generated stub: replace with real body!
pragma Compile_Time_Warning (Standard.True, "poll unimplemented");

79
src/zmq-sockets-streams.adb Executable file
View File

@ -0,0 +1,79 @@
package body ZMQ.Sockets.Streams is
------------
-- stream --
------------
function stream (this : Stream_Socket) return Stream_Access is
begin
-- Generated stub: replace with real body!
pragma Compile_Time_Warning (Standard.True, "stream unimplemented");
raise Program_Error with "Unimplemented function stream";
return stream (this);
end stream;
----------
-- Read --
----------
procedure Read
(File : Stream_Socket;
Item : out Stream_Element_Array;
Last : out Stream_Element_Offset;
From : Positive_Count)
is
pragma Unreferenced (File, Item, Last, From);
begin
-- Generated stub: replace with real body!
pragma Compile_Time_Warning (Standard.True, "Read unimplemented");
raise Program_Error with "Unimplemented procedure Read";
end Read;
----------
-- Read --
----------
procedure Read
(File : Stream_Socket;
Item : out Stream_Element_Array;
Last : out Stream_Element_Offset)
is
pragma Unreferenced (File, Item, Last);
begin
-- Generated stub: replace with real body!
pragma Compile_Time_Warning (Standard.True, "Read unimplemented");
raise Program_Error with "Unimplemented procedure Read";
end Read;
-----------
-- Write --
-----------
procedure Write
(File : Stream_Socket;
Item : Stream_Element_Array;
To : Positive_Count)
is
pragma Unreferenced (File, Item, To);
begin
-- Generated stub: replace with real body!
pragma Compile_Time_Warning (Standard.True, "Write unimplemented");
raise Program_Error with "Unimplemented procedure Write";
end Write;
-----------
-- Write --
-----------
procedure Write
(File : Stream_Socket;
Item : Stream_Element_Array)
is
pragma Unreferenced (File, Item);
begin
-- Generated stub: replace with real body!
pragma Compile_Time_Warning (Standard.True, "Write unimplemented");
raise Program_Error with "Unimplemented procedure Write";
end Write;
end ZMQ.Sockets.Streams;

40
src/zmq-sockets-streams.ads Executable file
View File

@ -0,0 +1,40 @@
with Ada.Streams; use Ada.Streams;
with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO;
package ZMQ.Sockets.Streams is
type Stream_Access is access all Root_Stream_Type'Class;
type Stream_Socket (With_Context : Contexts.Any_Context;
Kind : Socket_Type;
Buffer_Size : Positive) is new Socket with private;
function stream (this : Stream_Socket) return Stream_Access;
procedure Read
(File : Stream_Socket;
Item : out Stream_Element_Array;
Last : out Stream_Element_Offset;
From : Positive_Count);
procedure Read
(File : Stream_Socket;
Item : out Stream_Element_Array;
Last : out Stream_Element_Offset);
procedure Write
(File : Stream_Socket;
Item : Stream_Element_Array;
To : Positive_Count);
procedure Write
(File : Stream_Socket;
Item : Stream_Element_Array);
private
type Stream_Socket
(With_Context : Contexts.Any_Context;
Kind : Socket_Type;
Buffer_Size : Positive) is new Socket (With_Context, Kind) with
null record;
end ZMQ.Sockets.Streams;

500
src/zmq-sockets.adb
View File

@ -31,7 +31,6 @@
with ZMQ.Low_Level;
with Interfaces.C.Strings;
with GNAT.OS_Lib;
with GNAT.Source_Info;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
package body ZMQ.Sockets is
@ -41,65 +40,71 @@ package body ZMQ.Sockets is
use Ada.Streams;
type Map_Array is array (Socket_Opt) of int;
Map : constant Map_Array :=
(HWM => Low_Level.Defs.ZMQ_HWM,
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,
RCVMORE => Low_Level.Defs.ZMQ_RCVMORE,
FD => Low_Level.Defs.ZMQ_FD,
EVENTS => Low_Level.Defs.ZMQ_EVENTS,
GET_TYPE => Low_Level.Defs.ZMQ_TYPE,
LINGER => Low_Level.Defs.ZMQ_LINGER,
RECONNECT_IVL => Low_Level.Defs.ZMQ_RECONNECT_IVL,
BACKLOG => Low_Level.Defs.ZMQ_BACKLOG
(AFFINITY => Low_Level.ZMQ_AFFINITY,
IDENTITY => Low_Level.ZMQ_IDENTITY,
SUBSCRIBE => Low_Level.ZMQ_SUBSCRIBE,
UNSUBSCRIBE => Low_Level.ZMQ_UNSUBSCRIBE,
RATE => Low_Level.ZMQ_RATE,
RECOVERY_IVL => Low_Level.ZMQ_RECOVERY_IVL,
SNDBUF => Low_Level.ZMQ_SNDBUF,
RCVBUF => Low_Level.ZMQ_RCVBUF,
RCVMORE => Low_Level.ZMQ_RCVMORE,
FD => Low_Level.ZMQ_FD,
EVENTS => Low_Level.ZMQ_EVENTS,
GET_TYPE => Low_Level.ZMQ_TYPE,
LINGER => Low_Level.ZMQ_LINGER,
RECONNECT_IVL => Low_Level.ZMQ_RECONNECT_IVL,
BACKLOG => Low_Level.ZMQ_BACKLOG,
RECONNECT_IVL_MAX => Low_Level.ZMQ_RECONNECT_IVL_MAX,
MAXMSGSIZE => Low_Level.ZMQ_MAXMSGSIZE,
SNDHWM => Low_Level.ZMQ_SNDHWM,
RCVHWM => Low_Level.ZMQ_RCVHWM,
MULTICAST_HOPS => Low_Level.ZMQ_MULTICAST_HOPS,
RCVTIMEO => Low_Level.ZMQ_RCVTIMEO,
SNDTIMEO => Low_Level.ZMQ_SNDTIMEO,
IPV4ONLY => Low_Level.ZMQ_IPV4ONLY,
LAST_ENDPOINT => Low_Level.ZMQ_LAST_ENDPOINT,
ROUTER_BEHAVIOR => Low_Level.ZMQ_ROUTER_BEHAVIOR,
TCP_KEEPALIVE => Low_Level.ZMQ_TCP_KEEPALIVE,
TCP_KEEPALIVE_CNT => Low_Level.ZMQ_TCP_KEEPALIVE_CNT,
TCP_KEEPALIVE_IDLE => Low_Level.ZMQ_TCP_KEEPALIVE_IDLE,
TCP_KEEPALIVE_INTVL => Low_Level.ZMQ_TCP_KEEPALIVE_INTVL,
TCP_ACCEPT_FILTER => Low_Level.ZMQ_TCP_ACCEPT_FILTER,
DELAY_ATTACH_ON_CONNECT => Low_Level.ZMQ_DELAY_ATTACH_ON_CONNECT,
XPUB_VERBOSE => Low_Level.ZMQ_XPUB_VERBOSE
);
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) ..
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');
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;
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;
return Ret;
end Img;
----------------
-- Initialize --
----------------
not overriding procedure Initialize
(This : in out Socket;
With_Context : Contexts.Context;
Kind : Socket_Type)
overriding procedure Initialize
(This : in out Socket)
is
begin
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,
Socket_Type'Pos (Kind));
if This.c = Null_Address then
This.C := Low_Level.zmq_socket (This.With_Context.GetImpl,
Socket_Type'Pos (This.Kind));
if This.C = Null_Address then
raise ZMQ_Error with "Unable to initialize";
end if;
end Initialize;
@ -112,12 +117,12 @@ package body ZMQ.Sockets is
(This : in out Socket;
Address : String)
is
addr : chars_ptr := Interfaces.C.Strings.New_String (Address);
ret : int;
Addr : chars_ptr := Interfaces.C.Strings.New_String (Address);
Ret : int;
begin
ret := Low_Level.zmq_bind (This.c, addr);
Free (addr);
if ret /= 0 then
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 " &
GNAT.Source_Info.Enclosing_Entity & "(" & Address & ")";
end if;
@ -129,73 +134,73 @@ package body ZMQ.Sockets is
This.Bind (To_String (Address));
end Bind;
procedure setsockopt (This : in out Socket;
procedure Setsockopt (This : in out Socket;
Option : Socket_Opt;
Value : System.Address;
Value_Size : Natural) is
ret : int;
Ret : int;
begin
ret := Low_Level.zmq_setsockopt
(This.c,
Ret := Low_Level.zmq_setsockopt
(This.C,
Map (Option),
Value,
size_t (Value_Size));
if ret /= 0 then
if Ret /= 0 then
raise ZMQ_Error with Error_Message (GNAT.OS_Lib.Errno) & " in " &
GNAT.Source_Info.Enclosing_Entity & "(" & Option'Img & ")";
end if;
end setsockopt;
end Setsockopt;
----------------
-- setsockopt --
----------------
not overriding procedure setsockopt
not overriding procedure Setsockopt
(This : in out Socket;
Option : Socket_Opt;
Value : String)
is
begin
This.setsockopt (Option, Value'Address, Value'Length);
end setsockopt;
This.Setsockopt (Option, Value'Address, Value'Length);
end Setsockopt;
----------------
-- setsockopt --
----------------
not overriding procedure setsockopt
not overriding procedure Setsockopt
(This : in out Socket;
Option : Socket_Opt;
Value : Boolean)
is
begin
This.setsockopt (Option, Value'Address, 1);
end setsockopt;
This.Setsockopt (Option, Value'Address, 1);
end Setsockopt;
----------------
-- setsockopt --
----------------
not overriding procedure setsockopt
not overriding procedure Setsockopt
(This : in out Socket;
Option : Socket_Opt;
Value : Natural)
is
begin
This.setsockopt (Option, Value'Address, 4);
end setsockopt;
This.Setsockopt (Option, Value'Address, 4);
end Setsockopt;
----------------
-- setsockopt --
----------------
not overriding procedure setsockopt
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);
end setsockopt;
This.Setsockopt (Option, Value (Value'First)'Address, Value'Length);
end Setsockopt;
-------------
-- Connect --
@ -205,12 +210,12 @@ package body ZMQ.Sockets is
(This : in out Socket;
Address : String)
is
addr : chars_ptr := Interfaces.C.Strings.New_String (Address);
ret : int;
Addr : chars_ptr := Interfaces.C.Strings.New_String (Address);
Ret : int;
begin
ret := Low_Level.zmq_connect (This.c, addr);
Free (addr);
if ret /= 0 then
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 " &
GNAT.Source_Info.Enclosing_Entity & "(" & Address & ")";
end if;
@ -228,51 +233,29 @@ package body ZMQ.Sockets is
-- Send --
----------
not overriding procedure Send
(This : in out Socket;
Msg : Messages.Message'Class;
Flags : Socket_Flags := No_Flags)
is
ret : int;
begin
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;
end if;
end Send;
not overriding
procedure Send (This : in out Socket;
Msg : String;
Flags : Socket_Flags := No_Flags) is
m : Messages.Message;
begin
m.Initialize (Msg);
This.Send (m, Flags);
m.Finalize;
This.Send (Msg'Address, Msg'Length, Flags);
end Send;
not overriding
procedure Send (This : in out Socket;
Msg : Ada.Streams.Stream_Element_Array;
Flags : Socket_Flags := No_Flags) is
M : Messages.Message;
begin
M.Initialize (Msg);
This.Send (M, Flags);
M.Finalize;
This.Send (Msg'Address, Msg'Length, Flags);
end Send;
not overriding
procedure Send (This : in out Socket;
Msg : Ada.Strings.Unbounded.Unbounded_String;
Flags : Socket_Flags := No_Flags) is
M : Messages.Message;
begin
M.Initialize (Ada.Strings.Unbounded.To_String (Msg));
This.Send (M, Flags);
M.Finalize;
This.Send (Ada.Strings.Unbounded.To_String (Msg), Flags);
end Send;
procedure Send_Generic (This : in out Socket;
@ -293,11 +276,15 @@ package body ZMQ.Sockets is
Msg_Addres : System.Address;
Msg_Length : Natural;
Flags : Socket_Flags := No_Flags) is
M : Messages.Message;
Ret : int;
begin
M.Initialize (Msg_Addres, Msg_Length);
This.Send (M, Flags);
M.Finalize;
Ret := Low_Level.zmq_send (This.C, Msg_Addres,
size_t (Msg_Length),
int (Flags));
if Ret /= 0 then
raise ZMQ_Error with Error_Message (GNAT.OS_Lib.Errno) & " in " &
GNAT.Source_Info.Enclosing_Entity;
end if;
end Send;
@ -321,342 +308,303 @@ package body ZMQ.Sockets is
-- recv --
----------
not overriding procedure recv
not overriding procedure Recv
(This : in Socket;
Msg : Messages.Message'Class;
Flags : Socket_Flags := No_Flags)
is
ret : int;
Ret : int;
begin
ret := Low_Level.zmq_recv (This.c,
Msg.getImpl,
int (Flags));
Ret := Low_Level.zmq_recvmsg (This.C,
Msg.GetImpl,
int (Flags));
if ret /= 0 then
if Ret /= 0 then
raise ZMQ_Error with Error_Message (GNAT.OS_Lib.Errno) & " in "
& GNAT.Source_Info.Enclosing_Entity;
end if;
end recv;
end Recv;
procedure recv (This : in Socket;
procedure Recv (This : in Socket;
Flags : Socket_Flags := No_Flags) is
dummy_Msg : Messages.Message;
Dummy_Msg : Messages.Message;
begin
dummy_Msg.Initialize;
This.recv (dummy_Msg, Flags);
dummy_Msg.Finalize;
end recv;
not overriding
function recv (This : in Socket;
Flags : Socket_Flags := No_Flags) return String is
Msg : Messages.Message;
begin
Msg.Initialize;
This.recv (Msg, Flags);
return ret : String (1 .. Msg.getSize) do
ret := Msg.getData;
end return;
end recv;
procedure recv (This : in Socket;
msg : out Ada.Strings.Unbounded.Unbounded_String;
Flags : Socket_Flags := No_Flags) is
begin
msg := Ada.Strings.Unbounded.To_Unbounded_String (This.recv (Flags));
end recv;
Dummy_Msg.Initialize;
This.Recv (Dummy_Msg, Flags);
Dummy_Msg.Finalize;
end Recv;
not overriding
function recv (This : in Socket;
function Recv (This : in Socket;
Max_Length : Natural := 1024;
Flags : Socket_Flags := No_Flags) return String is
Buffer : String (1 .. Max_Length);
begin
This.Recv (Buffer'Address, Buffer'Length, Flags);
end Recv;
procedure Recv (This : in Socket;
Msg : out Ada.Strings.Unbounded.Unbounded_String;
Flags : Socket_Flags := No_Flags) is
begin
Msg := Ada.Strings.Unbounded.To_Unbounded_String (This.Recv (Flags));
end Recv;
not overriding
function Recv (This : in Socket;
Flags : Socket_Flags := No_Flags)
return Ada.Strings.Unbounded.Unbounded_String is
begin
return ret : Ada.Strings.Unbounded.Unbounded_String do
This.recv (ret, Flags);
return Ret : Ada.Strings.Unbounded.Unbounded_String do
This.Recv (Ret, Flags);
end return;
end recv;
end Recv;
--------------
-- Finalize --
--------------
overriding procedure Finalize
(this : in out Socket)
(This : in out Socket)
is
ret : int;
Ret : int;
begin
if this.c /= Null_Address then
ret := Low_Level.zmq_close (this.c);
this.c := Null_Address;
if ret /= 0 then
if This.C /= Null_Address then
Ret := Low_Level.zmq_close (This.C);
This.C := Null_Address;
if Ret /= 0 then
raise ZMQ_Error with Error_Message (GNAT.OS_Lib.Errno);
end if;
end if;
end Finalize;
not overriding
procedure Set_high_water_mark (This : in out Socket;
Value : Natural) is
begin
This.setsockopt (HWM, Value);
end Set_high_water_mark;
not overriding
procedure Set_disk_offload_size (This : in out Socket;
Value : Natural) is
begin
This.setsockopt (SWAP, Value);
end Set_disk_offload_size;
not overriding
procedure Set_IO_thread_affinity (This : in out Socket;
procedure Set_IO_Thread_Affinity (This : in out Socket;
Value : Natural) is
begin
This.setsockopt (AFFINITY, Value);
end Set_IO_thread_affinity;
This.Setsockopt (AFFINITY, Value);
end Set_IO_Thread_Affinity;
not overriding
procedure Set_socket_identity
procedure Set_Socket_Identity
(This : in out Socket;
Value : Ada.Streams.Stream_Element_Array) is
begin
This.setsockopt (IDENTITY, Value);
end Set_socket_identity;
This.Setsockopt (IDENTITY, Value);
end Set_Socket_Identity;
procedure Set_socket_identity
procedure Set_Socket_Identity
(This : in out Socket;
Value : String) is
begin
This.setsockopt (IDENTITY, Value);
end Set_socket_identity;
This.Setsockopt (IDENTITY, Value);
end Set_Socket_Identity;
not overriding
procedure Establish_message_filter (This : in out Socket;
procedure Establish_Message_Filter (This : in out Socket;
Value : String) is
begin
This.setsockopt (SUBSCRIBE, Value);
end Establish_message_filter;
This.Setsockopt (SUBSCRIBE, Value);
end Establish_Message_Filter;
not overriding
procedure Establish_message_filter
procedure Establish_Message_Filter
(This : in out Socket;
Value : Ada.Streams.Stream_Element_Array) is
begin
This.setsockopt (SUBSCRIBE, Value);
end Establish_message_filter;
This.Setsockopt (SUBSCRIBE, Value);
end Establish_Message_Filter;
procedure Establish_message_filter
procedure Establish_Message_Filter
(This : in out Socket;
Value : Ada.Strings.Unbounded.Unbounded_String) is
begin
This.setsockopt (SUBSCRIBE, To_String (Value));
end Establish_message_filter;
This.Setsockopt (SUBSCRIBE, To_String (Value));
end Establish_Message_Filter;
not overriding
procedure Remove_message_filter (This : in out Socket;
procedure Remove_Message_Filter (This : in out Socket;
Value : String) is
begin
This.setsockopt (UNSUBSCRIBE, Value);
end Remove_message_filter;
This.Setsockopt (UNSUBSCRIBE, Value);
end Remove_Message_Filter;
procedure Remove_message_filter
procedure Remove_Message_Filter
(This : in out Socket;
Value : Ada.Strings.Unbounded.Unbounded_String) is
begin
This.setsockopt (UNSUBSCRIBE, To_String (Value));
end Remove_message_filter;
This.Setsockopt (UNSUBSCRIBE, To_String (Value));
end Remove_Message_Filter;
procedure Remove_message_filter
procedure Remove_Message_Filter
(This : in out Socket;
Value : Ada.Streams.Stream_Element_Array) is
begin
This.setsockopt (UNSUBSCRIBE, Value);
end Remove_message_filter;
This.Setsockopt (UNSUBSCRIBE, Value);
end Remove_Message_Filter;
not overriding
procedure Set_multicast_data_rate (This : in out Socket;
procedure Set_Multicast_Data_Rate (This : in out Socket;
Value : Natural) is
begin
This.setsockopt (RATE, Value);
end Set_multicast_data_rate;
This.Setsockopt (RATE, Value);
end Set_Multicast_Data_Rate;
not overriding
procedure set_multicast_recovery_interval (This : in out Socket;
procedure Set_Multicast_Recovery_Interval (This : in out Socket;
Value : Duration) is
begin
This.setsockopt (RECOVERY_IVL, Integer (Value));
end set_multicast_recovery_interval;
This.Setsockopt (RECOVERY_IVL, Integer (Value));
end Set_Multicast_Recovery_Interval;
not overriding
procedure Set_multicast_loopback (This : in out Socket;
Enable : Boolean) is
begin
This.setsockopt (HWM, Enable);
end Set_multicast_loopback;
not overriding
procedure Set_kernel_transmit_buffer_size (This : in out Socket;
procedure Set_Kernel_Transmit_Buffer_Size (This : in out Socket;
Value : Natural) is
begin
This.setsockopt (SNDBUF, Value);
end Set_kernel_transmit_buffer_size;
This.Setsockopt (SNDBUF, Value);
end Set_Kernel_Transmit_Buffer_Size;
not overriding
procedure Set_kernel_receive_buffer_size (This : in out Socket;
procedure Set_Kernel_Receive_Buffer_Size (This : in out Socket;
Value : Natural) is
begin
This.setsockopt (RCVBUF, Value);
end Set_kernel_receive_buffer_size;
This.Setsockopt (RCVBUF, Value);
end Set_Kernel_Receive_Buffer_Size;
function get_impl (This : in Socket) return System.Address is
function Get_Impl (This : in Socket) return System.Address is
begin
return This.c;
end get_impl;
return This.C;
end Get_Impl;
-------------
not overriding
procedure getsockopt (This : in Socket;
procedure Getsockopt (This : in Socket;
Option : Socket_Opt;
Value : System.Address;
Value_Size : out Natural) is
ret : int;
Value_Size_i : aliased size_t;
Ret : int;
Value_Size_I : aliased size_t;
begin
ret := Low_Level.zmq_getsockopt
(This.c,
Ret := Low_Level.zmq_getsockopt
(This.C,
Map (Option),
Value,
Value_Size_i'Access);
Value_Size := Natural (Value_Size_i);
if ret /= 0 then
Value_Size_I'Access);
Value_Size := Natural (Value_Size_I);
if Ret /= 0 then
raise ZMQ_Error with Error_Message (GNAT.OS_Lib.Errno) & " in " &
GNAT.Source_Info.Enclosing_Entity & "(" & Option'Img & ")";
end if;
end getsockopt;
end Getsockopt;
not overriding
function getsockopt (This : in Socket;
function Getsockopt (This : in Socket;
Option : Socket_Opt) return unsigned_long is
Dummy_Value_Size : Natural;
begin
return ret : unsigned_long do
This.getsockopt (Option, ret'Address, Dummy_Value_Size);
return Ret : unsigned_long do
This.Getsockopt (Option, Ret'Address, Dummy_Value_Size);
if Dummy_Value_Size /= 8 then
raise Program_Error with "Invalid getsockopt for this type";
end if;
end return;
end getsockopt;
end Getsockopt;
function getsockopt (This : in Socket;
function Getsockopt (This : in Socket;
Option : Socket_Opt) return String is
Buffer : aliased String (1 .. MAX_OPTION_SIZE);
Value_Size : Natural;
begin
This.getsockopt (Option, Buffer'Address, Value_Size);
This.Getsockopt (Option, Buffer'Address, Value_Size);
return Buffer (1 .. Value_Size);
end getsockopt;
end Getsockopt;
not overriding
function getsockopt (This : in Socket;
function Getsockopt (This : in Socket;
Option : Socket_Opt) return Boolean is
begin
return ret : Boolean do
ret := unsigned_long'(This.getsockopt (Option)) /= 0;
return Ret : Boolean do
Ret := unsigned_long'(This.Getsockopt (Option)) /= 0;
end return;
end getsockopt;
end Getsockopt;
not overriding
function getsockopt (This : in Socket;
function Getsockopt (This : in Socket;
Option : Socket_Opt) return Natural is
begin
return ret : Natural do
ret := Natural (unsigned_long'(This.getsockopt (Option)));
return Ret : Natural do
Ret := Natural (unsigned_long'(This.Getsockopt (Option)));
end return;
end getsockopt;
end Getsockopt;
not overriding
function getsockopt
function Getsockopt
(This : in Socket;
Option : Socket_Opt) return Ada.Streams.Stream_Element_Array is
Buffer : aliased Stream_Element_Array (1 .. MAX_OPTION_SIZE);
Value_Size : Ada.Streams.Stream_Element_Offset;
begin
This.getsockopt (Option, Buffer'Address, Natural (Value_Size));
This.Getsockopt (Option, Buffer'Address, Natural (Value_Size));
return Buffer (1 .. Value_Size);
end getsockopt;
end Getsockopt;
function More_message_parts_to_follow (This : Socket) return Boolean is
function More_Message_Parts_To_Follow (This : Socket) return Boolean is
begin
return ret : Boolean do
ret := This.getsockopt (RCVMORE);
return Ret : Boolean do
Ret := This.Getsockopt (RCVMORE);
end return;
end More_message_parts_to_follow;
end More_Message_Parts_To_Follow;
function Get_high_water_mark (This : Socket) return Natural is
begin
return ret : Natural do
ret := This.getsockopt (HWM);
end return;
end Get_high_water_mark;
function Get_disk_offload_size (This : Socket) return Natural is
begin
return ret : Natural do
ret := This.getsockopt (SWAP);
end return;
end Get_disk_offload_size;
function Get_IO_thread_affinity (This : Socket) return Thread_Bitmap is
function Get_IO_Thread_Affinity (This : Socket) return Thread_Bitmap is
Value_Size : Natural;
begin
return ret : Thread_Bitmap do
This.getsockopt (AFFINITY, ret'Address, Value_Size);
return Ret : Thread_Bitmap do
This.Getsockopt (AFFINITY, Ret'Address, Value_Size);
if Value_Size /= 8 then
raise Program_Error with "Invalid bitmap size " & Value_Size'Img;
end if;
end return;
end Get_IO_thread_affinity;
end Get_IO_Thread_Affinity;
function Get_socket_identity
function Get_Socket_Identity
(This : Socket) return Ada.Streams.Stream_Element_Array is
begin
return This.getsockopt (IDENTITY);
end Get_socket_identity;
return This.Getsockopt (IDENTITY);
end Get_Socket_Identity;
function Get_multicast_data_rate (This : Socket) return Natural is
function Get_Multicast_Data_Rate (This : Socket) return Natural is
begin
return This.getsockopt (RATE);
end Get_multicast_data_rate;
return This.Getsockopt (RATE);
end Get_Multicast_Data_Rate;
function Get_multicast_recovery_interval (This : Socket) return Duration is
function Get_Multicast_Recovery_Interval (This : Socket) return Duration is
begin
return Duration (unsigned_long'(This.getsockopt (RECOVERY_IVL)));
end Get_multicast_recovery_interval;
return Duration (unsigned_long'(This.Getsockopt (RECOVERY_IVL)));
end Get_Multicast_Recovery_Interval;
function Get_multicast_loopback (This : Socket) return Boolean is
function Get_Kernel_Transmit_Buffer_Size (This : Socket) return Natural is
begin
return This.getsockopt (MCAST_LOOP);
end Get_multicast_loopback;
return This.Getsockopt (SNDBUF);
end Get_Kernel_Transmit_Buffer_Size;
function Get_kernel_transmit_buffer_size (This : Socket) return Natural is
function Get_Kernel_Receive_Buffer_Size (This : Socket) return Natural is
begin
return This.getsockopt (SNDBUF);
end Get_kernel_transmit_buffer_size;
function Get_kernel_receive_buffer_size (This : Socket) return Natural is
begin
return This.getsockopt (RCVBUF);
end Get_kernel_receive_buffer_size;
return This.Getsockopt (RCVBUF);
end Get_Kernel_Receive_Buffer_Size;
end ZMQ.Sockets;

496
src/zmq-sockets.ads
View File

@ -29,14 +29,13 @@
-- OTHER DEALINGS IN THE SOFTWARE. --
-------------------------------------------------------------------------------
with Ada.Streams;
with Ada.Finalization;
with Ada.Strings.Unbounded;
with ZMQ.Messages;
with ZMQ.Contexts;
with ZMQ.Messages;
with System;
with GNAT.OS_Lib;
private with Interfaces.C;
package ZMQ.Sockets is
@ -49,64 +48,43 @@ package ZMQ.Sockets is
XREQ,
XREP,
PULL,
PUSH);
PUSH,
XPUB,
XSUB);
type Socket
(With_Context : Contexts.Any_Context;
Kind : Socket_Type) is
new Ada.Finalization.Limited_Controlled with private;
type Socket is new Ada.Finalization.Limited_Controlled with private;
type Socket_Flags is mod 2 ** 32;
pragma Warnings (off);
pragma Warnings (Off);
function "+" (L, R : Socket_Flags) return Socket_Flags renames "or";
pragma Warnings (on);
pragma Warnings (On);
No_Flags : constant Socket_Flags := 2#0000_0000_0000_0000#;
More : constant Socket_Flags := 2#0000_0000_0000_0001#;
Shared : constant Socket_Flags := 2#0000_0000_1000_0000#;
not overriding
procedure Initialize (This : in out Socket;
With_Context : Contexts.Context;
Kind : Socket_Type);
not overriding
procedure Bind (This : in out Socket;
Address : String);
procedure Bind
(This : in out Socket;
Address : String);
not overriding
procedure Bind (This : in out Socket;
Address : Ada.Strings.Unbounded.Unbounded_String);
procedure Bind
(This : in out Socket;
Address : Ada.Strings.Unbounded.Unbounded_String);
not overriding
procedure Set_high_water_mark
(This : in out Socket;
Value : Natural);
-- Sets the high water mark for the specified socket.
-- The high water mark is a hard limit on the maximum number of
-- outstanding messages 0MQ shall queue in memory for any single peer
-- that the specified socket is communicating with.
-- If this limit has been reached the socket shall enter an exceptional
-- state and depending on the socket type,
-- 0MQ shall take appropriate action such as blocking or dropping
-- sent messages.
-- Refer to the individual socket descriptions in zmq_socket(3)
-- for details on the exact action taken for each socket type.
-- The default ZMQ_HWM value of zero means "no limit".
not overriding
procedure Set_disk_offload_size (This : in out Socket;
Value : Natural);
-- Sets the disk offload (swap) size < for the specified socket.
-- A socket which has ZMQ_SWAP set to a non - zero value may exceed
-- in this case outstanding messages shall be offloaded to storage on
-- disk rather than held in memory.
-- The value defines the maximum size of the swap space in bytes
not overriding
procedure Set_IO_thread_affinity (This : in out Socket;
Value : Natural);
procedure Set_IO_Thread_Affinity
(This : in out Socket;
Value : Natural);
-- Sets the I/O thread affinity for newly created connections on the
-- specified socket.
-- Affinity determines which threads from the 0MQ I/O thread pool
@ -123,13 +101,13 @@ package ZMQ.Sockets is
-- of I/O threads for a specific context.
not overriding
procedure Set_socket_identity
(This : in out Socket;
Value : String);
procedure Set_Socket_Identity
(This : in out Socket;
Value : String);
not overriding
procedure Set_socket_identity
(This : in out Socket;
Value : Ada.Streams.Stream_Element_Array);
procedure Set_Socket_Identity
(This : in out Socket;
Value : Ada.Streams.Stream_Element_Array);
-- Sets the identity of the specified socket.
-- Socket identity determines if existing 0MQ infastructure
-- (message queues, forwarding devices) shall be identified with a specific
@ -146,15 +124,17 @@ package ZMQ.Sockets is
-- by 0MQ infrastructure.
not overriding
procedure Establish_message_filter (This : in out Socket;
Value : String);
procedure Establish_Message_Filter
(This : in out Socket;
Value : String);
not overriding
procedure Establish_message_filter
(This : in out Socket;
Value : Ada.Strings.Unbounded.Unbounded_String);
procedure Establish_message_filter
(This : in out Socket;
Value : Ada.Streams.Stream_Element_Array);
procedure Establish_Message_Filter
(This : in out Socket;
Value : Ada.Strings.Unbounded.Unbounded_String);
not overriding
procedure Establish_Message_Filter
(This : in out Socket;
Value : Ada.Streams.Stream_Element_Array);
-- Establishes a new message filter on a SUB socket.
-- Newly created SUB sockets filters out all incoming messages,
-- therefore you should call this option to establish an initial
@ -168,16 +148,17 @@ package ZMQ.Sockets is
-- if it matches at least one filter.
not overriding
procedure Remove_message_filter (This : in out Socket;
Value : String);
procedure Remove_Message_Filter
(This : in out Socket;
Value : String);
not overriding
procedure Remove_message_filter
(This : in out Socket;
Value : Ada.Strings.Unbounded.Unbounded_String);
procedure Remove_Message_Filter
(This : in out Socket;
Value : Ada.Strings.Unbounded.Unbounded_String);
not overriding
procedure Remove_message_filter
(This : in out Socket;
Value : Ada.Streams.Stream_Element_Array);
procedure Remove_Message_Filter
(This : in out Socket;
Value : Ada.Streams.Stream_Element_Array);
-- Remove an existing message filter on a SUB socket.
-- The filter specified must match an existing filter previously
-- established with "Establish_message_filter".
@ -186,14 +167,16 @@ package ZMQ.Sockets is
-- leaving the rest in place and functional.
not overriding
procedure Set_multicast_data_rate (This : in out Socket;
Value : Natural);
procedure Set_Multicast_Data_Rate
(This : in out Socket;
Value : Natural);
-- Sets the maximum send or receive data rate for multicast transports
-- such as PGM using the specified socket.
not overriding
procedure set_multicast_recovery_interval (This : in out Socket;
Value : Duration);
procedure Set_Multicast_Recovery_Interval
(This : in out Socket;
Value : Duration);
-- Sets the recovery interval in seconds for multicast transports using
-- the specified socket.
-- The recovery interval determines the maximum time in seconds that a
@ -205,32 +188,21 @@ package ZMQ.Sockets is
-- For example, a 1 minute recovery interval at a data rate of
-- 1Gbps requires a 7GB in-memory buffer.
not overriding
procedure Set_multicast_loopback (This : in out Socket;
Enable : Boolean);
-- Controls whether data sent via multicast transports using
-- the specified socket can also be received by the sending host
-- via loopback.
-- A value of False disables the loopback functionality,
-- while the default value of True enables the loopback functionality.
-- Leaving multicast loopback enabled when it is not required can have
-- a negative impact on performance.
-- Where possible, disable multicast_loopback
-- in production environments.
not overriding
procedure Set_kernel_transmit_buffer_size (This : in out Socket;
Value : Natural);
procedure Set_Kernel_Transmit_Buffer_Size
(This : in out Socket;
Value : Natural);
-- Sets the underlying kernel transmit buffer size for the socket
-- to the specified size in bytes.
-- A value of zero means leave the OS default unchanged.
-- For details please refer to your operating system documentation
-- for the SO_SNDBUF socket option.
not overriding
procedure Set_kernel_receive_buffer_size (This : in out Socket;
Value : Natural);
procedure Set_Kernel_Receive_Buffer_Size
(This : in out Socket;
Value : Natural);
-- Sets the underlying kernel receive buffer size for the socket to
-- the specified size in bytes.
-- A value of zero means leave the OS default unchanged.
@ -238,34 +210,23 @@ package ZMQ.Sockets is
-- SO_RCVBUF socket option.
function More_message_parts_to_follow (This : Socket) return Boolean;
not overriding
function More_Message_Parts_To_Follow (This : Socket) return Boolean;
-- Returns True if the multi-part message currently being read from the
-- specified socket has more message parts to follow.
-- If there are no message parts to follow or if the message currently
-- being read is not a multi-part message a value of True will be returned.
-- Otherwise, False will be returned.
function Get_high_water_mark (This : Socket) return Natural;
-- Returns the high water mark for the specified socket.
-- The high water mark is a hard limit on the maximum number of outstanding
-- messages ZMQ shall queue in memory for any single peer that
-- the specified socket is communicating with.
-- If this limit has been reached the socket shall enter an exceptional
-- state and depending on the socket type, ZMQ shall take appropriate
-- action such as blocking or dropping sent messages.
-- The default high_water_mark value of zero means "no limit".
function Get_disk_offload_size (This : Socket) return Natural;
-- Returns the disk offload (swap) size for the specified socket.
-- A socket which has SWAP set to a non-zero value may exceed
-- in this case outstanding messages shall be offloaded to storage on disk
-- rather than held in memory.
-- The value of defines the maximum size of the swap space in bytes.
type Thread_Bitmap is array (0 .. 63) of Boolean;
pragma Pack (Thread_Bitmap);
function Get_IO_thread_affinity (This : Socket) return Thread_Bitmap;
function Get_IO_Thread_Affinity (This : Socket) return Thread_Bitmap;
-- Returns the I/O thread affinity for newly created connections
-- on the specified socket.
-- Affinity determines which threads from the ZMQ I/O thread pool
@ -278,8 +239,9 @@ package ZMQ.Sockets is
-- a value of 3 specifies that subsequent connections on socket shall be
-- handled exclusively by I/O threads 1 and 2.
function Get_socket_identity
(This : Socket) return Ada.Streams.Stream_Element_Array;
function Get_Socket_Identity
(This : Socket)
return Ada.Streams.Stream_Element_Array;
-- Returns the identity of the specified socket.
-- Socket identity determines if existing ZMQ infastructure
-- (message queues, forwarding devices) shall be identified with a specific
@ -295,68 +257,62 @@ package ZMQ.Sockets is
-- Identities starting with binary zero are reserved for use by the
-- ZMQ infrastructure.
function Get_multicast_data_rate (This : Socket) return Natural;
function Get_Multicast_Data_Rate (This : Socket) return Natural;
-- Returns the maximum send or receive data rate for multicast transports
-- using the specified socket.
function Get_multicast_recovery_interval (This : Socket) return Duration;
function Get_Multicast_Recovery_Interval (This : Socket) return Duration;
-- Retrieves the recovery interval for multicast transports using the
-- specified socket.
-- The recovery interval determines the maximum time in seconds that
-- a receiver can be absent from a multicast group before unrecoverable
-- data loss will occur.
function Get_multicast_loopback (This : Socket) return Boolean;
-- Returns True if multicast transports shall be recievd bye the
-- loopback interface.
function Get_kernel_transmit_buffer_size (This : Socket) return Natural;
function Get_Kernel_Transmit_Buffer_Size (This : Socket) return Natural;
-- Returns the underlying kernel transmit buffer size for the
-- specified socket.
-- A value of zero means that the OS default is in effect.
-- For details refer to your operating system documentation for
-- the SO_SNDBUF socket option.
function Get_kernel_receive_buffer_size (This : Socket) return Natural;
function Get_Kernel_Receive_Buffer_Size (This : Socket) return Natural;
-- Returns the underlying kernel receive buffer size for the
-- specified socket.
-- A value of zero means that the OS default is in effect.
-- For details refer to your operating system documentation
-- for the SO_RCVBUF socket option
not overriding
procedure Connect (This : in out Socket;
Address : String);
procedure Connect (This : in out Socket;
Address : Ada.Strings.Unbounded.Unbounded_String);
not overriding procedure Connect
(This : in out Socket;
Address : String);
not overriding
procedure Send (This : in out Socket;
Msg : Messages.Message'Class;
Flags : Socket_Flags := No_Flags);
procedure Connect
(This : in out Socket;
Address : Ada.Strings.Unbounded.Unbounded_String);
not overriding
procedure Send (This : in out Socket;
Msg : String;
Flags : Socket_Flags := No_Flags);
not overriding
procedure Send (This : in out Socket;
Msg : Ada.Strings.Unbounded.Unbounded_String;
Flags : Socket_Flags := No_Flags);
not overriding procedure Send
(This : in out Socket;
Msg : String;
Flags : Socket_Flags := No_Flags);
not overriding
procedure Send (This : in out Socket;
Msg : Ada.Streams.Stream_Element_Array;
Flags : Socket_Flags := No_Flags);
not overriding procedure Send
(This : in out Socket;
Msg : Ada.Strings.Unbounded.Unbounded_String;
Flags : Socket_Flags := No_Flags);
not overriding
procedure Send (This : in out Socket;
Msg_Addres : System.Address;
Msg_Length : Natural;
Flags : Socket_Flags := No_Flags);
not overriding procedure Send
(This : in out Socket;
Msg : Ada.Streams.Stream_Element_Array;
Flags : Socket_Flags := No_Flags);
not overriding procedure Send
(This : in out Socket;
Msg_Addres : System.Address;
Msg_Length : Natural;
Flags : Socket_Flags := No_Flags);
-- Queues the message referenced by the msg argument to be sent to socket
-- The flags argument is a combination of the flags defined below:
-- NOBLOCK
@ -392,123 +348,195 @@ package ZMQ.Sockets is
generic
type Element is private;
procedure Send_Generic (This : in out Socket;
Msg : Element;
Flags : Socket_Flags := No_Flags);
procedure Send_Generic
(This : in out Socket;
Msg : Element;
Flags : Socket_Flags := No_Flags);
-- not overriding
-- procedure flush (This : in out Socket);
not overriding
procedure recv (This : in Socket;
Msg : Messages.Message'Class;
Flags : Socket_Flags := No_Flags);
procedure recv (This : in Socket;
msg : out Ada.Strings.Unbounded.Unbounded_String;
Flags : Socket_Flags := No_Flags);
procedure Recv
(This : in Socket;
Msg : out Ada.Strings.Unbounded.Unbounded_String;
Flags : Socket_Flags := No_Flags);
not overriding function Recv
(This : in Socket;
Flags : Socket_Flags := No_Flags)
return String;
not overriding function Recv
(This : in Socket;
Flags : Socket_Flags := No_Flags)
return Ada.Strings.Unbounded.Unbounded_String;
not overriding procedure Recv
(This : in Socket;
Msg : Messages.Message'Class;
Flags : Socket_Flags := No_Flags);
procedure Recv (This : in Socket; Flags : Socket_Flags := No_Flags);
not overriding
function recv (This : in Socket;
Flags : Socket_Flags := No_Flags) return String;
not overriding
function recv (This : in Socket;
Flags : Socket_Flags := No_Flags)
return Ada.Strings.Unbounded.Unbounded_String;
procedure recv (This : in Socket;
Flags : Socket_Flags := No_Flags);
overriding
procedure Finalize (this : in out Socket);
procedure Close (this : in out Socket) renames Finalize;
procedure Close (This : in out Socket) renames Finalize;
--
type Socket_Monitor is limited interface;
type Any_Socket_Monitor is access all Socket_Monitor'Class;
procedure Connected
(This : Socket_Monitor;
Address : String;
Fd : GNAT.OS_Lib.File_Descriptor) is null;
procedure Connect_Delayed
(This : Socket_Monitor;
Address : String;
Err : Integer) is null;
procedure Connect_Retried
(This : Socket_Monitor;
Address : String;
Interval : Duration) is null;
procedure Listening
(This : Socket_Monitor;
Address : String;
Fd : GNAT.OS_Lib.File_Descriptor) is null;
procedure Bind_Failed
(This : Socket_Monitor;
Address : String;
Err : Integer) is null;
procedure Accepted
(This : Socket_Monitor;
Address : String;
Fd : GNAT.OS_Lib.File_Descriptor) is null;
procedure Accept_Failed
(This : Socket_Monitor;
Address : String;
Err : Integer) is null;
procedure Closed
(This : Socket_Monitor;
Address : String;
Fd : GNAT.OS_Lib.File_Descriptor) is null;
procedure Close_Failed
(This : Socket_Monitor;
Address : String;
Err : Integer) is null;
procedure Disconnected
(This : Socket_Monitor;
Address : String;
Fd : GNAT.OS_Lib.File_Descriptor) is null;
procedure Set_Monitor (This : Socket;
Monitor : Any_Socket_Monitor);
-- function "=" (Left, Right : in Context) return Boolean;
function get_impl (This : in Socket) return System.Address;
function Get_Impl (This : in Socket) return System.Address;
private
type Socket is new Ada.Finalization.Limited_Controlled with record
c : System.Address := System.Null_Address;
type Socket
(With_Context : Contexts.Any_Context;
Kind : Socket_Type)
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;
function Img (Item : Ada.Streams.Stream_Element_Array) return String;
overriding
procedure Initialize
(This : in out Socket);
overriding
procedure Finalize (This : in out Socket);
type Socket_Opt is
(HWM,
SWAP,
AFFINITY,
IDENTITY,
SUBSCRIBE,
UNSUBSCRIBE,
RATE,
RECOVERY_IVL,
MCAST_LOOP,
SNDBUF,
RCVBUF,
RCVMORE,
FD,
EVENTS,
GET_TYPE,
LINGER,
RECONNECT_IVL,
BACKLOG);
type Socket_Opt is (AFFINITY,
IDENTITY,
SUBSCRIBE,
UNSUBSCRIBE,
RATE,
RECOVERY_IVL,
SNDBUF,
RCVBUF,
RCVMORE,
FD,
EVENTS,
GET_TYPE,
LINGER,
RECONNECT_IVL,
BACKLOG, ---
RECONNECT_IVL_MAX,
MAXMSGSIZE,
SNDHWM,
RCVHWM,
MULTICAST_HOPS,
RCVTIMEO,
SNDTIMEO,
IPV4ONLY,
LAST_ENDPOINT,
ROUTER_BEHAVIOR,
TCP_KEEPALIVE,
TCP_KEEPALIVE_CNT,
TCP_KEEPALIVE_IDLE,
TCP_KEEPALIVE_INTVL,
TCP_ACCEPT_FILTER,
DELAY_ATTACH_ON_CONNECT,
XPUB_VERBOSE);
not overriding
procedure setsockopt (This : in out Socket;
Option : Socket_Opt;
Value : String);
not overriding
procedure setsockopt (This : in out Socket;
Option : Socket_Opt;
Value : Boolean);
not overriding
procedure setsockopt (This : in out Socket;
Option : Socket_Opt;
Value : Natural);
not overriding
procedure setsockopt
(This : in out Socket;
Option : Socket_Opt;
Value : Ada.Streams.Stream_Element_Array);
not overriding
procedure setsockopt (This : in out Socket;
Option : Socket_Opt;
Value : System.Address;
Value_Size : Natural);
not overriding procedure Setsockopt
(This : in out Socket;
Option : Socket_Opt;
Value : String);
not overriding procedure Setsockopt
(This : in out Socket;
Option : Socket_Opt;
Value : Boolean);
not overriding procedure Setsockopt
(This : in out Socket;
Option : Socket_Opt;
Value : Natural);
not overriding procedure Setsockopt
(This : in out Socket;
Option : Socket_Opt;
Value : Ada.Streams.Stream_Element_Array);
not overriding procedure Setsockopt
(This : in out Socket;
Option : Socket_Opt;
Value : System.Address;
Value_Size : Natural);
--------------------------------------------------------
--------------------------------------------------------
function getsockopt (This : in Socket;
Option : Socket_Opt) return String;
not overriding
function getsockopt (This : in Socket;
Option : Socket_Opt) return Boolean;
not overriding
function getsockopt (This : in Socket;
Option : Socket_Opt) return Natural;
not overriding
function getsockopt
(This : in Socket;
Option : Socket_Opt) return Interfaces.C.unsigned_long;
function Getsockopt
(This : in Socket;
Option : Socket_Opt)
return String;
not overriding function Getsockopt
(This : in Socket;
Option : Socket_Opt)
return Boolean;
not overriding function Getsockopt
(This : in Socket;
Option : Socket_Opt)
return Natural;
not overriding function Getsockopt
(This : in Socket;
Option : Socket_Opt)
return Interfaces.C.unsigned_long;
not overriding
function getsockopt
(This : in Socket;
Option : Socket_Opt) return Ada.Streams.Stream_Element_Array;
not overriding function Getsockopt
(This : in Socket;
Option : Socket_Opt)
return Ada.Streams.Stream_Element_Array;
not overriding
procedure getsockopt (This : in Socket;
Option : Socket_Opt;
Value : System.Address;
Value_Size : out Natural);
not overriding procedure Getsockopt
(This : in Socket;
Option : Socket_Opt;
Value : System.Address;
Value_Size : out Natural);
MAX_OPTION_SIZE : constant := 256;

515
src/zmq-sockets.ads.npp Normal file
View File

@ -0,0 +1,515 @@
-------------------------------------------------------------------------------
-- --
-- 0MQ Ada-binding --
-- --
-- Z M Q . S O C K E T S --
-- --
-- S p e c --
-- --
-- Copyright (C) 2010-2011, per.sandberg@bredband.net --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files --
-- (the "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, sublicense, and / or sell copies of the Software, and to --
-- permit persons to whom the Software is furnished to do so, subject to --
-- the following conditions : --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, --
-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL --
-- THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR --
-- OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, --
-- ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR --
-- OTHER DEALINGS IN THE SOFTWARE. --
-------------------------------------------------------------------------------
with Ada.Streams;
with Ada.Finalization;
with Ada.Strings.Unbounded;
with ZMQ.Messages;
with ZMQ.Contexts;
with System;
private with Interfaces.C;
package ZMQ.Sockets is
type Socket_Type is
(PAIR,
PUB,
SUB,
REQ,
REP,
XREQ,
XREP,
PULL,
PUSH);
type Socket is new Ada.Finalization.Limited_Controlled with private;
type Socket_Flags is mod 2 ** 32;
pragma Warnings (Off);
function "+" (L, R : Socket_Flags) return Socket_Flags renames "or";
pragma Warnings (On);
No_Flags : constant Socket_Flags := 2#0000_0000_0000_0000#;
More : constant Socket_Flags := 2#0000_0000_0000_0001#;
Shared : constant Socket_Flags := 2#0000_0000_1000_0000#;
not overriding
procedure Initialize (This : in out Socket;
With_Context : Contexts.Context;
Kind : Socket_Type);
not overriding
procedure Bind (This : in out Socket;
Address : String);
not overriding
procedure Bind (This : in out Socket;
Address : Ada.Strings.Unbounded.Unbounded_String);
not overriding
procedure Set_High_Water_Mark
(This : in out Socket;
Value : Natural);
-- Sets the high water mark for the specified socket.
-- The high water mark is a hard limit on the maximum number of
-- outstanding messages 0MQ shall queue in memory for any single peer
-- that the specified socket is communicating with.
-- If this limit has been reached the socket shall enter an exceptional
-- state and depending on the socket type,
-- 0MQ shall take appropriate action such as blocking or dropping
-- sent messages.
-- Refer to the individual socket descriptions in zmq_socket(3)
-- for details on the exact action taken for each socket type.
-- The default ZMQ_HWM value of zero means "no limit".
not overriding
procedure Set_Disk_Offload_Size (This : in out Socket;
Value : Natural);
-- Sets the disk offload (swap) size < for the specified socket.
-- A socket which has ZMQ_SWAP set to a non - zero value may exceed
-- in this case outstanding messages shall be offloaded to storage on
-- disk rather than held in memory.
-- The value defines the maximum size of the swap space in bytes
not overriding
procedure Set_IO_Thread_Affinity (This : in out Socket;
Value : Natural);
-- Sets the I/O thread affinity for newly created connections on the
-- specified socket.
-- Affinity determines which threads from the 0MQ I/O thread pool
-- created connections.
-- A value of zero specifies no affinity, meaning that work shall be
-- distributed fairly among all 0MQ I/O threads in the thread pool.
-- For non-zero values,
-- the lowest bit corresponds to thread 1, second lowest bit to thread 2
-- and so on.
-- For example, a value of 3 specifies that subsequent connections on
-- socket shall behandled exclusively by I/O threads 1 and 2.
-- See also zmq_init(3) for details on allocating the number
-- of I/O threads for a specific context.
not overriding
procedure Set_Socket_Identity
(This : in out Socket;
Value : String);
not overriding
procedure Set_Socket_Identity
(This : in out Socket;
Value : Ada.Streams.Stream_Element_Array);
-- Sets the identity of the specified socket.
-- Socket identity determines if existing 0MQ infastructure
-- (message queues, forwarding devices) shall be identified with a specific
-- application and persist across multiple runs of the application.
-- If the socket has no identity, each run of an application is completely
-- separate from other runs. However, with identity set the socket shall
-- re-use any existing 0MQ infrastructure configured by the
-- previous run(s).
-- Thus the application may receive messages that were sent in the
-- meantime, message queue limits shall be shared with previous run(s)
-- and so on.
-- Identity should be at least one byte and at most 255 bytes long.
-- Identities starting with binary zero are reserved for use
-- by 0MQ infrastructure.
not overriding
procedure Establish_Message_Filter (This : in out Socket;
Value : String);
not overriding
procedure Establish_Message_Filter
(This : in out Socket;
Value : Ada.Strings.Unbounded.Unbounded_String);
procedure Establish_Message_Filter
(This : in out Socket;
Value : Ada.Streams.Stream_Element_Array);
-- Establishes a new message filter on a SUB socket.
-- Newly created SUB sockets filters out all incoming messages,
-- therefore you should call this option to establish an initial
-- message filter.
-- An empty option_value of length zero shall subscribe to all
-- incoming messages.
-- A non-empty option_value shall subscribe to all messages beginning
-- with the specified prefix.
-- Mutiple filters may be attached to a single SUB socket,
-- in which case a message shall be accepted
-- if it matches at least one filter.
not overriding
procedure Remove_Message_Filter (This : in out Socket;
Value : String);
not overriding
procedure Remove_Message_Filter
(This : in out Socket;
Value : Ada.Strings.Unbounded.Unbounded_String);
not overriding
procedure Remove_Message_Filter
(This : in out Socket;
Value : Ada.Streams.Stream_Element_Array);
-- Remove an existing message filter on a SUB socket.
-- The filter specified must match an existing filter previously
-- established with "Establish_message_filter".
-- If the socket has several instances of the same filter attached the
-- Remove_message_filter removes only one instance,
-- leaving the rest in place and functional.
not overriding
procedure Set_Multicast_Data_Rate (This : in out Socket;
Value : Natural);
-- Sets the maximum send or receive data rate for multicast transports
-- such as PGM using the specified socket.
not overriding
procedure Set_Multicast_Recovery_Interval (This : in out Socket;
Value : Duration);
-- Sets the recovery interval in seconds for multicast transports using
-- the specified socket.
-- The recovery interval determines the maximum time in seconds that a
-- receiver can be absent from a multicast group before unrecoverable
-- data loss will occur.
-- Caution:
-- Excersize care when setting large recovery intervals as the data needed
-- for recovery will be held in memory.
-- For example, a 1 minute recovery interval at a data rate of
-- 1Gbps requires a 7GB in-memory buffer.
not overriding
procedure Set_Multicast_Loopback (This : in out Socket;
Enable : Boolean);
-- Controls whether data sent via multicast transports using
-- the specified socket can also be received by the sending host
-- via loopback.
-- A value of False disables the loopback functionality,
-- while the default value of True enables the loopback functionality.
-- Leaving multicast loopback enabled when it is not required can have
-- a negative impact on performance.
-- Where possible, disable multicast_loopback
-- in production environments.
not overriding
procedure Set_Kernel_Transmit_Buffer_Size (This : in out Socket;
Value : Natural);
-- Sets the underlying kernel transmit buffer size for the socket
-- to the specified size in bytes.
-- A value of zero means leave the OS default unchanged.
-- For details please refer to your operating system documentation
-- for the SO_SNDBUF socket option.
not overriding
procedure Set_Kernel_Receive_Buffer_Size (This : in out Socket;
Value : Natural);
-- Sets the underlying kernel receive buffer size for the socket to
-- the specified size in bytes.
-- A value of zero means leave the OS default unchanged.
-- For details refer to your operating system documentation for the
-- SO_RCVBUF socket option.
function More_Message_Parts_To_Follow (This : Socket) return Boolean;
-- Returns True if the multi-part message currently being read from the
-- specified socket has more message parts to follow.
-- If there are no message parts to follow or if the message currently
-- being read is not a multi-part message a value of True will be returned.
-- Otherwise, False will be returned.
function Get_High_Water_Mark (This : Socket) return Natural;
-- Returns the high water mark for the specified socket.
-- The high water mark is a hard limit on the maximum number of outstanding
-- messages ZMQ shall queue in memory for any single peer that
-- the specified socket is communicating with.
-- If this limit has been reached the socket shall enter an exceptional
-- state and depending on the socket type, ZMQ shall take appropriate
-- action such as blocking or dropping sent messages.
-- The default high_water_mark value of zero means "no limit".
function Get_Disk_Offload_Size (This : Socket) return Natural;
-- Returns the disk offload (swap) size for the specified socket.
-- A socket which has SWAP set to a non-zero value may exceed
-- in this case outstanding messages shall be offloaded to storage on disk
-- rather than held in memory.
-- The value of defines the maximum size of the swap space in bytes.
type Thread_Bitmap is array (0 .. 63) of Boolean;
pragma Pack (Thread_Bitmap);
function Get_IO_Thread_Affinity (This : Socket) return Thread_Bitmap;
-- Returns the I/O thread affinity for newly created connections
-- on the specified socket.
-- Affinity determines which threads from the ZMQ I/O thread pool
-- created connections.
-- A value of zero specifies no affinity, meaning that work shall be
-- distributed fairly among all ZMQ I/O threads in the thread pool.
-- For non-zero values, the lowest bit corresponds to thread 1,
-- second lowest bit to thread 2 and so on. For example,
-- a value of 3 specifies that subsequent connections on socket shall be
-- handled exclusively by I/O threads 1 and 2.
function Get_Socket_Identity
(This : Socket) return Ada.Streams.Stream_Element_Array;
-- Returns the identity of the specified socket.
-- Socket identity determines if existing ZMQ infastructure
-- (message queues, forwarding devices) shall be identified with a specific
-- application and persist across multiple runs of the application.
-- If the socket has no identity, each run of an application is completely
-- separate from other runs. However, with identity set the socket shall
-- re-use any existing ZMQ infrastructure configured by the
-- previous run(s).
-- Thus the application may receive messages that were sent
-- in the meantime,
-- message queue limits shall be shared with previous run(s) and so on.
-- Identity can be at least one byte and at most 255 bytes long.
-- Identities starting with binary zero are reserved for use by the
-- ZMQ infrastructure.
function Get_Multicast_Data_Rate (This : Socket) return Natural;
-- Returns the maximum send or receive data rate for multicast transports
-- using the specified socket.
function Get_Multicast_Recovery_Interval (This : Socket) return Duration;
-- Retrieves the recovery interval for multicast transports using the
-- specified socket.
-- The recovery interval determines the maximum time in seconds that
-- a receiver can be absent from a multicast group before unrecoverable
-- data loss will occur.
function Get_Multicast_Loopback (This : Socket) return Boolean;
-- Returns True if multicast transports shall be recievd bye the
-- loopback interface.
function Get_Kernel_Transmit_Buffer_Size (This : Socket) return Natural;
-- Returns the underlying kernel transmit buffer size for the
-- specified socket.
-- A value of zero means that the OS default is in effect.
-- For details refer to your operating system documentation for
-- the SO_SNDBUF socket option.
function Get_Kernel_Receive_Buffer_Size (This : Socket) return Natural;
-- Returns the underlying kernel receive buffer size for the
-- specified socket.
-- A value of zero means that the OS default is in effect.
-- For details refer to your operating system documentation
-- for the SO_RCVBUF socket option
not overriding
procedure Connect (This : in out Socket;
Address : String);
procedure Connect (This : in out Socket;
Address : Ada.Strings.Unbounded.Unbounded_String);
not overriding
procedure Send (This : in out Socket;
Msg : Messages.Message'Class;
Flags : Socket_Flags := No_Flags);
not overriding
procedure Send (This : in out Socket;
Msg : String;
Flags : Socket_Flags := No_Flags);
not overriding
procedure Send (This : in out Socket;
Msg : Ada.Strings.Unbounded.Unbounded_String;
Flags : Socket_Flags := No_Flags);
not overriding
procedure Send (This : in out Socket;
Msg : Ada.Streams.Stream_Element_Array;
Flags : Socket_Flags := No_Flags);
not overriding
procedure Send (This : in out Socket;
Msg_Addres : System.Address;
Msg_Length : Natural;
Flags : Socket_Flags := No_Flags);
-- Queues the message referenced by the msg argument to be sent to socket
-- The flags argument is a combination of the flags defined below:
-- NOBLOCK
-- Specifies that the operation should be performed in non-blocking mode.
-- If the message cannot be queued on the socket,
-- the send function shall fail with errno set to EAGAIN.
-- SNDMORE
-- Specifies that the message being sent is a multi-part message,
-- and that further message parts are to follow.
-- Refer to the section regarding multi-part messages
-- below for a detailed description.
-- Note!
-- A successful invocation of send does not indicate that the message
-- has been transmitted to the network,
-- only that it has been queued on the socket and 0MQ has assumed
-- responsibility for the message.
-- Multi-part messages
-- A 0MQ message is composed of 1 or more message parts;
-- each message part is an independent zmq_msg_t in its own right.
-- 0MQ ensures atomic delivery of messages;
-- peers shall receive either all message parts of
-- a message or none at all.
-- The total number of message parts is unlimited.
--
-- An application wishing to send a multi-part message does so by
-- specifying the SNDMORE flag to send.
-- The presence of this flag indicates to 0MQ that the message being sent
-- is a multi-part message and that more message parts are to follow.
-- When the application wishes to send the final message part it does so
-- by calling zmq without the SNDMORE flag;
-- this indicates that no more message parts are to follow.
-- Creates a Message and sends it over the socket.
generic
type Element is private;
procedure Send_Generic (This : in out Socket;
Msg : Element;
Flags : Socket_Flags := No_Flags);
-- not overriding
-- procedure flush (This : in out Socket);
not overriding
procedure Recv (This : in Socket;
Msg : Messages.Message'Class;
Flags : Socket_Flags := No_Flags);
procedure Recv (This : in Socket;
Msg : out Ada.Strings.Unbounded.Unbounded_String;
Flags : Socket_Flags := No_Flags);
not overriding
function Recv (This : in Socket;
Flags : Socket_Flags := No_Flags) return String;
not overriding
function Recv (This : in Socket;
Flags : Socket_Flags := No_Flags)
return Ada.Strings.Unbounded.Unbounded_String;
procedure Recv (This : in Socket;
Flags : Socket_Flags := No_Flags);
overriding
procedure Finalize (This : in out Socket);
procedure Close (This : in out Socket) renames Finalize;
--
-- function "=" (Left, Right : in Context) return Boolean;
function Get_Impl (This : in Socket) return System.Address;
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;
type Socket_Opt is
(HWM,
SWAP,
AFFINITY,
IDENTITY,
SUBSCRIBE,
UNSUBSCRIBE,
RATE,
RECOVERY_IVL,
MCAST_LOOP,
SNDBUF,
RCVBUF,
RCVMORE,
FD,
EVENTS,
GET_TYPE,
LINGER,
RECONNECT_IVL,
BACKLOG);
not overriding
procedure Setsockopt (This : in out Socket;
Option : Socket_Opt;
Value : String);
not overriding
procedure Setsockopt (This : in out Socket;
Option : Socket_Opt;
Value : Boolean);
not overriding
procedure Setsockopt (This : in out Socket;
Option : Socket_Opt;
Value : Natural);
not overriding
procedure Setsockopt
(This : in out Socket;
Option : Socket_Opt;
Value : Ada.Streams.Stream_Element_Array);
not overriding
procedure Setsockopt (This : in out Socket;
Option : Socket_Opt;
Value : System.Address;
Value_Size : Natural);
--------------------------------------------------------
--------------------------------------------------------
function Getsockopt (This : in Socket;
Option : Socket_Opt) return String;
not overriding
function Getsockopt (This : in Socket;
Option : Socket_Opt) return Boolean;
not overriding
function Getsockopt (This : in Socket;
Option : Socket_Opt) return Natural;
not overriding
function Getsockopt
(This : in Socket;
Option : Socket_Opt) return Interfaces.C.Unsigned_Long;
not overriding
function Getsockopt
(This : in Socket;
Option : Socket_Opt) return Ada.Streams.Stream_Element_Array;
not overriding
procedure Getsockopt (This : in Socket;
Option : Socket_Opt;
Value : System.Address;
Value_Size : out Natural);
MAX_OPTION_SIZE : constant := 256;
end ZMQ.Sockets;

19
src/zmq.adb
View File

@ -39,11 +39,11 @@ package body ZMQ is
-- Error_Message --
-------------------
function Error_Message (no : Integer) return String is
s : constant String := no'Img;
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)));
Interfaces.C.Strings.Value (Low_Level.zmq_strerror (int (No)));
end Error_Message;
function Library_Version return Version_Type is
@ -59,21 +59,22 @@ package body ZMQ is
end return;
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;
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 Image;
procedure Validate_Library_Version is
Lib_Version : constant Version_Type := Library_Version;
begin
Ada.Assertions.Assert ((Binding_Version.Major = Lib_Version.Major) and
(Binding_Version.Minor = Lib_Version.Minor),
"Incopatible Library" & image (Lib_Version));
"Incopatible Library " & Image (Lib_Version));
end Validate_Library_Version;
end ZMQ;

12
src/zmq.ads
View File

@ -34,18 +34,18 @@ package ZMQ is
pragma Preelaborate;
ZMQ_Error : exception;
type Version_Type is record
Major : Natural;
Minor : Natural;
Patch : Natural;
Major : aliased Natural;
Minor : aliased Natural;
Patch : aliased Natural;
end record;
Binding_Version : constant Version_Type := (2, 1, 0);
Binding_Version : constant Version_Type := (3, 3, 0);
function Library_Version return Version_Type;
function image (item : Version_Type) return String;
function Image (Item : Version_Type) return String;
private
function Error_Message (no : Integer) return String;
function Error_Message (No : Integer) return String;
procedure Validate_Library_Version;
-- Raiese ZMQ_Error if the underlaying library isent a valid version

25
tests/testcases/zmq-tests-testcases-test_pubsub.adb Normal file → Executable file
View File

@ -1,5 +1,6 @@
with GNAT.Source_Info;
with Ada.Strings.Unbounded;
with AUnit.Assertions; use AUnit.Assertions;
package body ZMQ.Tests.Testcases.Test_Pubsub is
use AUnit;
use Ada.Strings.Unbounded;
@ -23,29 +24,29 @@ package body ZMQ.Tests.Testcases.Test_Pubsub is
-------------------------
-- initialize
-------------------------
procedure initialize (Test : in out AUnit.Test_Cases.Test_Case'Class) is
procedure Initialize (Test : in out AUnit.Test_Cases.Test_Case'Class) is
T : Test_Case renames Test_Case (Test);
begin
T.Ctx.Initialize (1);
T.pub.Initialize (T.Ctx, Sockets.PUB);
T.Ctx.Initialize;
T.Pub.Initialize (T.Ctx, Sockets.PUB);
T.Sub.Initialize (T.Ctx, Sockets.SUB);
T.Sub.Establish_message_filter ("");
T.Sub.Establish_Message_Filter ("");
T.Sub.Bind ("inproc://pub-sub");
T.pub.Connect ("inproc://pub-sub");
end initialize;
T.Pub.Connect ("inproc://pub-sub");
end Initialize;
-------------------------
-- Publish
-------------------------
procedure Send (Test : in out AUnit.Test_Cases.Test_Case'Class) is
T : Test_Case renames Test_Case (Test);
msg : Ada.Strings.Unbounded.Unbounded_String;
Msg : Ada.Strings.Unbounded.Unbounded_String;
begin
T.pub.Send (MSG_STRING);
T.Sub.recv (msg);
T.Assert (msg = MSG_STRING, "Error");
T.Pub.Send (MSG_STRING);
T.Sub.Recv (Msg);
Assert (Msg = MSG_STRING, "Error");
end Send;
-------------------------
@ -54,7 +55,7 @@ package body ZMQ.Tests.Testcases.Test_Pubsub is
procedure Finalize (Test : in out AUnit.Test_Cases.Test_Case'Class) is
T : Test_Case renames Test_Case (Test);
begin
T.pub.Finalize;
T.Pub.Finalize;
T.Sub.Finalize;
T.Ctx.Finalize;
end Finalize;
@ -66,7 +67,7 @@ package body ZMQ.Tests.Testcases.Test_Pubsub is
use Test_Cases.Registration;
begin
Register_Routine (T, initialize'Access, "initialize");
Register_Routine (T, Initialize'Access, "initialize");
Register_Routine (T, Send'Access, "Send");
Register_Routine (T, Finalize'Access, "Finalize");
end Register_Tests;

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

@ -7,7 +7,7 @@ package ZMQ.Tests.Testcases.Test_Pubsub is
type Test_Case is new AUnit.Test_Cases.Test_Case with record
Ctx : ZMQ.Contexts.Context;
pub : ZMQ.Sockets.Socket;
Pub : ZMQ.Sockets.Socket;
Sub : ZMQ.Sockets.Socket;
end record;

78
tests/testcases/zmq-tests-testcases-test_reqresp.adb Normal file
View File

@ -0,0 +1,78 @@
with GNAT.Source_Info;
with Ada.Strings.Unbounded;
with AUnit.Assertions; use AUnit.Assertions;
package body ZMQ.Tests.Testcases.Test_REQRESP is
use AUnit;
use Ada.Strings.Unbounded;
MSG_STRING : constant Unbounded_String := To_Unbounded_String ("Query");
----------
-- Name --
----------
function Name (T : Test_Case)
return AUnit.Message_String is
pragma Unreferenced (T);
begin
return Format (GNAT.Source_Info.File);
end Name;
-------------------------
-- initialize
-------------------------
procedure Initialize (Test : in out AUnit.Test_Cases.Test_Case'Class) is
T : Test_Case renames Test_Case (Test);
begin
T.Ctx.Initialize;
T.Sub.Initialize (T.Ctx, Sockets.REP);
T.Sub.Bind ("inproc://req");
T.Pub.Initialize (T.Ctx, Sockets.REQ);
T.Pub.Connect ("inproc://req");
end Initialize;
-------------------------
-- Publish
-------------------------
procedure Send (Test : in out AUnit.Test_Cases.Test_Case'Class) is
T : Test_Case renames Test_Case (Test);
Msg : Ada.Strings.Unbounded.Unbounded_String;
begin
T.Pub.Send (MSG_STRING);
T.Sub.Recv (Msg);
T.Sub.Send (Msg);
T.Pub.Recv (Msg);
Assert (Msg = MSG_STRING, "Error");
end Send;
-------------------------
-- Subscribe
-------------------------
procedure Finalize (Test : in out AUnit.Test_Cases.Test_Case'Class) is
T : Test_Case renames Test_Case (Test);
begin
T.Pub.Finalize;
T.Sub.Finalize;
T.Ctx.Finalize;
end Finalize;
--------------------
-- Register_Tests --
--------------------
procedure Register_Tests (T : in out Test_Case) is
use Test_Cases.Registration;
begin
Register_Routine (T, Initialize'Access, "initialize");
Register_Routine (T, Send'Access, "Send");
Register_Routine (T, Finalize'Access, "Finalize");
end Register_Tests;
end ZMQ.Tests.TestCases.Test_REQRESP;

21
tests/testcases/zmq-tests-testcases-test_reqresp.ads Normal file
View File

@ -0,0 +1,21 @@
with AUnit;
with AUnit.Test_Cases;
with ZMQ.Contexts;
with ZMQ.Sockets;
package ZMQ.Tests.Testcases.Test_REQRESP is
type Test_Case;
type Test_Case is new AUnit.Test_Cases.Test_Case with record
Ctx : ZMQ.Contexts.Context;
Pub : ZMQ.Sockets.Socket;
Sub : ZMQ.Sockets.Socket;
end record;
procedure Register_Tests (T : in out Test_Case);
-- Register routines to be run
function Name (T : Test_Case)
return AUnit.Message_String;
-- Returns name identifying the test case
end ZMQ.Tests.TestCases.Test_REQRESP;

3
tests/zmq-tests-testsuits-test_all.adb
View File

@ -27,6 +27,7 @@
-- Import tests and sub-suites to run
with ZMQ.Tests.TestCases.Test_Compile;
with ZMQ.Tests.TestCases.Test_Pubsub;
with ZMQ.Tests.TestCases.Test_REQRESP;
package body ZMQ.Tests.Testsuits.Test_All is
use AUnit.Test_Suites;
@ -38,6 +39,7 @@ package body ZMQ.Tests.Testsuits.Test_All is
-- Statically allocate test cases:
Test_1 : aliased TestCases.Test_Compile.Test_Case;
Test_2 : aliased TestCases.Test_Pubsub.Test_Case;
Test_3 : aliased TestCases.Test_REQRESP.Test_Case;
-----------
-- Suite --
-----------
@ -46,6 +48,7 @@ package body ZMQ.Tests.Testsuits.Test_All is
begin
Add_Test (Result'Access, Test_1'Access);
Add_Test (Result'Access, Test_2'Access);
Add_Test (Result'Access, Test_3'Access);
return Result'Access;
end Suite;

5
zmq.gpr Normal file → Executable file
View File

@ -29,13 +29,13 @@
-- covered by the GNU Public License. --
-- --
------------------------------------------------------------------------------
with "libzmq.gpr";
project ZMQ is
For Languages use ("Ada");
type ZMQ_Kind_Type is ("static", "relocatable");
ZMQ_Kind : ZMQ_Kind_Type := external ("LIBRARY_TYPE", "static");
Version := "2.1.0";
Version := "3.2.0";
for Library_Name use "zmqAda";
for Library_Version use "lib" & project'Library_Name & ".so." &Version;
@ -67,7 +67,6 @@ project ZMQ is
for Switches("zmq-low_level.ads") use
Compiler'Default_Switches ("ada") & ("-gnaty-M");
-- Since this file is "autogenerated".
end Compiler;

3
zmq.gpr.inst
View File

@ -14,6 +14,7 @@ project Zmq is
when "relocatable" =>
for Library_Kind use "dynamic";
end case;
package Linker is
end Linker;
end Zmq;