diff options
Diffstat (limited to 'gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c940015.a')
| -rw-r--r-- | gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c940015.a | 149 |
1 files changed, 149 insertions, 0 deletions
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c940015.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c940015.a new file mode 100644 index 000000000..92a6699c3 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c940015.a @@ -0,0 +1,149 @@ +-- C940015.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. +--* +-- +-- TEST OBJECTIVE: +-- Check that the component_declarations of a protected_operation +-- are elaborated in the proper order. +-- +-- TEST DESCRIPTION: +-- A discriminated protected object is declared with some +-- components that depend upon the discriminant and some that +-- do not depend upon the discriminant. All the components +-- are initialized with a function call. As a side-effect of +-- the function call the parameter passed to the function is +-- recorded in an elaboration order array. +-- Two objects of the protected type are declared. The +-- elaboration order is recorded and checked against the +-- expected order. +-- +-- +-- CHANGE HISTORY: +-- 09 Jan 96 SAIC Initial Version for 2.1 +-- 09 Jul 96 SAIC Addressed reviewer comments. +-- 13 Feb 97 PWB.CTA Removed doomed attempt to check per-object +-- constraint elaborations. +--! + + +with Report; + +procedure C940015 is + Verbose : constant Boolean := False; + Do_Display : Boolean := Verbose; + + type Index is range 0..10; + + type List is array (1..10) of Integer; + Last : Natural range 0 .. List'Last := 0; + E_List : List := (others => 0); + + function Elaborate (Id : Integer) return Index is + begin + Last := Last + 1; + E_List (Last) := Id; + if Verbose then + Report.Comment ("Elaborating" & Integer'Image (Id)); + end if; + return Index(Id mod 10); + end Elaborate; + + function Elaborate (Id, Per_Obj_Expr : Integer) return Index is + begin + return Elaborate (Id); + end Elaborate; + +begin + + Report.Test ("C940015", "Check that the component_declarations of a" & + " protected object are elaborated in the" & + " proper order"); + declare + -- an unprotected queue type + type Storage is array (Index range <>) of Integer; + type Queue (Size, Flag : Index := 1) is + record + Head : Index := 1; + Tail : Index := 1; + Count : Index := 0; + Buffer : Storage (1..Size); + end record; + + -- protected group of queues type + protected type Prot_Queues (Size : Index := Elaborate (104)) is + procedure Clear; + -- other needed procedures not provided at this time + private + -- elaborate at type elaboration + Fixed_Queue_1 : Queue (3, + Elaborate (105)); + -- elaborate at type elaboration + Fixed_Queue_2 : Queue (6, + Elaborate (107)); + end Prot_Queues; + protected body Prot_Queues is + procedure Clear is + begin + Fixed_Queue_1.Count := 0; + Fixed_Queue_1.Head := 1; + Fixed_Queue_1.Tail := 1; + Fixed_Queue_2.Count := 0; + Fixed_Queue_2.Head := 1; + Fixed_Queue_2.Tail := 1; + end Clear; + end Prot_Queues; + + PO1 : Prot_Queues(9); + PO2 : Prot_Queues; + + Expected_Elab_Order : List := ( + -- from the elaboration of the protected type Prot_Queues + 105, 107, + -- from the unconstrained object PO2 + 104, + others => 0); + begin + for I in List'Range loop + if E_List (I) /= Expected_Elab_Order (I) then + Report.Failed ("wrong elaboration order"); + Do_Display := True; + end if; + end loop; + if Do_Display then + Report.Comment ("Expected Actual"); + for I in List'Range loop + Report.Comment ( + Integer'Image (Expected_Elab_Order(I)) & + Integer'Image (E_List(I))); + end loop; + end if; + + -- make use of the protected objects + PO1.Clear; + PO2.Clear; + end; + + Report.Result; + +end C940015; |