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

Working

This commit is contained in:
Per Sandberg 2013-04-11 16:55:39 +02:00
parent 4b9dbc4247
commit 16d8705194
12 changed files with 141 additions and 108 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitignore vendored
View File

@ -11,3 +11,5 @@ metrix.xml
gnatcheck.out
gnatcheck-source-list.out
*.tgz
.dist

28
Makefile
View File

@ -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`))" >${@}

6
doc/fedora.spec
View File

@ -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

4
examples/zmq-examples.gpr
View File

@ -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

8
helpers/getinfo.adb
View File

@ -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;

7
helpers/zmq-helpers.gpr
View File

@ -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;

2
src/zmq-contexts.ads
View File

@ -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;

79
src/zmq-sockets.adb
View File

@ -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;

95
src/zmq-sockets.ads
View File

@ -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;

2
src/zmq-utilities-memory_streams.ads
View File

@ -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;

12
tests/testcases/zmq-tests-testcases-test_reqresp.adb
View File

@ -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
View File

@ -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");