URL
https://opencores.org/ocsvn/openrisc/openrisc/trunk
Subversion Repositories openrisc
[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c9/] [c940015.a] - Rev 154
Go to most recent revision | Compare with Previous | Blame | View Log
-- 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;
Go to most recent revision | Compare with Previous | Blame | View Log