diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/cb/cb10002.a')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/cb/cb10002.a | 128 |
1 files changed, 0 insertions, 128 deletions
diff --git a/gcc/testsuite/ada/acats/tests/cb/cb10002.a b/gcc/testsuite/ada/acats/tests/cb/cb10002.a deleted file mode 100644 index f3099d4a26c..00000000000 --- a/gcc/testsuite/ada/acats/tests/cb/cb10002.a +++ /dev/null @@ -1,128 +0,0 @@ --- CB10002.A - --- Grant of Unlimited Rights --- --- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, --- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained --- unlimited rights in the software and documentation contained herein. --- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making --- this public release, the Government intends to confer upon all --- recipients unlimited rights equal to those held by the Government. --- These rights include rights to use, duplicate, release or disclose the --- released technical data and computer software in whole or in part, in --- any manner and for any purpose whatsoever, and to have or permit others --- to do so. --- --- DISCLAIMER --- --- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR --- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED --- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE --- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE --- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A --- PARTICULAR PURPOSE OF SAID MATERIAL. ---* --- --- OBJECTIVE: --- Check that Storage_Error is raised when storage for allocated objects --- is exceeded. --- --- TEST DESCRIPTION: --- This test allocates a very large data structure. --- --- In order to avoid running forever on virtual memory targets, the --- data structure is bounded in size, and elements are larger the longer --- the program runs. --- --- The program attempts to allocate about 8,600,000 integers, or about --- 32 Megabytes on a typical 32-bit machine. --- --- If Storage_Error is raised, the data structure is deallocated. --- (Otherwise, Report.Result may fail as memory is exhausted). - --- CHANGE HISTORY: --- 30 Aug 85 JRK Ada 83 test created. --- 14 Sep 99 RLB Created Ada 95 test. - - -with Report; -with Ada.Unchecked_Deallocation; -procedure CB10002 is - - type Data_Space is array (Positive range <>) of Integer; - - type Element (Size : Positive); - - type Link is access Element; - - type Element (Size : Positive) is - record - Parent : Link; - Child : Link; - Sibling: Link; - Data : Data_Space (1 .. Size); - end record; - - procedure Free is new Ada.Unchecked_Deallocation (Element, Link); - - Holder : array (1 .. 430) of Link; - Last_Allocated : Natural := 0; - - procedure Allocator (Count : in Positive) is - begin - -- Allocate various sized objects similar to what a real application - -- would do. - if Count in 1 .. 20 then - Holder(Count) := new Element (Report.Ident_Int(10)); - elsif Count in 21 .. 40 then - Holder(Count) := new Element (Report.Ident_Int(79)); - elsif Count in 41 .. 60 then - Holder(Count) := new Element (Report.Ident_Int(250)); - elsif Count in 61 .. 80 then - Holder(Count) := new Element (Report.Ident_Int(520)); - elsif Count in 81 .. 100 then - Holder(Count) := new Element (Report.Ident_Int(1000)); - elsif Count in 101 .. 120 then - Holder(Count) := new Element (Report.Ident_Int(2048)); - elsif Count in 121 .. 140 then - Holder(Count) := new Element (Report.Ident_Int(4200)); - elsif Count in 141 .. 160 then - Holder(Count) := new Element (Report.Ident_Int(7999)); - elsif Count in 161 .. 180 then - Holder(Count) := new Element (Report.Ident_Int(15000)); - else -- 181..430 - Holder(Count) := new Element (Report.Ident_Int(32000)); - end if; - Last_Allocated := Count; - end Allocator; - - -begin - Report.Test ("CB10002", "Check that Storage_Error is raised when " & - "storage for allocated objects is exceeded"); - - begin - for I in Holder'range loop - Allocator (I); - end loop; - Report.Not_Applicable ("Unable to exhaust memory"); - for I in 1 .. Last_Allocated loop - Free (Holder(I)); - end loop; - exception - when Storage_Error => - if Last_Allocated = 0 then - Report.Failed ("Unable to allocate anything"); - else -- Clean up, so we have enough memory to report on the result. - for I in 1 .. Last_Allocated loop - Free (Holder(I)); - end loop; - Report.Comment (Natural'Image(Last_Allocated) & " items allocated"); - end if; - when others => - Report.Failed ("Wrong exception raised by heap overflow"); - end; - - Report.Result; - -end CB10002; |