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/] [c940a03.a] - Rev 816
Compare with Previous | Blame | View Log
-- C940A03.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 protected object provides coordinated access to
-- shared data. Check that it can implement a semaphore-like construct
-- controlling access to shared data through procedure parameters to
-- allow a specific maximum number of tasks to run and exclude all
-- others.
--
-- TEST DESCRIPTION:
-- Declare a resource descriptor tagged type. Extend the type and
-- use the extended type in a protected data structure.
-- Implement a counting semaphore type that can be initialized to a
-- specific number of available resources. Declare an entry for
-- requesting a specific resource and an procedure for releasing the
-- same resource it. Declare an object of this (protected) type,
-- initialized to two resources. Declare and start three tasks each
-- of which asks for a resource. Verify that only two resources are
-- granted and that the last task in is queued.
--
-- This test models a multi-user operating system that allows a limited
-- number of logins. Users requesting login are modeled by tasks.
--
--
-- TEST FILES:
-- This test depends on the following foundation code:
--
-- F940A00
--
--
-- CHANGE HISTORY:
-- 06 Dec 94 SAIC ACVC 2.0
-- 13 Nov 95 SAIC Fixed bugs for ACVC 2.0.1
--
--!
package C940A03_0 is
--Resource_Pkg
-- General type declarations that will be extended to model available
-- logins
type Resource_ID_Type is range 0..10;
type Resource_Type is tagged record
Id : Resource_ID_Type := 0;
end record;
end C940A03_0;
--Resource_Pkg
--======================================--
-- no body for C940A3_0
--======================================--
with F940A00; -- Interlock_Foundation
with C940A03_0; -- Resource_Pkg;
package C940A03_1 is
-- Semaphores
-- Models a counting semaphore that will allow up to a specific
-- number of logins
-- Users (tasks) request a login slot by calling the Request_Login
-- entry and logout by calling the Release_Login procedure
Max_Logins : constant Integer := 2;
type Key_Type is range 0..100;
-- When a user requests a login, an
-- identifying key will be returned
Init_Key : constant Key_Type := 0;
type Login_Record_Type is new C940A03_0.Resource_Type with record
Key : Key_Type := Init_Key;
end record;
protected type Login_Semaphore_Type (Resources_Available : Integer :=1) is
entry Request_Login (Resource_Key : in out Login_Record_Type);
procedure Release_Login;
function Available return Integer; -- how many logins are available?
private
Logins_Avail : Integer := Resources_Available;
Next_Key : Key_Type := Init_Key;
end Login_Semaphore_Type;
Login_Semaphore : Login_Semaphore_Type (Max_Logins);
--====== machinery for the test, not the model =====--
TC_Control_Message : F940A00.Interlock_Type;
function TC_Key_Val (Login_Rec : Login_Record_Type) return Integer;
end C940A03_1;
-- Semaphores;
--=========================================================--
package body C940A03_1 is
-- Semaphores is
protected body Login_Semaphore_Type is
entry Request_Login (Resource_Key : in out Login_Record_Type)
when Logins_Avail > 0 is
begin
Next_Key := Next_Key + 1; -- login process returns a key
Resource_Key.Key := Next_Key; -- to the requesting user
Logins_Avail := Logins_Avail - 1;
end Request_Login;
procedure Release_Login is
begin
Logins_Avail := Logins_Avail + 1;
end Release_Login;
function Available return Integer is
begin
return Logins_Avail;
end Available;
end Login_Semaphore_Type;
function TC_Key_Val (Login_Rec : Login_Record_Type) return Integer is
begin
return Integer (Login_Rec.Key);
end TC_Key_Val;
end C940A03_1;
-- Semaphores;
--=========================================================--
with C940A03_0; -- Resource_Pkg,
with C940A03_1; -- Semaphores;
package C940A03_2 is
-- Task_Pkg
package Semaphores renames C940A03_1;
task type User_Task_Type is
entry Login (user_id : C940A03_0.Resource_Id_Type);
-- instructs the task to ask for a login
entry Logout; -- instructs the task to release the login
--=======================--
-- this entry is used to get information to verify test operation
entry Get_Status (User_Record : out Semaphores.Login_Record_Type);
end User_Task_Type;
end C940A03_2;
-- Task_Pkg
--=========================================================--
with Report;
with C940A03_0; -- Resource_Pkg,
with C940A03_1; -- Semaphores,
with F940A00; -- Interlock_Foundation;
package body C940A03_2 is
-- Task_Pkg
-- This task models a user requesting a login from the system
-- For control of this test, we can ask the task to login, logout, or
-- give us the current user record (containing login information)
task body User_Task_Type is
Rec : Semaphores.Login_Record_Type;
begin
loop
select
accept Login (user_id : C940A03_0.Resource_Id_Type) do
Rec.Id := user_id;
end Login;
Semaphores.Login_Semaphore.Request_Login (Rec);
-- request a resource; if resource is not available,
-- task will be queued to wait
--== following is test control machinery ==--
F940A00.Counter.Increment;
Semaphores.TC_Control_Message.Post;
-- after resource is obtained, post message
or
accept Logout do
Semaphores.Login_Semaphore.Release_Login;
-- release the resource
--== test control machinery ==--
F940A00.Counter.Decrement;
end Logout;
exit;
or
accept Get_Status (User_Record : out Semaphores.Login_Record_Type) do
User_Record := Rec;
end Get_Status;
end select;
end loop;
exception
when others => Report.Failed ("Exception raised in model user task");
end User_Task_Type;
end C940A03_2;
-- Task_Pkg
--=========================================================--
with Report;
with ImpDef;
with C940A03_1; -- Semaphores,
with C940A03_2; -- Task_Pkg,
with F940A00; -- Interlock_Foundation;
procedure C940A03 is
package Semaphores renames C940A03_1;
package Users renames C940A03_2;
Task1, Task2, Task3 : Users.User_Task_Type;
User_Rec : Semaphores.Login_Record_Type;
begin -- Tasks start here
Report.Test ("C940A03", "Check that a protected object can coordinate " &
"shared data access using procedure parameters");
if F940A00.Counter.Number /=0 then
Report.Failed ("Wrong initial conditions");
end if;
Task1.Login (1); -- request resource; request should be granted
Semaphores.TC_Control_Message.Consume;
-- ensure that task obtains resource by
-- waiting for task to post message
-- Task 1 waiting for call to Logout
-- Others still available
Task1.Get_Status (User_Rec);
if (F940A00.Counter.Number /= 1)
or (Semaphores.Login_Semaphore.Available /=1)
or (Semaphores.TC_Key_Val (User_Rec) /= 1) then
Report.Failed ("Resource not assigned to task 1");
end if;
Task2.Login (2); -- Request for resource should be granted
Semaphores.TC_Control_Message.Consume;
-- ensure that task obtains resource by
-- waiting for task to post message
Task2.Get_Status (User_Rec);
if (F940A00.Counter.Number /= 2)
or (Semaphores.Login_Semaphore.Available /=0)
or (Semaphores.TC_Key_Val (User_Rec) /= 2) then
Report.Failed ("Resource not assigned to task 2");
end if;
Task3.Login (3); -- request for resource should be denied
-- and task queued
-- Tasks 1 and 2 holds resources
-- and are waiting for a call to Logout
-- Task 3 is queued
if (F940A00.Counter.Number /= 2)
or (Semaphores.Login_Semaphore.Available /=0) then
Report.Failed ("Resource incorrectly assigned to task 3");
end if;
Task1.Logout; -- released resource should be given to
-- queued task
Semaphores.TC_Control_Message.Consume;
-- wait for confirming message from task
-- Task 1 holds no resources
-- and is terminated (or will soon)
-- Tasks 2 and 3 hold resources
-- and are waiting for a call to Logout
Task3.Get_Status (User_Rec);
if (F940A00.Counter.Number /= 2)
or (Semaphores.Login_Semaphore.Available /=0)
or (Semaphores.TC_Key_Val (User_Rec) /= 3) then
Report.Failed ("Resource not properly released/assigned to task 3");
end if;
Task2.Logout; -- no outstanding request for released
-- resource
-- Tasks 1 and 2 hold no resources
-- Task 3 holds a resource
-- and is waiting for a call to Logout
if (F940A00.Counter.Number /= 1)
or (Semaphores.Login_Semaphore.Available /=1) then
Report.Failed ("Resource not properly released from task 2");
end if;
Task3.Logout;
-- all resources have been returned
-- all tasks have terminated or will soon
if (F940A00.Counter.Number /=0)
or (Semaphores.Login_Semaphore.Available /=2) then
Report.Failed ("Resource not properly released from task 3");
end if;
-- Ensure all tasks have terminated before calling Result
while not (Task1'terminated and
Task2'terminated and
Task3'terminated) loop
delay ImpDef.Minimum_Task_Switch;
end loop;
Report.Result;
end C940A03;