spark_unbound_0.2.1_1f8dae01/tests/src/Safe_Alloc/sa_definite_tests.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
with Spark_Unbound.Safe_Alloc;
with AUnit.Assertions; use AUnit.Assertions;
with Ada.Exceptions;

package body SA_Definite_Tests is

   procedure TestAlloc_WithForcingStorageError_ResultNullReturned(T : in out Test_Fixture)
   is
      -- type Inner_Array is array(-90 .. 90) of Integer; -- forced test fail
      type Inner_Array is array(-9_00_000_000 .. 9_00_000_000) of Integer;      
      type Alloc_Record is record
         Arr1 : Inner_Array;
         Arr2 : Inner_Array;
         Arr3 : Inner_Array;
         Arr4 : Inner_Array;
         Arr5 : Inner_Array;
         Arr6 : Inner_Array;
         Arr7 : Inner_Array;
         Arr8 : Inner_Array;
         Arr9 : Inner_Array;
         Arr10 : Inner_Array;
         Arr11 : Inner_Array;
         Arr12 : Inner_Array;
         Arr13 : Inner_Array;
         Arr14 : Inner_Array;
         Arr15 : Inner_Array;
         Arr16 : Inner_Array;
         Arr17 : Inner_Array;
         Arr18 : Inner_Array;
         Arr19 : Inner_Array;
         Arr20 : Inner_Array;
         V1 : Integer;
         V2 : Natural;
         V3 : Positive;
      end record;
      
      type Record_Acc is access Alloc_Record;
        
      package Record_Alloc is new Spark_Unbound.Safe_Alloc.Definite(T => Alloc_Record, T_Acc => Record_Acc);
      Rec_Acc : Record_Acc;
      Storage_Error_Forced : Boolean := False;
      
      -- table to keep track of allocated records to be freed later
      type Rec_Table_Array is array (Integer range <>) of Record_Acc;
      Rec_Table : Rec_Table_Array(0 .. 1_000_000);
      Table_Index : Integer := Rec_Table'First;
   begin
      declare
      begin
         loop
            exit when (Storage_Error_Forced or else Table_Index >= Rec_Table'Last);
            
            begin
               Rec_Acc := Record_Alloc.Alloc;
               
               begin
                  Rec_Table(Table_Index) := Rec_Acc;
                  Table_Index := Table_Index + 1;
               exception
                  when others =>
                     Assert(False, "Table append failed");
               end;
                        
               if Rec_Acc = null then
                  Storage_Error_Forced := True;
               end if;
            exception
               when E : others =>
                  Assert(False, "Alloc failed: " & Ada.Exceptions.Exception_Name(E) & " => " & Ada.Exceptions.Exception_Message(E));
            end;
         end loop;

         -- free allocated
         for I in Rec_Table'First .. Rec_Table'Last loop
            Record_Alloc.Free(Rec_Table(I));
         end loop;
         
         Assert(Storage_Error_Forced, "Storage_Error could not be forced");
      exception
         when E : others =>
            Assert(False, "Exception got raised! Reason: " & Ada.Exceptions.Exception_Name(E) & " => " & Ada.Exceptions.Exception_Message(E));
      end;        
            
   end TestAlloc_WithForcingStorageError_ResultNullReturned;

end SA_Definite_Tests;