diff options
Diffstat (limited to 'gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc54001.a')
| -rw-r--r-- | gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc54001.a | 184 |
1 files changed, 184 insertions, 0 deletions
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc54001.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc54001.a new file mode 100644 index 000000000..eb297d0ec --- /dev/null +++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc54001.a @@ -0,0 +1,184 @@ +-- CC54001.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 a general access-to-constant type may be passed as an +-- actual to a generic formal access-to-constant type. +-- +-- TEST DESCRIPTION: +-- The generic implements a stack of access objects as an array. The +-- designated type of the formal access type is itself a formal private +-- type declared in the same generic formal part. +-- +-- The generic is instantiated with an unconstrained subtype of String, +-- which results in a stack which can accommodate strings of varying +-- lengths (ragged array). Furthermore, the access objects to be pushed +-- onto the stack are created both statically and dynamically, utilizing +-- allocators and the 'Access attribute. +-- +-- +-- CHANGE HISTORY: +-- 06 Dec 94 SAIC ACVC 2.0 +-- 10 Apr 96 SAIC ACVC 2.1: Added pragma Elaborate to context clause +-- preceding CC54001_1. +-- +--! + +generic + Size : in Positive; + type Element_Type (<>) is private; + type Element_Ptr is access constant Element_Type; +package CC54001_0 is -- Generic stack of pointers. + + type Stack_Type is private; + + procedure Push (Stack : in out Stack_Type; + Elem_Ptr : in Element_Ptr); + + procedure Pop (Stack : in out Stack_Type; + Elem_Ptr : out Element_Ptr); + + -- ... Other operations. + +private + + subtype Index is Positive range 1 .. (Size + 1); + type Stack_Type is array (Index) of Element_Ptr; -- Last element unused. + + Top : Index := 1; + +end CC54001_0; + + + --===================================================================-- + + +package body CC54001_0 is + + procedure Push (Stack : in out Stack_Type; + Elem_Ptr : in Element_Ptr) is + begin + Stack(Top) := Elem_Ptr; + Top := Top + 1; -- Artificial: no Constraint_Error protection. + end Push; + + + procedure Pop (Stack : in out Stack_Type; + Elem_Ptr : out Element_Ptr) is + begin + Top := Top - 1; -- Artificial: no Constraint_Error protection. + Elem_Ptr := Stack(Top); + end Pop; + +end CC54001_0; + + + --===================================================================-- + + +with CC54001_0; -- Generic stack of pointers. +pragma Elaborate (CC54001_0); + +package CC54001_1 is + + subtype Message is String; + type Message_Ptr is access constant Message; + + Message_Count : constant := 4; + + Message_0 : aliased constant Message := "Hello"; + Message_1 : aliased constant Message := "Doctor"; + Message_2 : aliased constant Message := "Name"; + Message_3 : aliased constant Message := "Continue"; + + + package Stack_of_Messages is new CC54001_0 + (Element_Type => Message, + Element_Ptr => Message_Ptr, + Size => Message_Count); + + Message_Stack : Stack_Of_Messages.Stack_Type; + + + procedure Create_Message_Stack; + +end CC54001_1; + + + --===================================================================-- + + +package body CC54001_1 is + + procedure Create_Message_Stack is + -- Push access objects onto stack. Note that some are statically + -- allocated, and some are dynamically allocated (using an aliased + -- object to initialize). + begin + Stack_Of_Messages.Push (Message_Stack, Message_0'Access); -- Static. + Stack_Of_Messages.Push (Message_Stack, + new Message'(Message_1)); -- Dynamic. + Stack_Of_Messages.Push (Message_Stack, Message_2'Access); -- Static. + Stack_Of_Messages.Push (Message_Stack, -- Dynamic. + new Message'(Message_3)); + end Create_Message_Stack; + +end CC54001_1; + + + --===================================================================-- + + +with CC54001_1; + +with Report; +procedure CC54001 is + + package Messages renames CC54001_1.Stack_Of_Messages; + + Msg0, Msg1, Msg2, Msg3 : CC54001_1.Message_Ptr; + +begin + Report.Test ("CC54001", "Check that a general access-to-constant type " & + "may be passed as an actual to a generic formal " & + "access-to-constant type"); + + CC54001_1.Create_Message_Stack; + + Messages.Pop (CC54001_1.Message_Stack, Msg3); -- Pop items off stack in the + Messages.Pop (CC54001_1.Message_Stack, Msg2); -- reverse order that they + Messages.Pop (CC54001_1.Message_Stack, Msg1); -- were pushed. + Messages.Pop (CC54001_1.Message_Stack, Msg0); + + if Msg0.all /= CC54001_1.Message_0 or else + Msg1.all /= CC54001_1.Message_1 or else + Msg2.all /= CC54001_1.Message_2 or else + Msg3.all /= CC54001_1.Message_3 + then + Report.Failed ("Items popped off of stack do not match those pushed"); + end if; + + Report.Result; +end CC54001; |