-- C953001.A
|
-- C953001.A
|
--
|
--
|
-- Grant of Unlimited Rights
|
-- Grant of Unlimited Rights
|
--
|
--
|
-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
|
-- 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
|
-- 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 in the software and documentation contained herein.
|
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
|
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
|
-- this public release, the Government intends to confer upon all
|
-- this public release, the Government intends to confer upon all
|
-- recipients unlimited rights equal to those held by the Government.
|
-- recipients unlimited rights equal to those held by the Government.
|
-- These rights include rights to use, duplicate, release or disclose the
|
-- These rights include rights to use, duplicate, release or disclose the
|
-- released technical data and computer software in whole or in part, in
|
-- 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
|
-- any manner and for any purpose whatsoever, and to have or permit others
|
-- to do so.
|
-- to do so.
|
--
|
--
|
-- DISCLAIMER
|
-- DISCLAIMER
|
--
|
--
|
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
|
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
|
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
|
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
|
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
|
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
|
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
|
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
|
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
|
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
|
-- PARTICULAR PURPOSE OF SAID MATERIAL.
|
-- PARTICULAR PURPOSE OF SAID MATERIAL.
|
--*
|
--*
|
--
|
--
|
-- OBJECTIVE:
|
-- OBJECTIVE:
|
-- Check that if the evaluation of an entry_barrier condition
|
-- Check that if the evaluation of an entry_barrier condition
|
-- propagates an exception, the exception Program_Error
|
-- propagates an exception, the exception Program_Error
|
-- is propagated to all current callers of all entries of the
|
-- is propagated to all current callers of all entries of the
|
-- protected object.
|
-- protected object.
|
--
|
--
|
-- TEST DESCRIPTION:
|
-- TEST DESCRIPTION:
|
-- This test declares a protected object (PO) with two entries and
|
-- This test declares a protected object (PO) with two entries and
|
-- a 5 element entry family.
|
-- a 5 element entry family.
|
-- All the entries are always closed. However, one of the entries
|
-- All the entries are always closed. However, one of the entries
|
-- (Oh_No) will get a constraint_error in its barrier_evaluation
|
-- (Oh_No) will get a constraint_error in its barrier_evaluation
|
-- whenever the global variable Blow_Up is true.
|
-- whenever the global variable Blow_Up is true.
|
-- An array of tasks is created where the tasks wait on the various
|
-- An array of tasks is created where the tasks wait on the various
|
-- entries of the protected object. Once all the tasks are waiting
|
-- entries of the protected object. Once all the tasks are waiting
|
-- the main procedure calls the entry Oh_No and causes an exception
|
-- the main procedure calls the entry Oh_No and causes an exception
|
-- to be propagated to all the tasks. The tasks record the fact
|
-- to be propagated to all the tasks. The tasks record the fact
|
-- that they got the correct exception in global variables that
|
-- that they got the correct exception in global variables that
|
-- can be checked after the tasks complete.
|
-- can be checked after the tasks complete.
|
--
|
--
|
--
|
--
|
-- CHANGE HISTORY:
|
-- CHANGE HISTORY:
|
-- 19 OCT 95 SAIC ACVC 2.1
|
-- 19 OCT 95 SAIC ACVC 2.1
|
--
|
--
|
--!
|
--!
|
|
|
|
|
with Report;
|
with Report;
|
with ImpDef;
|
with ImpDef;
|
procedure C953001 is
|
procedure C953001 is
|
Verbose : constant Boolean := False;
|
Verbose : constant Boolean := False;
|
Max_Tasks : constant := 12;
|
Max_Tasks : constant := 12;
|
|
|
-- note status and error conditions
|
-- note status and error conditions
|
Blocked_Entry_Taken : Boolean := False;
|
Blocked_Entry_Taken : Boolean := False;
|
In_Oh_No : Boolean := False;
|
In_Oh_No : Boolean := False;
|
Task_Passed : array (1..Max_Tasks) of Boolean := (1..Max_Tasks => False);
|
Task_Passed : array (1..Max_Tasks) of Boolean := (1..Max_Tasks => False);
|
|
|
begin
|
begin
|
Report.Test ("C953001",
|
Report.Test ("C953001",
|
"Check that an exception in an entry_barrier condition" &
|
"Check that an exception in an entry_barrier condition" &
|
" causes Program_Error to be propagated to all current" &
|
" causes Program_Error to be propagated to all current" &
|
" callers of all entries of the protected object");
|
" callers of all entries of the protected object");
|
|
|
declare -- test encapsulation
|
declare -- test encapsulation
|
-- miscellaneous values
|
-- miscellaneous values
|
Cows : Integer := Report.Ident_Int (1);
|
Cows : Integer := Report.Ident_Int (1);
|
Came_Home : Integer := Report.Ident_Int (2);
|
Came_Home : Integer := Report.Ident_Int (2);
|
|
|
-- make the Barrier_Condition fail only when we want it to
|
-- make the Barrier_Condition fail only when we want it to
|
Blow_Up : Boolean := False;
|
Blow_Up : Boolean := False;
|
|
|
function Barrier_Condition return Boolean is
|
function Barrier_Condition return Boolean is
|
begin
|
begin
|
if Blow_Up then
|
if Blow_Up then
|
return 5 mod Report.Ident_Int(0) = 1;
|
return 5 mod Report.Ident_Int(0) = 1;
|
else
|
else
|
return False;
|
return False;
|
end if;
|
end if;
|
end Barrier_Condition;
|
end Barrier_Condition;
|
|
|
subtype Family_Index is Integer range 1..5;
|
subtype Family_Index is Integer range 1..5;
|
|
|
protected PO is
|
protected PO is
|
entry Block1;
|
entry Block1;
|
entry Oh_No;
|
entry Oh_No;
|
entry Family (Family_Index);
|
entry Family (Family_Index);
|
end PO;
|
end PO;
|
|
|
protected body PO is
|
protected body PO is
|
entry Block1 when Report.Ident_Int(0) = Report.Ident_Int(1) is
|
entry Block1 when Report.Ident_Int(0) = Report.Ident_Int(1) is
|
begin
|
begin
|
Blocked_Entry_Taken := True;
|
Blocked_Entry_Taken := True;
|
end Block1;
|
end Block1;
|
|
|
-- barrier will get a Constraint_Error (divide by 0)
|
-- barrier will get a Constraint_Error (divide by 0)
|
entry Oh_No when Barrier_Condition is
|
entry Oh_No when Barrier_Condition is
|
begin
|
begin
|
In_Oh_No := True;
|
In_Oh_No := True;
|
end Oh_No;
|
end Oh_No;
|
|
|
entry Family (for Member in Family_Index) when Cows = Came_Home is
|
entry Family (for Member in Family_Index) when Cows = Came_Home is
|
begin
|
begin
|
Blocked_Entry_Taken := True;
|
Blocked_Entry_Taken := True;
|
end Family;
|
end Family;
|
end PO;
|
end PO;
|
|
|
|
|
task type Waiter is
|
task type Waiter is
|
entry Take_Id (Id : Integer);
|
entry Take_Id (Id : Integer);
|
end Waiter;
|
end Waiter;
|
|
|
Bunch_of_Waiters : array (1..Max_Tasks) of Waiter;
|
Bunch_of_Waiters : array (1..Max_Tasks) of Waiter;
|
|
|
task body Waiter is
|
task body Waiter is
|
Me : Integer;
|
Me : Integer;
|
Action : Integer;
|
Action : Integer;
|
begin
|
begin
|
accept Take_Id (Id : Integer) do
|
accept Take_Id (Id : Integer) do
|
Me := Id;
|
Me := Id;
|
end Take_Id;
|
end Take_Id;
|
|
|
Action := Me mod (Family_Index'Last + 1);
|
Action := Me mod (Family_Index'Last + 1);
|
begin
|
begin
|
if Action = 0 then
|
if Action = 0 then
|
PO.Block1;
|
PO.Block1;
|
else
|
else
|
PO.Family (Action);
|
PO.Family (Action);
|
end if;
|
end if;
|
Report.Failed ("no exception for task" & Integer'Image (Me));
|
Report.Failed ("no exception for task" & Integer'Image (Me));
|
exception
|
exception
|
when Program_Error =>
|
when Program_Error =>
|
Task_Passed (Me) := True;
|
Task_Passed (Me) := True;
|
if Verbose then
|
if Verbose then
|
Report.Comment ("pass for task" & Integer'Image (Me));
|
Report.Comment ("pass for task" & Integer'Image (Me));
|
end if;
|
end if;
|
when others =>
|
when others =>
|
Report.Failed ("wrong exception raised in task" &
|
Report.Failed ("wrong exception raised in task" &
|
Integer'Image (Me));
|
Integer'Image (Me));
|
end;
|
end;
|
end Waiter;
|
end Waiter;
|
|
|
|
|
begin -- test encapsulation
|
begin -- test encapsulation
|
for I in 1..Max_Tasks loop
|
for I in 1..Max_Tasks loop
|
Bunch_Of_Waiters(I).Take_Id (I);
|
Bunch_Of_Waiters(I).Take_Id (I);
|
end loop;
|
end loop;
|
|
|
-- give all the Waiters time to get queued
|
-- give all the Waiters time to get queued
|
delay 2*ImpDef.Clear_Ready_Queue;
|
delay 2*ImpDef.Clear_Ready_Queue;
|
|
|
-- cause the protected object to fail
|
-- cause the protected object to fail
|
begin
|
begin
|
Blow_Up := True;
|
Blow_Up := True;
|
PO.Oh_No;
|
PO.Oh_No;
|
Report.Failed ("no exception in call to PO.Oh_No");
|
Report.Failed ("no exception in call to PO.Oh_No");
|
exception
|
exception
|
when Constraint_Error =>
|
when Constraint_Error =>
|
Report.Failed ("Constraint_Error instead of Program_Error");
|
Report.Failed ("Constraint_Error instead of Program_Error");
|
when Program_Error =>
|
when Program_Error =>
|
if Verbose then
|
if Verbose then
|
Report.Comment ("main exception passed");
|
Report.Comment ("main exception passed");
|
end if;
|
end if;
|
when others =>
|
when others =>
|
Report.Failed ("wrong exception in main");
|
Report.Failed ("wrong exception in main");
|
end;
|
end;
|
end; -- test encapsulation
|
end; -- test encapsulation
|
|
|
-- all the tasks have now completed.
|
-- all the tasks have now completed.
|
-- check the flags for pass/fail info
|
-- check the flags for pass/fail info
|
if Blocked_Entry_Taken then
|
if Blocked_Entry_Taken then
|
Report.Failed ("blocked entry taken");
|
Report.Failed ("blocked entry taken");
|
end if;
|
end if;
|
if In_Oh_No then
|
if In_Oh_No then
|
Report.Failed ("entry taken with exception in barrier");
|
Report.Failed ("entry taken with exception in barrier");
|
end if;
|
end if;
|
for I in 1..Max_Tasks loop
|
for I in 1..Max_Tasks loop
|
if not Task_Passed (I) then
|
if not Task_Passed (I) then
|
Report.Failed ("task" & Integer'Image (I) & " did not pass");
|
Report.Failed ("task" & Integer'Image (I) & " did not pass");
|
end if;
|
end if;
|
end loop;
|
end loop;
|
|
|
Report.Result;
|
Report.Result;
|
end C953001;
|
end C953001;
|
|
|