Skip to content

Commit

Permalink
Working
Browse files Browse the repository at this point in the history
  • Loading branch information
Per Sandberg committed Apr 11, 2013
1 parent 4b9dbc4 commit 16d8705
Show file tree
Hide file tree
Showing 12 changed files with 141 additions and 108 deletions.
2 changes: 2 additions & 0 deletions .gitignore
Original file line number Diff line number Diff line change
Expand Up @@ -11,3 +11,5 @@ metrix.xml
gnatcheck.out
gnatcheck-source-list.out

*.tgz
.dist
28 changes: 20 additions & 8 deletions Makefile
Original file line number Diff line number Diff line change
@@ -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
Expand Down Expand Up @@ -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 changes: 3 additions & 3 deletions doc/fedora.spec
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
Name: zeromq-ada
Version: 2.0.10
Version: 3.2.0
Release: 1%{?dist}
Summary: Ada binding for zeromq

Expand All @@ -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
Expand All @@ -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
Expand Down
4 changes: 2 additions & 2 deletions examples/zmq-examples.gpr
Original file line number Diff line number Diff line change
@@ -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",
Expand All @@ -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
Expand Down
8 changes: 6 additions & 2 deletions helpers/getinfo.adb
Original file line number Diff line number Diff line change
Expand Up @@ -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");
Expand All @@ -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;
Expand All @@ -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;
Expand Down
7 changes: 5 additions & 2 deletions helpers/zmq-helpers.gpr
Original file line number Diff line number Diff line change
Expand Up @@ -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;
Expand Down
2 changes: 1 addition & 1 deletion src/zmq-contexts.ads
Original file line number Diff line number Diff line change
Expand Up @@ -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;


Expand Down
79 changes: 59 additions & 20 deletions src/zmq-sockets.adb
Original file line number Diff line number Diff line change
Expand Up @@ -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;

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

Expand Down Expand Up @@ -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;

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

Expand Down Expand Up @@ -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

Expand Down Expand Up @@ -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;
Expand Down Expand Up @@ -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;
Loading

0 comments on commit 16d8705

Please sign in to comment.