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

Clean up and reformat

This commit is contained in:
Per Sandberg 2014-01-31 07:35:30 +01:00
parent 2025a5fb96
commit 3dfe47e15d
39 changed files with 379 additions and 128 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
.gitignore vendored
View File

@ -14,3 +14,7 @@ gnatcheck-source-list.out
*.tgz
.dist
Makefile.config
gnatinspect.db
fontconfig
temp.out
.#*#

14
Makefile
View File

@ -1,4 +1,5 @@
ifndef PREFIX
PREFIX=$(dir $(shell dirname `which gnatls`))
endif
@ -7,6 +8,7 @@ DESTDIR ?=
GNATFLAGS ?=
ADA_PROJECT_DIR ?= ${PREFIX}/lib/gnat
GNATMAKE = gnatmake ${GNATFLAGS} -p -f -R
compile:
${GNATMAKE} -P zmq.gpr -XLIBRARY_TYPE=static
${GNATMAKE} -P zmq.gpr -XLIBRARY_TYPE=relocatable
@ -30,6 +32,7 @@ install: compile uninstall
mkdir -p ${DESTDIR}/${PREFIX}/share/zmq/examples/Ada
cp examples/zmq-examples*.ad* ${DESTDIR}/${PREFIX}/share/zmq/examples/Ada
cp examples/zmq-examples.gpr.inst ${DESTDIR}/${PREFIX}/share/zmq/examples/Ada/zmq-examples.gpr
all: compile install
samples:
@ -48,18 +51,19 @@ 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
echo "|$(shell helpers/getinfo --binding-version)|"
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 *
rm -rf .dist
Makefile.config:Makefile
Makefile.config:Makefile #IGNORE
echo "PREFIX=$(dir $(shell dirname `which gnatls`))" >${@}

2
README
View File

@ -2,7 +2,7 @@ zeromq-Ada
provides an Ada-binding the 0MQ library
Prerequisits:
zeromq 2.x installed
zeromq 4.x installed
a modern GCC (4.3 or better) with Ada enabled
Install:

0
examples/zmq-examples-hwserver.adb Executable file → Normal file
View File

2
examples/zmq-examples-json_data.adb
View File

@ -1,3 +1,5 @@
package body ZMQ.Examples.JSON_Data is
------------

2
examples/zmq-examples-json_data.ads
View File

@ -1,3 +1,5 @@
with GNATCOLL.JSON;
with Ada.Strings.Unbounded;
package ZMQ.Examples.JSON_Data is

6
examples/zmq-examples-monitor.adb
View File

