diff --git a/.gitignore b/.gitignore index 266af39..f8762b0 100644 --- a/.gitignore +++ b/.gitignore @@ -11,3 +11,5 @@ metrix.xml gnatcheck.out gnatcheck-source-list.out +*.tgz +.dist diff --git a/Makefile b/Makefile index 7cc8ab6..441d688 100644 --- a/Makefile +++ b/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`))" >${@} diff --git a/doc/fedora.spec b/doc/fedora.spec index 99689d5..c0ebf47 100644 --- a/doc/fedora.spec +++ b/doc/fedora.spec @@ -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 diff --git a/examples/zmq-examples.gpr b/examples/zmq-examples.gpr index 03cdbac..5c41bd6 100755 --- a/examples/zmq-examples.gpr +++ b/examples/zmq-examples.gpr @@ -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 diff --git a/helpers/getinfo.adb b/helpers/getinfo.adb index 2e2f1f5..df67a78 100644 --- a/helpers/getinfo.adb +++ b/helpers/getinfo.adb @@ -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; diff --git a/helpers/zmq-helpers.gpr b/helpers/zmq-helpers.gpr index 38e93dc..a47f670 100644 --- a/helpers/zmq-helpers.gpr +++ b/helpers/zmq-helpers.gpr @@ -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; diff --git a/src/zmq-contexts.ads b/src/zmq-contexts.ads index 6c4acc0..ec0fd45 100644 --- a/src/zmq-contexts.ads +++ b/src/zmq-contexts.ads @@ -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; diff --git a/src/zmq-sockets.adb b/src/zmq-sockets.adb index 4a09070..3dada3e 100644 --- a/src/zmq-sockets.adb +++ b/src/zmq-sockets.adb @@ -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; diff --git a/src/zmq-sockets.ads b/src/zmq-sockets.ads index 81b2ab2..c7e3e99 100644 --- a/src/zmq-sockets.ads +++ b/src/zmq-sockets.ads @@ -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; diff --git a/src/zmq-utilities-memory_streams.ads b/src/zmq-utilities-memory_streams.ads index 9350e6e..0932a51 100644 --- a/src/zmq-utilities-memory_streams.ads +++ b/src/zmq-utilities-memory_streams.ads @@ -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; diff --git a/tests/testcases/zmq-tests-testcases-test_reqresp.adb b/tests/testcases/zmq-tests-testcases-test_reqresp.adb index 305f3fe..cdcc92b 100644 --- a/tests/testcases/zmq-tests-testcases-test_reqresp.adb +++ b/tests/testcases/zmq-tests-testcases-test_reqresp.adb @@ -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; ------------------------- diff --git a/zmq.gpr b/zmq.gpr index 051e1a4..1f53e9b 100644 --- a/zmq.gpr +++ b/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");