Working
This commit is contained in:
parent
4b9dbc4247
commit
16d8705194
|
@ -11,3 +11,5 @@ metrix.xml
|
|||
gnatcheck.out
|
||||
gnatcheck-source-list.out
|
||||
|
||||
*.tgz
|
||||
.dist
|
||||
|
|
28
Makefile
28
Makefile
|
@ -1,15 +1,17 @@
|
|||
|
||||
ifndef PREFIX
|
||||
PREFIX=$(dir $(shell dirname `which gnatls`))
|
||||
endif
|
||||
|
||||
include Makefile.config
|
||||
|
||||
LIBDIR ?= ${PREFIX}/lib
|
||||
DESTDIR ?=
|
||||
DESTDIR ?=
|
||||
GNATFLAGS ?=
|
||||
ADA_PROJECT_DIR ?= ${PREFIX}/lib/gnat
|
||||
GNATMAKE = gnatmake ${GNATFLAGS} -p -f -R
|
||||
GNATMAKE = gnatmake ${GNATFLAGS} -p -f -R
|
||||
|
||||
|
||||
compile:
|
||||
${GNATMAKE} -P zmq.gpr -XLIBRARY_TYPE=static
|
||||
${GNATMAKE} -P zmq.gpr -XLIBRARY_TYPE=relocatable
|
||||
${GNATMAKE} -P zmq.gpr -XLIBRARY_TYPE=relocatable
|
||||
|
||||
uninstall:
|
||||
rm -rf ${DESTDIR}/${PREFIX}/include/zmq ${DESTDIR}/${LIBDIR}/zmq ${DESTDIR}/${ADA_PROJECT_DIR}/zmq.gpr
|
||||
|
@ -44,13 +46,23 @@ generate:
|
|||
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
|
||||
|
||||
|
||||
setup:
|
||||
${MAKE} -C eBindings install
|
||||
|
||||
test:
|
||||
${MAKE} -C tests
|
||||
|
||||
dist:
|
||||
rm -rf .dist
|
||||
gprbuild -p -P helpers/zmq-helpers.gpr -XLIBRARY_TYPE=static
|
||||
git clone . .dist/zeromq-ada-$(shell helpers/getinfo --binding-version)
|
||||
rm -rf .dist/zeromq-ada-$(shell helpers/getinfo --binding-version)/.git
|
||||
cd .dist; tar -czf ../zeromq-ada-$(shell helpers/getinfo --binding-version).tgz *
|
||||
|
||||
Makefile.config:Makefile
|
||||
echo "PREFIX=$(dir $(shell dirname `which gnatls`))" >${@}
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
Name: zeromq-ada
|
||||
Version: 2.0.10
|
||||
Version: 3.2.0
|
||||
Release: 1%{?dist}
|
||||
Summary: Ada binding for zeromq
|
||||
|
||||
|
@ -16,7 +16,7 @@ Requires: zeromq >= %{version}
|
|||
Ada bindings for zeromq
|
||||
|
||||
%prep
|
||||
%setup -q -n zeromq-Ada
|
||||
%setup -q -n zeromq-ada
|
||||
%patch0 -p1
|
||||
|
||||
%build
|
||||
|
@ -39,7 +39,7 @@ rm -f %{buildroot}/usr/lib/zmq/static/libzmqAda.a
|
|||
%files
|
||||
%defattr(-,root,root,-)
|
||||
%doc README
|
||||
/usr/lib/zmq/relocatable/libzmqAda.so.2.1.0
|
||||
/usr/lib/zmq/relocatable/libzmqAda.so.%{version}
|
||||
|
||||
|
||||
%files devel
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
with "../zmq.gpr";
|
||||
with "xmlada.gpr";
|
||||
-- with "gnatcoll.gpr";
|
||||
with "gnatcoll.gpr";
|
||||
|
||||
project ZMQ.Examples is
|
||||
for Main use ("zmq-examples-client.adb",
|
||||
|
@ -22,7 +22,7 @@ project ZMQ.Examples is
|
|||
|
||||
|
||||
package Compiler is
|
||||
for Default_Switches ("ada") use ZMQ.Compiler'Default_Switches ("ada");
|
||||
for Default_Switches ("ada") use ZMQ.Compiler'Default_Switches ("ada") & ("-gnatyyM128");
|
||||
end Compiler;
|
||||
|
||||
package Binder is
|
||||
|
|
|
@ -16,6 +16,7 @@ procedure getinfo is
|
|||
Put_Line
|
||||
(command_Name & " [options]" & LF &
|
||||
"Options:" & LF &
|
||||
" --ada-library-version Print Ada-Library version" & LF &
|
||||
" --binding-version Print Binding version" & LF &
|
||||
" --library-version Print version of the 0mq library." & LF &
|
||||
" -? | -h | --help Print this text");
|
||||
|
@ -25,6 +26,7 @@ procedure getinfo is
|
|||
begin
|
||||
loop
|
||||
case Getopt ("-binding-version " &
|
||||
"-ada-library-version " &
|
||||
"-library-version " &
|
||||
"h ? -help") is -- Accepts '-a', '-ad', or '-b argument'
|
||||
when ASCII.NUL => exit;
|
||||
|
@ -35,9 +37,11 @@ begin
|
|||
|
||||
when '-' =>
|
||||
if Full_Switch = "-binding-version" then
|
||||
Put_Line (ZMQ.image (ZMQ.Binding_Version));
|
||||
Put_Line (ZMQ.Image (ZMQ.Binding_Version));
|
||||
elsif Full_Switch = "-library-version" then
|
||||
Put_Line (ZMQ.image (ZMQ.Library_Version));
|
||||
Put_Line (ZMQ.Image (ZMQ.Library_Version));
|
||||
elsif Full_Switch = "-ada-library-version" then
|
||||
Put_Line ($version);
|
||||
elsif Full_Switch = "-help" then
|
||||
help;
|
||||
return;
|
||||
|
|
|
@ -4,8 +4,11 @@ project ZMQ.helpers is
|
|||
for Object_Dir use ".obj";
|
||||
for Exec_Dir use ".";
|
||||
|
||||
package Compiler renames zmq.Compiler;
|
||||
-- package Binder renames zmq.Binder;
|
||||
package Compiler is
|
||||
for Default_Switches ("ada") use ZMQ.Compiler'Default_Switches ("ada");
|
||||
for Switches("getinfo.adb") use
|
||||
Compiler'Default_Switches ("ada") & ("-gnateDversion=""" & ZMQ.Version & """");
|
||||
end Compiler;
|
||||
package IDE renames zmq.IDE;
|
||||
|
||||
end ZMQ.helpers;
|
||||
|
|
|
@ -36,7 +36,7 @@ package ZMQ.Contexts is
|
|||
IO_THREADS_DFLT : constant := 1;
|
||||
MAX_SOCKETS_DFLT : constant := 1024;
|
||||
|
||||
type Context is tagged limited private;
|
||||
type Context is new Ada.Finalization.Limited_Controlled with private;
|
||||
type Any_Context is access all Context'Class;
|
||||
|
||||
|
||||
|
|
|
@ -110,7 +110,7 @@ package body ZMQ.Sockets is
|
|||
Free (Addr);
|
||||
if Ret /= 0 then
|
||||
raise ZMQ_Error with Error_Message (GNAT.OS_Lib.Errno) & " in " &
|
||||
GNAT.Source_Info.Enclosing_Entity & "(" & Address & ")";
|
||||
GNAT.Source_Info.Enclosing_Entity & "(""" & Address & """)";
|
||||
end if;
|
||||
end Bind;
|
||||
|
||||
|
@ -132,7 +132,7 @@ package body ZMQ.Sockets is
|
|||
Free (Addr);
|
||||
if Ret /= 0 then
|
||||
raise ZMQ_Error with Error_Message (GNAT.OS_Lib.Errno) & " in " &
|
||||
GNAT.Source_Info.Enclosing_Entity & "(" & Address & ")";
|
||||
GNAT.Source_Info.Enclosing_Entity & "(""" & Address & """)";
|
||||
end if;
|
||||
end UnBind;
|
||||
|
||||
|
@ -227,7 +227,7 @@ package body ZMQ.Sockets is
|
|||
Free (Addr);
|
||||
if Ret /= 0 then
|
||||
raise ZMQ_Error with Error_Message (GNAT.OS_Lib.Errno) & " in " &
|
||||
GNAT.Source_Info.Enclosing_Entity & "(" & Address & ")";
|
||||
GNAT.Source_Info.Enclosing_Entity & "(""" & Address & """)";
|
||||
end if;
|
||||
end Connect;
|
||||
|
||||
|
@ -249,7 +249,7 @@ package body ZMQ.Sockets is
|
|||
Free (Addr);
|
||||
if Ret /= 0 then
|
||||
raise ZMQ_Error with Error_Message (GNAT.OS_Lib.Errno) & " in " &
|
||||
GNAT.Source_Info.Enclosing_Entity & "(" & Address & ")";
|
||||
GNAT.Source_Info.Enclosing_Entity & "(""" & Address & """)";
|
||||
end if;
|
||||
end DisConnect;
|
||||
|
||||
|
@ -291,16 +291,6 @@ package body ZMQ.Sockets is
|
|||
This.Send (Ada.Strings.Unbounded.To_String (Msg), Flags);
|
||||
end Send;
|
||||
|
||||
procedure Send_Generic (This : in out Socket;
|
||||
Msg : Element;
|
||||
Flags : Socket_Flags := No_Flags) is
|
||||
begin
|
||||
This.Send
|
||||
(Msg'Address,
|
||||
(Msg'Size + Ada.Streams.Stream_Element'Size - 1) /
|
||||
Ada.Streams.Stream_Element'Size,
|
||||
Flags);
|
||||
end Send_Generic;
|
||||
|
||||
not overriding
|
||||
|
||||
|
@ -379,16 +369,58 @@ package body ZMQ.Sockets is
|
|||
This.Recv (Dummy_Msg, Flags);
|
||||
end Recv;
|
||||
|
||||
not overriding
|
||||
function Recv
|
||||
(This : in Socket;
|
||||
Flags : Socket_Flags := No_Flags) return Messages.Message is
|
||||
begin
|
||||
return Ret : Messages.Message do
|
||||
This.Recv (Ret, Flags);
|
||||
end return;
|
||||
end Recv;
|
||||
|
||||
not overriding
|
||||
procedure Recv
|
||||
(This : in Socket;
|
||||
Handler : not null access procedure (This : in Socket; Data : String);
|
||||
Flags : Socket_Flags := No_Flags) is
|
||||
Msg : Messages.Message := This.Recv (Flags);
|
||||
type Msg_Str is new String (1 .. Msg.GetSize);
|
||||
package Conv is new System.Address_To_Access_Conversions (Msg_Str);
|
||||
begin
|
||||
Handler (This, String (Conv.To_Pointer (Msg.GetData).all));
|
||||
end Recv;
|
||||
|
||||
not overriding
|
||||
procedure Recv
|
||||
(This : in Socket;
|
||||
Msg_Address : System.Address;
|
||||
Msg_Length : Natural;
|
||||
Flags : Socket_Flags := No_Flags) is
|
||||
Ret : int;
|
||||
begin
|
||||
Ret := Low_Level.zmq_recv
|
||||
(This.C,
|
||||
buf => Msg_Address,
|
||||
len => size_t (Msg_Length),
|
||||
flags => int (Flags));
|
||||
if Ret = -1 then
|
||||
raise ZMQ_Error with Error_Message (GNAT.OS_Lib.Errno) & " in "
|
||||
& GNAT.Source_Info.Enclosing_Entity;
|
||||
end if;
|
||||
end Recv;
|
||||
not overriding
|
||||
function Recv (This : in Socket;
|
||||
Max_Length : Natural := 1024;
|
||||
Flags : Socket_Flags := No_Flags) return String is
|
||||
-- Buffer : String (1 .. Max_Length);
|
||||
Msg : Messages.Message;
|
||||
begin
|
||||
-- This.Recv (Buffer'Address, Buffer'Length, Flags);
|
||||
raise Program_Error with "function Recv not implemented";
|
||||
return "dummy";
|
||||
This.Recv (Msg, Flags);
|
||||
if Msg.GetSize > Max_Length then
|
||||
raise Constraint_Error with
|
||||
"Message to long " & Msg.GetSize'Img & ">" & Max_Length'Img & ".";
|
||||
end if;
|
||||
return Msg.GetData;
|
||||
end Recv;
|
||||
|
||||
procedure Recv (This : in Socket;
|
||||
|
@ -1196,8 +1228,15 @@ package body ZMQ.Sockets is
|
|||
procedure Set_Monitor
|
||||
(This : Socket;
|
||||
Address : String;
|
||||
Mask : Mask_Type) is
|
||||
Mask : Event_Type) is
|
||||
Addr : chars_ptr := Interfaces.C.Strings.New_String (Address);
|
||||
Ret : int;
|
||||
begin
|
||||
null;
|
||||
Ret := Low_Level.zmq_socket_monitor (This.Get_Impl, Addr, int (Mask));
|
||||
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;
|
||||
end Set_Monitor;
|
||||
end ZMQ.Sockets;
|
||||
|
|
|
@ -94,7 +94,7 @@ package ZMQ.Sockets is
|
|||
(This : in out Socket;
|
||||
Address : Ada.Strings.Unbounded.Unbounded_String);
|
||||
|
||||
type Thread_Bitmap is array (0 .. 63) of Boolean;
|
||||
type Thread_Bitmap is array (1 .. 64) of Boolean;
|
||||
pragma Pack (Thread_Bitmap);
|
||||
|
||||
not overriding
|
||||
|
@ -784,25 +784,6 @@ package ZMQ.Sockets is
|
|||
-- this indicates that no more message parts are to follow.
|
||||
-- Creates a Message and sends it over the socket.
|
||||
|
||||
generic
|
||||
type Element is private;
|
||||
pragma Compile_Time_Error
|
||||
(Element'Has_Access_Values, "No access values allowed in Element");
|
||||
procedure Send_Generic
|
||||
(This : in out Socket;
|
||||
Msg : Element;
|
||||
Flags : Socket_Flags := No_Flags);
|
||||
|
||||
-- generic
|
||||
-- type Element is private;
|
||||
-- with procedure Write (S : access Ada.Streams.Root_Stream_Type'Class;
|
||||
-- Data : Element);
|
||||
-- procedure Send_Indefinite_Generic
|
||||
-- (This : in out Socket;
|
||||
-- Msg : Element;
|
||||
-- Flags : Socket_Flags := No_Flags);
|
||||
-- not overriding
|
||||
-- procedure flush (This : in out Socket);
|
||||
|
||||
|
||||
not overriding
|
||||
|
@ -830,6 +811,23 @@ package ZMQ.Sockets is
|
|||
Msg : in out Messages.Message'Class;
|
||||
Flags : Socket_Flags := No_Flags);
|
||||
|
||||
function Recv
|
||||
(This : in Socket;
|
||||
Flags : Socket_Flags := No_Flags) return Messages.Message;
|
||||
|
||||
not overriding
|
||||
procedure Recv
|
||||
(This : in Socket;
|
||||
Handler : not null access procedure (This : in Socket; Data : String);
|
||||
Flags : Socket_Flags := No_Flags);
|
||||
|
||||
not overriding
|
||||
procedure Recv
|
||||
(This : in Socket;
|
||||
Msg_Address : System.Address;
|
||||
Msg_Length : Natural;
|
||||
Flags : Socket_Flags := No_Flags);
|
||||
|
||||
not overriding
|
||||
procedure Recv
|
||||
(This : in Socket;
|
||||
|
@ -838,54 +836,23 @@ package ZMQ.Sockets is
|
|||
not overriding
|
||||
procedure Close (This : in out Socket) renames Finalize;
|
||||
|
||||
type Event_Type is mod 2 ** 32;
|
||||
EVENT_CONNECTED : constant Event_Type := 2#0000_0000_0001#;
|
||||
EVENT_CONNECT_DELAYED : constant Event_Type := 2#0000_0000_0010#;
|
||||
EVENT_CONNECT_RETRIED : constant Event_Type := 2#0000_0000_0100#;
|
||||
EVENT_LISTENING : constant Event_Type := 2#0000_0000_1000#;
|
||||
EVENT_BIND_FAILED : constant Event_Type := 2#0000_0001_0000#;
|
||||
EVENT_ACCEPTED : constant Event_Type := 2#0000_0010_0000#;
|
||||
EVENT_ACCEPT_FAILED : constant Event_Type := 2#0000_0100_0000#;
|
||||
EVENT_CLOSED : constant Event_Type := 2#0000_1000_0000#;
|
||||
EVENT_CLOSE_FAILED : constant Event_Type := 2#0001_0000_0000#;
|
||||
EVENT_DISCONNECTED : constant Event_Type := 2#0010_0000_0000#;
|
||||
EVENT_ALL : constant Event_Type := 2#0011_1111_1111#;
|
||||
|
||||
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;
|
||||
type Mask_Type is mod 2 ** 32;
|
||||
procedure Set_Monitor
|
||||
(This : Socket;
|
||||
Address : String;
|
||||
Mask : Mask_Type);
|
||||
Mask : Event_Type);
|
||||
|
||||
|
||||
function Get_Impl (This : in Socket) return System.Address;
|
||||
|
|
|
@ -175,7 +175,7 @@ package ZMQ.Utilities.Memory_Streams is
|
|||
|
||||
private
|
||||
subtype large_buffer is
|
||||
Streams.Stream_Element_Array (1 .. Streams.Stream_Element_Offset'Last);
|
||||
Streams.Stream_Element_Array (0 .. Streams.Stream_Element_Offset'Last);
|
||||
type Large_Buffer_Access is access large_buffer;
|
||||
for Large_Buffer_Access'Storage_Size use 0;
|
||||
|
||||
|
|
|
@ -5,7 +5,9 @@ package body ZMQ.Tests.Testcases.Test_REQRESP is
|
|||
use AUnit;
|
||||
use Ada.Strings.Unbounded;
|
||||
|
||||
MSG_STRING : constant Unbounded_String := To_Unbounded_String ("Query");
|
||||
REQUEST_STRING : constant Unbounded_String := To_Unbounded_String ("Query");
|
||||
RESPONSE_STRING : constant Unbounded_String :=
|
||||
To_Unbounded_String ("Reply");
|
||||
|
||||
|
||||
----------
|
||||
|
@ -44,11 +46,13 @@ package body ZMQ.Tests.Testcases.Test_REQRESP is
|
|||
T : Test_Case renames Test_Case (Test);
|
||||
Msg : Ada.Strings.Unbounded.Unbounded_String;
|
||||
begin
|
||||
T.Pub.Send (MSG_STRING);
|
||||
T.Pub.Send (REQUEST_STRING);
|
||||
T.Sub.Recv (Msg);
|
||||
T.Sub.Send (Msg);
|
||||
Assert (Msg = REQUEST_STRING, "Error");
|
||||
|
||||
T.Sub.Send (RESPONSE_STRING);
|
||||
T.Pub.Recv (Msg);
|
||||
Assert (Msg = MSG_STRING, "Error");
|
||||
Assert (Msg = RESPONSE_STRING, "Error");
|
||||
end Send;
|
||||
|
||||
-------------------------
|
||||
|
|
4
zmq.gpr
4
zmq.gpr
|
@ -38,11 +38,12 @@ project ZMQ is
|
|||
Version := "3.2.0";
|
||||
|
||||
for Library_Name use "zmqAda";
|
||||
for Library_Version use "lib" & project'Library_Name & ".so." &Version;
|
||||
for Library_Version use "lib" & project'Library_Name & ".so." & Version;
|
||||
for Library_Dir use "lib/" & ZMQ_Kind;
|
||||
for Object_Dir use ".obj/" & ZMQ_Kind;
|
||||
|
||||
for Source_Dirs use ("src");
|
||||
-- ,"_src-exprimental");
|
||||
|
||||
case ZMQ_Kind is
|
||||
when "static" =>
|
||||
|
@ -56,6 +57,7 @@ project ZMQ is
|
|||
"ZMQ.devices",
|
||||
"ZMQ.messages",
|
||||
"ZMQ.sockets",
|
||||
"ZMQ.proxys",
|
||||
"ZMQ.low_level",
|
||||
"ZMQ.Utilities",
|
||||
"ZMQ.Utilities.Memory_Streams");
|
||||
|
|
Loading…
Reference in New Issue