@ -127,9 +127,9 @@ procedure ZMQ.Examples.Monitor is
Ctx_1 : aliased ZMQ.Contexts.Context;
Ctx_2 : aliased ZMQ.Contexts.Context;
Monitor : Monitor_Type (Ctx_1'Access);
Server : Server_Type (Ctx_2'Access);
Client : Client_Type (Ctx_1'Access);
Monitor : Monitor_Type (Ctx_1'Access);
Server : Server_Type (Ctx_2'Access);
Client : Client_Type (Ctx_1'Access);
begin
GNAT.Exception_Traces.Trace_On (GNAT.Exception_Traces.Every_Raise);

2
examples/zmq-examples-multi_thread_server.adb
View File

@ -48,7 +48,7 @@ procedure ZMQ.examples.Multi_Thread_Server is
ctx : aliased ZMQ.Contexts.Context;
Number_Of_Servers : constant := 10;
servers : array (1 .. Number_Of_Servers) of access server_task;
servers : array (1 .. Number_Of_Servers) of access server_task;
workers : ZMQ.Sockets.Socket;
clients : ZMQ.Sockets.Socket;

2
examples/zmq-examples-sparse.ads
View File

@ -1,3 +1,5 @@
with Ada.Strings.Unbounded;
with Ada.Containers.Indefinite_Vectors;
package ZMQ.Examples.Sparse is

114
fixHeader.py
View File

@ -1,61 +1,91 @@
#!/usr/bin/env python
import GPS
from os.path import *
HEADER="""------------------------------------------------------------------------------
-- --
-- 0MQ Ada-binding --
-- --
HEADER="""##############################################################################
## ##
## 0MQ Ada-binding ##
## ##
%(name)s
-- --
## ##
%(ext)s
-- --
-- Copyright (C) 2010-2011, per.sandberg@bredband.net --
-- --
-- 0MQ Ada-binding is free software; you can redistribute it and/or --
-- modify it under terms of the GNU General Public License as published --
-- by the Free Soft-ware Foundation; --
-- either version 2, or (at your option) any later version. --
-- 0MQ Ada-binding is distributed in the hope that it will be useful, but --
-- WITH OUT ANY WARRANTY; --
-- without even the implied warranty of MERCHANTABILITY or --
-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
-- Boston, MA 02110-1301, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
------------------------------------------------------------------------------
## ##
## Copyright (C) 2013-2020, per.s.sandberg@bahnhof.se ##
## ##
## 0MQ Ada-binding is free software; you can redistribute it and/or ##
## modify it under terms of the GNU General Public License as published ##
## by the Free Soft-ware Foundation; ##
## either version 2, or (at your option) any later version. ##
## 0MQ Ada-binding is distributed in the hope that it will be useful, but ##
## WITH OUT ANY WARRANTY; ##
## without even the implied warranty of MERCHANTABILITY or ##
## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ##
## for more details. You should have received a copy of the GNU General ##
## Public License distributed with GNAT; see file COPYING. If not, write ##
## to the Free Software Foundation, 51 Franklin Street, Fifth Floor, ##
## Boston, MA 02110-1301, USA. ##
## ##
## As a special exception, if other files instantiate generics from this ##
## unit, or you link this unit with other files to produce an executable, ##
## this unit does not by itself cause the resulting executable to be ##
## covered by the GNU General Public License. This exception does not ##
## however invalidate any other reasons why the executable file might be ##
## covered by the GNU Public License. ##
## ##
##############################################################################
"""
import string
def to80Comment(s):
if len(s) > 76:
s = s.replace(" ","");
if len(s) > 76:
s=s[:-76]
n= 76 - len(s)
n=n/2
ret = "--" + (" " * n) + s
ret = ret + (" " * (76 - len(ret))) + "--"
ret = "##" + (" " * n) + s
ret = ret + (" " * (76 - len(ret))) + "##"
return ret
def fixFile(f):
def getHeader(f):
name,ext=splitext(basename(f.name()))
name=name.upper().replace("-",".")
if ext==".ads":
ext="S p e c"
elif ext==".adb":
ext="B o d y"
elif ext==".gpr":
ext="P r o j e c t"
name =to80Comment( string.join(name," "))
ext =to80Comment( ext )
if ext==".ads":
ext =to80Comment("S p e c" )
return (HEADER % {"name" : name , "ext" : ext}).replace("#","-")
elif ext==".adb":
ext =to80Comment("B o d y" )
return (HEADER % {"name" : name , "ext" : ext}).replace("#","-")
elif ext==".gpr":
ext =to80Comment( "P r o j e c t" )
return (HEADER % {"name" : name , "ext" : ext}).replace("#","-")
else:
ext =to80Comment("")
return HEADER % {"name" : name , "ext" : ext}
print HEADER % {"name" : name , "ext" : ext}
def fixFile(f,of):
name,ext=splitext(basename(f.name()))
ed = GPS.EditorBuffer.get(f)
begin=ed.beginning_of_buffer()
if (ext not in [".gpr",".adb",".ads",".c",".cpp",".h",".hh",".idl"]):
begin=begin.forward_line(1)
last=ed.beginning_of_buffer().search(r"\n\n", regexp=True)
of.write("%s\n" % "///////////////////////////////////////////////////////////////////////////////")
of.write("%s\n" % f.name())
of.write("%s\n" % "<<<<<<<<<<<<<<<<<<<<<<<<<<<<")
of.write("%s\n" % ed.get_chars(begin,last[0]))
of.write("%s\n" % "<<<<<<<<<<<<<<<<<<<<<<<<<<<<")
of.write("%s\n" % getHeader(f))
of.write("%s\n" % "///////////////////////////////////////////////////////////////////////////////")
with file("temp.out","w") as of:
for i in GPS.Project("zmq.tests").sources():
fixFile(i,of)
for i in GPS.Project("zmq").sources():
fixFile(i)

30
helpers/getinfo.adb
View File

@ -1,3 +1,4 @@
with ZMQ;
with Ada.Text_IO;
with Ada.Directories;
@ -10,32 +11,31 @@ procedure Getinfo is
use Ada.Text_IO;
command_Name : constant String :=
Ada.Directories.Base_Name (Ada.Command_Line.Command_Name);
procedure help;
procedure help is
procedure Help;
procedure Help is
use ASCII;
begin
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");
"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");
end Help;
begin
Ada.Text_IO.Put_Line (Getinfo'Version);
loop
case Getopt ("-binding-version " &
"-ada-library-version " &
"-library-version " &
"-compiler-version " &
"h ? -help") is -- Accepts '-a', '-ad', or '-b argument'
"-ada-library-version " &
"-library-version " &
"-compiler-version " &
"h ? -help") is -- Accepts '-a', '-ad', or '-b argument'
when ASCII.NUL => exit;
when 'h' | '?' =>
help;
Help;
return;
when '-' =>
@ -48,7 +48,7 @@ begin
elsif Full_Switch = "-ada-library-version" then
Put_Line ($version);
elsif Full_Switch = "-help" then
help;
Help;
return;
end if;
when others =>
@ -68,4 +68,4 @@ begin
exception
when Invalid_Switch => Put_Line ("Invalid Switch " & Full_Switch);
when Invalid_Parameter => Put_Line ("No parameter for " & Full_Switch);
end getinfo;
end Getinfo;

4
rename.py
View File

@ -1,4 +1,6 @@
import os
#!/usr/bin/env python
import sys
import re
header="""-------------------------------------------------------------------------------

2
renames.py
View File

@ -1,4 +1,6 @@
#!/usr/bin/env python
renames=[["with stddef_h;\n",""],
["stddef_h.size_t","size_t"],
["zmq_h","ZMQ.Low_Level"]]

6
src/zmq-contexts.adb
View File

@ -53,7 +53,7 @@ package body ZMQ.Contexts is
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;
@ -70,7 +70,7 @@ package body ZMQ.Contexts is
rc := Low_Level.zmq_ctx_destroy (This.c);
if rc /= 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;
This.c := Null_Address;
end if;
@ -107,7 +107,7 @@ package body ZMQ.Contexts is
not overriding
procedure Set_maximum_number_of_sockets
(This : in out Context; Count : Positive := 1024) is
(This : in out Context; Count : Positive := 1024) is
begin
if Low_Level.zmq_ctx_set
(This.c, Low_Level.Defs.ZMQ_MAX_SOCKETS, int (Count)) /= 0 then

4
src/zmq-devices.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2010-2011, per.sandberg@bredband.net --
-- Copyright (C) 2013-2020, per.s.sandberg@bahnhof.se --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files --
@ -34,7 +34,7 @@
private with Interfaces.C;
with ZMQ.Sockets;
package ZMQ.Devices is
pragma Obsolescent ("Use ZMQ.Proxys;");
pragma Obsolescent ("use ZMQ.Proxys");
-- Devices are building blocks intended to serve as intermediate nodes
-- in complex messaging topologies.

2
src/zmq-pollsets.ads
View File

@ -1,5 +1,5 @@
-------------------------------------------------------------------------------
-- Copyright (c) 2011 Per Sandberg --
-- Copyright (C) 2013-2020, per.s.sandberg@bahnhof.se --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files --

31
src/zmq-proxys.adb
View File

@ -1,3 +1,34 @@
-------------------------------------------------------------------------------
-- --
-- 0MQ Ada-binding --
-- --
-- Z M Q . P R O X Y S --
-- --
-- B o d y --
-- --
-- Copyright (C) 2013-2020, per.s.sandberg@bahnhof.se --
-- --
-- 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 ZMQ.Low_Level;
with Interfaces.C; use Interfaces.C;
package body ZMQ.Proxys is

2
src/zmq-proxys.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2010-2011, per.sandberg@bredband.net --
-- Copyright (C) 2013-2020, per.s.sandberg@bahnhof.se --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files --

35
src/zmq-sockets-indefinite_typed_generic.adb
View File

@ -1,7 +1,36 @@
-------------------------------------------------------------------------------
-- --
-- 0MQ Ada-binding --
-- --
-- Z M Q . S O C K E T S . I N D E F I N I T E _ T Y P E D _ G E N E R I C --
-- --
-- B o d y --
-- --
-- Copyright (C) 2013-2020, per.s.sandberg@bahnhof.se --
-- --
-- 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 ZMQ.Utilities.Memory_Streams;
package body ZMQ.Sockets.Indefinite_Typed_Generic is
Acutal_Initial_Size : Ada.Streams.Stream_Element_Offset := Initial_Size;
----------
-- Send --
----------
@ -15,8 +44,8 @@ package body ZMQ.Sockets.Indefinite_Typed_Generic is
begin
Element_Type'Write (S'Access, Msg);
This.Send (S.Get_Address, Integer (S.Get_Length));
if Acutal_Initial_Size < S.Get_Length then
Acutal_Initial_Size := S.Get_Length;
if This.Acutal_Initial_Size < S.Get_Length then
This.Acutal_Initial_Size := S.Get_Length;
end if;
end Send;

6
src/zmq-sockets-indefinite_typed_generic.ads
View File

@ -34,8 +34,8 @@ generic
type Element_Type (<>) is private;
Initial_Size : Ada.Streams.Stream_Element_Offset := 1024;
package ZMQ.Sockets.Indefinite_Typed_Generic is
-- This package provides a wraper for first serializeing any object
-- then send the serialized data over the socket.
-- This package provides a wraper for first serializeing any object
-- then send the serialized data over the socket.
type Socket is new ZMQ.Sockets.Socket with private;
@ -50,6 +50,6 @@ package ZMQ.Sockets.Indefinite_Typed_Generic is
Msg : out Element_Type);
private
type Socket is new ZMQ.Sockets.Socket with record
null;
Acutal_Initial_Size : Ada.Streams.Stream_Element_Offset := Initial_Size;
end record;
end ZMQ.Sockets.Indefinite_Typed_Generic;

31
src/zmq-sockets-typed_generic.adb
View File

@ -1,3 +1,34 @@
-------------------------------------------------------------------------------
-- --
-- 0MQ Ada-binding --
-- --
-- Z M Q . S O C K E T S . T Y P E D _ G E N E R I C --
-- --
-- S p e c --
-- --
-- Copyright (C) 2013-2020, per.s.sandberg@bahnhof.se --
-- --
-- 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. --
-------------------------------------------------------------------------------
package body ZMQ.Sockets.Typed_Generic is
----------

31
src/zmq-sockets-typed_generic.ads
View File

@ -1,3 +1,34 @@
-------------------------------------------------------------------------------
-- --
-- 0MQ Ada-binding --
-- --
-- Z M Q . S O C K E T S . T Y P E D _ G E N E R I C --
-- --
-- B o d y --
-- --
-- Copyright (C) 2013-2020, per.s.sandberg@bahnhof.se --
-- --
-- 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. --
-------------------------------------------------------------------------------
generic
type Element_Type is private;
pragma Compile_Time_Error

2
src/zmq-sockets.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2010-2011, per.sandberg@bredband.net --
-- Copyright (C) 2013-2020, per.s.sandberg@bahnhof.se --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files --

2
src/zmq-sockets.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2010-2011, per.sandberg@bredband.net --
-- Copyright (C) 2013-2020, per.s.sandberg@bahnhof.se --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files --

20
src/zmq-utilities-memory_streams.adb
View File

@ -1,6 +1,6 @@
-------------------------------------------------------------------------------
-- --
-- Copyright 2007 Per Sandberg <per.sandberg@bredband.net> --
-- Copyright (C) 2013-2020, per.s.sandberg@bahnhof.se --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files --
@ -116,11 +116,11 @@ package body ZMQ.Utilities.Memory_Streams is
overriding
procedure Read
(This : in out Memory_Stream;
(This : in out Memory_Stream;
Item : out Stream_Element_Array;
Last : out Stream_Element_Offset)
is
First : Stream_Element_Offset;
First : Stream_Element_Offset;
LLast : Stream_Element_Offset;
begin
First := This.Cursor;
@ -139,7 +139,7 @@ package body ZMQ.Utilities.Memory_Streams is
overriding
procedure Write
(This : in out Memory_Stream;
(This : in out Memory_Stream;
Item : in Stream_Element_Array)
is
First : Stream_Element_Offset;
@ -161,7 +161,7 @@ package body ZMQ.Utilities.Memory_Streams is
end Reset;
procedure Read
(This : not null access Ada.Streams.Root_Stream_Type'Class;
(This : not null access Ada.Streams.Root_Stream_Type'Class;
Item : out Memory_Stream) is
begin
raise Program_Error with
@ -169,7 +169,7 @@ package body ZMQ.Utilities.Memory_Streams is
end Read;
procedure Write
(This : not null access Ada.Streams.Root_Stream_Type'Class;
(This : not null access Ada.Streams.Root_Stream_Type'Class;
Item : in Memory_Stream) is
begin
Ada.Streams.Stream_Element_Array'Write
@ -181,21 +181,21 @@ package body ZMQ.Utilities.Memory_Streams is
procedure Read
(This : not null access Ada.Streams.Root_Stream_Type'Class;
(This : not null access Ada.Streams.Root_Stream_Type'Class;
Item : out Dynamic_Memory_Stream) is
begin
Read (This, Memory_Stream (Item));
end Read;
procedure Write
(This : not null access Ada.Streams.Root_Stream_Type'Class;
(This : not null access Ada.Streams.Root_Stream_Type'Class;
Item : in Dynamic_Memory_Stream) is
begin
Write (This, Memory_Stream (Item));
end Write;
procedure Write
(This : in out Dynamic_Memory_Stream;
(This : in out Dynamic_Memory_Stream;
Item : in Ada.Streams.Stream_Element_Array) is
begin
if This.Cursor + Item'Length > This.Buffer_Length then
@ -205,7 +205,7 @@ package body ZMQ.Utilities.Memory_Streams is
end Write;
procedure Expand
(This : in out Dynamic_Memory_Stream;
(This : in out Dynamic_Memory_Stream;
to_Size : Ada.Streams.Stream_Element_Offset) is
new_Size : System.Memory.size_t := 0;
use System.Memory;

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

@ -1,6 +1,6 @@
-------------------------------------------------------------------------------
-- --
-- Copyright 2007 Per Sandberg <per.sandberg@bredband.net> --
-- Copyright (C) 2013-2020, per.s.sandberg@bahnhof.se --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files --
@ -51,12 +51,12 @@ package ZMQ.Utilities.Memory_Streams is
all Memory_Stream_Interface'Class;
--
procedure Read
(This : in out Memory_Stream_Interface;
(This : in out Memory_Stream_Interface;
Item : out Ada.Streams.Stream_Element_Array;
Last : out Ada.Streams.Stream_Element_Offset) is abstract;
procedure Write
(This : in out Memory_Stream_Interface;
(This : in out Memory_Stream_Interface;
Item : in Ada.Streams.Stream_Element_Array) is abstract;
function Get_Address
@ -149,19 +149,19 @@ package ZMQ.Utilities.Memory_Streams is
overriding
procedure Dump
(This : in Memory_Stream;
(This : in Memory_Stream;
Full_Buffer : in Boolean := False;
Outf : in Ada.Text_IO.File_Access := Ada.Text_IO.Standard_Output);
-- Dumps the contents of the buffer from the first element
-- to the cursor.
overriding procedure Read
(This : in out Memory_Stream;
(This : in out Memory_Stream;
Item : out Ada.Streams.Stream_Element_Array;
Last : out Ada.Streams.Stream_Element_Offset);
overriding procedure Write
(This : in out Memory_Stream;
(This : in out Memory_Stream;
Item : in Ada.Streams.Stream_Element_Array);
@ -173,7 +173,7 @@ package ZMQ.Utilities.Memory_Streams is
Strategy : Expand_Strategy) is new Memory_Stream with private;
overriding procedure Write
(This : in out Dynamic_Memory_Stream;
(This : in out Dynamic_Memory_Stream;
Item : in Ada.Streams.Stream_Element_Array);
@ -202,12 +202,12 @@ private
end record;
procedure Read
(This : not null access Ada.Streams.Root_Stream_Type'Class;
(This : not null access Ada.Streams.Root_Stream_Type'Class;
Item : out Memory_Stream);
for Memory_Stream'Read use Read;
procedure Write
(This : not null access Ada.Streams.Root_Stream_Type'Class;
(This : not null access Ada.Streams.Root_Stream_Type'Class;
Item : in Memory_Stream);
for Memory_Stream'Write use Write;
@ -227,16 +227,16 @@ private
procedure Finalize (This : in out Dynamic_Memory_Stream);
procedure Read
(This : not null access Ada.Streams.Root_Stream_Type'Class;
(This : not null access Ada.Streams.Root_Stream_Type'Class;
Item : out Dynamic_Memory_Stream);
for Dynamic_Memory_Stream'Read use Read;
procedure Write
(This : not null access Ada.Streams.Root_Stream_Type'Class;
(This : not null access Ada.Streams.Root_Stream_Type'Class;
Item : in Dynamic_Memory_Stream);
for Dynamic_Memory_Stream'Write use Write;
procedure Expand
(This : in out Dynamic_Memory_Stream;
(This : in out Dynamic_Memory_Stream;
to_Size : Ada.Streams.Stream_Element_Offset);
end ZMQ.Utilities.Memory_Streams;

45
src/zmq-utilities-stream_element_array_image.adb
View File

@ -1,22 +1,55 @@
-------------------------------------------------------------------------------
-- --
-- 0MQ Ada-binding --
-- --
-- ZMQ.Utilities.Stream_Element_Array_Image --
-- --
-- B o d y --
-- --
-- Copyright (C) 2013-2020, per.s.sandberg@bahnhof.se --
-- --
-- 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. --
-------------------------------------------------------------------------------
function ZMQ.Utilities.Stream_Element_Array_Image
(Item : Ada.Streams.Stream_Element_Array)
return String
is
use Ada.Streams;
Cursor : Natural := 1;
Cursor : Natural;
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 := "0123456789ABCDEF";
begin
return Ret : String (1 .. Item'Length * 2) do
return Ret : String (1 .. Item'Length * 3 - 1) do
Cursor := Ret'First;
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;
if I < Item'Last then
Ret (Cursor) := ' ';
Cursor := Cursor + 1;
end if;
end loop;
end return;
end ZMQ.Utilities.Stream_Element_Array_Image;

34
src/zmq-utilities-stream_element_array_image.ads
View File

@ -1,3 +1,35 @@
-------------------------------------------------------------------------------
-- --
-- 0MQ Ada-binding --
-- --
-- ZMQ.Utilities.Stream_Element_Array_Image --
-- --
-- S p e c --
-- --
-- Copyright (C) 2013-2020, 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;
function ZMQ.Utilities.Stream_Element_Array_Image
(Item : Ada.Streams.Stream_Element_Array) return String;
(Item : Ada.Streams.Stream_Element_Array) return String;
-- Returns an hex image of the Stream_Element_Array.

2
src/zmq-utilities.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2010-2011, per.sandberg@bredband.net --
-- Copyright (C) 2013-2020, per.s.sandberg@bahnhof.se --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files --

10
src/zmq.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2010-2011, per.sandberg@bredband.net --
-- Copyright (C) 2013-2020, per.s.sandberg@bahnhof.se --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files --
@ -43,7 +43,7 @@ package body ZMQ 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
@ -65,8 +65,8 @@ package body ZMQ is
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);
s2 (s2'First + 1 .. s2'Last) & "." &
s3 (s3'First + 1 .. s3'Last);
end Image;
procedure Validate_Library_Version is
@ -76,7 +76,7 @@ package body ZMQ is
((Binding_Version.Major = Lib_Version.Major) and
(Binding_Version.Minor = Lib_Version.Minor),
"Incompatible libzmq found: " & Image (Lib_Version) &
", expected: " &Image (Binding_Version));
", expected: " & Image (Binding_Version));
end Validate_Library_Version;
function errno return Integer is

2
src/zmq.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2010-2011, per.sandberg@bredband.net --
-- Copyright (C) 2013-2020, per.s.sandberg@bahnhof.se --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files --

2
tests/testcases/zmq-tests-testcases-test_compile.adb
View File

@ -1,3 +1,5 @@
pragma Warnings (off);
with GNAT.Source_Info;
with ZMQ.Contexts;

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

@ -1,3 +1,5 @@
with AUnit;
with AUnit.Test_Cases;

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

@ -1,3 +1,5 @@
with GNAT.Source_Info;
with Ada.Strings.Unbounded;
with AUnit.Assertions; use AUnit.Assertions;

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

@ -1,3 +1,5 @@
with AUnit;
with AUnit.Test_Cases;
with ZMQ.Contexts;

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

@ -1,3 +1,5 @@
with GNAT.Source_Info;
with Ada.Strings.Unbounded;
with AUnit.Assertions; use AUnit.Assertions;

6
tests/testcases/zmq-tests-testcases-test_reqresp.ads
View File

@ -1,3 +1,5 @@
with AUnit;
with AUnit.Test_Cases;
with ZMQ.Contexts;
@ -6,8 +8,8 @@ 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;
REQ : ZMQ.Sockets.Socket;
Ctx : ZMQ.Contexts.Context;
REQ : ZMQ.Sockets.Socket;
RESP : ZMQ.Sockets.Socket;
end record;

2
tests/zmq-examples-json_data-test.adb
View File

@ -1,3 +1,5 @@
with Ada.Text_IO;
procedure ZMQ.Examples.JSON_Data.Test is
V : Data_Type;

16
tests/zmq-tests.gpr → zmq-tests.gpr
View File

@ -1,7 +1,7 @@
with "../zmq.gpr";
with "zmq.gpr";
with "aunit.gpr";
with "../helpers/zmq-helpers.gpr";
with "../examples/zmq-examples.gpr";
with "helpers/zmq-helpers.gpr";
with "examples/zmq-examples.gpr";
project ZMQ.Tests is
@ -9,9 +9,11 @@ project ZMQ.Tests is
("zmq-tests-testharnesess-test_all.adb",
"zmq-examples-json_data-test.adb");
for Source_Dirs use (".","testcases");
for Object_Dir use ".obj";
for Exec_Dir use "bin";
ROOT := "tests/";
for Source_Dirs use (ROOT & ".", ROOT & "testcases");
for Object_Dir use ROOT & ".obj";
for Exec_Dir use ROOT & "bin";
package Builder is
for Executable ("zmq-tests-testharnesess-test_all.adb") use "test_all";
@ -19,7 +21,7 @@ project ZMQ.Tests is
end Builder;
package Compiler is
for Default_Switches ("ada") use Zmq.Compiler'Default_Switches ("ada") & ("-gnaty-s","-gnata");
for Default_Switches ("ada") use Zmq.Compiler'Default_Switches ("ada") & ("-gnaty-s", "-gnata");
end Compiler;
package Binder is