Working

Makefile

@@ -27,4 +27,10 @@ install:
 
 all: compile install
 
+generate:
+	mkdir -p .temp
+	echo "#include <zmq.h>">.temp/x.c
+	(cd .temp;gcc  -c -fdump-ada-spec x.c)
+	cat .temp/zmq_h.ads | sed "s-/usr/local/include/--" >src/zmq_h.ads
+
 

eBindings/Makefile

@@ -1,5 +1,8 @@
 all:
+compile:
+install:
 %:
 	${MAKE} -C uuid ${@}
 	${MAKE} -C pthread ${@}
+	${MAKE} -C dl ${@}
 

eBindings/dl/Makefile

@@ -0,0 +1,24 @@
+PREFIX=$(dir $(shell which gnatls))..
+
+compile:
+	gprbuild -p -P dl.gpr
+
+all:compile install
+
+install:
+	mkdir -p ${PREFIX}/include/dl
+	cp dl.ad? ${PREFIX}/include/dl
+	chmod -w ${PREFIX}/include/dl/*.ad?
+	mkdir -p ${PREFIX}/lib/gnat
+	cp libdl.gpr ${PREFIX}/lib/gnat
+	cp dl.gpr.inst ${PREFIX}/lib/gnat/dl.gpr
+	chmod -w ${PREFIX}/lib/gnat/*dl.gpr
+	mkdir -p    ${PREFIX}/lib/dl
+	cp lib/*    ${PREFIX}/lib/dl/
+
+clean:
+	rm -rf lib .obj gen
+generate:
+	rm -rf gen
+	mkdir -p gen
+	(cd gen ;gcc -c -fdump-ada-spec -D__USE_GNU=1 ../generate.c)

eBindings/dl/dl.adb

@@ -0,0 +1,58 @@
+with Interfaces.C; use Interfaces.C;
+with Interfaces.C.Strings;
+with System;
+package body dl is
+
+   package dlfcn_h is
+
+      function dlopen (arg1 : Interfaces.C.Strings.chars_ptr; arg2 : int) return System.Address;  -- dlfcn.h:57:14
+      pragma Import (C, dlopen, "dlopen");
+
+      function dlclose (arg1 : System.Address) return int;  -- dlfcn.h:61:12
+      pragma Import (C, dlclose, "dlclose");
+
+      function dlsym (arg1 : System.Address; arg2 : Interfaces.C.Strings.chars_ptr) return System.Address;  -- dlfcn.h:65:14
+      pragma Import (C, dlsym, "dlsym");
+
+      function dlerror return Interfaces.C.Strings.chars_ptr;  -- dlfcn.h:83:14
+      pragma Import (C, dlerror, "dlerror");
+
+   end dlfcn_h;
+   use dlfcn_h;
+   use type system.Address;
+
+   procedure open (this       : in out dynamic_Library;
+                   File_Name  : string;
+                   Flags      : integer) is
+   begin
+      this.handle := dlopen (Strings.Null_Ptr,0);
+      if this.handle = System.Null_Address then
+         raise Dynamic_Library_Error  with error;
+      end if;
+   end;
+
+   procedure close (this : dynamic_Library) is
+      ret : int;
+   begin
+      ret := dlclose (this.handle);
+      if ret /= 0 then
+         raise Dynamic_Library_Error  with error;
+      end if;
+   end;
+
+   function sym (this : dynamic_Library; Symbol_name : String) return System.Address is
+   begin
+      return ret : System.Address do
+         ret := dlsym (this.handle, strings.Null_Ptr);
+         if ret = System.Null_Address then
+            raise Dynamic_Library_Error  with error;
+         end if;
+      end return;
+   end;
+
+   function error return String is
+   begin
+      return Interfaces.C.Strings.Value (dlerror);
+   end;
+
+end dl;

eBindings/dl/dl.ads

@@ -0,0 +1,23 @@
+with System;
+package dl is
+   pragma Preelaborate;
+
+   type dynamic_Library is tagged private;
+
+   procedure open (this       : in out dynamic_Library;
+                   File_Name  : string;
+                   Flags      : integer);
+
+   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;
+   end record;
+   function error return String;  -- dlfcn.h:83:14
+end dl;

eBindings/dl/dl.gpr

@@ -0,0 +1,18 @@
+with "libdl.gpr";
+project DL is
+
+   for Languages use ("C","Ada");
+
+   package Compiler is
+      for Driver ("C") use "";
+      for Default_Switches ("ada") use ("-g", "-O2", "-gnat05");
+   end Compiler;
+
+   for Object_Dir use ".obj";
+   for Library_Name use "dlAda";
+   for Library_Dir use "lib";
+   for Library_Interface use ("dl");
+   for Library_Kind use "dynamic";
+
+end DL;
+

eBindings/dl/dl.gpr.inst

@@ -0,0 +1,12 @@
+with "libdl";
+project dl is
+
+   for source_files use ("dl.ads",
+                         "dl.adb");
+   for Library_Name use "dlAda";
+   for Library_Dir use "..";
+   for Library_Kind use "dynamic";
+   for Source_Dirs use ("../../include/dl");
+   for Externally_Built use "True";
+end dl;
+

eBindings/dl/gen/dlfcn_h.ads

@@ -0,0 +1,19 @@
+with Interfaces.C; use Interfaces.C;
+with Interfaces.C.Strings;
+with System;
+
+package dlfcn_h is
+
+   function dlopen (arg1 : Interfaces.C.Strings.chars_ptr; arg2 : int) return System.Address;  -- /usr/include/dlfcn.h:57:14
+   pragma Import (C, dlopen, "dlopen");
+
+   function dlclose (arg1 : System.Address) return int;  -- /usr/include/dlfcn.h:61:12
+   pragma Import (C, dlclose, "dlclose");
+
+   function dlsym (arg1 : System.Address; arg2 : Interfaces.C.Strings.chars_ptr) return System.Address;  -- /usr/include/dlfcn.h:65:14
+   pragma Import (C, dlsym, "dlsym");
+
+   function dlerror return Interfaces.C.Strings.chars_ptr;  -- /usr/include/dlfcn.h:83:14
+   pragma Import (C, dlerror, "dlerror");
+
+end dlfcn_h;

eBindings/dl/generate.c

@@ -0,0 +1 @@
+#include <dlfcn.h>

eBindings/dl/libdl.gpr

@@ -0,0 +1,10 @@
+project libDL is
+   for languages use ("C");
+   for source_files use ("dlfcn.h");
+   for source_dirs use ("/usr/include");
+   for Library_name use "dl";
+   for externally_Built use "True";
+   for Library_dir use "/usr/lib";
+   for Library_Kind use "dynamic";
+end libDL;
+

eBindings/uuid/Makefile

@@ -18,3 +18,7 @@ install:
 
 clean:
 	rm -rf lib .obj
+generate:
+	rm -rf gen
+	mkdir -p gen
+	(cd gen ;gcc -c -fdump-ada-spec ../generate.c)

eBindings/uuid/generate.c

@@ -0,0 +1 @@
+#include <uuid/uuid.h>

eBindings/uuid/tests/testcases/uuid-test.adb

@@ -0,0 +1,39 @@
+with Ada.Text_IO;
+with GNAT.Source_Info;
+package body uuid.Test is
+
+   ----------
+   -- Name --
+   ----------
+
+   function Name (T : Test_Case)
+                  return AUnit.Test_String is
+      pragma Unreferenced (T);
+   begin
+      return AUnit.Format (GNAT.Source_Info.File);
+   end Name;
+
+   procedure test_Generate (Test : in out AUnit.Test_Cases.Test_Case'Class) is
+      pragma Unreferenced (Test);
+      t : UUID;
+   begin
+      Ada.Text_IO.Put_Line (GNAT.Source_Info.Source_Location);
+      t.Clear;
+      Ada.Text_IO.Put_Line (GNAT.Source_Info.Source_Location);
+      t.Generate;
+      Ada.Text_IO.Put_Line (GNAT.Source_Info.Source_Location);
+      Ada.Text_IO.Put_Line (Unparse (t));
+      Ada.Text_IO.Put_Line (Unparse_Lower (t));
+      Ada.Text_IO.Put_Line (Unparse_Upper (t));
+   end test_Generate;
+   --------------------
+   -- Register_Tests --
+   --------------------
+
+   procedure Register_Tests (T : in out Test_Case) is
+      use AUnit.Test_Cases.Registration;
+   begin
+      Register_Routine (T, test_Generate'Access, "test_Generate");
+   end Register_Tests;
+
+end uuid.Test;

eBindings/uuid/tests/testcases/uuid-test.ads

@@ -0,0 +1,14 @@
+with AUnit;
+with AUnit.Test_Cases;
+package uuid.Test 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.Test_String;
+   --  Returns name identifying the test case
+
+end uuid.Test;

eBindings/uuid/tests/uuid-suite.adb

@@ -0,0 +1,18 @@
+
+with uuid.Test;
+package body uuid.Suite is
+   use AUnit.Test_Suites;
+   Result : aliased Test_Suite;
+   Test_1 : aliased Standard.uuid.Test.Test_Case;
+
+   -----------
+   -- Suite --
+   -----------
+
+   function Suite return Access_Test_Suite is
+   begin
+      Add_Test (Result'Access, Test_1'Access);
+      return Result'Access;
+   end Suite;
+
+end uuid.Suite;

eBindings/uuid/tests/uuid-suite.ads

@@ -0,0 +1,8 @@
+with AUnit; use AUnit;
+with AUnit.Test_Suites;
+package uuid.Suite is
+
+   function Suite return Test_Suites.Access_Test_Suite;
+   --  Return the test suite
+
+end uuid.Suite;

eBindings/uuid/tests/uuid-test_main.adb

@@ -0,0 +1,14 @@
+with AUnit;
+
+--------------------
+-- Uuid.Test_Main --
+--------------------
+with AUnit.Reporter.Text;
+with AUnit.Run;
+with uuid.Suite;
+procedure uuid.Test_Main is
+   procedure Run is new AUnit.Run.Test_Runner (Standard.uuid.Suite.Suite);
+   reporter : AUnit.Reporter.Text.Text_Reporter;
+begin
+   Run (reporter);
+end uuid.Test_Main;

eBindings/uuid/tests/uuid-tests.gpr

@@ -0,0 +1,11 @@
+with "../uuid.gpr";
+with "aunit.gpr";
+project uuid.tests is
+   for Languages use ("C","Ada");
+   for source_dirs use (".","testcases");
+   for object_dir use ".obj";
+   for main use ("uuid-test_main","ctest.c");
+   package compiler is
+      for Default_Switches("Ada") use ("-gnatwa","-gnat05","-gnaty", "-gnaty-s");
+   end compiler;
+end uuid.tests;

eBindings/uuid/uuid.adb

@@ -139,30 +139,28 @@ package body uuid is
    end "=";
 
 
-   function Generate return  UUID is
+   procedure Generate (this : out UUID) is
    begin
-      return ret : UUID do
-         uuid_uuid_h.uuid_generate (ret.data (1)'Access);
-      end return;
+      uuid_uuid_h.uuid_generate (this.data (this.data'First)'Access);
    end Generate;
 
    function Generate_Random return  UUID is
    begin
       return ret : UUID do
-         uuid_uuid_h.uuid_generate_random (ret.data (1)'Access);
+         uuid_uuid_h.uuid_generate_random (ret.data (ret.data'First)'Access);
       end return;
    end Generate_Random;
 
    function Generate_Time return  UUID is
    begin
       return ret : UUID do
-         uuid_uuid_h.uuid_generate_time (ret.data (1)'Access);
+         uuid_uuid_h.uuid_generate_time (ret.data (ret.data'First)'Access);
       end return;
    end Generate_Time;
 
    function Is_Null (arg1 : UUID) return Boolean is
    begin
-      return uuid_uuid_h.uuid_is_null (arg1.data (1)'Unrestricted_Access) /= 0;
+      return uuid_uuid_h.uuid_is_null (arg1.data (arg1.data'First)'Unrestricted_Access) /= 0;
    end Is_Null;
 
    function Parse (arg2 : String) return UUID is
@@ -172,22 +170,22 @@ package body uuid is
       end return;
    end Parse;
 
-   function Unparse (arg1 : access UUID) return String is
+   function Unparse (arg1 : UUID) return String is
    begin
       return "";
    end Unparse;
 
-   function Unparse_Lower (arg1 : access UUID) return String is
+   function Unparse_Lower (arg1 : UUID) return String is
    begin
       return "";
    end Unparse_Lower;
 
-   function Unparse_Upper (arg1 : access UUID) return String is
+   function Unparse_Upper (arg1 : UUID) return String is
    begin
       return "";
    end Unparse_Upper;
 
-   function time (arg1 : access uuid;
+   function time (arg1 : uuid;
                   arg2 : access bits_time_h.timeval) return time_h.time_t is
    begin
       return time(arg1,arg2);

eBindings/uuid/uuid.ads

@@ -13,7 +13,7 @@ package uuid is
    function "=" (l, r : UUID) return Boolean;
 
 
-   function Generate return  UUID;
+   procedure Generate (this : out UUID);
 
    function Generate_Random return  UUID;
 
@@ -23,11 +23,11 @@ package uuid is
 
    function Parse (arg2 : String) return UUID;
 
-   function Unparse (arg1 : access UUID) return String;
+   function Unparse (arg1 : UUID) return String;
 
-   function Unparse_Lower (arg1 : access UUID) return String;
+   function Unparse_Lower (arg1 : UUID) return String;
 
-   function Unparse_Upper (arg1 : access UUID) return String;
+   function Unparse_Upper (arg1 : UUID) return String;
 
    --  function time (arg1 : access uuid;
    --                 arg2 : access bits_time_h.timeval) return time_h.time_t;
@@ -41,6 +41,6 @@ package uuid is
 private
    type uuid_t is array (0 .. 15) of aliased Interfaces.C.unsigned_char;
    type UUID is tagged record
-      data : aliased uuid_t;
+      data : uuid_t;
    end record;
 end uuid;

eBindings/uuid/uuid.gpr

@@ -1,7 +1,10 @@
 with "libuuid";
 project UUID is
 
+   for Languages use ("C","Ada");
+
    package Compiler is
+      for Driver ("C") use "";
       for Default_Switches ("ada") use ("-g", "-O2", "-gnat05");
    end Compiler;
 

make/Makefile

@@ -0,0 +1,9 @@
+compile:
+
+all: compile link
+
+
+link:
+
+%:
+	echo $@

tests/zmq-tests.gpr

@@ -24,9 +24,8 @@ project ZMQ.Tests is
    package Binder is
       for Default_Switches ("ada") use ("-E");
    end Binder;
-   package Linker is
-      for Default_Switches ("ada") use ("-lpthread","-luuid");
-   end Linker;
+   package Make renames ZMQ.Make;
    package Ide renames ZMQ.Ide;
+
 end ZMQ.Tests;
 

zmq.gpr

@@ -91,7 +91,7 @@ project ZMQ is
       for Driver("Project File") use "";
       for Default_Switches ("ada") use ("-g", "-O2", "-gnatf", "-gnat05","-gnatwa","-gnaty");
       for Switches("zmq-low_level.ads") use
-         Compiler'Default_Switches ("ada") & ("-gnaty-M"); -- Since this file is autogenerated.
+        Compiler'Default_Switches ("ada") & ("-gnaty-M"); -- Since this file is autogenerated.
    end Compiler;
 
    package Naming is
@@ -99,6 +99,11 @@ project ZMQ is
       -- for Body_Suffix("Project File") use ".gpr";
    end Naming;
 
+   package Make is
+      for Directory use project'Project_Dir;
+      for Makefile  use "Makefile";
+   end Make;
+
    package Check is
       for Default_Switches ("ada") use ("-rules", "-from=" & Project'Project_Dir & "/zmq.rules");
    end Check;