Skip to content
Browse files

Updated to zeromq 2.0.7

test for dl-binding

Ignore outputs
  • Loading branch information...
1 parent 2f565bd commit 104179ef3f4a974c2978aaaf6782939615df5888 Per Sandberg committed
View
1 .gitignore
@@ -5,4 +5,5 @@ lib
new\ file
.temp
make
+default.gpr
View
19 eBindings/dl/dl-test.gpr
@@ -0,0 +1,19 @@
+with "dl.gpr";
+with "aunit.gpr";
+project Dl.test is
+
+ for Source_Dirs use ("tests");
+ for Object_Dir use "tests/.obj";
+ for Exec_Dir use "tests/bin";
+ for Main use ("dl-test_all.adb");
+
+ package Compiler is
+ for Default_Switches ("ada") use ("-gnatf", "-gnat05");
+ end Compiler;
+
+ package Binder is
+ for Default_Switches ("ada") use ("-E");
+ end Binder;
+
+end Dl.test;
+
View
80 eBindings/dl/dl.ads
@@ -1,23 +1,79 @@
with System;
-package dl is
+package Dl is
pragma Preelaborate;
- type dynamic_Library is tagged private;
+ type Dynamic_Library is tagged private;
- procedure open (this : in out dynamic_Library;
- File_Name : string;
- Flags : integer);
+ type Flag is private;
+ function "+" (L , R Flag) return Flag;
+ function "or" (L , R Flag) return Flag;
- procedure close (this : dynamic_Library);
+ RTLD_LAZY : constant Flag;
+ -- Perform lazy binding.
+ -- Only resolve symbols as the code that references them is executed.
+ -- If the symbol is never referenced, then it is never resolved.
+ -- (Lazy binding is only performed for function references;
+ -- references to variables are always immediately bound when the
+ -- library is loaded.)
- function sym (this : dynamic_Library;
- Symbol_name : String) return System.Address;
+ RTLD_NOW : constant Flag;
+ -- If this value is specified, or the environment variable LD_BIND_NOW
+ -- is set to a non-empty string, all undefined symbols in the library are
+ -- Resolved Before Dlopen () Returns. if This Cannot Be Done, An Error
+ -- is Returned.
+ -- Zero of more of the following values may also be ORed in flag:
+
+ RTLD_GLOBAL : constant Flag;
+ -- The symbols defined by this library will be made available for
+ -- symbol resolution of subsequently loaded libraries.
+
+ RTLD_LOCAL : constant Flag;
+ -- This is the converse of RTLD_GLOBAL, and the default if neither flag
+ -- is Specified. Symbols Defined in This Library Are not Made Available
+ -- To Resolve References in Subsequently Loaded Libraries.
+
+ RTLD_NODELETE : constant Flag;
+ -- Do not unload the library during dlclose(). Consequently,
+ -- the library's static variables are not reinitialised if the library is
+ -- reloaded with dlopen() at a later time.
+
+ RTLD_NOLOAD : constant Flag;
+ -- Don't load the library. This can be used to test if the library
+ -- is already resident (dlopen() returns NULL if it is not,
+ -- or the library's handle if it is resident).
+ -- This flag can also be used to promote the flags on a library that
+ -- is already loaded. For example, a library that was previously loaded
+ -- with RTLD_LOCAL can be re-opened with RTLD_NOLOAD | RTLD_GLOBAL.
+
+ RTLD_DEEPBIND : constant Flag;
+ -- Place the lookup scope of the symbols in this library ahead of the global
+ -- scope. This means that a self-contained library will use its own symbols
+ -- in preference to global symbols with the same name contained in libraries
+ -- that have already been loaded.
+
+ procedure Open (This : in out Dynamic_Library;
+ File_Name : String;
+ Flags : Flag := RTLD_LAZY);
+
+ procedure Close (This : Dynamic_Library);
+
+ function Sym (This : Dynamic_Library;
+ Symbol_Name : String) return System.Address;
Dynamic_Library_Error : exception;
private
- type dynamic_Library is tagged record
- handle : System.Address := System.Null_Address;
+ type Dynamic_Library is tagged record
+ Handle : System.Address := System.Null_Address;
end record;
- function error return String; -- dlfcn.h:83:14
-end dl;
+ function Error return String; -- dlfcn.h:83:14
+
+ type Flag is mod 2**32;
+ RTLD_LAZY : constant Flag := 2#0000_0000_0000_0001#;
+ RTLD_NOW : constant Flag := 2#0000_0000_0000_0010#;
+ RTLD_GLOBAL : constant Flag := 2#0000_0001_0000_0000#;
+ RTLD_LOCAL : constant Flag := 2#0000_0000_0000_0000#;
+ RTLD_NODELETE : constant Flag := 2#0001_0000_0000_0000#;
+ RTLD_NOLOAD : constant Flag := 2#0000_0000_0000_0100#;
+ RTLD_DEEPBIND : constant Flag := 2#0000_0000_0000_1000#;
+end Dl;
View
13 eBindings/dl/tests/.gitignore
@@ -0,0 +1,13 @@
+lib
+.obj
+*~
+*.pyc
+new\ file
+.temp
+make
+default.gpr
+*.out
+flags.c
+.#*#
+bin
+
View
19 eBindings/dl/tests/dl-test_all.adb
@@ -0,0 +1,19 @@
+with AUnit.Run;
+-- with AUnit.Reporter.Text;
+with AUnit.Reporter.XML;
+
+with Dl.Test_All_Suit;
+
+-----------------
+-- Dl.Test_All --
+-----------------
+
+procedure Dl.Test_All is
+
+ procedure Run is new AUnit.Run.Test_Runner (Dl.Test_All_Suit.Suite);
+ -- Reporter : AUnit.Reporter.Text.Text_Reporter;
+ Reporter : AUnit.Reporter.XML.XML_Reporter;
+
+begin
+ Run (Reporter);
+end Dl.Test_All;
View
27 eBindings/dl/tests/dl-test_all_suit.adb
@@ -0,0 +1,27 @@
+
+
+-- Import tests and sub-suites to run
+with Dl.Test_Basics;
+
+package body Dl.Test_All_Suit is
+ use AUnit.Test_Suites;
+
+
+ -- Statically allocate test suite:
+ Result : aliased Test_Suite;
+
+
+ -- Statically allocate test cases:
+ Test_1 : aliased Dl.Test_Basics.Test_Case;
+
+ -----------
+ -- Suite --
+ -----------
+
+ function Suite return AUnit.Test_Suites.Access_Test_Suite is
+ begin
+ Add_Test (Result'Access, Test_1'Access);
+ return Result'Access;
+ end Suite;
+
+end Dl.Test_All_Suit;
View
8 eBindings/dl/tests/dl-test_all_suit.ads
@@ -0,0 +1,8 @@
+with AUnit.Test_Suites;
+
+package Dl.Test_All_Suit is
+
+ function Suite return AUnit.Test_Suites.Access_Test_Suite;
+ -- Return the test suite
+
+end Dl.Test_All_Suit;
View
45 eBindings/dl/tests/dl-test_basics.adb
@@ -0,0 +1,45 @@
+with GNAT.Source_Info;
+with AUnit.Assertions;
+package body Dl.Test_Basics is
+ use AUnit;
+ use AUnit.Assertions;
+
+ -- Fixture elements
+
+
+ ----------
+ -- Name --
+ ----------
+
+ function Name (T : Test_Case)
+ return AUnit.Message_String is
+ pragma Unreferenced (T);
+ begin
+ return Format (GNAT.Source_Info.File & ":(no description)");
+ end Name;
+
+
+ -------------------------
+ -- SampleTest
+ -------------------------
+ procedure SampleTest (Test : in out AUnit.Test_Cases.Test_Case'Class) is
+ T : Test_Case renames Test_Case (Test);
+ pragma Unreferenced (T);
+ P : Dynamic_Library;
+ begin
+ p.open(
+ Assert (False, "TODO Implement Test");
+ end SampleTest;
+
+ --------------------
+ -- Register_Tests --
+ --------------------
+
+ procedure Register_Tests (T : in out Test_Case) is
+ use Test_Cases.Registration;
+
+ begin
+ Register_Routine (T, SampleTest'Access, "SampleTest");
+ end Register_Tests;
+
+end Dl.Test_Basics;
View
15 eBindings/dl/tests/dl-test_basics.ads
@@ -0,0 +1,15 @@
+with AUnit;
+with AUnit.Test_Cases;
+
+package Dl.Test_Basics is
+
+ type Test_Case is new AUnit.Test_Cases.Test_Case with null record;
+
+ procedure Register_Tests (T : in out Test_Case);
+ -- Register routines to be run
+
+ function Name (T : Test_Case)
+ return Aunit.Message_String;
+ -- Returns name identifying the test case
+
+end Dl.Test_Basics;
View
2 src/zmq-contexts.adb
@@ -53,7 +53,7 @@ package body ZMQ.Contexts is
raise ZMQ_Error with "Alredy Initialized";
end if;
This.c := Low_Level.zmq_init
- (int (App_Threads), 1, 0);
+ (int (App_Threads));
if This.c = Null_Address then
raise ZMQ_Error with Error_Message (GNAT.OS_Lib.Errno) & " in " &
GNAT.Source_Info.Enclosing_Entity;
View
13 src/zmq-low_level.ads
@@ -59,7 +59,6 @@ package ZMQ.Low_Level is
ZMQ_POLL : constant := 1; -- zmq.h:148
ZMQ_PAIR : constant := 0; -- zmq.h:159
- ZMQ_P2P : constant := 0; -- zmq.h:160
ZMQ_PUB : constant := 1; -- zmq.h:161
ZMQ_SUB : constant := 2; -- zmq.h:162
ZMQ_REQ : constant := 3; -- zmq.h:163
@@ -70,7 +69,6 @@ package ZMQ.Low_Level is
ZMQ_DOWNSTREAM : constant := 8; -- zmq.h:168
ZMQ_HWM : constant := 1; -- zmq.h:171
- ZMQ_LWM : constant := 2; -- zmq.h:172
ZMQ_SWAP : constant := 3; -- zmq.h:173
ZMQ_AFFINITY : constant := 4; -- zmq.h:174
ZMQ_IDENTITY : constant := 5; -- zmq.h:175
@@ -98,8 +96,11 @@ package ZMQ.Low_Level is
end defs;
- function zmq_strerror (errnum : int) return Interfaces.C.Strings.chars_ptr; -- zmq.h:82:48
- pragma Import (C, zmq_strerror, "zmq_strerror");
+ procedure Zmq_Version (Major : not null access int; Minor : not null access int; Patch : not null access int); -- zmq.h:48
+ pragma Import (C, Zmq_Version, "zmq_version");
+
+ function Zmq_Strerror (Errnum : int) return Interfaces.C.Strings.chars_ptr; -- zmq.h:82:48
+ pragma Import (C, Zmq_Strerror, "zmq_strerror");
type zmq_msg_t_vsm_data_array is array (0 .. 29) of aliased unsigned_char;
type zmq_msg_t is record
@@ -144,9 +145,7 @@ package ZMQ.Low_Level is
pragma Import (C, zmq_msg_size, "zmq_msg_size");
function zmq_init
- (app_threads : int;
- io_threads : int;
- flags : int) return System.Address; -- zmq.h:130:70
+ (app_threads : int) return System.Address; -- zmq.h:130:70
pragma Import (C, zmq_init, "zmq_init");
function zmq_term (context : System.Address) return int; -- zmq.h:131:39
View
7 src/zmq-sockets.adb
@@ -42,7 +42,6 @@ package body ZMQ.Sockets is
type Map_Array is array (Socket_Opt) of int;
Map : constant Map_Array :=
(HWM => Low_Level.defs.ZMQ_HWM, -- Set high water mark
- LWM => Low_Level.defs.ZMQ_LWM, -- Set low water mark
SWAP => Low_Level.defs.ZMQ_SWAP,
AFFINITY => Low_Level.defs.ZMQ_AFFINITY,
IDENTITY => Low_Level.defs.ZMQ_IDENTITY,
@@ -386,12 +385,6 @@ package body ZMQ.Sockets is
This.setsockopt (HWM, Value);
end setsockopt_HWM;
- not overriding
- procedure setsockopt_LWM (This : in out Socket;
- Value : Natural) is
- begin
- This.setsockopt (LWM, Value);
- end setsockopt_LWM;
not overriding
procedure setsockopt_SWAP (This : in out Socket;
View
4 src/zmq-sockets.ads
@@ -74,9 +74,6 @@ package ZMQ.Sockets is
procedure setsockopt_HWM (This : in out Socket;
Value : Natural);
not overriding
- procedure setsockopt_LWM (This : in out Socket;
- Value : Natural);
- not overriding
procedure setsockopt_SWAP (This : in out Socket;
Value : Boolean);
not overriding
@@ -201,7 +198,6 @@ private
type Socket_Opt is
(HWM, -- Set high water mark
- LWM, -- Set low water mark
SWAP,
AFFINITY,
IDENTITY,
View
10 src/zmq.adb
@@ -42,13 +42,19 @@ 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
+ Major : aliased int;
+ Minor : aliased int;
+ Patch : aliased int;
begin
return ret : Version_Type do
- ret := (2, 0, 6); --#TODO fetch from library
+ Low_Level.Zmq_Version (Major'Access,
+ Minor'Access,
+ Patch'Access); --#TODO fetch from library
+ ret := (Natural (Major), Natural (Minor), Natural (Patch));
end return;
end Library_Version;
View
3 zmq.gpr
@@ -100,8 +100,7 @@ project ZMQ is
end Naming;
package Make is
- for Directory use project'Project_Dir;
- for Makefile use "Makefile";
+ for Makefile use project'Project_dir & "Makefile";
end Make;
package Check is

0 comments on commit 104179e

Please sign in to comment.
Something went wrong with that request. Please try again.