spark_unbound_0.2.1_1f8dae01/src/spark_unbound-safe_alloc.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
with Ada.Unchecked_Deallocation;

package body Spark_Unbound.Safe_Alloc with SPARK_Mode is

   package body Definite with SPARK_Mode is
      
      function Alloc return T_Acc is
         pragma SPARK_Mode (Off); -- Spark OFF for exception handling
      begin
         return new T;
      exception
         when Storage_Error =>
            return null;
      end Alloc;

      procedure Free (Pointer : in out T_Acc) is
         procedure Dealloc is new Ada.Unchecked_Deallocation (T, T_Acc);
      begin
         Dealloc (Pointer);
      end Free;
   end Definite;
   
   package body Arrays with SPARK_Mode is

      function Alloc (First, Last : Index_Type) return Array_Type_Acc is
         pragma SPARK_Mode (Off); -- Spark OFF for exception handling
      begin
         return new Array_Type(First .. Last);
      exception
         when Storage_Error =>
            return null;
      end Alloc;
      
      procedure Free (Pointer : in out Array_Type_Acc) is
         procedure Dealloc is new Ada.Unchecked_Deallocation (Array_Type, Array_Type_Acc);
      begin
         Dealloc (Pointer);
      end Free;
      
   end Arrays;
   
end Spark_Unbound.Safe_Alloc;