agpl_1.0.0_b5da3320/src/agpl-interfaces-c-types.adb

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
with Ada.Strings.Fixed;

package body Agpl.Interfaces.C.Types is

   ---------
   -- "+" --
   ---------

   function "+" (B : Boolean)   return Agpl_Bool is
   begin
      if B then
         return 1;
      else
         return 0;
      end if;
   end "+";

   function "+" (B : Agpl_Bool) return Boolean is
   begin
      return B /= 0;
   end "+";

   -----------------
   -- New_Cstring --
   -----------------

   function New_Cstring (Str : String) return Cstring is
   begin
      return Cstring'(Ada.Finalization.Controlled with
                      Ptr => Ic.Strings.New_String (Str));
   end New_Cstring;

   -----------------------
   -- New_Empty_CString --
   -----------------------

   function New_Empty_CString (Length : Natural) return Cstring is
      use Ada.Strings.Fixed;
   begin
      return New_Cstring ((Length + 1) * Character'Val (0));
   end New_Empty_CString;

   ---------
   -- Ptr --
   ---------

   function Ptr (Cstr : Cstring) return Ic.Strings.Chars_Ptr is
   begin
      return Cstr.Ptr;
   end Ptr;

   -----------
   -- Value --
   -----------

   function Value (Str : Cstring) return String is
   begin
      return Standard.Interfaces.C.Strings.Value (Str.Ptr);
   end Value;

   --------------
   -- Finalize --
   --------------

   procedure Finalize
     (This : in out Cstring)
   is
      use Ic.Strings;
   begin
      if This.Ptr /= Null_Ptr then
         Ic.Strings.Free (This.Ptr);
      end if;
   end Finalize;

   ------------
   -- Adjust --
   ------------

   procedure Adjust (This : in out Cstring) is
      use Ic.Strings;
   begin
      if This.Ptr /= Null_Ptr then
         This.Ptr := New_String (Value (This.Ptr));
      end if;
   end Adjust;

end Agpl.Interfaces.C.Types;