OpenCores
URL https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk

Subversion Repositories openrisc_2011-10-31

Compare Revisions

  • This comparison shows the changes necessary to convert path 
    /openrisc/tags/gnu-src/gcc-4.5.1/gcc-4.5.1-or32-1.0rc1/gcc/testsuite/ada/acats/support
    from Rev 294 to Rev 338
    ↔ Reverse comparison
  •

Rev 294 → Rev 338

/f730a001.a
0,0 → 1,76
-- F730A001.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.
--*
--
-- FOUNDATION DESCRIPTION:
-- This file declares a tagged type and primitive subprogram for use in
-- tests covering tagged types and type extensions.
--
-- TEST FILES:
-- The following files comprise this foundation:
--
-- F730A000.A
-- => F730A001.A
--
-- CHANGE HISTORY:
-- 06 Dec 94 SAIC ACVC 2.0
--
--!
 
 
package F730A001 is -- Book definitions.
 
 
type Text_Ptr is access String;
 
type Book_Type is tagged record -- Root tagged type.
Title : Text_Ptr;
Author : Text_Ptr;
end record;
 
 
procedure Create_Book (Title : in Text_Ptr; -- Primitive operation
Author : in Text_Ptr; -- of root tagged type.
Book : out Book_Type);
 
end F730A001;
 
 
--==================================================================--
 
 
package body F730A001 is -- Book definitions.
 
 
procedure Create_Book (Title : in Text_Ptr;
Author : in Text_Ptr;
Book : out Book_Type) is
begin
Book.Title := Title;
Book.Author := Author;
end Create_Book;
 
end F730A001;
/fxe2a00.a
0,0 → 1,90
-- FXE2A00.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.
--*
--
-- FOUNDATION DESCRIPTION:
-- This foundation provides a Declared Pure package, a Shared Passive
-- package, a Remote Types package and a normal, unrestricted package.
--
-- It is used by tests checking the interrelationship between the
-- categorized packages
--
-- CHANGE HISTORY:
-- 06 Dec 94 SAIC ACVC 2.0
--
--!
 
 
--====================================================================
 
-- This is a DECLARED PURE package
--
package FXE2A00_0 is
 
pragma pure (FXE2A00_0);
 
type Type_From_0 is (Red, Orange, Yellow);
 
 
end FXE2A00_0;
 
 
--====================================================================
 
-- This is a SHARED_PASSIVE package
--
package FXE2A00_1 is
 
 
pragma shared_passive (FXE2A00_1);
type Type_From_1 is (Blue, Indigo, Violet);
 
end FXE2A00_1;
 
 
--====================================================================
 
-- This is a REMOTE TYPES package
--
package FXE2A00_2 is
 
pragma Remote_Types (FXE2A00_2);
 
type Type_From_2 is (Red, Orange, Yellow, Green, Blue, Indigo, Violet);
 
end FXE2A00_2;
 
 
--====================================================================
 
-- This is a NORMAL unrestricted package which has no categorization
--
package FXE2A00_4 is
 
type Type_From_4 is (Black, White);
 
end FXE2A00_4;
 
--====================================================================
/fxc6a00.a
0,0 → 1,162
-- FXC6A00.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.
--*
--
-- FOUNDATION DESCRIPTION:
-- This foundation declares various volatile and non-volatile types. Some
-- are by-reference types, and some allow pass-by-copy.
--
-- CHANGE HISTORY:
-- 23 Jan 96 SAIC Initial version for ACVC 2.1.
-- 02 DEC 97 EDS Removed Pragma Volatile applied to composite types.
-- 27 AUG 99 RLB Repaired so Nonvolatile_Tagged really is
-- Nonvolatile.
--!
 
package FXC6A00 is
 
type Roman is ('I', 'V', 'X', 'L', 'C', 'D', 'M'); -- By-copy type.
 
type Acc_Roman is access all Roman;
 
 
type Tagged_Type is tagged record -- By-reference type.
C: Natural;
end record;
 
 
type Volatile_Tagged is new Tagged_Type with record -- Volatile by-reference
R1: Roman; -- type.
end record;
pragma Volatile (Volatile_Tagged);
 
type Acc_Volatile_Tagged is access all Volatile_Tagged;
 
-- By-reference type.
type NonVolatile_Tagged is new Tagged_Type with record
R2: aliased Roman;
end record;
 
 
task type Task_Type is -- By-reference type.
entry Calculate (C: in out Natural);
end Task_Type;
 
type Acc_Task_Type is access all Task_Type;
 
 
protected type Protected_Type is -- By-reference type.
procedure Op;
private
Count : Natural := 0;
end Protected_Type;
 
 
protected type Volatile_Protected is -- Volatile by-reference
procedure Handler; -- type.
pragma Interrupt_Handler (Handler);
 
function Handled return Boolean;
private
Was_Handled : Boolean := False;
end Volatile_Protected;
pragma Volatile (Volatile_Protected);
 
type Acc_Vol_Protected is access all Volatile_Protected;
 
 
type Record_Type is record -- Allows pass-by-copy.
C: String(1 .. 2);
end record;
 
 
type Volatile_Record is limited record -- Volatile by-reference
C: String(1 .. 2); -- type.
end record;
pragma Volatile (Volatile_Record);
 
 
type Composite_Type is record -- By-reference type.
C: Tagged_Type;
D: aliased Volatile_Tagged; -- Volatile component.
end record;
 
 
type Private_Type is private; -- By-reference type.
 
 
type Array_Type is array (1..3) of Tagged_Type; -- By-reference type.
pragma Volatile_Components (Array_Type);
 
type Acc_Array_Type is access all Array_Type;
 
 
type Lim_Private_Type is limited private; -- By-copy type.
 
private
 
type Private_Type is new Tagged_Type with record
D: Character;
end record;
 
 
type Lim_Private_Type is new Integer;
 
end FXC6A00;
 
 
--==================================================================--
 
 
package body FXC6A00 is
 
task body Task_Type is
begin
accept Calculate (C: in out Natural) do
C := C * 10;
end Calculate;
end Task_Type;
 
 
protected body Protected_Type is
procedure Op is
begin
Count := Count + 1;
end Op;
end Protected_Type;
 
 
protected body Volatile_Protected is
procedure Handler is
begin
Was_Handled := True;
end Handler;
 
function Handled return Boolean is
begin
return Was_Handled;
end Handled;
end Volatile_Protected;
 
end FXC6A00;
/impdefe.a
0,0 → 1,58
-- IMPDEFE.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.
--*
--
-- DESCRIPTION:
-- This package provides tailorable entities for a particular
-- implementation. Each entity may be modified to suit the needs
-- of the implementation. Default values are provided to act as
-- a guide.
--
-- The entities in this package are those which are used exclusively
-- in tests for Annex E (Distributed Systems).
--
-- APPLICABILITY CRITERIA:
-- This package is only required for implementations validating the
-- Distributed Systems Annex.
--
-- CHANGE HISTORY:
-- 29 Jan 96 SAIC Initial version for ACVC 2.1.
--
--!
package ImpDef.Annex_E is
--=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
 
-- The Max_RPC_Call_Time value is the longest time a test needs to wait for
-- an RPC to complete. Included in this time is the time for the called
-- procedure to make a task entry call where the task is ready to accept
-- the call.
 
Max_RPC_Call_Time : constant Duration := 2.0;
-- ^^^ --- MODIFY HERE AS NEEDED
--=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
 
end ImpDef.Annex_E;
/impdefg.a
0,0 → 1,83
-- IMPDEFG.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.
--*
--
-- DESCRIPTION:
-- This package provides tailorable entities for a particular
-- implementation. Each entity may be modified to suit the needs
-- of the implementation. Default values are provided to act as
-- a guide.
--
-- The entities in this package are those which are used exclusively
-- in tests for Annex G (Numerics).
--
-- APPLICABILITY CRITERIA:
-- This package is only required for implementations validating the
-- Numerics Annex.
--
-- CHANGE HISTORY:
-- 29 Jan 96 SAIC Initial version for ACVC 2.1.
--
--!
package ImpDef.Annex_G is
--=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
 
-- This function must return a "negative zero" value for implementations
-- for which Float'Signed_Zeros is True.
 
function Negative_Zero return Float;
 
--=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
 
end ImpDef.Annex_G;
 
 
--==================================================================--
 
package body ImpDef.Annex_G is
 
 
--=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
 
-- This function must return a negative zero value for implementations
-- for which Float'Signed_Zeros is True.
-- We generate the smallest normalized negative number, and divide by a
-- few powers of two to obtain a number whose absolute value equals zero
-- but whose sign is negative.
 
function Negative_Zero return Float is
negz : float := -1.0 *
float (float'Machine_Radix)
** ( Float'Machine_Emin - Float'Machine_Mantissa);
begin
return negz / 8.0;
end Negative_Zero;
 
--=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
 
end ImpDef.Annex_G;
 
/checkfil.ada
0,0 → 1,197
-- CHECK_FILE.ADA
--
-- 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.
--*
--
-- THIS IS A PROCEDURE USED BY MANY OF THE CHAPTER 14 TESTS TO CHECK THE
-- CONTENTS OF A TEXT FILE.
 
-- THIS PROCEDURE ASSUMES THE FILE PARAMETER PASSED TO IT IS AN OPEN
-- TEXT FILE.
 
-- THE STRING PARAMETER CONTAINS THE CHARACTERS THAT ARE SUPPOSED TO BE
-- IN THE TEXT FILE. A '#' CHARACTER IS USED IN THE STRING TO DENOTE
-- THE END OF A LINE. A '@' CHARACTER IS USED TO DENOTE THE END OF A
-- PAGE. A '%' CHARACTER IS USED TO DENOTE THE END OF THE TEXT FILE.
-- THESE SYMBOLS SHOULD NOT BE USED AS TEXT OUTPUT.
 
-- SPS 11/30/82
-- JBG 2/3/83
 
WITH REPORT; USE REPORT;
WITH TEXT_IO; USE TEXT_IO;
 
PROCEDURE CHECK_FILE (FILE: IN OUT FILE_TYPE; CONTENTS : STRING) IS
 
X : CHARACTER;
COL_COUNT : POSITIVE_COUNT := 1;
LINE_COUNT : POSITIVE_COUNT := 1;
PAGE_COUNT : POSITIVE_COUNT := 1;
TRAILING_BLANKS_MSG_WRITTEN : BOOLEAN := FALSE;
STOP_PROCESSING : EXCEPTION;
 
PROCEDURE CHECK_END_OF_LINE (EXPECT_END_OF_PAGE : BOOLEAN) IS
BEGIN
 
-- SKIP OVER ANY TRAILING BLANKS. AN IMPLEMENTATION CAN LEGALLY
-- APPEND BLANKS TO THE END OF ANY LINE.
 
WHILE NOT END_OF_LINE (FILE) LOOP
GET (FILE, X);
IF X /= ' ' THEN
FAILED ("FROM CHECK_FILE: END OF LINE EXPECTED - " &
X & " ENCOUNTERED");
RAISE STOP_PROCESSING;
ELSE
IF NOT TRAILING_BLANKS_MSG_WRITTEN THEN
COMMENT ("FROM CHECK_FILE: " &
"THIS IMPLEMENTATION PADS " &
"LINES WITH BLANKS");
TRAILING_BLANKS_MSG_WRITTEN := TRUE;
END IF;
END IF;
END LOOP;
 
IF LINE_COUNT /= LINE (FILE) THEN
FAILED ("FROM CHECK_FILE: " &
"LINE COUNT INCORRECT - EXPECTED " &
POSITIVE_COUNT'IMAGE(LINE_COUNT) &
" GOT FROM FILE " &
POSITIVE_COUNT'IMAGE(LINE(FILE)));
END IF;
 
-- NOTE: DO NOT SKIP_LINE WHEN AT END OF PAGE BECAUSE SKIP_LINE WILL
-- ALSO SKIP THE PAGE TERMINATOR. SEE RM 14.3.5 PARAGRAPH 1.
 
IF NOT EXPECT_END_OF_PAGE THEN
IF END_OF_PAGE (FILE) THEN
FAILED ("FROM CHECK_FILE: PREMATURE END OF PAGE");
RAISE STOP_PROCESSING;
ELSE
SKIP_LINE (FILE);
LINE_COUNT := LINE_COUNT + 1;
END IF;
END IF;
COL_COUNT := 1;
END CHECK_END_OF_LINE;
 
PROCEDURE CHECK_END_OF_PAGE IS
BEGIN
IF NOT END_OF_PAGE (FILE) THEN
FAILED ("FROM CHECK_FILE: " &
"END_OF_PAGE NOT WHERE EXPECTED");
RAISE STOP_PROCESSING;
ELSE
IF PAGE_COUNT /= PAGE (FILE) THEN
FAILED ("FROM CHECK_FILE: " &
"PAGE COUNT INCORRECT - EXPECTED " &
POSITIVE_COUNT'IMAGE (PAGE_COUNT) &
" GOT FROM FILE " &
POSITIVE_COUNT'IMAGE (PAGE(FILE)));
END IF;
 
SKIP_PAGE (FILE);
PAGE_COUNT := PAGE_COUNT + 1;
LINE_COUNT := 1;
END IF;
END CHECK_END_OF_PAGE;
 
BEGIN
 
RESET (FILE, IN_FILE);
SET_LINE_LENGTH (STANDARD_OUTPUT, 0);
SET_PAGE_LENGTH (STANDARD_OUTPUT, 0);
 
FOR I IN 1 .. CONTENTS'LENGTH LOOP
 
BEGIN
CASE CONTENTS (I) IS
WHEN '#' =>
CHECK_END_OF_LINE (CONTENTS (I + 1) = '@');
WHEN '@' =>
CHECK_END_OF_PAGE;
WHEN '%' =>
IF NOT END_OF_FILE (FILE) THEN
FAILED ("FROM CHECK_FILE: " &
"END_OF_FILE NOT WHERE EXPECTED");
RAISE STOP_PROCESSING;
END IF;
WHEN OTHERS =>
IF COL_COUNT /= COL(FILE) THEN
FAILED ("FROM CHECK_FILE: " &
"COL COUNT INCORRECT - " &
"EXPECTED " & POSITIVE_COUNT'
IMAGE(COL_COUNT) & " GOT FROM " &
"FILE " & POSITIVE_COUNT'IMAGE
(COL(FILE)));
END IF;
GET (FILE, X);
COL_COUNT := COL_COUNT + 1;
IF X /= CONTENTS (I) THEN
FAILED("FROM CHECK_FILE: " &
"FILE DOES NOT CONTAIN CORRECT " &
"OUTPUT - EXPECTED " & CONTENTS(I)
& " - GOT " & X);
RAISE STOP_PROCESSING;
END IF;
END CASE;
EXCEPTION
WHEN STOP_PROCESSING =>
COMMENT ("FROM CHECK_FILE: " &
"LAST CHARACTER IN FOLLOWING STRING " &
"REVEALED ERROR: " & CONTENTS (1 .. I));
EXIT;
END;
END LOOP;
 
EXCEPTION
WHEN STATUS_ERROR =>
FAILED ("FROM CHECK_FILE: " &
"STATUS_ERROR RAISED - FILE CHECKING INCOMPLETE");
WHEN MODE_ERROR =>
FAILED ("FROM CHECK_FILE: " &
"MODE_ERROR RAISED - FILE CHECKING INCOMPLETE");
WHEN NAME_ERROR =>
FAILED ("FROM CHECK_FILE: " &
"NAME_ERROR RAISED - FILE CHECKING INCOMPLETE");
WHEN USE_ERROR =>
FAILED ("FROM CHECK_FILE: " &
"USE_ERROR RAISED - FILE CHECKING INCOMPLETE");
WHEN DEVICE_ERROR =>
FAILED ("FROM CHECK_FILE: " &
"DEVICE_ERROR RAISED - FILE CHECKING INCOMPLETE");
WHEN END_ERROR =>
FAILED ("FROM CHECK_FILE: " &
"END_ERROR RAISED - FILE CHECKING INCOMPLETE");
WHEN DATA_ERROR =>
FAILED ("FROM CHECK_FILE: " &
"DATA_ERROR RAISED - FILE CHECKING INCOMPLETE");
WHEN LAYOUT_ERROR =>
FAILED ("FROM CHECK_FILE: " &
"LAYOUT_ERROR RAISED - FILE CHECKING INCOMPLETE");
WHEN OTHERS =>
FAILED ("FROM CHECK_FILE: " &
"SOME EXCEPTION RAISED - FILE CHECKING INCOMPLETE");
 
END CHECK_FILE;
/f460a00.a
0,0 → 1,90
-- F460A00.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.
--*
--
-- FOUNDATION DESCRIPTION:
-- This foundation declares support types and subprograms for testing
-- run-time accessibility checks.
--
-- CHANGE HISTORY:
-- 11 May 95 SAIC Initial prerelease version.
-- 24 Apr 96 SAIC Modified Array_Type.
--
--!
 
package F460A00 is
 
type Tagged_Type is tagged record
C : Integer := 0;
end record;
 
type Derived_Tagged_Type is new Tagged_Type with record
D : String (1 .. 4) := "void";
end record;
 
type Composite_Type (D: access Tagged_Type) is limited record
C : Boolean;
end record;
 
type Array_Type is array (1 .. 10) of Tagged_Type;
 
type AccTag_L0 is access constant Tagged_Type;
type AccTagClass_L0 is access all Tagged_Type'Class;
 
type AccArr_L0 is access all Array_Type;
 
X_DerivedTag : aliased Derived_Tagged_Type;
PTagClass_L0 : AccTagClass_L0 := X_DerivedTag'Access;
 
type TC_Result_Kind is (OK, UN_Init, PE_Exception, Others_Exception);
 
procedure TC_Check_Results (Actual : in TC_Result_Kind;
Expected: in TC_Result_Kind;
Message : in String);
end F460A00;
 
 
--==================================================================--
 
 
with Report;
package body F460A00 is
 
procedure TC_Check_Results (Actual : in TC_Result_Kind;
Expected: in TC_Result_Kind;
Message : in String) is
begin
if Actual /= Expected then
case Actual is
when OK | UN_Init =>
Report.Failed ("No exception raised: " & Message);
when PE_Exception =>
Report.Failed ("Program_Error raised: " & Message);
when Others_Exception =>
Report.Failed ("Unexpected exception raised: " & Message);
end case;
end if;
end TC_Check_Results;
 
end F460A00;
/f731a00.a
0,0 → 1,66
-- F731A00.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.
--*
--
-- FOUNDATION DESCRIPTION:
-- This foundation declares parent tagged types and subprograms for use
-- in tests covering operations of private types and private extensions.
--
-- CHANGE HISTORY:
-- 06 Dec 94 SAIC ACVC 2.0
--
--!
 
package F731A00 is
 
type Parent is tagged private;
 
function Vis_Op (P: Parent) return Boolean;
 
private
 
type Parent is tagged record
Component : Integer := 1;
end record;
 
function Pri_Op (P: Parent) return Boolean;
 
end F731A00;
 
 
--==================================================================--
 
 
package body F731A00 is
function Vis_Op (P: Parent) return Boolean is
begin
return True;
end Vis_Op;
 
function Pri_Op (P: Parent) return Boolean is
begin
return False;
end Pri_Op;
 
end F731A00;
/impbit.adb
0,0 → 1,6
with System;
with Ada.Text_IO;
procedure Impbit is
begin
Ada.Text_IO.Put_Line (System.Address'Size'Img);
end Impbit;
/f340a000.a
0,0 → 1,149
-- F340A000.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.
--*
--
-- FOUNDATION DESCRIPTION:
-- This file simulates a generic linked list abstraction for use in tests
-- covering tagged types and type extensions.
--
-- TEST FILES:
-- This foundation consists of the following files:
--
-- => F340A000.A
-- F340A001.A
--
-- CHANGE HISTORY:
-- 06 Dec 94 SAIC ACVC 2.0
-- 12 Jun 96 SAIC ACVC 2.1: Modified prologue. Added pragma
-- Elaborate_Body.
--
--!
 
generic -- Singly-linked list abstraction.
type Parent_Type is tagged private; -- Actual is parent
package F340A000 is -- tagged type.
 
pragma Elaborate_Body;
 
 
-- Declarations for visible linked list nodes:
 
type Node_Type;
 
type Node_Ptr is access Node_Type;
 
type Node_Type is new Parent_Type with record -- Record extension
Next : Node_Ptr := null; -- of parent type.
end record;
 
 
-- Inherits primitive operations of actual type corresponding
-- to Parent_Type.
 
-- Add node at head of list.
procedure Add (Item : in Node_Ptr;
Head : in out Node_Ptr);
 
-- Remove node from head of list and return it.
procedure Remove (Head : in out Node_Ptr;
Item : out Node_Ptr);
 
 
 
-- Declarations for private linked list nodes:
 
type Priv_Node_Type is new Parent_Type with private; -- Private extension
-- of parent type.
 
-- Inherits primitive operations of actual parameter corresponding
-- to Parent_Type.
 
 
type Priv_Node_Ptr is access Priv_Node_Type;
 
 
-- Add node at head of list.
procedure Add (Item : in Priv_Node_Ptr;
Head : in out Priv_Node_Ptr);
 
-- Remove node from head of list and return it.
procedure Remove (Head : in out Priv_Node_Ptr;
Item : out Priv_Node_Ptr);
 
private
 
type Priv_Node_Type is new Parent_Type with record
Next : Priv_Node_Ptr := null;
end record;
 
end F340A000;
 
 
--==================================================================--
 
 
package body F340A000 is -- Singly-linked list abstraction.
 
procedure Add (Item : in Node_Ptr;
Head : in out Node_Ptr) is
begin
if Item /= null then
Item.Next := Head;
Head := Item;
end if;
end Add;
 
 
procedure Remove (Head : in out Node_Ptr;
Item : out Node_Ptr) is
begin
Item := Head;
if Head /= null then
Head := Head.Next;
end if;
end Remove;
 
 
procedure Add (Item : in Priv_Node_Ptr;
Head : in out Priv_Node_Ptr) is
begin
if Item /= null then
Item.Next := Head;
Head := Item;
end if;
end Add;
 
 
procedure Remove (Head : in out Priv_Node_Ptr;
Item : out Priv_Node_Ptr) is
begin
Item := Head;
if Head /= null then
Head := Head.Next;
end if;
end Remove;
 
 
end F340A000;
/fc50a00.a
0,0 → 1,92
-- FC50A00.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.
--*
--
-- FOUNDATION DESCRIPTION:
-- This foundation declares various tagged types which will be passed as
-- actuals to generic formal tagged private types. It also declares
-- various objects of these types, which will be used for testing.
-- The types defined are both discriminated and nondiscriminated.
--
-- CHANGE HISTORY:
-- 06 Dec 94 SAIC ACVC 2.0
--
--!
 
package FC50A00 is
 
--
-- Nonlimited tagged types:
--
 
type Count_Type is tagged record -- Nondiscriminated
Count : Integer := 0; -- type.
end record;
 
 
subtype Str_Len is Natural range 0 .. 100;
subtype Stu_ID is String (1 .. 5);
subtype Dept_ID is String (1 .. 4);
subtype Emp_ID is String (1 .. 9);
type Status is (Student, Faculty, Staff);
subtype Reserved is Positive range 1 .. 50;
 
 
type Person_Type (Stat : Status; -- Discriminated
NameLen, AddrLen : Str_Len) is -- type.
tagged record
Name : String (1 .. NameLen);
Address : String (1 .. AddrLen);
case Stat is
when Student =>
Student_ID : Stu_ID;
when Faculty =>
Department : Dept_ID;
when Staff =>
Employee_ID : Emp_ID;
end case;
end record;
 
 
type VIPerson_Type is new Person_Type with record -- Extension of
Parking_Space : Reserved; -- discriminated type.
end record;
 
 
-- Testing entities: ------------------------------------------------
 
TC_Count_Item : constant Count_Type := (Count => 111);
TC_Default_Count : constant Count_Type := (Count => 0);
 
TC_Person_Item : constant Person_Type :=
(Faculty, 18, 17, "Eccles, John Scott", "Popham House, Lee", "0931");
TC_Default_Person : constant Person_Type :=
(Student, 0, 0, "", "", "00000");
 
TC_VIPerson_Item : constant VIPerson_Type := (TC_Person_Item with 1);
 
---------------------------------------------------------------------
 
 
end FC50A00;
/fc70a00.a
0,0 → 1,117
-- FC70A00.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.
--*
--
-- FOUNDATION DESCRIPTION:
-- This file simulates a generic complex integer support package, to be
-- used for tests covering generic formal packages.
--
-- CHANGE HISTORY:
-- 06 Dec 94 SAIC ACVC 2.0
--
--!
 
generic -- Complex integer abstraction.
type Int_Type is range <>;
package FC70A00 is
 
-- Simulate a generic complex integer support package. Complex integers
-- are treated as coordinates in the Cartesian plane.
 
 
type Complex_Type is private;
 
Zero : constant Complex_Type; -- (0,0).
One : constant Complex_Type; -- (1,0).
 
 
function "-" (Right : Complex_Type) -- Invert a complex
return Complex_Type; -- integer.
 
function "+" (Left, Right : Complex_Type) -- Add two complex
return Complex_Type; -- integers.
 
function "*" (Left, Right : Complex_Type) -- Multiply two complex
return Complex_Type; -- integers.
 
function Reciprocal (Right : Complex_Type) -- Return the reciprocal
return Complex_Type; -- of a complex integer.
 
function Complex (Real, Imag : Int_Type) -- Create a complex
return Complex_Type; -- integer.
 
private
type Complex_Type is record
Real : Int_Type;
Imag : Int_Type;
end record;
 
Zero : constant Complex_Type := (Real => 0, Imag => 0);
One : constant Complex_Type := (Real => 1, Imag => 0);
 
end FC70A00;
 
 
--==================================================================--
 
 
package body FC70A00 is -- Complex integer abstraction.
 
function Complex (Real, Imag : Int_Type) return Complex_Type is
begin
return ( (Real, Imag) );
end Complex;
 
--==============================================--
 
function "-" (Right : Complex_Type) return Complex_Type is
begin
return ( (-Right.Real, -Right.Imag) );
end "-";
 
--==============================================--
 
function "+" (Left, Right : Complex_Type) return Complex_Type is
begin
return ( (Left.Real + Right.Real, Left.Imag + Right.Imag) );
end "+";
 
--==============================================--
 
function "*" (Left, Right : Complex_Type) return Complex_Type is
begin
return ( (Real => (Left.Real * Right.Real) - (Left.Imag * Right.Imag),
Imag => (Left.Imag * Right.Real) + (Left.Real * Right.Imag)) );
end "*";
 
--==============================================--
 
function Reciprocal (Right : Complex_Type) return Complex_Type is
Denominator : Int_Type := Right.Real**2 + Right.Imag**2;
begin -- NOTE: Results are truncated.
return ( (Right.Real/Denominator, -Right.Imag/Denominator) );
end Reciprocal;
 
end FC70A00;
/fc70b00.a
0,0 → 1,133
-- FC70B00.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.
--*
--
-- FOUNDATION DESCRIPTION:
-- This foundation defines a generic list abstraction. List elements can
-- be of any (nonlimited) type. Lists are implemented as singly linked
-- lists. Access to list elements is sequential. For each list, pointers
-- are maintained to the first and last elements in the list, as well as
-- the next element to be accessed.
--
-- CHANGE HISTORY:
-- 06 Dec 94 SAIC ACVC 2.0
--
--!
 
generic -- List abstraction.
type Element_Type is private; -- List elems can be of any nonlimited type.
package FC70B00 is
 
type List_Type is limited private;
 
-- Return true if current element is last in the list.
function End_Of_List (L : List_Type) return Boolean;
 
-- Read current element value; do NOT advance "current" pointer.
procedure View_Element (L : in List_Type; E : out Element_Type);
 
-- Read from current element and advance "current" pointer.
procedure Read_Element (L : in out List_Type; E : out Element_Type);
 
-- Write to current element and advance "current" pointer.
procedure Write_Element (L : in out List_Type; E : in Element_Type);
 
-- Add element to end of list.
procedure Add_Element (L : in out List_Type; E : in Element_Type);
 
-- Set "current" pointer to first list element.
procedure Reset (L : in out List_Type);
 
private
 
type Node_Type;
type Node_Pointer is access Node_Type;
 
type Node_Type is record
Item : Element_Type;
Next : Node_Pointer;
end record;
 
type List_Type is record
First : Node_Pointer;
Current : Node_Pointer;
Last : Node_Pointer;
end record;
 
end FC70B00;
 
 
--==================================================================--
 
 
package body FC70B00 is
 
function End_Of_List (L : List_Type) return Boolean is
begin
return (L.Current = null);
end End_Of_List;
 
 
procedure View_Element (L : in List_Type; E : out Element_Type) is
begin
-- ... Error-checking code omitted for brevity.
E := L.Current.Item; -- Retrieve current element.
end View_Element;
 
 
procedure Read_Element (L : in out List_Type; E : out Element_Type) is
begin
-- ... Error-checking code omitted for brevity.
E := L.Current.Item; -- Retrieve current element.
L.Current := L.Current.Next; -- Advance "current" pointer.
end Read_Element;
 
 
procedure Write_Element (L : in out List_Type; E : in Element_Type) is
begin
-- ... Error-checking code omitted for brevity.
L.Current.Item := E; -- Write to current element.
L.Current := L.Current.Next; -- Advance "current" pointer.
end Write_Element;
 
 
procedure Add_Element (L : in out List_Type; E : in Element_Type) is
New_Node : Node_Pointer := new Node_Type'(E, null);
begin
if L.First = null then -- No elements in list, so add new
L.First := New_Node; -- element at beginning of list.
else
L.Last.Next := New_Node; -- Add new element at end of list.
end if;
L.Last := New_Node; -- Set last-in-list pointer.
end Add_Element;
 
 
procedure Reset (L : in out List_Type) is
begin
L.Current := L.First; -- Set "current" pointer to first
end Reset; -- list element.
 
 
end FC70B00;
/fc54a00.a
0,0 → 1,132
-- FC54A00.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.
--*
--
-- FOUNDATION DESCRIPTION:
-- This foundation declares various types which will serve as designated
-- types for tests involving generic formal access types (including
-- access-to-subprogram types).
--
-- CHANGE HISTORY:
-- 06 Dec 94 SAIC ACVC 2.0
--
--!
 
package FC54A00 is
 
 
-- Discrete (integer) types:
 
Bits : constant := 8; -- Named number.
 
type Numerals is range -256 .. 255;
type New_Numerals is new Numerals range -128 .. 127;
subtype Positives is Numerals range 0 .. 255;
subtype Same_Numerals is Numerals;
subtype Numerals_Static is Numerals range -2**Bits .. 2**Bits - 1;
 
Min : Numerals := Numerals'First; -- Variable.
Max : Integer := 255; -- Variable.
 
subtype Numerals_Nonstatic is Numerals range Min .. 255;
subtype Positive_Nonstatic is Positives range 0 .. Positives(Max);
subtype Pos_Dupl_Nonstatic is Positives range 0 .. Positives(Max);
subtype Pos_Attr_Nonstatic is Positives range Positive_Nonstatic'Range;
 
 
 
-- Floating point types:
 
type Float_Type is digits 3;
type New_Float is new Float_Type;
subtype Float_100 is Float_Type range 0.0 .. 100.0;
subtype Same_Float is Float_Type;
 
Hundred : constant := 100.0; -- Named number.
 
type Float_With_Range is digits 3 range 0.0 .. 100.0;
subtype Float_Same_Range is Float_With_Range range 0.0 .. Hundred;
 
 
 
-- Tagged record types:
 
subtype Lengths is Natural range 0 .. 50;
 
type Parent is abstract tagged null record;
 
type Tag (Len: Lengths) is new Parent with record
Msg : String (1 .. Len);
end record;
 
type New_Tag is new Tag with record
Sent : Boolean;
end record;
 
subtype Same_Tag is Tag;
 
Twenty : constant := 20; -- Named number.
 
subtype Tag20 is Tag (Len => 20);
subtype Tag25 is Tag (25);
subtype Tag_Twenty is Tag (Twenty);
 
My_Len : Lengths := Twenty; -- Variable.
subtype Sub_Length is Lengths range 1 .. My_Len;
 
subtype Tag20_Nonstatic is Tag (Len => Sub_Length'Last);
subtype Tag20_Dupl_Nonstatic is Tag (Sub_Length'Last);
subtype Tag20_Same_Nonstatic is Tag20_Nonstatic;
subtype Tag20_Var_Nonstatic is Tag (Len => My_Len);
 
 
 
-- Access types (designated type is tagged):
 
type Tagged_Ptr is access Tag;
type Tag_Class_Ptr is access Tag'Class;
 
subtype Msg_Ptr_Static is Tagged_Ptr(Twenty);
 
 
 
-- Array types:
 
type New_String is new String;
subtype Same_String is String;
 
Ten : constant := 10; -- Named number.
 
subtype Msg_Static is String(1 .. Ten);
type Msg10 is new String(1 .. 10);
subtype Msg20 is String(1 .. 20);
 
Size : Positive := 10;
 
subtype Msg_Nonstatic is String(1 .. Size);
subtype Msg_Dupl_Nonstatic is String(1 .. Size);
subtype Msg_Same_Nonstatic is Msg_Nonstatic;
 
 
end FC54A00;
/fc70c00.a
0,0 → 1,100
-- FC70C00.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.
--*
--
-- FOUNDATION DESCRIPTION:
-- This foundation defines a generic list abstraction in two packages.
-- The first package declares the types, the second declares the
-- operations. List elements can be of any (nonlimited) type. Lists are
-- implemented as singly linked lists. Access to list elements is
-- sequential. For each list, pointers are maintained to the first and
-- last elements in the list, as well as the next element to be accessed.
--
-- CHANGE HISTORY:
-- 06 Dec 94 SAIC ACVC 2.0
--
--!
 
generic
type Element_Type is private; -- List elems may be of any nonlimited type.
package FC70C00_0 is -- List abstraction.
 
type Node_Type;
type Node_Pointer is access Node_Type;
 
type Node_Type is record
Item : Element_Type;
Next : Node_Pointer;
end record;
 
type List_Type is record
First : Node_Pointer;
Current : Node_Pointer;
Last : Node_Pointer;
end record;
 
end FC70C00_0;
 
 
--==================================================================--
 
 
-- No body for FC70C00_0;
 
 
--==================================================================--
 
 
with FC70C00_0; -- List abstraction.
generic
with package List_Mgr is new FC70C00_0 (<>);
package FC70C00_1 is -- Basic list operations.
 
-- Return true if current element is last in the list.
function End_Of_List (L : List_Mgr.List_Type) return Boolean;
 
-- Set "current" pointer to first list element.
procedure Reset (L : in out List_Mgr.List_Type);
 
end FC70C00_1;
 
 
--==================================================================--
 
 
package body FC70C00_1 is
 
function End_Of_List (L : List_Mgr.List_Type) return Boolean is
use List_Mgr; -- Renders "=" directly visible.
begin
return (L.Current = null);
end End_Of_List;
 
 
procedure Reset (L : in out List_Mgr.List_Type) is
begin
L.Current := L.First; -- Set "current" pointer to first
end Reset; -- list element.
 
end FC70C00_1;
/fcndecl.ada
0,0 → 1,50
-- FCNDECL.ADA
--
-- 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.
--*
--
-- PACKAGE THAT MAY BE MODIFIED TO DECLARE FUNCTIONS THAT RETURN
-- VALUES USABLE FOR INITIALIZATION OF CONSTANTS IN PACKAGE SPPRT13.
 
WITH SYSTEM;
PACKAGE FCNDECL IS
-- INSERT FUNCTION DECLARATIONS AS NEEDED.
 
type Mem is array (1 .. 100) of Long_Long_Integer;
Var0: Mem;
Var1: Mem;
Var2: Mem;
 
Var_Addr : constant System.Address := Var0'address;
Var_Addr1: constant System.Address := Var1'address;
Var_Addr2: constant System.Address := Var2'address;
 
Ent0: Mem;
Ent1: Mem;
Ent2: Mem;
 
Entry_Addr : constant System.Address := Ent0'address;
Entry_Addr1: constant System.Address := Ent0'address;
Entry_Addr2: constant System.Address := Ent0'address;
 
END FCNDECL;
/repspec.ada
0,0 → 1,149
-- REPSPEC.ADA
--
-- 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.
--*
--
-- PURPOSE:
-- THIS REPORT PACKAGE PROVIDES THE MECHANISM FOR REPORTING THE
-- PASS/FAIL/NOT-APPLICABLE RESULTS OF EXECUTABLE (CLASSES A, C,
-- D, E, AND L) TESTS.
 
-- IT ALSO PROVIDES THE MECHANISM FOR GUARANTEEING THAT CERTAIN
-- VALUES BECOME DYNAMIC (NOT KNOWN AT COMPILE-TIME).
 
-- HISTORY:
-- JRK 12/13/79
-- JRK 06/10/80
-- JRK 08/06/81
-- JRK 10/27/82
-- JRK 06/01/84
-- PWB 07/30/87 ADDED PROCEDURE SPECIAL_ACTION.
-- TBN 08/20/87 ADDED FUNCTION LEGAL_FILE_NAME.
-- BCB 05/17/90 ADDED FUNCTION TIME_STAMP.
-- WMC 01/24/94 INCREASED RANGE OF TYPE FILE_NUM FROM 1..3 TO 1..5.
-- KAS 06/19/95 ADDED FUNCTION IDENT_WIDE_CHAR.
-- KAS 06/19/95 ADDED FUNCTION IDENT_WIDE_STR.
 
PACKAGE REPORT IS
 
SUBTYPE FILE_NUM IS INTEGER RANGE 1..5;
 
-- THE REPORT ROUTINES.
 
PROCEDURE TEST -- THIS ROUTINE MUST BE INVOKED AT THE
-- START OF A TEST, BEFORE ANY OF THE
-- OTHER REPORT ROUTINES ARE INVOKED.
-- IT SAVES THE TEST NAME AND OUTPUTS THE
-- NAME AND DESCRIPTION.
( NAME : STRING; -- TEST NAME, E.G., "C23001A-AB".
DESCR : STRING -- BRIEF DESCRIPTION OF TEST, E.G.,
-- "UPPER/LOWER CASE EQUIVALENCE IN " &
-- "IDENTIFIERS".
);
 
PROCEDURE FAILED -- OUTPUT A FAILURE MESSAGE. SHOULD BE
-- INVOKED SEPARATELY TO REPORT THE
-- FAILURE OF EACH SUBTEST WITHIN A TEST.
( DESCR : STRING -- BRIEF DESCRIPTION OF WHAT FAILED.
-- SHOULD BE PHRASED AS:
-- "(FAILED BECAUSE) ...REASON...".
);
 
PROCEDURE NOT_APPLICABLE -- OUTPUT A NOT-APPLICABLE MESSAGE.
-- SHOULD BE INVOKED SEPARATELY TO REPORT
-- THE NON-APPLICABILITY OF EACH SUBTEST
-- WITHIN A TEST.
( DESCR : STRING -- BRIEF DESCRIPTION OF WHAT IS
-- NOT-APPLICABLE. SHOULD BE PHRASED AS:
-- "(NOT-APPLICABLE BECAUSE)...REASON...".
);
 
PROCEDURE SPECIAL_ACTION -- OUTPUT A MESSAGE DESCRIBING SPECIAL
-- ACTIONS TO BE TAKEN.
-- SHOULD BE INVOKED SEPARATELY TO GIVE
-- EACH SPECIAL ACTION.
( DESCR : STRING -- BRIEF DESCRIPTION OF ACTION TO BE
-- TAKEN.
);
 
PROCEDURE COMMENT -- OUTPUT A COMMENT MESSAGE.
( DESCR : STRING -- THE MESSAGE.
);
 
PROCEDURE RESULT; -- THIS ROUTINE MUST BE INVOKED AT THE
-- END OF A TEST. IT OUTPUTS A MESSAGE
-- INDICATING WHETHER THE TEST AS A
-- WHOLE HAS PASSED, FAILED, IS
-- NOT-APPLICABLE, OR HAS TENTATIVELY
-- PASSED PENDING SPECIAL ACTIONS.
 
-- THE DYNAMIC VALUE ROUTINES.
 
-- EVEN WITH STATIC ARGUMENTS, THESE FUNCTIONS WILL HAVE DYNAMIC
-- RESULTS.
 
FUNCTION IDENT_INT -- AN IDENTITY FUNCTION FOR TYPE INTEGER.
( X : INTEGER -- THE ARGUMENT.
) RETURN INTEGER; -- X.
 
FUNCTION IDENT_CHAR -- AN IDENTITY FUNCTION FOR TYPE
-- CHARACTER.
( X : CHARACTER -- THE ARGUMENT.
) RETURN CHARACTER; -- X.
 
FUNCTION IDENT_WIDE_CHAR -- AN IDENTITY FUNCTION FOR TYPE
-- WIDE_CHARACTER.
( X : WIDE_CHARACTER -- THE ARGUMENT.
) RETURN WIDE_CHARACTER; -- X.
 
FUNCTION IDENT_BOOL -- AN IDENTITY FUNCTION FOR TYPE BOOLEAN.
( X : BOOLEAN -- THE ARGUMENT.
) RETURN BOOLEAN; -- X.
 
FUNCTION IDENT_STR -- AN IDENTITY FUNCTION FOR TYPE STRING.
( X : STRING -- THE ARGUMENT.
) RETURN STRING; -- X.
 
FUNCTION IDENT_WIDE_STR -- AN IDENTITY FUNCTION FOR TYPE WIDE_STRING.
( X : WIDE_STRING -- THE ARGUMENT.
) RETURN WIDE_STRING; -- X.
 
FUNCTION EQUAL -- A RECURSIVE EQUALITY FUNCTION FOR TYPE
-- INTEGER.
( X, Y : INTEGER -- THE ARGUMENTS.
) RETURN BOOLEAN; -- X = Y.
 
-- OTHER UTILITY ROUTINES.
 
FUNCTION LEGAL_FILE_NAME -- A FUNCTION TO GENERATE LEGAL EXTERNAL
-- FILE NAMES.
( X : FILE_NUM := 1; -- DETERMINES FIRST CHARACTER OF NAME.
NAM : STRING := "" -- DETERMINES REST OF NAME.
) RETURN STRING; -- THE GENERATED NAME.
 
FUNCTION TIME_STAMP -- A FUNCTION TO GENERATE THE TIME AND
-- DATE TO PLACE IN THE OUTPUT OF AN ACVC
-- TEST.
RETURN STRING; -- THE TIME AND DATE.
 
END REPORT;
/macrosub.ada
0,0 → 1,548
-- MACROSUB.ADA
--
-- 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.
--*
--
-----------------------------------------------------------------------
-- --
-- THIS PROGRAM IS CALLED MACROSUB. IT IS USED TO REPLACE THE --
-- MACROS IN THE ACVC TEST SUITE WITH THEIR PROPER VALUES. THE --
-- STEPS LISTED BELOW SHOULD BE FOLLOWED TO ENSURE PROPER RUNNING --
-- OF THE MACROSUB PROGRAM: --
-- --
-- 1) Edit the file MACRO.DFS (included with the testtape) --
-- and insert your macro values. The macros which use --
-- the value of MAX_IN_LEN are calculated automatically --
-- and do not need to be entered. --
-- --
-- 2) Create a file called TSTTESTS.DAT which includes all --
-- of the .TST test file names and their directory --
-- specifications, if necessary. If a different name --
-- other than TSTTESTS.DAT is used, this name must be --
-- substituted in the MACROSUB.ADA file. --
-- --
-- 3) Compile and link MACROSUB. --
-- --
-- 4) Run the MACROSUB program. --
-- --
-- WHEN THE PROGRAM FINISHES RUNNING, THE MACROS WILL HAVE BEEN --
-- REPLACED WITH THE APPROPRIATE VALUES FROM MACRO.DFS. --
-- --
-- --
-- --
-- HISTORY: --
-- BCB 04/17/90 CHANGED MODE OF CALC_MAX_VALS TO OUT. CHANGED --
-- VALUE OF MAX_VAL_LENGTH FROM 512 TO 400. ADDED --
-- EXCEPTION HANDLER SO PROGRAM DOES NOT CRASH IF --
-- AN EXCEPTION IS RAISED. ADDED MESSAGES TO --
-- REPORT PROGRESS OF PROGRAM. CHANGED PROGRAM SO --
-- IT DOES NOT ABORT IF A FILE CANNOT BE FOUND. --
-- MODIFIED PROGRAM SO IT ACCEPTS FILENAMES WITH --
-- VERSION NUMBERS. --
-----------------------------------------------------------------------
 
WITH TEXT_IO;
USE TEXT_IO;
 
PACKAGE DEFS IS
 
-----------------------------------------------------------------------
-- --
-- THIS PACKAGE IS USED BY MACROSUB.ADA, PARSEMAC.ADA, AND BY --
-- GETSUBS.ADA. THE PACKAGE CONTAINS VARIABLE DECLARATIONS WHICH --
-- NEED TO BE KNOWN BY ALL OF THE PROCEDURES AND PACKAGES WHICH --
-- MAKE UP THE PROGRAM. --
-- --
-----------------------------------------------------------------------
 
MAX_VAL_LENGTH : CONSTANT INTEGER := 400;
 
SUBTYPE VAL_STRING IS STRING (1..MAX_VAL_LENGTH);
 
TYPE REC_TYPE IS RECORD
MACRO_NAME : STRING (1..80);
NAME_LENGTH, VALUE_LENGTH : INTEGER;
MACRO_VALUE : VAL_STRING;
END RECORD;
 
TYPE TABLE_TYPE IS ARRAY (1..100) OF REC_TYPE;
 
SYMBOL_TABLE : TABLE_TYPE;
 
NUM_MACROS : INTEGER;
 
END DEFS;
 
WITH TEXT_IO;
USE TEXT_IO;
WITH DEFS;
USE DEFS;
 
PACKAGE GETSUBS IS
 
------------------------------------------------------------------------
-- --
-- THIS PACKAGE IS USED BY MACROSUB.ADA FOR READING FROM MACRO.DFS --
-- THE VALUES FOR THE MACRO SUBSTITUTIONS FOR A TEST TAPE. --
-- --
------------------------------------------------------------------------
 
MAC_FILE, LINE_LEN : EXCEPTION;
 
PROCEDURE CALC_MAX_VALS(INDEX, LENGTH, MAX_IN_LEN : IN INTEGER;
CALCULATED : OUT BOOLEAN);
 
PROCEDURE FILL_TABLE;
 
END GETSUBS;
 
PACKAGE BODY GETSUBS IS
 
-----------------------------------------------------------------------
-- --
-- PROCEDURE CALC_MAX_VALS CALCULATES THE VALUE FOR THE MACRO --
-- READ FROM MACRO.DFS IF ITS LENGTH IS EQUAL OR NEARLY EQUAL TO --
-- MAX_IN_LEN. IT THEN RETURNS A FLAG SET TO TRUE IF A VALUE WAS --
-- CALCULATED, FALSE IF ONE WAS NOT. --
-- --
-----------------------------------------------------------------------
 
PROCEDURE CALC_MAX_VALS(INDEX, LENGTH, MAX_IN_LEN : IN INTEGER;
CALCULATED : OUT BOOLEAN) IS
 
BEGIN
 
IF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) = "BIG_ID1"
THEN SYMBOL_TABLE (INDEX).MACRO_VALUE (1..MAX_IN_LEN) :=
(1..(MAX_IN_LEN-1) => 'A') & "1";
CALCULATED := TRUE;
ELSIF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) =
"BIG_ID2" THEN SYMBOL_TABLE (INDEX).MACRO_VALUE
(1..MAX_IN_LEN) := (1..(MAX_IN_LEN-1) => 'A') & "2";
CALCULATED := TRUE;
ELSIF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) =
"BIG_ID3" THEN SYMBOL_TABLE (INDEX).MACRO_VALUE
(1..MAX_IN_LEN) := (1..(MAX_IN_LEN + 1)/2 => 'A') & "3" &
((MAX_IN_LEN + 1)/2 + 2..MAX_IN_LEN => 'A');
CALCULATED := TRUE;
ELSIF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) =
"BIG_ID4" THEN SYMBOL_TABLE (INDEX).MACRO_VALUE
(1..MAX_IN_LEN) := (1..(MAX_IN_LEN + 1)/2 => 'A') & "4" &
((MAX_IN_LEN + 1)/2 + 2..MAX_IN_LEN => 'A');
CALCULATED := TRUE;
ELSIF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) =
"BIG_STRING1" THEN SYMBOL_TABLE (INDEX).MACRO_VALUE
(1..(MAX_IN_LEN + 1)/2 + 2) :=
'"' & (1..(MAX_IN_LEN + 1)/2 => 'A') & '"';
CALCULATED := TRUE;
ELSIF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) =
"BIG_STRING2" THEN SYMBOL_TABLE (INDEX).MACRO_VALUE
(1..MAX_IN_LEN - (MAX_IN_LEN + 1)/2 + 2) :=
'"' & (2..MAX_IN_LEN - (MAX_IN_LEN + 1)/2 => 'A') &
'1' & '"';
CALCULATED := TRUE;
ELSIF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) =
"MAX_STRING_LITERAL" THEN SYMBOL_TABLE (INDEX).
MACRO_VALUE (1..MAX_IN_LEN) := '"' &
(1..MAX_IN_LEN-2 => 'A') & '"';
CALCULATED := TRUE;
ELSIF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) =
"BIG_INT_LIT" THEN SYMBOL_TABLE (INDEX).MACRO_VALUE
(1..MAX_IN_LEN) := (1..MAX_IN_LEN-3 => '0') & "298";
CALCULATED := TRUE;
ELSIF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) =
"BIG_REAL_LIT" THEN SYMBOL_TABLE (INDEX).MACRO_VALUE
(1..MAX_IN_LEN) := (1..MAX_IN_LEN-5 => '0') & "690.0";
CALCULATED := TRUE;
ELSIF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) =
"MAX_LEN_INT_BASED_LITERAL" THEN
SYMBOL_TABLE (INDEX).
MACRO_VALUE (1..MAX_IN_LEN) := "2:" &
(1..MAX_IN_LEN - 5 => '0') & "11:";
CALCULATED := TRUE;
ELSIF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) =
"MAX_LEN_REAL_BASED_LITERAL" THEN SYMBOL_TABLE (INDEX).
MACRO_VALUE (1..MAX_IN_LEN) := "16:" &
(1..MAX_IN_LEN - 7 => '0') & "F.E:";
CALCULATED := TRUE;
ELSIF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) =
"BLANKS" THEN SYMBOL_TABLE (INDEX).MACRO_VALUE
(1..MAX_IN_LEN-20) := (1..MAX_IN_LEN-20 => ' ');
CALCULATED := TRUE;
ELSE
CALCULATED := FALSE;
END IF;
IF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) =
"BLANKS" THEN SYMBOL_TABLE (INDEX).VALUE_LENGTH :=
MAX_IN_LEN - 20;
ELSIF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) =
"BIG_STRING1" THEN
SYMBOL_TABLE (INDEX).VALUE_LENGTH :=
(MAX_IN_LEN + 1)/2 + 2;
ELSIF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) =
"BIG_STRING2" THEN
SYMBOL_TABLE (INDEX).VALUE_LENGTH :=
MAX_IN_LEN - (MAX_IN_LEN + 1)/2 + 2;
ELSE SYMBOL_TABLE (INDEX).VALUE_LENGTH := MAX_IN_LEN;
END IF;
END CALC_MAX_VALS;
 
-----------------------------------------------------------------------
-- --
-- PROCEDURE FILL_TABLE READS THE MACRO NAMES AND MACRO VALUES IN --
-- FROM MACRO.DFS AND STORES THEM IN THE SYMBOL TABLE. PROCEDURE --
-- CALC_MAX_VALS IS CALLED TO DETERMINE IF THE MACRO VALUE SHOULD --
-- BE CALCULATED OR READ FROM MACRO.DFS. --
-- --
-----------------------------------------------------------------------
 
PROCEDURE FILL_TABLE IS
 
INFILE1 : FILE_TYPE;
MACRO_FILE : CONSTANT STRING := "MACRO.DFS";
A_LINE : VAL_STRING;
I, INDEX, LENGTH, HOLD, A_LENGTH, NAME : INTEGER;
MAX_IN_LEN : INTEGER := 1;
CALCULATED : BOOLEAN;
 
BEGIN
INDEX := 1;
BEGIN
OPEN (INFILE1, IN_FILE, MACRO_FILE);
EXCEPTION
WHEN NAME_ERROR =>
PUT_LINE ("** ERROR: MACRO FILE " & MACRO_FILE &
" NOT FOUND.");
RAISE MAC_FILE;
END;
WHILE NOT END_OF_FILE (INFILE1) LOOP
GET_LINE (INFILE1, A_LINE, A_LENGTH);
IF A_LENGTH > 0 AND A_LINE (1..2) /= "--" AND
A_LINE (1) /= ' ' AND A_LINE (1) /= ASCII.HT THEN
I := 1;
WHILE I <= A_LENGTH AND THEN
((A_LINE (I) IN 'A'..'Z') OR
(A_LINE (I) IN '0'..'9') OR
A_LINE (I) = '_') LOOP
I := I + 1;
END LOOP;
I := I - 1;
LENGTH := I;
BEGIN
SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) :=
A_LINE (1..I);
EXCEPTION
WHEN CONSTRAINT_ERROR =>
PUT_LINE ("** ERROR: LINE LENGTH IS " &
"GREATER THAN MAX_VAL_LENGTH.");
RAISE LINE_LEN;
END;
SYMBOL_TABLE (INDEX).NAME_LENGTH := I;
CALC_MAX_VALS (INDEX, LENGTH, MAX_IN_LEN,
CALCULATED);
IF NOT CALCULATED THEN
I := I + 1;
WHILE A_LINE (I) = ' ' OR A_LINE (I) =
ASCII.HT LOOP
I := I + 1;
IF SYMBOL_TABLE (INDEX).MACRO_NAME
(1..LENGTH) = "BLANKS" THEN
EXIT;
END IF;
END LOOP;
HOLD := I;
 
-- MACRO VALUE BEGINS AT POSITION HOLD.
-- NOW FIND WHERE IT ENDS BY STARTING AT THE END OF THE INPUT
-- LINE AND SEARCHING BACKWARD FOR A NON-BLANK.
 
I := A_LENGTH;
WHILE I > HOLD AND THEN (A_LINE (I) = ' '
OR A_LINE(I) = ASCII.HT) LOOP
I := I - 1;
END LOOP;
LENGTH := I - HOLD + 1;
SYMBOL_TABLE (INDEX).MACRO_VALUE (1..LENGTH)
:= A_LINE (HOLD..I);
SYMBOL_TABLE (INDEX).VALUE_LENGTH := LENGTH;
NAME := SYMBOL_TABLE (INDEX).NAME_LENGTH;
IF SYMBOL_TABLE (INDEX).MACRO_NAME (1..NAME) =
"MAX_IN_LEN" THEN MAX_IN_LEN :=
INTEGER'VALUE (SYMBOL_TABLE (INDEX).
MACRO_VALUE (1..LENGTH));
END IF;
END IF;
INDEX := INDEX + 1;
END IF;
END LOOP;
NUM_MACROS := INDEX - 1;
CLOSE (INFILE1);
END FILL_TABLE;
 
BEGIN
NULL;
END GETSUBS;
 
WITH TEXT_IO;
USE TEXT_IO;
WITH DEFS;
USE DEFS;
 
PACKAGE PARSEMAC IS
 
------------------------------------------------------------------------
-- --
-- THIS PACKAGE IS USED BY MACROSUB.ADA FOR FINDING A MACRO TO --
-- SUBSTITUTE. MACRO SUBSTITUTIONS ARE MADE IN *.TST TESTS IN THE --
-- ACVC TEST SUITE. THIS PROCEDURE IS CURRENTLY SET UP FOR ACVC --
-- VERSION 1.10. --
-- --
------------------------------------------------------------------------
 
PROCEDURE LOOK_FOR_MACRO (A_LINE : IN STRING;
A_LENGTH : IN INTEGER;
PTR : IN OUT INTEGER;
MACRO : OUT STRING;
MACRO_LEN : IN OUT INTEGER);
 
 
PROCEDURE WHICH_MACRO (MACRO : IN STRING;
MACRO_LEN : IN INTEGER;
TEMP_MACRO : OUT STRING;
TEMP_MACRO_LEN : IN OUT INTEGER);
 
END PARSEMAC;
 
PACKAGE BODY PARSEMAC IS
 
-----------------------------------------------------------------------
-- PROCEDURE LOOK_FOR_MACRO LOOKS FOR A DOLLAR SIGN WHICH SIGNALS --
-- THE START OF A MACRO IN THE *.TST FILES. IT THEN COUNTS --
-- CHARACTERS UNTIL A <LETTER>, <NUMBER>, OR <_> IS NOT FOUND. --
-- RETURN PARAMETERS SEND THE BEGINNING POINTER AND LENGTH OF THE --
-- MACRO BACK TO THE MAIN PROGRAM. ALSO RETURNED IS THE MACRO --
-- STRING. --
-----------------------------------------------------------------------
 
PROCEDURE LOOK_FOR_MACRO (A_LINE : IN STRING;
A_LENGTH : IN INTEGER;
PTR : IN OUT INTEGER;
MACRO : OUT STRING;
MACRO_LEN : IN OUT INTEGER) IS
 
II, J : INTEGER := INTEGER'LAST;
 
BEGIN
FOR I IN PTR..A_LENGTH LOOP
IF A_LINE (I) = '$' THEN
II := I+1;
EXIT;
END IF;
II := I;
END LOOP;
IF II < A_LENGTH THEN -- DOLLAR SIGN IS FOUND.
J := II;
WHILE J <= A_LENGTH AND THEN ((A_LINE(J) IN 'A'..'Z') OR
(A_LINE(J) IN '0'..'9') OR
A_LINE(J) = '_') LOOP
J := J+1;
END LOOP;
J := J-1;
MACRO_LEN := (J-II+1);
MACRO (1..MACRO_LEN) := A_LINE (II .. J);
-- DON'T INCLUDE THE DOLLAR SIGN
PTR := J+1;
ELSE
MACRO_LEN := 0;
END IF;
RETURN;
END LOOK_FOR_MACRO;
 
------------------------------------------------------------------------
-- PROCEDURE WHICH_MACRO COMPARES THE INPUT MACRO STRING TO A --
-- VALUE READ FROM MACRO.DFS AND STORED IN THE SYMBOL TABLE AND --
-- RETURNS THE MACRO SUBSTITUTION STRING BACK TO THE MAIN PROGRAM. --
------------------------------------------------------------------------
 
PROCEDURE WHICH_MACRO (MACRO : IN STRING;
MACRO_LEN : IN INTEGER;
TEMP_MACRO : OUT STRING;
TEMP_MACRO_LEN : IN OUT INTEGER) IS
 
BEGIN
FOR INDEX IN 1 .. NUM_MACROS LOOP
IF MACRO (1..MACRO_LEN) =
SYMBOL_TABLE (INDEX).MACRO_NAME
(1..SYMBOL_TABLE (INDEX).NAME_LENGTH) THEN
TEMP_MACRO_LEN :=
SYMBOL_TABLE (INDEX).VALUE_LENGTH;
TEMP_MACRO (1..TEMP_MACRO_LEN) :=
SYMBOL_TABLE (INDEX).MACRO_VALUE
(1..TEMP_MACRO_LEN);
EXIT;
END IF;
IF INDEX = NUM_MACROS THEN
PUT_LINE ("** ERROR: MACRO " & MACRO (1..MACRO_LEN)
& " NOT FOUND. UPDATE PROGRAM.");
TEMP_MACRO_LEN := MACRO_LEN;
TEMP_MACRO (1..TEMP_MACRO_LEN) :=
MACRO (1..MACRO_LEN);
END IF;
END LOOP;
 
END WHICH_MACRO;
 
BEGIN
NULL;
END PARSEMAC;
 
WITH TEXT_IO, GETSUBS, PARSEMAC, DEFS;
USE TEXT_IO, GETSUBS, PARSEMAC, DEFS;
 
PROCEDURE MACROSUB IS
 
------------------------------------------------------------------------
-- --
-- MACROSUB IS THE MAIN PROGRAM THAT CALLS PROCEDURES IN TWO --
-- PACKAGES, GETSUBS AND PARSEMAC. THIS PROGRAM IS USED TO MAKE --
-- THE MACRO SUBSTITUTIONS FOR TST TESTS IN THE ACVC TEST SUITE. --
-- --
------------------------------------------------------------------------
 
INFILE1, INFILE2, OUTFILE1 : FILE_TYPE;
FNAME, MACRO : VAL_STRING;
LENGTH, A_LENGTH, PTR,
TEMP_MACRO_LENGTH, MACRO_LEN, FILE_COUNT : INTEGER := 0;
A_LINE, TEMP_MACRO, TEMP_LINE, NEW_LINE : VAL_STRING;
END_OF_LINE_SEARCH, FLAG : BOOLEAN := FALSE;
TESTS_FILE : CONSTANT STRING := "TSTTESTS.DAT";
TSTTESTS,FILE_CRE : EXCEPTION;
 
BEGIN
PUT_LINE ("BEGINNING MACRO SUBSTITUTIONS.");
FILL_TABLE;
BEGIN
OPEN (INFILE2, IN_FILE, TESTS_FILE);
EXCEPTION
WHEN NAME_ERROR =>
PUT_LINE ("** ERROR: ERROR DURING OPENING OF " &
"TSTTESTS.DAT");
RAISE TSTTESTS;
END;
WHILE NOT END_OF_FILE (INFILE2) LOOP
GET_LINE (INFILE2, FNAME, LENGTH);
FILE_COUNT := FILE_COUNT + 1;
BEGIN
OPEN (INFILE1, IN_FILE, FNAME(1..LENGTH));
EXCEPTION
WHEN NAME_ERROR =>
PUT_LINE ("** ERROR: ERROR DURING OPENING OF " &
FNAME(1..LENGTH) & ".");
FLAG := TRUE;
END;
IF NOT FLAG THEN
PUT_LINE ("WORKING ON " & FNAME(1..LENGTH));
IF FILE_COUNT = 70 THEN
PUT_LINE ("MACRO SUBSTITUTIONS HALF COMPLETED.");
END IF;
FOR I IN REVERSE 1 .. LENGTH LOOP
IF FNAME(I) = ';' THEN
LENGTH := I - 1;
EXIT;
END IF;
END LOOP;
IF FNAME (LENGTH-2..LENGTH) = "TST" THEN
FNAME (LENGTH-2..LENGTH) := "ADT";
ELSIF FNAME (LENGTH-2..LENGTH) = "tst" THEN
FNAME (LENGTH-2..LENGTH) := "adt";
END IF;
BEGIN
CREATE (OUTFILE1, OUT_FILE, FNAME (1..LENGTH));
EXCEPTION
WHEN OTHERS =>
PUT_LINE ("** ERROR: EXCEPTION RAISED DURING" &
" ATTEMPTED CREATION OF " &
FNAME(1..LENGTH) & ".");
RAISE FILE_CRE;
END;
WHILE NOT END_OF_FILE (INFILE1) LOOP
GET_LINE (INFILE1, A_LINE, A_LENGTH);
IF A_LENGTH > 0 AND A_LINE(1..2) /= "--" THEN
END_OF_LINE_SEARCH := FALSE;
PTR := 1;
WHILE NOT END_OF_LINE_SEARCH LOOP
LOOK_FOR_MACRO (A_LINE, A_LENGTH, PTR,
MACRO, MACRO_LEN);
IF MACRO_LEN = 0 THEN
END_OF_LINE_SEARCH := TRUE;
ELSE -- SEE WHICH MACRO IT IS
WHICH_MACRO (MACRO, MACRO_LEN,
TEMP_MACRO, TEMP_MACRO_LENGTH);
END IF;
IF NOT END_OF_LINE_SEARCH THEN
IF PTR-MACRO_LEN-2 > 0 THEN
-- IF MACRO IS NOT FIRST ON THE LINE
NEW_LINE (1..PTR-MACRO_LEN-2)
:= A_LINE(1..PTR-MACRO_LEN -2);
-- THE OLD LINE UNTIL THE DOLLAR SIGN
END IF;
NEW_LINE(PTR-MACRO_LEN-1 ..
TEMP_MACRO_LENGTH +
(PTR-MACRO_LEN) - 2) :=
TEMP_MACRO(1..TEMP_MACRO_LENGTH);
IF PTR <= A_LENGTH THEN
-- IF MACRO IS NOT LAST ON THE LINE
NEW_LINE (TEMP_MACRO_LENGTH +
PTR-MACRO_LEN - 1 ..
TEMP_MACRO_LENGTH - 1 +
A_LENGTH - MACRO_LEN) :=
A_LINE (PTR..A_LENGTH);
ELSE
END_OF_LINE_SEARCH := TRUE;
END IF;
A_LENGTH := A_LENGTH +
TEMP_MACRO_LENGTH -
MACRO_LEN - 1;
A_LINE (1..A_LENGTH) :=
NEW_LINE (1..A_LENGTH);
PTR := PTR - MACRO_LEN +
TEMP_MACRO_LENGTH - 1;
END IF;
END LOOP;
END IF;
PUT_LINE (OUTFILE1, A_LINE (1..A_LENGTH));
END LOOP;
CLOSE (OUTFILE1);
CLOSE (INFILE1);
ELSE
FLAG := FALSE;
END IF;
END LOOP;
CLOSE (INFILE2);
PUT_LINE ("MACRO SUBSTITUTIONS COMPLETED.");
EXCEPTION
WHEN MAC_FILE | LINE_LEN | TSTTESTS | FILE_CRE =>
NULL;
WHEN OTHERS =>
PUT_LINE ("UNEXPECTED EXCEPTION RAISED");
END MACROSUB;
/fdd2a00.a
0,0 → 1,149
-- FDD2A00.A
--
-- Grant of Unlimited Rights
--
-- The Ada Conformity Assessment Authority (ACAA) holds unlimited
-- rights in the software and documentation contained herein. Unlimited
-- rights are the same as those granted by the U.S. Government for older
-- parts of the Ada Conformity Assessment Test Suite, and are defined
-- in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
-- intends to confer upon all recipients unlimited rights equal to those
-- held by the ACAA. 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.
--
--
-- FOUNDATION DESCRIPTION:
-- This foundation provides the basis for testing user-defined stream
-- attributes. It provides operations which count calls to stream
-- attributes.
--
-- CHANGE HISTORY:
-- 30 JUL 2001 PHL Initial version.
-- 5 DEC 2001 RLB Reformatted for ACATS.
--
 
with Ada.Streams;
use Ada.Streams;
package FDD2A00 is
 
type Kinds is (Read, Write, Input, Output);
type Counts is array (Kinds) of Natural;
 
 
type My_Stream (Size : Stream_Element_Count) is new Root_Stream_Type with
record
First : Stream_Element_Offset := 1;
Last : Stream_Element_Offset := 0;
Contents : Stream_Element_Array (1 .. Size);
end record;
 
procedure Clear (Stream : in out My_Stream);
 
procedure Read (Stream : in out My_Stream;
Item : out Stream_Element_Array;
Last : out Stream_Element_Offset);
 
procedure Write (Stream : in out My_Stream; Item : in Stream_Element_Array);
 
 
generic
type T (<>) is limited private;
with procedure Actual_Write
(Stream : access Root_Stream_Type'Class; Item : T);
with function Actual_Input
(Stream : access Root_Stream_Type'Class) return T;
with procedure Actual_Read (Stream : access Root_Stream_Type'Class;
Item : out T);
with procedure Actual_Output
(Stream : access Root_Stream_Type'Class; Item : T);
package Counting_Stream_Ops is
 
procedure Write (Stream : access Root_Stream_Type'Class; Item : T);
function Input (Stream : access Root_Stream_Type'Class) return T;
procedure Read (Stream : access Root_Stream_Type'Class; Item : out T);
procedure Output (Stream : access Root_Stream_Type'Class; Item : T);
 
function Get_Counts return Counts;
 
end Counting_Stream_Ops;
 
end FDD2A00;
package body FDD2A00 is
 
procedure Clear (Stream : in out My_Stream) is
begin
Stream.First := 1;
Stream.Last := 0;
end Clear;
 
procedure Read (Stream : in out My_Stream;
Item : out Stream_Element_Array;
Last : out Stream_Element_Offset) is
begin
if Item'Length >= Stream.Last - Stream.First + 1 then
Item (Item'First .. Item'First + Stream.Last - Stream.First) :=
Stream.Contents (Stream.First .. Stream.Last);
Last := Item'First + Stream.Last - Stream.First;
Stream.First := Stream.Last + 1;
else
Item := Stream.Contents (Stream.First ..
Stream.First + Item'Length - 1);
Last := Item'Last;
Stream.First := Stream.First + Item'Length;
end if;
end Read;
 
procedure Write (Stream : in out My_Stream;
Item : in Stream_Element_Array) is
begin
Stream.Contents (Stream.Last + 1 .. Stream.Last + Item'Length) := Item;
Stream.Last := Stream.Last + Item'Length;
end Write;
 
 
package body Counting_Stream_Ops is
Cnts : Counts := (others => 0);
 
procedure Write (Stream : access Root_Stream_Type'Class; Item : T) is
begin
Cnts (Write) := Cnts (Write) + 1;
Actual_Write (Stream, Item);
end Write;
 
function Input (Stream : access Root_Stream_Type'Class) return T is
begin
Cnts (Input) := Cnts (Input) + 1;
return Actual_Input (Stream);
end Input;
 
procedure Read (Stream : access Root_Stream_Type'Class; Item : out T) is
begin
Cnts (Read) := Cnts (Read) + 1;
Actual_Read (Stream, Item);
end Read;
 
procedure Output (Stream : access Root_Stream_Type'Class; Item : T) is
begin
Cnts (Output) := Cnts (Output) + 1;
Actual_Output (Stream, Item);
end Output;
 
function Get_Counts return Counts is
begin
return Cnts;
end Get_Counts;
 
end Counting_Stream_Ops;
 
end FDD2A00;
/lencheck.ada
0,0 → 1,60
-- THIS GENERIC PROCEDURE IS INTENDED FOR USE IN CONJUNCTION WITH THE
-- ACVC CHAPTER 13 C TESTS. IT IS INSTANTIATED FOR A TYPE WHOSE
-- REPRESENTATION IS TO BE CHECKED, AND THEN THE PROCEDURE REP_CHECK
-- IS CALLED WITH TWO ARGUMENTS, THE FIRST IS A VALUE OF THE TYPE TO
-- BE CHECKED, AND THE SECOND IS A STRING DESCRIBING OR NAMING THE
-- TYPE (FOR USE IN A CALL TO FAILED IF THE REPRESENTATION CHECK FAILS)
 
-- THE CHECK IS TO CONVERT THE VALUE TO A PACKED BOOLEAN ARRAY WITH A
-- LENGTH CORRESPONDING TO THE 'SIZE OF THE TYPE, AND THEN CONVERT IT
-- BACK AGAIN AND CHECK THAT THE SAME VALUE IS OBTAINED. THE
-- CONVERSIONS ARE PERFORMED USING APPROPRIATE INSTANTIATIONS OF
-- UNCHECKED_CONVERSION.
 
-- AUTHOR: ROBERT B. K. DEWAR, UNCOPYRIGHTED, PUBLIC DOMAIN USE
-- AUTHORIZED
-- DHH 03/27/89 CHANGED REP_CHECK TO LENGTH_CHECK BY ADDING A THIRD
-- PARAMETER TO GIVE LENGTH EXPECTED AND BY DOING A BIT TO
-- BIT COPY OF THE UNCHECKED CONVERSION BOOLEAN ARRAY SO
-- A STRAIGHT COMPARE OF THE TWO VALUES CAN BE DONE.
 
GENERIC
 
TYPE TEST_TYPE IS PRIVATE;
 
PROCEDURE LENGTH_CHECK (TEST_VALUE : TEST_TYPE;
EXPECTED_LENGTH : INTEGER;
TYPE_ID : STRING);
 
WITH UNCHECKED_CONVERSION;
WITH REPORT; USE REPORT;
 
PROCEDURE LENGTH_CHECK (TEST_VALUE : TEST_TYPE;
EXPECTED_LENGTH : INTEGER;
TYPE_ID : STRING) IS
LEN : CONSTANT INTEGER := EXPECTED_LENGTH;
TYPE BIT_ARRAY_TYPE IS ARRAY (1 .. LEN) OF BOOLEAN;
PRAGMA PACK (BIT_ARRAY_TYPE);
TYPE NEW_BIT_ARRAY_TYPE IS ARRAY (1 .. 3) OF BIT_ARRAY_TYPE;
 
FUNCTION TO_BITS IS NEW UNCHECKED_CONVERSION (TEST_TYPE,
BIT_ARRAY_TYPE);
FUNCTION FROM_BITS IS NEW UNCHECKED_CONVERSION (BIT_ARRAY_TYPE,
TEST_TYPE);
 
BIT_ARRAY : BIT_ARRAY_TYPE := (OTHERS => FALSE);
 
BIT_ARRAY_NEW : NEW_BIT_ARRAY_TYPE := (OTHERS => (OTHERS => FALSE));
BEGIN
 
BIT_ARRAY := TO_BITS (TEST_VALUE);
 
FOR I IN 1 .. LEN LOOP
BIT_ARRAY_NEW(IDENT_INT(1)) (IDENT_INT(I)) := BIT_ARRAY(I);
END LOOP;
 
IF TEST_VALUE /= FROM_BITS (BIT_ARRAY_NEW(1)) THEN
FAILED ("CHECK ON REPRESENTATION FOR " & TYPE_ID & " FAILED.");
END IF;
 
END LENGTH_CHECK;
/f392a00.a
0,0 → 1,200
-- F392A00.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.
--*
--
-- FOUNDATION DESCRIPTION:
-- This foundation provides a basis for tests needing a hierarchy of
-- types to check object-oriented features.
--
-- CHANGE HISTORY:
-- 06 Dec 94 SAIC ACVC 2.0
--
--!
 
package F392A00 is -- package Accounts
 
--
-- Types and subtypes.
--
 
type Dollar_Amount is new Float;
type Interest_Rate is delta 0.001 range 0.000 .. 1.000;
type Account_Types is (Bank, Savings, Preferred, Total);
type Account_Counter is array (Account_Types) of Integer;
type Account_Rep is (President, Manager, New_Account_Manager, Teller);
 
--
-- Constants.
--
 
Opening_Balance : constant Dollar_Amount := 100.00;
Current_Rate : constant Interest_Rate := 0.030;
Preferred_Minimum_Balance : constant Dollar_Amount := 1000.00;
 
--
-- Global Variables
--
 
Bank_Reserve : Dollar_Amount := 0.00;
Daily_Representative : Account_Rep := New_Account_Manager;
Number_Of_Accounts : Account_Counter := (Bank => 0,
Savings => 0,
Preferred => 0,
Total => 0);
--
-- Account types and their primitive operations.
--
 
-- Root type.
 
type Bank_Account is tagged
record
Balance : Dollar_Amount;
end record;
 
-- Primitive operations of Bank_Account.
 
procedure Increment_Bank_Reserve (Acct : in Bank_Account);
procedure Assign_Representative (Acct : in Bank_Account);
procedure Increment_Counters (Acct : in Bank_Account);
procedure Open (Acct : in out Bank_Account);
 
--
type Savings_Account is new Bank_Account with
record
Rate : Interest_Rate;
end record;
 
-- Procedure Increment_Bank_Reserve inherited from parent (Bank_Account).
 
-- Primitive operations (Overridden).
procedure Assign_Representative (Acct : in Savings_Account);
procedure Increment_Counters (Acct : in Savings_Account);
procedure Open (Acct : in out Savings_Account);
--
 
type Preferred_Account is new Savings_Account with
record
Minimum_Balance : Dollar_Amount;
end record;
 
-- Procedure Increment_Bank_Reserve inherited twice.
-- Procedure Assign_Representative inherited from parent (Savings_Account).
 
-- Primitive operations (Overridden).
procedure Increment_Counters (Acct : in Preferred_Account);
procedure Open (Acct : in out Preferred_Account);
 
-- Function used to verify Open operation for Preferred_Account objects.
function Verify_Open (Acct : in Preferred_Account) return Boolean;
 
end F392A00;
 
 
--=================================================================--
 
 
package body F392A00 is
 
--
-- Primitive operations for Bank_Account.
--
 
procedure Increment_Bank_Reserve (Acct : in Bank_Account) is
begin
Bank_Reserve := Bank_Reserve + Acct.Balance;
end Increment_Bank_Reserve;
 
procedure Assign_Representative (Acct : in Bank_Account) is
begin
Daily_Representative := Teller;
end Assign_Representative;
 
procedure Increment_Counters (Acct : in Bank_Account) is
begin
Number_Of_Accounts (Bank) := Number_Of_Accounts (Bank) + 1;
Number_Of_Accounts (Total) := Number_Of_Accounts (Total) + 1;
end Increment_Counters;
 
procedure Open (Acct : in out Bank_Account) is
begin
Acct.Balance := Opening_Balance;
end Open;
 
 
--
-- Overridden operations for Savings_Account type.
--
 
procedure Assign_Representative (Acct : in Savings_Account) is
begin
Daily_Representative := Manager;
end Assign_Representative;
 
procedure Increment_Counters (Acct : in Savings_Account) is
begin
Number_Of_Accounts (Savings) := Number_Of_Accounts (Savings) + 1;
Number_Of_Accounts (Total) := Number_Of_Accounts (Total) + 1;
end Increment_Counters;
 
procedure Open (Acct : in out Savings_Account) is
begin
Open (Bank_Account(Acct));
Acct.Rate := Current_Rate;
Acct.Balance := 2.0 * Opening_Balance;
end Open;
 
--
-- Overridden operation for Preferred_Account type.
--
procedure Increment_Counters (Acct : in Preferred_Account) is
begin
Number_Of_Accounts (Preferred) := Number_Of_Accounts (Preferred) + 1;
Number_Of_Accounts (Total) := Number_Of_Accounts (Total) + 1;
end Increment_Counters;
 
procedure Open (Acct : in out Preferred_Account) is
begin
Open (Savings_Account(Acct));
Acct.Minimum_Balance := Preferred_Minimum_Balance;
Acct.Balance := Acct.Minimum_Balance;
end Open;
 
--
-- Function used to verify Open operation for Preferred_Account objects.
--
 
function Verify_Open (Acct : in Preferred_Account) return Boolean is
begin
return (Acct.Balance = Preferred_Minimum_Balance and
Acct.Rate = Current_Rate and
Acct.Minimum_Balance = Preferred_Minimum_Balance);
end Verify_Open;
 
end F392A00;
/acats25.lst
0,0 → 1,4308
a22006b.ada
a22006c.ada
a22006d.ada
a26007a.tst
a27003a.ada
a29003a.ada
a2a031a.ada
a33003a.ada
a34017c.ada
a35101b.ada
a35402a.ada
a35801f.ada
a35902c.ada
a38106d.ada
a38106e.ada
a49027a.ada
a49027b.ada
a49027c.ada
a54b01a.ada
a54b02a.ada
a55b12a.ada
a55b13a.ada
a55b14a.ada
a71004a.ada
a73001i.ada
a73001j.ada
a74105b.ada
a74106a.ada
a74106b.ada
a74106c.ada
a74205e.ada
a74205f.ada
a83009a.ada
a83009b.ada
a83a02a.ada
a83a02b.ada
a83a06a.ada
a83a08a.ada
a83c01c.ada
a83c01h.ada
a83c01i.ada
a85007d.ada
a85013b.ada
a87b59a.ada
a95001c.ada
a95074d.ada
a97106a.ada
a99006a.ada
aa2010a.ada
aa2012a.ada
acats25.lst
ac1015b.ada
ac3106a.ada
ac3206a.ada
ac3207a.ada
ad7001b.ada
ad7001c0.ada
ad7001c1.ada
ad7001d0.ada
ad7001d1.ada
ad7006a.ada
ad7101a.ada
ad7101c.ada
ad7102a.ada
ad7103a.ada
ad7103c.ada
ad7104a.ada
ad7201a.ada
ad7203b.ada
ad7205b.ada
ad8011a.tst
ada101a.ada
ae2113a.ada
ae2113b.ada
ae3002g.ada
ae3101a.ada
ae3702a.ada
ae3709a.ada
b22001a.tst
b22001b.tst
b22001c.tst
b22001d.tst
b22001e.tst
b22001f.tst
b22001g.tst
b22001h.ada
b22001i.tst
b22001j.tst
b22001k.tst
b22001l.tst
b22001m.tst
b22001n.tst
b23002a.ada
b23004a.ada
b23004b.ada
b24001a.ada
b24001b.ada
b24001c.ada
b24005a.ada
b24005b.ada
b24007a.ada
b24009a.ada
b24009b.ada
b24104a.ada
b24204a.ada
b24204b.ada
b24204c.ada
b24204d.ada
b24204e.ada
b24204f.ada
b24205a.ada
b24206a.ada
b24206b.ada
b24211b.ada
b25002a.ada
b25002b.ada
b26001a.ada
b26002a.ada
b26005a.ada
b28001a.ada
b28001b.ada
b28001c.ada
b28001d.ada
b28001e.ada
b28001f.ada
b28001g.ada
b28001h.ada
b28001i.ada
b28001j.ada
b28001k.ada
b28001l.ada
b28001m.ada
b28001n.ada
b28001o.ada
b28001p.ada
b28001q.ada
b28001r.ada
b28001s.ada
b28001t.ada
b28001u.ada
b28001v.ada
b28001w.ada
b29001a.ada
b2a003a.ada
b2a003b.ada
b2a003c.ada
b2a003d.ada
b2a003e.ada
b2a003f.ada
b2a005a.ada
b2a005b.ada
b2a007a.ada
b2a010a.ada
b2a021a.ada
b32101a.ada
b32103a.ada
b32104a.ada
b32106a.ada
b32201a.ada
b32202a.ada
b32202b.ada
b32202c.ada
b330001.a
b33001a.ada
b33101a.ada
b33102a.ada
b33102b.ada
b33102c.ada
b33102d.ada
b33102e.ada
b33201a.ada
b33201b.ada
b33201c.ada
b33201d.ada
b33201e.ada
b33204a.ada
b33205a.ada
b33302a.ada
b34001b.ada
b34001e.ada
b34002b.ada
b34003b.ada
b34004b.ada
b34005b.ada
b34005e.ada
b34005h.ada
b34005k.ada
b34005n.ada
b34005q.ada
b34005t.ada
b34006b.ada
b34006e.ada
b34006h.ada
b34006k.ada
b34007b.ada
b34007e.ada
b34007h.ada
b34007k.ada
b34007n.ada
b34007q.ada
b34007t.ada
b34008b.ada
b34009b.ada
b34009e.ada
b34009h.ada
b34009k.ada
b34011a.ada
b34014b.ada
b34014d.ada
b34014f.ada
b34014i.ada
b34014m.ada
b34014o.ada
b34014q.ada
b34014s.ada
b34014v.ada
b34014z.ada
b35004a.ada
b35101a.ada
b35103a.ada
b35103b.ada
b35302a.ada
b354001.a
b35401a.ada
b35401b.ada
b35403a.ada
b35501a.ada
b35501b.ada
b35506a.ada
b35506b.ada
b35506c.ada
b35506d.ada
b35701a.ada
b35709a.ada
b35901a.ada
b35901c.ada
b35901d.ada
b35a01a.ada
b35a08a.ada
b360001.a
b36001a.ada
b36002a.ada
b36101a.ada
b36102a.ada
b36103a.ada
b36105c.dep
b36171a.ada
b36171b.ada
b36171c.ada
b36171d.ada
b36171e.ada
b36171f.ada
b36171g.ada
b36171h.ada
b36171i.ada
b36201a.ada
b36307a.ada
b370001.a
b370002.a
b37004a.ada
b37004b.ada
b37004c.ada
b37004d.ada
b37004e.ada
b37004f.ada
b37004g.ada
b3710010.a
b3710011.a
b3710012.a
b3710013.a
b3710014.am
b37101a.ada
b37102a.ada
b37104a.ada
b37106a.ada
b37201a.ada
b37201b.ada
b37203a.ada
b37301i.ada
b37301j.ada
b37302a.ada
b37303a.ada
b37309b.ada
b37310b.ada
b37311a.ada
b37401a.ada
b37409b.ada
b380001.a
b38003a.ada
b38003b.ada
b38003c.ada
b38003d.ada
b38008a.ada
b38008b.ada
b38009a.ada
b38009d.ada
b38101a.ada
b38101b.ada
b38101c.ada
b38103a.ada
b38103b.ada
b38103c0.ada
b38103c1.ada
b38103c2.ada
b38103c3.ada
b38103d.ada
b38103e0.ada
b38103e1.ada
b38105a.ada
b38105b.ada
b38203a.ada
b390001.a
b391001.a
b391002.a
b391003.a
b391004.a
b392001.a
b392002.a
b392003.a
b392004.a
b392005.a
b392006.a
b392007.a
b392008.a
b392009.a
b392010.a
b392011.a
b393001.a
b393002.a
b393003.a
b393004.a
b393005.a
b393006.a
b393007.a
b3a0001.a
b3a0002.a
b3a0003.a
b3a0004.a
b3a2002.a
b3a2003.a
b3a2004.a
b3a2005.a
b3a2006.a
b3a2007.a
b3a2008.a
b3a2009.a
b3a2010.a
b3a2011.a
b3a2012.a
b3a2013.a
b3a2014.a
b3a2015.a
b3a2016.a
b41101a.ada
b41101c.ada
b41201a.ada
b41201c.ada
b41202c.ada
b41202d.ada
b41324b.ada
b41325b.ada
b41327b.ada
b420001.a
b430001.a
b43001m.ada
b43002d.ada
b43002e.ada
b43002f.ada
b43002g.ada
b43002h.ada
b43002i.ada
b43002j.ada
b43002k.ada
b43005a.ada
b43005b.ada
b43005f.ada
b43101a.ada
b43102a.ada
b43102b.ada
b43105c.ada
b43201a.ada
b43201c.ada
b43201d.ada
b43202a.ada
b43202c.ada
b43209b.ada
b43221a.ada
b43221b.ada
b43223a.ada
b44001a.ada
b44001b.ada
b44002b.ada
b44002c.ada
b44004a.ada
b44004b.ada
b44004c.ada
b44004d.ada
b44004e.ada
b45102a.ada
b45116a.ada
b45121a.ada
b45204a.ada
b45205a.ada
b45206c.ada
b45207a.ada
b45207b.ada
b45207c.ada
b45207d.ada
b45207g.ada
b45207h.ada
b45207i.ada
b45207j.ada
b45207m.ada
b45207n.ada
b45207o.ada
b45207p.ada
b45207s.ada
b45207t.ada
b45207u.ada
b45207v.ada
b45208a.ada
b45208b.ada
b45208c.ada
b45208g.ada
b45208h.ada
b45208i.ada
b45208m.ada
b45208n.ada
b45208s.ada
b45208t.ada
b45209a.ada
b45209b.ada
b45209c.ada
b45209d.ada
b45209e.ada
b45209f.ada
b45209g.ada
b45209h.ada
b45209i.ada
b45209j.ada
b45209k.ada
b45221a.ada
b45261a.ada
b45261b.ada
b45261c.ada
b45261d.ada
b45301a.ada
b45301b.ada
b45301c.ada
b45302a.ada
b45341a.ada
b455002.a
b45501a.ada
b45501b.ada
b45501c.ada
b45522a.ada
b45537a.ada
b45601a.ada
b45625a.ada
b45661a.ada
b460001.a
b460002.a
b460004.a
b460005.a
b46002a.ada
b46003a.ada
b46004a.ada
b46004b.ada
b46004c.ada
b46004d.ada
b46004e.ada
b46005a.ada
b47001a.ada
b480001.a
b48001a.ada
b48001b.ada
b48002a.ada
b48002b.ada
b48002c.ada
b48002d.ada
b48002e.ada
b48002g.ada
b48003a.ada
b48003b.ada
b48003c.ada
b48003d.ada
b48003e.ada
b490001.a
b490002.a
b49002a.ada
b49004a.ada
b49005a.ada
b49007a.ada
b49007b.ada
b49008a.ada
b49008c.ada
b49009b.ada
b49009c.ada
b49010a.ada
b49011a.ada
b4a010c.ada
b4a016a.ada
b51001a.ada
b51004b.ada
b51004c.ada
b52002a.ada
b52002b.ada
b52002c.ada
b52002d.ada
b52002e.ada
b52002f.ada
b52002g.ada
b52004a.ada
b52004b.ada
b52004c.ada
b52004d.dep
b52004e.dep
b53001a.ada
b53001b.ada
b53002a.ada
b53002b.ada
b53009a.ada
b53009b.ada
b53009c.ada
b54a01b.ada
b54a01f.ada
b54a01g.ada
b54a01l.ada
b54a05a.ada
b54a05b.ada
b54a10a.ada
b54a12a.ada
b54a20a.ada
b54a21a.ada
b54a25a.ada
b54a60a.ada
b54a60b.ada
b54b01b.tst
b54b01c.ada
b54b02b.ada
b54b02c.ada
b54b02d.ada
b54b04a.ada
b54b04b.ada
b54b05a.ada
b54b06a.ada
b55a01a.ada
b55a01d.ada
b55a01e.ada
b55a01j.ada
b55a01k.ada
b55a01l.ada
b55a01n.ada
b55a01o.ada
b55a01t.ada
b55a01u.ada
b55a01v.ada
b55b01a.ada
b55b01b.ada
b55b09b.ada
b55b09c.dep
b55b09d.dep
b55b12b.ada
b55b12c.ada
b55b17a.ada
b55b17b.ada
b55b17c.ada
b55b18a.ada
b56001a.ada
b56001d.ada
b56001e.ada
b56001f.ada
b56001g.ada
b56001h.ada
b57001a.ada
b57001b.ada
b57001c.ada
b57001d.ada
b58001a.ada
b58002a.ada
b58002b.ada
b58002c.ada
b58003a.ada
b58003b.ada
b59001a.ada
b59001c.ada
b59001d.ada
b59001e.ada
b59001f.ada
b59001g.ada
b59001h.ada
b59001i.ada
b610001.a
b61001f.ada
b61005a.ada
b61006a.ada
b61011a.ada
b62001a.ada
b62001b.ada
b62001c.ada
b62001d.ada
b63001a.ada
b63001b.ada
b63005a.ada
b63005b.ada
b63006a.ada
b63009a.ada
b63009b.ada
b63009c0.ada
b63009c1.ada
b63009c2.ada
b63009c3.ada
b63103a.ada
b64002a.ada
b64002c.ada
b64003a.ada
b64004a.ada
b64004b.ada
b64004c.ada
b64004d.ada
b64004e.ada
b64004f.ada
b641001.a
b64101a.ada
b64201a.ada
b65001a.ada
b65002a.ada
b65002b.ada
b660001.a
b660002.a
b66001a.ada
b66001b.ada
b66001c.ada
b66001d.ada
b67001a.ada
b67001b.ada
b67001c.ada
b67001d.ada
b67001h.ada
b67001i.ada
b67001j.ada
b67001k.ada
b67004a.ada
b71001a.ada
b71001b.ada
b71001c.ada
b71001d.ada
b71001f.ada
b71001g.ada
b71001h.ada
b71001i.ada
b71001j.ada
b71001l.ada
b71001m.ada
b71001n.ada
b71001o.ada
b71001p.ada
b71001r.ada
b71001t.ada
b71001u.ada
b71001v.ada
b7200010.a
b7200011.a
b7200012.a
b7200013.a
b7200014.a
b7200015.a
b7200016.a
b730001.a
b730002.a
b730003.a
b730004.a
b730005.a
b7300060.a
b7300061.a
b7300062.a
b7300063.am
b73001a.ada
b73001b.ada
b73001c.ada
b73001d.ada
b73001e.ada
b73001f.ada
b73001g.ada
b73001h.ada
b73004a.ada
b73004b0.ada
b73004b1.ada
b73004b2.ada
b7310010.a
b7310011.a
b7310012.a
b7310013.a
b7310014.a
b7310015.a
b7310016.am
b731a01.a
b731a02.a
b740001.a
b74001a.ada
b74001b.ada
b74101a.ada
b74101b.ada
b74103a.ada
b74103d.ada
b74103e.ada
b74103g.ada
b74103i.ada
b74104a.ada
b74105a.ada
b74105c.ada
b74201a.ada
b74202a.ada
b74202b.ada
b74202c.ada
b74202d.ada
b74203b.ada
b74203c.ada
b74203d.ada
b74203e.ada
b74205a.ada
b74207a.ada
b74304a.ada
b74304b.ada
b74304c.ada
b74404a.ada
b74404b.ada
b74409a.ada
b810001.a
b830001.a
b8300020.a
b8300021.a
b8300022.a
b8300023.a
b8300024.a
b8300025.am
b83001a.ada
b83003a.ada
b83003b0.ada
b83003b1.ada
b83003b2.ada
b83003b3.ada
b83003b4.ada
b83003c.ada
b83004a.ada
b83004b0.ada
b83004b1.ada
b83004b2.ada
b83004b3.ada
b83004c0.ada
b83004c1.ada
b83004c2.ada
b83004d0.ada
b83004d1.ada
b83004d2.ada
b83004d3.ada
b83006a.ada
b83006b.ada
b83008a.ada
b83008b.ada
b83011a.ada
b83023b.ada
b83024b.ada
b83024f0.ada
b83024f1.ada
b83024f2.ada
b83024f3.ada
b83026b.ada
b83027b.ada
b83027d.ada
b83028b.ada
b83029b.ada
b83030b.ada
b83030d.ada
b83031b.ada
b83031d.ada
b83031f.ada
b83032b.ada
b83033b.ada
b83041e.ada
b83a01a.ada
b83a01b.ada
b83a01c.ada
b83a05a.ada
b83a06b.ada
b83a06h.ada
b83a07a.ada
b83a07b.ada
b83a07c.ada
b83a08b.ada
b83a09a.ada
b83b01a.ada
b83b02c.ada
b83e01a.ada
b83e01b.ada
b83e01c.ada
b83e01d.ada
b83e01e0.ada
b83e01e1.ada
b83e01e2.ada
b83e01e3.ada
b83e01f0.ada
b83e01f1.ada
b83e01f2.ada
b83e01f3.ada
b83e01f4.ada
b83e01f5.ada
b83e01f6.ada
b83e11a.ada
b83f02a.ada
b83f02b.ada
b83f02c.ada
b840001.a
b84001a.ada
b84002b.ada
b84004a.ada
b84005b.ada
b84006a.ada
b84007a.ada
b84008b.ada
b85001a.ada
b85001b.ada
b85001c.ada
b85001d.ada
b85001e.ada
b85001f.ada
b85001g.ada
b85001h.ada
b85001i.ada
b85001j.ada
b85001k.ada
b85001l.ada
b85002a.ada
b85003a.ada
b85003b.ada
b85004a.ada
b85008f.ada
b85008g.ada
b85008h.ada
b85010a.ada
b85010b.ada
b85012a.ada
b85013c.ada
b85013d.ada
b85015a.ada
b8510010.a
b8510011.a
b8510012.am
b86001a0.ada
b86001a1.ada
b87b23b.ada
b87b26a.ada
b87b48c.ada
b91001b.ada
b91001c.ada
b91001d.ada
b91001e.ada
b91001f.ada
b91001g.ada
b91002a.ada
b91002b.ada
b91002c.ada
b91002d.ada
b91002e.ada
b91002f.ada
b91002g.ada
b91002h.ada
b91002i.ada
b91002j.ada
b91002k.ada
b91002l.ada
b91003a.ada
b91003b.ada
b91003c.ada
b91003d.ada
b91003e.ada
b91004a.ada
b91005a.ada
b92001a.ada
b92001b.ada
b940001.a
b940002.a
b940003.a
b940004.a
b940005.a
b940006.a
b940007.a
b95001a.ada
b95001b.ada
b95001d.ada
b95002a.ada
b95003a.ada
b95004a.ada
b95004b.ada
b95006a.ada
b95006b.ada
b95006c.ada
b95006d.ada
b95007a.ada
b95007b.ada
b95020a.ada
b95020b0.ada
b95020b1.ada
b95020b2.ada
b95030a.ada
b95031a.ada
b95032a.ada
b95061a.ada
b95061b.ada
b95061c.ada
b95061d.ada
b95061e.ada
b95061f.ada
b95061g.ada
b95062a.ada
b95063a.ada
b95064a.ada
b95068a.ada
b95070a.ada
b95080a.ada
b95080c.ada
b95081a.ada
b95082a.ada
b95082b.ada
b95082c.ada
b95082d.ada
b95082e.ada
b95082f.ada
b95083a.ada
b95094a.ada
b95094b.ada
b95094c.ada
b951001.a
b952001.a
b952002.a
b952003.a
b952004.a
b954001.a
b954003.a
b954004.a
b960001.a
b96002a.ada
b97102b.ada
b97102c.ada
b97102d.ada
b97102f.ada
b97102g.ada
b97102h.ada
b97102i.ada
b97103a.ada
b97103b.ada
b97103d.ada
b97103e.ada
b97103f.ada
b97103g.ada
b97104a.ada
b97104b.ada
b97104c.ada
b97104d.ada
b97104e.ada
b97104f.ada
b97104g.ada
b97107a.ada
b97108a.ada
b97108b.ada
b97109a.ada
b97110a.ada
b97110b.ada
b97111a.ada
b97206a.ada
b97306a.ada
b99001a.ada
b99001b.ada
b99002a.ada
b99002b.ada
b99002c.ada
b99003a.ada
b9a001a.ada
b9a001b.ada
ba1001a0.ada
ba1001a1.ada
ba1001a4.ada
ba1001ac.ada
ba1001d.ada
ba1010a0.ada
ba1010a1.ada
ba1010a2.ada
ba1010a3.ada
ba1010b0.ada
ba1010b1.ada
ba1010b2.ada
ba1010b4.ada
ba1010b5.ada
ba1010b6.ada
ba1010b7.ada
ba1010b8.ada
ba1010c0.ada
ba1010c1.ada
ba1010c2.ada
ba1010c3.ada
ba1010c4.ada
ba1010c5.ada
ba1010c6.ada
ba1010d0.ada
ba1010d1.ada
ba1010d2.ada
ba1010d3.ada
ba1010e0.ada
ba1010e1.ada
ba1010e2.ada
ba1010e3.ada
ba1010e4.ada
ba1010e5.ada
ba1010e6.ada
ba1010f0.ada
ba1010f1.ada
ba1010f3.ada
ba1010f4.ada
ba1010f5.ada
ba1010f6.ada
ba1010f7.ada
ba1010f8.ada
ba1010g0.ada
ba1010g2.ada
ba1010g3.ada
ba1010g4.ada
ba1010g5.ada
ba1010h0.ada
ba1010h2.ada
ba1010i0.ada
ba1010i1.ada
ba1010i3.ada
ba1010i4.ada
ba1010j0.ada
ba1010j1.ada
ba1010j2.ada
ba1010j4.ada
ba1010j5.ada
ba1010j6.ada
ba1010j7.ada
ba1010j8.ada
ba1010k0.ada
ba1010k1.ada
ba1010k2.ada
ba1010k3.ada
ba1010k4.ada
ba1010k5.ada
ba1010k6.ada
ba1010l0.ada
ba1010l1.ada
ba1010l2.ada
ba1010l3.ada
ba1010l4.ada
ba1010l5.ada
ba1010l6.ada
ba1010m0.ada
ba1010m1.ada
ba1010m3.ada
ba1010m4.ada
ba1010m5.ada
ba1010m6.ada
ba1010m7.ada
ba1010m8.ada
ba1010n0.ada
ba1010n2.ada
ba1010n3.ada
ba1010n4.ada
ba1010n5.ada
ba1010p0.ada
ba1010p2.ada
ba1010q0.ada
ba1010q1.ada
ba1010q3.ada
ba1010q4.ada
ba1011b0.ada
ba1011b1.ada
ba1011b2.ada
ba1011b3.ada
ba1011b4.ada
ba1011b5.ada
ba1011b6.ada
ba1011b7.ada
ba1011b8.ada
ba1011c0.ada
ba1011c1.ada
ba1011c2.ada
ba1011c3.ada
ba1011c4.ada
ba1011c5.ada
ba1011c6.ada
ba1011c7.ada
ba1011c8.ada
ba1020a0.ada
ba1020a1.ada
ba1020a2.ada
ba1020a3.ada
ba1020a4.ada
ba1020a5.ada
ba1020a6.ada
ba1020a7.ada
ba1020a8.ada
ba1020b0.ada
ba1020b1.ada
ba1020b2.ada
ba1020b3.ada
ba1020b4.ada
ba1020b5.ada
ba1020b6.ada
ba1020c0.ada
ba1020c1.ada
ba1020c2.ada
ba1020c3.ada
ba1020c4.ada
ba1020c5.ada
ba1020f0.ada
ba1020f1.ada
ba1020f2.ada
ba11001.a
ba11002.a
ba11003.a
ba11004.a
ba11005.a
ba11007.a
ba11008.a
ba11009.a
ba11010.a
ba11011.a
ba11012.a
ba1101a.ada
ba1101b0.ada
ba1101b1.ada
ba1101b2.ada
ba1101b3.ada
ba1101b4.ada
ba1101c0.ada
ba1101c1.ada
ba1101c2.ada
ba1101c3.ada
ba1101c4.ada
ba1101c5.ada
ba1101c6.ada
ba1101e0.ada
ba1101e1.ada
ba1101f.ada
ba1101g.ada
ba1109a0.ada
ba1109a1.ada
ba1109a2.ada
ba1110a0.ada
ba1110a1.ada
ba1110a2.ada
ba1110a3.ada
ba1110a4.ada
ba1110a5.ada
ba12001.a
ba12002.a
ba12003.a
ba12004.a
ba12005.a
ba12007.a
ba12008.a
ba13b01.a
ba13b02.a
ba15001.a
ba150020.a
ba150021.a
ba150022.a
ba150023.a
ba150024.a
ba150025.a
ba150026.a
ba150027.a
ba150028.a
ba150029.am
ba2001a.ada
ba2001b.ada
ba2001c.ada
ba2001d.ada
ba2001f0.ada
ba2001f1.ada
ba2001f2.ada
ba2003b0.ada
ba2003b1.ada
ba2011a0.ada
ba2011a1.ada
ba2011a2.ada
ba2011a3.ada
ba2011a4.ada
ba2011a5.ada
ba2011a6.ada
ba2011a7.ada
ba2011a8.ada
ba2011a9.ada
ba2013a.ada
ba2013b.ada
ba21001.a
ba21002.a
ba210030.a
ba210031.a
ba210032.a
ba210033.a
ba210034.a
ba210035.a
ba210040.a
ba210041.a
ba210042.a
ba210043.a
ba210044.a
ba210045.am
ba21a01.a
ba21a02.a
ba3001a0.ada
ba3001a1.ada
ba3001a2.ada
ba3001a3.ada
ba3001b0.ada
ba3001b1.ada
ba3001c0.ada
ba3001c1.ada
ba3001e0.ada
ba3001e1.ada
ba3001e2.ada
ba3001e3.ada
ba3001f0.ada
ba3001f1.ada
ba3001f2.ada
ba3001f3.ada
ba3006a0.ada
ba3006a1.ada
ba3006a2.ada
ba3006a3.ada
ba3006a4.ada
ba3006a5.ada
ba3006a6.ada
ba3006b0.ada
ba3006b1.ada
ba3006b2.ada
ba3006b3.ada
ba3006b4.ada
bb10001.a
bb20001.a
bb2001a.ada
bb2002a.ada
bb2003a.ada
bb2003b.ada
bb2003c.ada
bb3001a.ada
bb3002a.ada
bc1001a.ada
bc1002a.ada
bc1005a.ada
bc1008a.ada
bc1008b.ada
bc1008c.ada
bc1009a.ada
bc1011a.ada
bc1011b.ada
bc1011c.ada
bc1012a.ada
bc1013a.ada
bc1014a.ada
bc1014b.ada
bc1016a.ada
bc1016b.ada
bc1101a.ada
bc1102a.ada
bc1103a.ada
bc1106a.ada
bc1107a.ada
bc1109a.ada
bc1109b.ada
bc1109c.ada
bc1109d.ada
bc1110a.ada
bc1201a.ada
bc1201b.ada
bc1201c.ada
bc1201d.ada
bc1201e.ada
bc1201f.ada
bc1201g.ada
bc1201h.ada
bc1201i.ada
bc1201j.ada
bc1201k.ada
bc1201l.ada
bc1202a.ada
bc1202c.ada
bc1202e.ada
bc1202f.ada
bc1202g.ada
bc1203a.ada
bc1205a.ada
bc1206a.ada
bc1207a.ada
bc1208a.ada
bc1226a.ada
bc1230a.ada
bc1303a.ada
bc1303b.ada
bc1303c.ada
bc1303d.ada
bc1303e.ada
bc1303f.ada
bc1303g.ada
bc1306a.ada
bc2001b.ada
bc2001c.ada
bc2001d.ada
bc2001e.ada
bc2004a.ada
bc2004b.ada
bc30001.a
bc3001a.ada
bc3002a.ada
bc3002b.ada
bc3002c.ada
bc3002d.ada
bc3002e.ada
bc3005a.ada
bc3005b.ada
bc3005c.ada
bc3006a.ada
bc3009c.ada
bc3011b.ada
bc3013a.ada
bc3016g.ada
bc3018a.ada
bc3101a.ada
bc3101b.ada
bc3102a.ada
bc3102b.ada
bc3103b.ada
bc3123c.ada
bc3201a.ada
bc3201b.ada
bc3201c.ada
bc3202a.ada
bc3202b.ada
bc3202c.ada
bc3202d.ada
bc3205c.ada
bc3301a.ada
bc3301b.ada
bc3302a.ada
bc3302b.ada
bc3303a.ada
bc3304a.ada
bc3401a.ada
bc3401b.ada
bc3402a.ada
bc3402b.ada
bc3403a.ada
bc3403b.ada
bc3403c.ada
bc3404a.ada
bc3404b.ada
bc3404c.ada
bc3404d.ada
bc3404e.ada
bc3404f.ada
bc3405a.ada
bc3405b.ada
bc3405d.ada
bc3405e.ada
bc3405f.ada
bc3501a.ada
bc3501b.ada
bc3501c.ada
bc3501d.ada
bc3501e.ada
bc3501f.ada
bc3501g.ada
bc3501h.ada
bc3501i.ada
bc3501j.ada
bc3501k.ada
bc3502a.ada
bc3502b.ada
bc3502c.ada
bc3502d.ada
bc3502e.ada
bc3502f.ada
bc3502g.ada
bc3502h.ada
bc3502i.ada
bc3502j.ada
bc3502k.ada
bc3502l.ada
bc3502m.ada
bc3502n.ada
bc3502o.ada
bc3503a.ada
bc3503c.ada
bc3503d.ada
bc3503e.ada
bc3503f.ada
bc3604a.ada
bc3604b.ada
bc3607a.ada
bc40001.a
bc40002.a
bc50001.a
bc50002.a
bc50003.a
bc50004.a
bc51002.a
bc51003.a
bc51004.a
bc51005.a
bc51006.a
bc51007.a
bc51011.a
bc51012.a
bc51013.a
bc51015.a
bc51016.a
bc51017.a
bc51018.a
bc51019.a
bc51020.a
bc51b01.a
bc51b02.a
bc51c01.a
bc51c02.a
bc53001.a
bc53002.a
bc54001.a
bc54002.a
bc54003.a
bc54a01.a
bc54a02.a
bc54a03.a
bc54a04.a
bc54a05.a
bc54a06.a
bc70001.a
bc70002.a
bc70003.a
bc70004.a
bc70005.a
bc70006.a
bc70007.a
bc70008.a
bc70009.a
bc70010.a
bd1b01a.ada
bd1b02b.ada
bd1b03c.ada
bd1b05e.ada
bd1b06j.ada
bd2001b.ada
bd2a01h.ada
bd2a02a.tst
bd2a03a.ada
bd2a03b.ada
bd2a06a.ada
bd2a25a.ada
bd2a35a.ada
bd2a45a.ada
bd2a55a.ada
bd2a55b.ada
bd2a67a.ada
bd2a77a.ada
bd2a85a.ada
bd2a85b.ada
bd2b01c.ada
bd2b02a.ada
bd2b03a.ada
bd2b03b.ada
bd2b03c.ada
bd2c01d.tst
bd2c02a.tst
bd2c03a.tst
bd2d01c.ada
bd2d01d.ada
bd2d02a.ada
bd2d03a.ada
bd2d03b.ada
bd3001a.ada
bd3001b.ada
bd3001c.ada
bd3002a.ada
bd3003a.ada
bd3003b.ada
bd3012a.ada
bd3013a.ada
bd4001a.ada
bd4002a.ada
bd4003a.ada
bd4003b.ada
bd4003c.ada
bd4006a.tst
bd4007a.ada
bd4009a.ada
bd4011a.ada
bd5001a.ada
bd5005a.ada
bd5005d.ada
bd5102a.ada
bd5102b.ada
bd5103a.ada
bd5104a.ada
bd7001a.ada
bd7101h.ada
bd7201c.ada
bd7203a.ada
bd7204a.ada
bd7205a.ada
bd7301a.ada
bd7302a.ada
bd8001a.tst
bd8002a.tst
bd8003a.tst
bd8004a.tst
bd8004b.tst
bd8004c.tst
bdb0a01.a
bdd2001.a
bde0001.a
bde0002.a
bde0003.a
bde0004.a
bde0005.a
bde0006.a
bde0007.a
bde0008.a
be2101e.ada
be2101j.ada
be2114a.ada
be2116a.ada
be2208a.ada
be3002a.ada
be3002e.ada
be3205a.ada
be3301c.ada
be3606c.ada
be3703a.ada
be3802a.ada
be3803a.ada
be3902a.ada
be3903a.ada
bxa8001.a
bxac001.a
bxac002.a
bxac003.a
bxac004.a
bxac005.a
bxc3001.a
bxc3002.a
bxc5001.a
bxc6001.a
bxc6002.a
bxc6003.a
bxc6a01.a
bxc6a02.a
bxc6a03.a
bxc6a04.a
bxd1001.a
bxd1002.a
bxe2007.a
bxe2008.a
bxe2009.a
bxe2010.a
bxe2011.a
bxe2012.a
bxe2013.a
bxe2a01.a
bxe2a02.a
bxe2a03.a
bxe2a04.a
bxe2a05.a
bxe2a06.a
bxe4001.a
bxf1001.a
bxh4001.a
bxh4002.a
bxh4003.a
bxh4004.a
bxh4005.a
bxh4006.a
bxh4007.a
bxh4008.a
bxh4009.a
bxh4010.a
bxh4011.a
bxh4012.a
bxh4013.a
c23001a.ada
c23003a.tst
c23003b.tst
c23003g.tst
c23003i.tst
c23006a.ada
c23006b.ada
c23006c.ada
c23006d.ada
c23006e.ada
c23006f.ada
c23006g.ada
c24002d.ada
c24003a.ada
c24003b.ada
c24003c.ada
c24106a.ada
c24202d.ada
c24203a.ada
c24203b.ada
c24207a.ada
c24211a.ada
c250001.aw
c250002.aw
c25001a.ada
c25001b.ada
c26006a.ada
c26008a.ada
c2a001a.ada
c2a001b.ada
c2a001c.ada
c2a002a.ada
c2a008a.ada
c2a021b.ada
c32001a.ada
c32001b.ada
c32001c.ada
c32001d.ada
c32001e.ada
c32107a.ada
c32107c.ada
c32108a.ada
c32108b.ada
c32111a.ada
c32111b.ada
c32112b.ada
c32113a.ada
c32115a.ada
c32115b.ada
c330001.a
c330002.a
c332001.a
c340001.a
c34001a.ada
c34001c.ada
c34001d.ada
c34001f.ada
c34002a.ada
c34002c.ada
c34003a.ada
c34003c.ada
c34004a.ada
c34004c.ada
c34005a.ada
c34005c.ada
c34005d.ada
c34005f.ada
c34005g.ada
c34005i.ada
c34005j.ada
c34005l.ada
c34005m.ada
c34005o.ada
c34005p.ada
c34005r.ada
c34005s.ada
c34005u.ada
c34005v.ada
c34006a.ada
c34006d.ada
c34006f.ada
c34006g.ada
c34006j.ada
c34006l.ada
c34007a.ada
c34007d.ada
c34007f.ada
c34007g.ada
c34007i.ada
c34007j.ada
c34007m.ada
c34007p.ada
c34007r.ada
c34007s.ada
c34007u.ada
c34007v.ada
c34008a.ada
c34009a.ada
c34009d.ada
c34009f.ada
c34009g.ada
c34009j.ada
c34009l.ada
c34011b.ada
c34012a.ada
c34014a.ada
c34014c.ada
c34014e.ada
c34014g.ada
c34014h.ada
c34014n.ada
c34014p.ada
c34014r.ada
c34014t.ada
c34014u.ada
c34018a.ada
c340a01.a
c340a02.a
c341a01.a
c341a02.a
c341a03.a
c341a04.a
c35003a.ada
c35003b.ada
c35003d.ada
c35102a.ada
c352001.a
c354002.a
c354003.a
c35502a.ada
c35502b.ada
c35502c.ada
c35502d.tst
c35502e.ada
c35502f.tst
c35502g.ada
c35502h.ada
c35502i.ada
c35502j.ada
c35502k.ada
c35502l.ada
c35502m.ada
c35502n.ada
c35502o.ada
c35502p.ada
c35503a.ada
c35503b.ada
c35503c.ada
c35503d.tst
c35503e.ada
c35503f.tst
c35503g.ada
c35503h.ada
c35503k.ada
c35503l.ada
c35503o.ada
c35503p.ada
c35504a.ada
c35504b.ada
c35505c.ada
c35505e.ada
c35505f.ada
c35507a.ada
c35507b.ada
c35507c.ada
c35507e.ada
c35507g.ada
c35507h.ada
c35507i.ada
c35507j.ada
c35507k.ada
c35507l.ada
c35507m.ada
c35507n.ada
c35507o.ada
c35507p.ada
c35508a.ada
c35508b.ada
c35508c.ada
c35508e.ada
c35508g.ada
c35508h.ada
c35508k.ada
c35508l.ada
c35508o.ada
c35508p.ada
c35703a.ada
c35704a.ada
c35704b.ada
c35704c.ada
c35704d.ada
c35801d.ada
c35902d.ada
c35904a.ada
c35904b.ada
c35a02a.ada
c35a05a.ada
c35a05d.ada
c35a05n.ada
c35a05q.ada
c35a07a.ada
c35a07d.ada
c35a08b.ada
c360002.a
c36104a.ada
c36104b.ada
c36172a.ada
c36172b.ada
c36172c.ada
c36174a.ada
c36180a.ada
c36202c.ada
c36203a.ada
c36204a.ada
c36204b.ada
c36204c.ada
c36204d.ada
c36205a.ada
c36205b.ada
c36205c.ada
c36205d.ada
c36205e.ada
c36205f.ada
c36205g.ada
c36205h.ada
c36205i.ada
c36205j.ada
c36205k.ada
c36205l.ada
c36301a.ada
c36301b.ada
c36302a.ada
c36304a.ada
c36305a.ada
c37002a.ada
c37003a.ada
c37003b.ada
c37005a.ada
c37006a.ada
c37008a.ada
c37008b.ada
c37009a.ada
c37010a.ada
c37010b.ada
c371001.a
c371002.a
c371003.a
c37102b.ada
c37103a.ada
c37105a.ada
c37107a.ada
c37108b.ada
c37206a.ada
c37207a.ada
c37208a.ada
c37208b.ada
c37209a.ada
c37209b.ada
c37210a.ada
c37211a.ada
c37211b.ada
c37211c.ada
c37211d.ada
c37211e.ada
c37213b.ada
c37213d.ada
c37213f.ada
c37213h.ada
c37213j.ada
c37213k.ada
c37213l.ada
c37215b.ada
c37215d.ada
c37215f.ada
c37215h.ada
c37217a.ada
c37217b.ada
c37217c.ada
c37304a.ada
c37305a.ada
c37306a.ada
c37309a.ada
c37310a.ada
c37312a.ada
c37402a.ada
c37403a.ada
c37404a.ada
c37404b.ada
c37405a.ada
c37411a.ada
c38002a.ada
c38002b.ada
c38005a.ada
c38005b.ada
c38005c.ada
c38006a.ada
c38102a.ada
c38102b.ada
c38102c.ada
c38102d.ada
c38102e.ada
c38104a.ada
c38107a.ada
c38107b.ada
c38108a.ada
c38108b.ada
c38108c0.ada
c38108c1.ada
c38108c2.ada
c38108d0.ada
c38108d1.ada
c38202a.ada
c3900010.a
c3900011.am
c390002.a
c390003.a
c390004.a
c3900050.a
c3900051.a
c3900052.a
c3900053.am
c3900060.a
c3900061.a
c3900062.a
c3900063.am
c390007.a
c390010.a
c390011.a
c39006a.ada
c39006b.ada
c39006c0.ada
c39006c1.ada
c39006d.ada
c39006e.ada
c39006f0.ada
c39006f1.ada
c39006f2.ada
c39006f3.ada
c39006g.ada
c39007a.ada
c39007b.ada
c39008a.ada
c39008b.ada
c39008c.ada
c390a010.a
c390a011.am
c390a020.a
c390a021.a
c390a022.am
c390a030.a
c390a031.am
c391001.a
c391002.a
c392002.a
c392003.a
c392004.a
c392005.a
c392008.a
c392010.a
c392011.a
c392013.a
c392014.a
c392a01.a
c392c05.a
c392c07.a
c392d01.a
c392d02.a
c392d03.a
c393001.a
c393007.a
c393008.a
c393009.a
c393010.a
c393011.a
c393012.a
c393a02.a
c393a03.a
c393a05.a
c393a06.a
c393b12.a
c393b13.a
c393b14.a
c3a0001.a
c3a0002.a
c3a0003.a
c3a0004.a
c3a0005.a
c3a0006.a
c3a0007.a
c3a0008.a
c3a0009.a
c3a0010.a
c3a0011.a
c3a00120.a
c3a00121.a
c3a00122.am
c3a0013.a
c3a0014.a
c3a0015.a
c3a1001.a
c3a1002.a
c3a2001.a
c3a2002.a
c3a2003.a
c3a2a01.a
c3a2a02.a
c410001.a
c41101d.ada
c41103a.ada
c41103b.ada
c41104a.ada
c41105a.ada
c41107a.ada
c41201d.ada
c41203a.ada
c41203b.ada
c41204a.ada
c41205a.ada
c41206a.ada
c41207a.ada
c41301a.ada
c41303a.ada
c41303b.ada
c41303c.ada
c41303e.ada
c41303f.ada
c41303g.ada
c41303i.ada
c41303j.ada
c41303k.ada
c41303m.ada
c41303n.ada
c41303o.ada
c41303q.ada
c41303r.ada
c41303s.ada
c41303u.ada
c41303v.ada
c41303w.ada
c41304a.ada
c41304b.ada
c41306a.ada
c41306b.ada
c41306c.ada
c41307d.ada
c41309a.ada
c41320a.ada
c41321a.ada
c41322a.ada
c41323a.ada
c41324a.ada
c41325a.ada
c41326a.ada
c41327a.ada
c41328a.ada
c41401a.ada
c41402a.ada
c41404a.ada
c420001.a
c42006a.ada
c42007e.ada
c43003a.ada
c43004a.ada
c43004c.ada
c431001.a
c43103a.ada
c43103b.ada
c43104a.ada
c43105a.ada
c43105b.ada
c43106a.ada
c43107a.ada
c43108a.ada
c432001.a
c432002.a
c432003.a
c432004.a
c43204a.ada
c43204c.ada
c43204e.ada
c43204f.ada
c43204g.ada
c43204h.ada
c43204i.ada
c43205a.ada
c43205b.ada
c43205c.ada
c43205d.ada
c43205e.ada
c43205g.ada
c43205h.ada
c43205i.ada
c43205j.ada
c43205k.ada
c43206a.ada
c43207b.ada
c43207d.ada
c43208a.ada
c43208b.ada
c43209a.ada
c43210a.ada
c43211a.ada
c43212a.ada
c43212c.ada
c43214a.ada
c43214b.ada
c43214c.ada
c43214d.ada
c43214e.ada
c43214f.ada
c43215a.ada
c43215b.ada
c43222a.ada
c43224a.ada
c433001.a
c44003d.ada
c44003f.ada
c44003g.ada
c450001.a
c45112a.ada
c45112b.ada
c45113a.ada
c45114b.ada
c452001.a
c45201a.ada
c45201b.ada
c45202b.ada
c45210a.ada
c45211a.ada
c45220a.ada
c45220b.ada
c45220c.ada
c45220d.ada
c45220e.ada
c45220f.ada
c45231a.ada
c45231b.dep
c45231c.dep
c45231d.tst
c45232b.ada
c45242b.ada
c45251a.ada
c45252a.ada
c45252b.ada
c45253a.ada
c45262a.ada
c45262b.ada
c45262c.ada
c45262d.ada
c45264a.ada
c45264b.ada
c45264c.ada
c45265a.ada
c45271a.ada
c45272a.ada
c45273a.ada
c45274a.ada
c45274b.ada
c45274c.ada
c45281a.ada
c45282a.ada
c45282b.ada
c45291a.ada
c45303a.ada
c45304a.ada
c45304b.dep
c45304c.dep
c45322a.ada
c45323a.ada
c45331a.ada
c45342a.ada
c45343a.ada
c45344a.ada
c45345b.ada
c45347a.ada
c45347b.ada
c45347c.ada
c45347d.ada
c45411a.ada
c45411b.dep
c45411c.dep
c45411d.ada
c45413a.ada
c45431a.ada
c455001.a
c45502b.dep
c45502c.dep
c45503a.ada
c45503b.dep
c45503c.dep
c45504a.ada
c45504b.dep
c45504c.dep
c45504d.ada
c45504e.dep
c45504f.dep
c45505a.ada
c45523a.ada
c45531a.ada
c45531b.ada
c45531c.ada
c45531d.ada
c45531e.ada
c45531f.ada
c45531g.ada
c45531h.ada
c45531i.ada
c45531j.ada
c45531k.ada
c45531l.ada
c45531m.dep
c45531n.dep
c45531o.dep
c45531p.dep
c45532a.ada
c45532b.ada
c45532c.ada
c45532d.ada
c45532e.ada
c45532f.ada
c45532g.ada
c45532h.ada
c45532i.ada
c45532j.ada
c45532k.ada
c45532l.ada
c45532m.dep
c45532n.dep
c45532o.dep
c45532p.dep
c45534b.ada
c45536a.dep
c45611a.ada
c45611b.dep
c45611c.dep
c45613a.ada
c45613b.dep
c45613c.dep
c45614a.ada
c45614b.dep
c45614c.dep
c45622a.ada
c45624a.ada
c45624b.ada
c45631a.ada
c45631b.dep
c45631c.dep
c45632a.ada
c45632b.dep
c45632c.dep
c45651a.ada
c45662a.ada
c45662b.ada
c45672a.ada
c460001.a
c460002.a
c460004.a
c460005.a
c460006.a
c460007.a
c460008.a
c460009.a
c460010.a
c460011.a
c460012.a
c46011a.ada
c46013a.ada
c46014a.ada
c46021a.ada
c46024a.ada
c46031a.ada
c46032a.ada
c46033a.ada
c46041a.ada
c46042a.ada
c46043b.ada
c46044b.ada
c46051a.ada
c46051b.ada
c46051c.ada
c46052a.ada
c46053a.ada
c46054a.ada
c460a01.a
c460a02.a
c47002a.ada
c47002b.ada
c47002c.ada
c47002d.ada
c47003a.ada
c47004a.ada
c47005a.ada
c47006a.ada
c47007a.ada
c47008a.ada
c47009a.ada
c47009b.ada
c48004a.ada
c48004b.ada
c48004c.ada
c48004d.ada
c48004e.ada
c48004f.ada
c48005a.ada
c48005b.ada
c48006a.ada
c48006b.ada
c48007a.ada
c48007b.ada
c48007c.ada
c48008a.ada
c48008c.ada
c48009a.ada
c48009b.ada
c48009c.ada
c48009d.ada
c48009e.ada
c48009f.ada
c48009g.ada
c48009h.ada
c48009i.ada
c48009j.ada
c48010a.ada
c48011a.ada
c48012a.ada
c490001.a
c490002.a
c490003.a
c49020a.ada
c49021a.ada
c49022a.ada
c49022b.ada
c49022c.ada
c49023a.ada
c49024a.ada
c49025a.ada
c49026a.ada
c4a005b.ada
c4a006a.ada
c4a007a.tst
c4a010a.ada
c4a010b.ada
c4a011a.ada
c4a012b.ada
c4a013a.ada
c4a014a.ada
c51004a.ada
c52005a.ada
c52005b.ada
c52005c.ada
c52005d.ada
c52005e.ada
c52005f.ada
c52008a.ada
c52008b.ada
c52009a.ada
c52009b.ada
c52010a.ada
c52011a.ada
c52011b.ada
c52101a.ada
c52102a.ada
c52102b.ada
c52102c.ada
c52102d.ada
c52103a.ada
c52103b.ada
c52103c.ada
c52103f.ada
c52103g.ada
c52103h.ada
c52103k.ada
c52103l.ada
c52103m.ada
c52103p.ada
c52103q.ada
c52103r.ada
c52103x.ada
c52104a.ada
c52104b.ada
c52104c.ada
c52104f.ada
c52104g.ada
c52104h.ada
c52104k.ada
c52104l.ada
c52104m.ada
c52104p.ada
c52104q.ada
c52104r.ada
c52104x.ada
c52104y.ada
c53007a.ada
c540001.a
c54a03a.ada
c54a04a.ada
c54a07a.ada
c54a13a.ada
c54a13b.ada
c54a13c.ada
c54a13d.ada
c54a22a.ada
c54a23a.ada
c54a24a.ada
c54a24b.ada
c54a42a.ada
c54a42b.ada
c54a42c.ada
c54a42d.ada
c54a42e.ada
c54a42f.ada
c54a42g.ada
c55b03a.ada
c55b04a.ada
c55b05a.ada
c55b06a.ada
c55b06b.ada
c55b07a.dep
c55b07b.dep
c55b10a.ada
c55b11a.ada
c55b11b.ada
c55b15a.ada
c55b16a.ada
c55c02a.ada
c55c02b.ada
c56002a.ada
c57003a.ada
c57004a.ada
c57004b.ada
c58004c.ada
c58004d.ada
c58004g.ada
c58005a.ada
c58005b.ada
c58005h.ada
c58006a.ada
c58006b.ada
c59002a.ada
c59002b.ada
c59002c.ada
c61008a.ada
c61009a.ada
c61010a.ada
c62002a.ada
c62003a.ada
c62003b.ada
c62004a.ada
c62006a.ada
c631001.a
c640001.a
c64002b.ada
c64004g.ada
c64005a.ada
c64005b.ada
c64005c.ada
c64005d0.ada
c64005da.ada
c64005db.ada
c64005dc.ada
c641001.a
c64103b.ada
c64103c.ada
c64103d.ada
c64103e.ada
c64103f.ada
c64104a.ada
c64104b.ada
c64104c.ada
c64104d.ada
c64104e.ada
c64104f.ada
c64104g.ada
c64104h.ada
c64104i.ada
c64104j.ada
c64104k.ada
c64104l.ada
c64104m.ada
c64104n.ada
c64104o.ada
c64105a.ada
c64105b.ada
c64105c.ada
c64105d.ada
c64106a.ada
c64106b.ada
c64106c.ada
c64106d.ada
c64107a.ada
c64108a.ada
c64109a.ada
c64109b.ada
c64109c.ada
c64109d.ada
c64109e.ada
c64109f.ada
c64109g.ada
c64109h.ada
c64109i.ada
c64109j.ada
c64109k.ada
c64109l.ada
c64201b.ada
c64201c.ada
c64202a.ada
c650001.a
c65003a.ada
c65003b.ada
c66002a.ada
c66002c.ada
c66002d.ada
c66002e.ada
c66002f.ada
c66002g.ada
c67002a.ada
c67002b.ada
c67002c.ada
c67002d.ada
c67002e.ada
c67003f.ada
c67005a.ada
c67005b.ada
c67005c.ada
c67005d.ada
c72001b.ada
c72002a.ada
c730001.a
c730002.a
c730003.a
c730004.a
c73002a.ada
c730a01.a
c730a02.a
c731001.a
c74004a.ada
c74203a.ada
c74206a.ada
c74207b.ada
c74208a.ada
c74208b.ada
c74209a.ada
c74210a.ada
c74211a.ada
c74211b.ada
c74302a.ada
c74302b.ada
c74305a.ada
c74305b.ada
c74306a.ada
c74307a.ada
c74401d.ada
c74401e.ada
c74401k.ada
c74401q.ada
c74402a.ada
c74402b.ada
c74406a.ada
c74407b.ada
c74409b.ada
c760001.a
c760002.a
c760007.a
c760009.a
c760010.a
c760011.a
c760012.a
c760013.a
c761001.a
c761002.a
c761003.a
c761004.a
c761005.a
c761006.a
c761007.a
c761010.a
c761011.a
c83007a.ada
c83012d.ada
c83022a.ada
c83022g0.ada
c83022g1.ada
c83023a.ada
c83024a.ada
c83024e0.ada
c83024e1.ada
c83025a.ada
c83025c.ada
c83027a.ada
c83027c.ada
c83028a.ada
c83029a.ada
c83030a.ada
c83030c.ada
c83031a.ada
c83031c.ada
c83031e.ada
c83032a.ada
c83033a.ada
c83051a.ada
c83b02a.ada
c83b02b.ada
c83e02a.ada
c83e02b.ada
c83e03a.ada
c83f01a.ada
c83f01b.ada
c83f01c0.ada
c83f01c1.ada
c83f01c2.ada
c83f01d0.ada
c83f01d1.ada
c83f03a.ada
c83f03b.ada
c83f03c0.ada
c83f03c1.ada
c83f03c2.ada
c83f03d0.ada
c83f03d1.ada
c840001.a
c84002a.ada
c84005a.ada
c84008a.ada
c84009a.ada
c85004b.ada
c85005a.ada
c85005b.ada
c85005c.ada
c85005d.ada
c85005e.ada
c85005f.ada
c85005g.ada
c85006a.ada
c85006b.ada
c85006c.ada
c85006d.ada
c85006e.ada
c85006f.ada
c85006g.ada
c85007a.ada
c85007e.ada
c85009a.ada
c85011a.ada
c85013a.ada
c85014a.ada
c85014b.ada
c85014c.ada
c85017a.ada
c85018a.ada
c85018b.ada
c85019a.ada
c854001.a
c854002.a
c86003a.ada
c86004a.ada
c86004b0.ada
c86004b1.ada
c86004b2.ada
c86004c0.ada
c86004c1.ada
c86004c2.ada
c86006i.ada
c86007a.ada
c87a05a.ada
c87a05b.ada
c87b02a.ada
c87b02b.ada
c87b03a.ada
c87b04a.ada
c87b04b.ada
c87b04c.ada
c87b05a.ada
c87b06a.ada
c87b07a.ada
c87b07b.ada
c87b07c.ada
c87b07d.ada
c87b07e.ada
c87b08a.ada
c87b09a.ada
c87b09c.ada
c87b10a.ada
c87b11a.ada
c87b11b.ada
c87b13a.ada
c87b14a.ada
c87b14b.ada
c87b14c.ada
c87b14d.ada
c87b15a.ada
c87b16a.ada
c87b17a.ada
c87b18a.ada
c87b18b.ada
c87b19a.ada
c87b23a.ada
c87b24a.ada
c87b24b.ada
c87b26b.ada
c87b27a.ada
c87b28a.ada
c87b29a.ada
c87b30a.ada
c87b31a.ada
c87b32a.ada
c87b33a.ada
c87b34a.ada
c87b34b.ada
c87b34c.ada
c87b35c.ada
c87b38a.ada
c87b39a.ada
c87b40a.ada
c87b41a.ada
c87b42a.ada
c87b43a.ada
c87b44a.ada
c87b45a.ada
c87b45c.ada
c87b47a.ada
c87b48a.ada
c87b48b.ada
c87b50a.ada
c87b54a.ada
c87b57a.ada
c87b62a.ada
c87b62b.ada
c87b62c.ada
c87b62d.tst
c910001.a
c910002.a
c910003.a
c91004b.ada
c91004c.ada
c91006a.ada
c91007a.ada
c92002a.ada
c92003a.ada
c92005a.ada
c92005b.ada
c92006a.ada
c930001.a
c93001a.ada
c93002a.ada
c93003a.ada
c93004a.ada
c93004b.ada
c93004c.ada
c93004d.ada
c93004f.ada
c93005a.ada
c93005b.ada
c93005c.ada
c93005d.ada
c93005e.ada
c93005f.ada
c93005g.ada
c93005h.ada
c93006a.ada
c93007a.ada
c93008a.ada
c93008b.ada
c940001.a
c940002.a
c940004.a
c940005.a
c940006.a
c940007.a
c940010.a
c940011.a
c940012.a
c940013.a
c940014.a
c940015.a
c940016.a
c94001a.ada
c94001b.ada
c94001c.ada
c94001e.ada
c94001f.ada
c94001g.ada
c94002a.ada
c94002b.ada
c94002d.ada
c94002e.ada
c94002f.ada
c94002g.ada
c94004a.ada
c94004b.ada
c94004c.ada
c94005a.ada
c94005b.ada
c94006a.ada
c94007a.ada
c94007b.ada
c94008a.ada
c94008b.ada
c94008c.ada
c94008d.ada
c94010a.ada
c94011a.ada
c94020a.ada
c940a03.a
c95008a.ada
c95009a.ada
c95010a.ada
c95011a.ada
c95012a.ada
c95021a.ada
c95022a.ada
c95022b.ada
c95033a.ada
c95033b.ada
c95034a.ada
c95034b.ada
c95035a.ada
c95040a.ada
c95040b.ada
c95040c.ada
c95040d.ada
c95041a.ada
c95065a.ada
c95065b.ada
c95065c.ada
c95065d.ada
c95065e.ada
c95065f.ada
c95066a.ada
c95067a.ada
c95071a.ada
c95072a.ada
c95072b.ada
c95073a.ada
c95074c.ada
c95076a.ada
c95078a.ada
c95080b.ada
c95082g.ada
c95085a.ada
c95085b.ada
c95085c.ada
c95085d.ada
c95085e.ada
c95085f.ada
c95085g.ada
c95085h.ada
c95085i.ada
c95085j.ada
c95085k.ada
c95085l.ada
c95085m.ada
c95085n.ada
c95085o.ada
c95086a.ada
c95086b.ada
c95086c.ada
c95086d.ada
c95086e.ada
c95086f.ada
c95087a.ada
c95087b.ada
c95087c.ada
c95087d.ada
c95088a.ada
c95089a.ada
c95090a.ada
c95092a.ada
c95093a.ada
c95095a.ada
c95095b.ada
c95095c.ada
c95095d.ada
c95095e.ada
c951001.a
c951002.a
c953001.a
c953002.a
c953003.a
c954001.a
c954010.a
c954011.a
c954012.a
c954013.a
c954014.a
c954015.a
c954016.a
c954017.a
c954018.a
c954019.a
c954020.a
c954021.a
c954022.a
c954023.a
c954024.a
c954025.a
c954026.a
c954a01.a
c954a02.a
c954a03.a
c960001.a
c960002.a
c960004.a
c96001a.ada
c96004a.ada
c96005a.ada
c96005b.tst
c96005d.ada
c96005f.ada
c96006a.ada
c96007a.ada
c96008a.ada
c96008b.ada
c97112a.ada
c97113a.ada
c97114a.ada
c97115a.ada
c97116a.ada
c97117a.ada
c97117b.ada
c97117c.ada
c97118a.ada
c97120a.ada
c97120b.ada
c97201a.ada
c97201b.ada
c97201c.ada
c97201d.ada
c97201e.ada
c97201g.ada
c97201h.ada
c97201x.ada
c97202a.ada
c97203a.ada
c97203b.ada
c97203c.ada
c97204a.ada
c97204b.ada
c97205a.ada
c97205b.ada
c97301a.ada
c97301b.ada
c97301c.ada
c97301d.ada
c97301e.ada
c97302a.ada
c97303a.ada
c97303b.ada
c97303c.ada
c97304a.ada
c97304b.ada
c97305a.ada
c97305b.ada
c97305c.ada
c97305d.ada
c97307a.ada
c974001.a
c974002.a
c974003.a
c974004.a
c974005.a
c974006.a
c974007.a
c974008.a
c974009.a
c974010.a
c974011.a
c974012.a
c974013.a
c974014.a
c980001.a
c980002.a
c980003.a
c99004a.ada
c99005a.ada
c9a003a.ada
c9a004a.ada
c9a007a.ada
c9a009a.ada
c9a009c.ada
c9a009f.ada
c9a009g.ada
c9a009h.ada
c9a010a.ada
c9a011a.ada
c9a011b.ada
ca1003a.ada
ca1004a.ada
ca1005a.ada
ca1006a.ada
ca1011a0.ada
ca1011a1.ada
ca1011a2.ada
ca1011a3.ada
ca1011a4.ada
ca1011a5.ada
ca1011a6.ada
ca1012a0.ada
ca1012a1.ada
ca1012a2.ada
ca1012a3.ada
ca1012a4.ada
ca1012b0.ada
ca1012b2.ada
ca1012b4.ada
ca1013a0.ada
ca1013a1.ada
ca1013a2.ada
ca1013a3.ada
ca1013a4.ada
ca1013a5.ada
ca1013a6.ada
ca1014a0.ada
ca1014a1.ada
ca1014a2.ada
ca1014a3.ada
ca1020e0.ada
ca1020e1.ada
ca1020e2.ada
ca1020e3.ada
ca1022a0.ada
ca1022a1.ada
ca1022a2.ada
ca1022a3.ada
ca1022a4.ada
ca1022a5.ada
ca1022a6.ada
ca11001.a
ca11002.a
ca11003.a
ca110040.a
ca110041.a
ca110042.am
ca110050.a
ca110051.am
ca11006.a
ca11007.a
ca11008.a
ca11009.a
ca11010.a
ca11011.a
ca11012.a
ca11013.a
ca11014.a
ca11015.a
ca11016.a
ca11017.a
ca11018.a
ca11019.a
ca11020.a
ca11021.a
ca11022.a
ca1102a0.ada
ca1102a1.ada
ca1102a2.ada
ca1106a.ada
ca1108a.ada
ca1108b.ada
ca11a01.a
ca11a02.a
ca11b01.a
ca11b02.a
ca11c01.a
ca11c02.a
ca11c03.a
ca11d010.a
ca11d011.a
ca11d012.a
ca11d013.am
ca11d02.a
ca11d03.a
ca13001.a
ca13002.a
ca13003.a
ca13a01.a
ca13a02.a
ca140230.a
ca140231.a
ca140232.am
ca140233.a
ca140280.a
ca140281.a
ca140282.a
ca140283.am
ca15003.a
ca200020.a
ca200021.a
ca200022.am
ca2001h0.ada
ca2001h1.ada
ca2001h2.ada
ca2001h3.ada
ca2002a0.ada
ca2002a1.ada
ca2002a2.ada
ca2003a0.ada
ca2003a1.ada
ca2004a0.ada
ca2004a1.ada
ca2004a2.ada
ca2004a3.ada
ca2004a4.ada
ca2007a0.ada
ca2007a1.ada
ca2007a2.ada
ca2007a3.ada
ca2008a0.ada
ca2008a1.ada
ca2008a2.ada
ca2009a.ada
ca2009c0.ada
ca2009c1.ada
ca2009d.ada
ca2009f0.ada
ca2009f1.ada
ca2009f2.ada
ca2011b.ada
ca21001.a
ca3011a0.ada
ca3011a1.ada
ca3011a2.ada
ca3011a3.ada
ca3011a4.ada
ca5003a0.ada
ca5003a1.ada
ca5003a2.ada
ca5003a3.ada
ca5003a4.ada
ca5003a5.ada
ca5003a6.ada
ca5003b0.ada
ca5003b1.ada
ca5003b2.ada
ca5003b3.ada
ca5003b4.ada
ca5003b5.ada
ca5004a.ada
ca5004b0.ada
ca5004b1.ada
ca5004b2.ada
ca5006a.ada
cb10002.a
cb1001a.ada
cb1004a.ada
cb1005a.ada
cb1010a.ada
cb1010c.ada
cb1010d.ada
cb20001.a
cb20003.a
cb20004.a
cb20005.a
cb20006.a
cb20007.a
cb2004a.ada
cb2005a.ada
cb2006a.ada
cb2007a.ada
cb20a02.a
cb3003a.ada
cb3003b.ada
cb3004a.ada
cb40005.a
cb4001a.ada
cb4002a.ada
cb4003a.ada
cb4004a.ada
cb4005a.ada
cb4006a.ada
cb4007a.ada
cb4008a.ada
cb4009a.ada
cb4013a.ada
cb40a01.a
cb40a020.a
cb40a021.am
cb40a030.a
cb40a031.am
cb40a04.a
cb41001.a
cb41002.a
cb41003.a
cb41004.a
cb5001a.ada
cb5001b.ada
cb5002a.ada
cc1004a.ada
cc1005b.ada
cc1010a.ada
cc1010b.ada
cc1018a.ada
cc1104c.ada
cc1107b.ada
cc1111a.ada
cc1204a.ada
cc1207b.ada
cc1220a.ada
cc1221a.ada
cc1221b.ada
cc1221c.ada
cc1221d.ada
cc1222a.ada
cc1223a.ada
cc1224a.ada
cc1225a.tst
cc1226b.ada
cc1227a.ada
cc1301a.ada
cc1302a.ada
cc1304a.ada
cc1304b.ada
cc1307a.ada
cc1307b.ada
cc1308a.ada
cc1310a.ada
cc1311a.ada
cc1311b.ada
cc2002a.ada
cc30001.a
cc30002.a
cc3004a.ada
cc3007a.ada
cc3007b.ada
cc3011a.ada
cc3011d.ada
cc3012a.ada
cc3015a.ada
cc3016b.ada
cc3016c.ada
cc3016f.ada
cc3016i.ada
cc3017b.ada
cc3017c.ada
cc3019a.ada
cc3019b0.ada
cc3019b1.ada
cc3019b2.ada
cc3019c0.ada
cc3019c1.ada
cc3019c2.ada
cc3106b.ada
cc3120a.ada
cc3120b.ada
cc3121a.ada
cc3123a.ada
cc3125a.ada
cc3125b.ada
cc3125c.ada
cc3125d.ada
cc3126a.ada
cc3127a.ada
cc3128a.ada
cc3203a.ada
cc3207b.ada
cc3220a.ada
cc3221a.ada
cc3222a.ada
cc3223a.ada
cc3224a.ada
cc3225a.ada
cc3230a.ada
cc3231a.ada
cc3232a.ada
cc3233a.ada
cc3234a.ada
cc3235a.ada
cc3236a.ada
cc3240a.ada
cc3305a.ada
cc3305b.ada
cc3305c.ada
cc3305d.ada
cc3601a.ada
cc3601c.ada
cc3602a.ada
cc3603a.ada
cc3605a.ada
cc3606a.ada
cc3606b.ada
cc3607b.ada
cc40001.a
cc50001.a
cc50a01.a
cc50a02.a
cc51001.a
cc51002.a
cc51003.a
cc51004.a
cc51006.a
cc51007.a
cc51a01.a
cc51b03.a
cc51d01.a
cc51d02.a
cc54001.a
cc54002.a
cc54003.a
cc54004.a
cc70001.a
cc70002.a
cc70003.a
cc70a01.a
cc70a02.a
cc70b01.a
cc70b02.a
cc70c01.a
cc70c02.a
cd10001.a
cd1009a.ada
cd1009b.ada
cd1009d.ada
cd1009e.ada
cd1009f.ada
cd1009g.ada
cd1009h.ada
cd1009i.ada
cd1009j.ada
cd1009k.tst
cd1009l.ada
cd1009m.ada
cd1009n.ada
cd1009o.ada
cd1009p.ada
cd1009q.ada
cd1009r.ada
cd1009s.ada
cd1009t.tst
cd1009u.tst
cd1009v.ada
cd1009w.ada
cd1009x.ada
cd1009y.ada
cd1009z.ada
cd1c03a.ada
cd1c03b.ada
cd1c03c.ada
cd1c03e.tst
cd1c03f.ada
cd1c03g.ada
cd1c03h.ada
cd1c03i.ada
cd1c04a.ada
cd1c04d.ada
cd1c04e.ada
cd1c06a.tst
cd20001.a
cd2a21a.ada
cd2a21c.ada
cd2a21e.ada
cd2a22a.ada
cd2a22e.ada
cd2a22i.ada
cd2a22j.ada
cd2a23a.ada
cd2a23e.ada
cd2a24a.ada
cd2a24e.ada
cd2a24i.ada
cd2a24j.ada
cd2a31a.ada
cd2a31c.ada
cd2a31e.ada
cd2a32a.ada
cd2a32c.ada
cd2a32e.ada
cd2a32g.ada
cd2a32i.ada
cd2a32j.ada
cd2a51a.ada
cd2a53a.ada
cd2a53e.ada
cd2a83c.tst
cd2a91c.tst
cd2b11a.ada
cd2b11b.ada
cd2b11d.ada
cd2b11e.ada
cd2b11f.ada
cd2b15c.ada
cd2b16a.ada
cd2c11a.tst
cd2c11d.tst
cd2d11a.ada
cd2d13a.ada
cd30001.a
cd30002.a
cd30003.a
cd30004.a
cd300050.am
cd300051.c
cd3014a.ada
cd3014c.ada
cd3014d.ada
cd3014f.ada
cd3015a.ada
cd3015c.ada
cd3015e.ada
cd3015f.ada
cd3015g.ada
cd3015h.ada
cd3015i.ada
cd3015k.ada
cd3021a.ada
cd33001.a
cd33002.a
cd40001.a
cd4031a.ada
cd4041a.tst
cd4051a.ada
cd4051b.ada
cd4051c.ada
cd4051d.ada
cd5003a.ada
cd5003b.ada
cd5003c.ada
cd5003d.ada
cd5003e.ada
cd5003f.ada
cd5003g.ada
cd5003h.ada
cd5003i.ada
cd5011a.ada
cd5011c.ada
cd5011e.ada
cd5011g.ada
cd5011i.ada
cd5011k.ada
cd5011m.ada
cd5011q.ada
cd5011s.ada
cd5012a.ada
cd5012b.ada
cd5012e.ada
cd5012f.ada
cd5012i.ada
cd5012m.ada
cd5013a.ada
cd5013c.ada
cd5013e.ada
cd5013g.ada
cd5013i.ada
cd5013k.ada
cd5013m.ada
cd5013o.ada
cd5014a.ada
cd5014c.ada
cd5014e.ada
cd5014g.ada
cd5014i.ada
cd5014k.ada
cd5014m.ada
cd5014o.ada
cd5014t.ada
cd5014v.ada
cd5014x.ada
cd5014y.ada
cd5014z.ada
cd70001.a
cd7002a.ada
cd7007b.ada
cd7101d.ada
cd7101e.dep
cd7101f.dep
cd7101g.tst
cd7103d.ada
cd7202a.ada
cd7204b.ada
cd7204c.ada
cd72a01.a
cd72a02.a
cd7305a.ada
cd90001.a
cd92001.a
cda201a.ada
cda201b.ada
cda201c.ada
cda201e.ada
cdb0a01.a
cdb0a02.a
cdd1001.a
cdd2001.a
cde0001.a
ce2102a.ada
ce2102b.ada
ce2102c.tst
ce2102d.ada
ce2102e.ada
ce2102f.ada
ce2102g.ada
ce2102h.tst
ce2102i.ada
ce2102j.ada
ce2102k.ada
ce2102l.ada
ce2102m.ada
ce2102n.ada
ce2102o.ada
ce2102p.ada
ce2102q.ada
ce2102r.ada
ce2102s.ada
ce2102t.ada
ce2102u.ada
ce2102v.ada
ce2102w.ada
ce2102x.ada
ce2102y.ada
ce2103a.tst
ce2103b.tst
ce2103c.ada
ce2103d.ada
ce2104a.ada
ce2104b.ada
ce2104c.ada
ce2104d.ada
ce2106a.ada
ce2106b.ada
ce2108e.ada
ce2108f.ada
ce2108g.ada
ce2108h.ada
ce2109a.ada
ce2109b.ada
ce2109c.ada
ce2110a.ada
ce2110c.ada
ce2111a.ada
ce2111b.ada
ce2111c.ada
ce2111e.ada
ce2111f.ada
ce2111g.ada
ce2111i.ada
ce2201a.ada
ce2201b.ada
ce2201c.ada
ce2201d.dep
ce2201e.dep
ce2201f.ada
ce2201g.ada
ce2201h.ada
ce2201i.ada
ce2201j.ada
ce2201k.ada
ce2201l.ada
ce2201m.ada
ce2201n.ada
ce2202a.ada
ce2203a.tst
ce2204a.ada
ce2204b.ada
ce2204c.ada
ce2204d.ada
ce2205a.ada
ce2206a.ada
ce2208b.ada
ce2401a.ada
ce2401b.ada
ce2401c.ada
ce2401e.ada
ce2401f.ada
ce2401h.ada
ce2401i.ada
ce2401j.ada
ce2401k.ada
ce2401l.ada
ce2402a.ada
ce2403a.tst
ce2404a.ada
ce2404b.ada
ce2405b.ada
ce2406a.ada
ce2407a.ada
ce2407b.ada
ce2408a.ada
ce2408b.ada
ce2409a.ada
ce2409b.ada
ce2410a.ada
ce2410b.ada
ce2411a.ada
ce3002b.tst
ce3002c.tst
ce3002d.ada
ce3002f.ada
ce3102a.ada
ce3102b.tst
ce3102d.ada
ce3102e.ada
ce3102f.ada
ce3102g.ada
ce3102h.ada
ce3102i.ada
ce3102j.ada
ce3102k.ada
ce3103a.ada
ce3104a.ada
ce3104b.ada
ce3104c.ada
ce3106a.ada
ce3106b.ada
ce3107a.tst
ce3107b.ada
ce3108a.ada
ce3108b.ada
ce3110a.ada
ce3112c.ada
ce3112d.ada
ce3114a.ada
ce3115a.ada
ce3201a.ada
ce3202a.ada
ce3206a.ada
ce3207a.ada
ce3301a.ada
ce3302a.ada
ce3303a.ada
ce3304a.tst
ce3305a.ada
ce3306a.ada
ce3401a.ada
ce3402a.ada
ce3402c.ada
ce3402d.ada
ce3402e.ada
ce3403a.ada
ce3403b.ada
ce3403c.ada
ce3403d.ada
ce3403e.ada
ce3403f.ada
ce3404a.ada
ce3404b.ada
ce3404c.ada
ce3404d.ada
ce3405a.ada
ce3405c.ada
ce3405d.ada
ce3406a.ada
ce3406b.ada
ce3406c.ada
ce3406d.ada
ce3407a.ada
ce3407b.ada
ce3407c.ada
ce3408a.ada
ce3408b.ada
ce3408c.ada
ce3409a.ada
ce3409b.ada
ce3409c.ada
ce3409d.ada
ce3409e.ada
ce3410a.ada
ce3410b.ada
ce3410c.ada
ce3410d.ada
ce3410e.ada
ce3411a.ada
ce3411c.ada
ce3412a.ada
ce3413a.ada
ce3413b.ada
ce3413c.ada
ce3414a.ada
ce3601a.ada
ce3602a.ada
ce3602b.ada
ce3602c.ada
ce3602d.ada
ce3603a.ada
ce3604a.ada
ce3604b.ada
ce3605a.ada
ce3605b.ada
ce3605c.ada
ce3605d.ada
ce3605e.ada
ce3606a.ada
ce3606b.ada
ce3701a.ada
ce3704a.ada
ce3704b.ada
ce3704c.ada
ce3704d.ada
ce3704e.ada
ce3704f.ada
ce3704m.ada
ce3704n.ada
ce3704o.ada
ce3705a.ada
ce3705b.ada
ce3705c.ada
ce3705d.ada
ce3705e.ada
ce3706c.ada
ce3706d.ada
ce3706f.ada
ce3706g.ada
ce3707a.ada
ce3708a.ada
ce3801a.ada
ce3801b.ada
ce3804a.ada
ce3804b.ada
ce3804c.ada
ce3804d.ada
ce3804e.ada
ce3804f.ada
ce3804g.ada
ce3804h.ada
ce3804i.ada
ce3804j.ada
ce3804m.ada
ce3804o.ada
ce3804p.ada
ce3805a.ada
ce3805b.ada
ce3806a.ada
ce3806b.ada
ce3806c.ada
ce3806d.ada
ce3806e.ada
ce3806f.ada
ce3806g.ada
ce3806h.ada
ce3809a.ada
ce3809b.ada
ce3810a.ada
ce3810b.ada
ce3815a.ada
ce3901a.ada
ce3902b.ada
ce3904a.ada
ce3904b.ada
ce3905a.ada
ce3905b.ada
ce3905c.ada
ce3905l.ada
ce3906a.ada
ce3906b.ada
ce3906c.ada
ce3906d.ada
ce3906e.ada
ce3906f.ada
ce3907a.ada
ce3908a.ada
checkfil.ada
coverage.txt
cxa3001.a
cxa3002.a
cxa3003.a
cxa3004.a
cxa4001.a
cxa4002.a
cxa4003.a
cxa4004.a
cxa4005.a
cxa4006.a
cxa4007.a
cxa4008.a
cxa4009.a
cxa4010.a
cxa4011.a
cxa4012.a
cxa4013.a
cxa4014.a
cxa4015.a
cxa4016.a
cxa4017.a
cxa4018.a
cxa4019.a
cxa4020.a
cxa4021.a
cxa4022.a
cxa4023.a
cxa4024.a
cxa4025.a
cxa4026.a
cxa4027.a
cxa4028.a
cxa4029.a
cxa4030.a
cxa4031.a
cxa4032.a
cxa4033.a
cxa4034.a
cxa5011.a
cxa5012.a
cxa5013.a
cxa5015.a
cxa5a01.a
cxa5a02.a
cxa5a03.a
cxa5a04.a
cxa5a05.a
cxa5a06.a
cxa5a07.a
cxa5a08.a
cxa5a09.a
cxa5a10.a
cxa8001.a
cxa8002.a
cxa8003.a
cxa9001.a
cxa9002.a
cxaa001.a
cxaa002.a
cxaa003.a
cxaa004.a
cxaa005.a
cxaa006.a
cxaa007.a
cxaa008.a
cxaa009.a
cxaa010.a
cxaa011.a
cxaa012.a
cxaa013.a
cxaa014.a
cxaa015.a
cxaa016.a
cxaa017.a
cxaa018.a
cxaa019.a
cxab001.a
cxac001.a
cxac002.a
cxac003.a
cxac004.a
cxac005.a
cxaca01.a
cxaca02.a
cxacb01.a
cxacb02.a
cxacc01.a
cxaf001.a
cxb2001.a
cxb2002.a
cxb2003.a
cxb3001.a
cxb3002.a
cxb3003.a
cxb30040.c
cxb30041.am
cxb3005.a
cxb30060.c
cxb30061.am
cxb3007.a
cxb3008.a
cxb3009.a
cxb3010.a
cxb3011.a
cxb3012.a
cxb30130.c
cxb30131.c
cxb30132.am
cxb3014.a
cxb3015.a
cxb3016.a
cxb4001.a
cxb4002.a
cxb4003.a
cxb4004.a
cxb4005.a
cxb4006.a
cxb4007.a
cxb4008.a
cxb40090.cbl
cxb40091.cbl
cxb40092.cbl
cxb40093.am
cxb5001.a
cxb5002.a
cxb5003.a
cxb50040.ftn
cxb50041.ftn
cxb50042.am
cxb50050.ftn
cxb50051.ftn
cxb50052.am
cxc3001.a
cxc3002.a
cxc3003.a
cxc3004.a
cxc3005.a
cxc3006.a
cxc3007.a
cxc3008.a
cxc3009.a
cxc6001.a
cxc6002.a
cxc6003.a
cxc7001.a
cxc7002.a
cxc7003.a
cxc7004.a
cxd1001.a
cxd1002.a
cxd1003.a
cxd1004.a
cxd1005.a
cxd1006.a
cxd1007.a
cxd1008.a
cxd2001.a
cxd2002.a
cxd2003.a
cxd2004.a
cxd2006.a
cxd2007.a
cxd2008.a
cxd3001.a
cxd3002.a
cxd3003.a
cxd4001.a
cxd4002.a
cxd4003.a
cxd4004.a
cxd4005.a
cxd4006.a
cxd4007.a
cxd4008.a
cxd4009.a
cxd4010.a
cxd5001.a
cxd6001.a
cxd6002.a
cxd6003.a
cxd8001.a
cxd8002.a
cxd8003.a
cxd9001.a
cxda001.a
cxda002.a
cxda003.a
cxda004.a
cxdb001.a
cxdb002.a
cxdb003.a
cxdb004.a
cxe1001.a
cxe2001.a
cxe2002.a
cxe4001.a
cxe4002.a
cxe4003.a
cxe4004.a
cxe4005.a
cxe4006.a
cxe5001.a
cxe5002.a
cxe5003.a
cxf1001.a
cxf2001.a
cxf2002.a
cxf2003.a
cxf2004.a
cxf2005.a
cxf2a01.a
cxf2a02.a
cxf3001.a
cxf3002.a
cxf3003.a
cxf3004.a
cxf3a01.a
cxf3a02.a
cxf3a03.a
cxf3a04.a
cxf3a05.a
cxf3a06.a
cxf3a07.a
cxf3a08.a
cxg1001.a
cxg1002.a
cxg1003.a
cxg1004.a
cxg1005.a
cxg2001.a
cxg2002.a
cxg2003.a
cxg2004.a
cxg2005.a
cxg2006.a
cxg2007.a
cxg2008.a
cxg2009.a
cxg2010.a
cxg2011.a
cxg2012.a
cxg2013.a
cxg2014.a
cxg2015.a
cxg2016.a
cxg2017.a
cxg2018.a
cxg2019.a
cxg2020.a
cxg2021.a
cxg2022.a
cxg2023.a
cxg2024.a
cxh1001.a
cxh3001.a
cxh3002.a
cxh30030.a
cxh30031.am
cz00004.a
cz1101a.ada
cz1102a.ada
cz1103a.ada
d4a002a.ada
d4a002b.ada
d4a004a.ada
d4a004b.ada
e28002b.ada
e28005d.ada
e52103y.ada
eb4011a.ada
eb4012a.ada
eb4014a.ada
ee3203a.ada
ee3204a.ada
ee3402b.ada
ee3409f.ada
ee3412c.ada
enumchek.ada
f340a000.a
f340a001.a
f341a00.a
f390a00.a
f392a00.a
f392c00.a
f392d00.a
f393a00.a
f393b00.a
f3a2a00.a
f460a00.a
f730a000.a
f730a001.a
f731a00.a
f940a00.a
f954a00.a
fa11a00.a
fa11b00.a
fa11c00.a
fa11d00.a
fa13a00.a
fa13b00.a
fa21a00.a
fb20a00.a
fb40a00.a
fc50a00.a
fc51a00.a
fc51b00.a
fc51c00.a
fc51d00.a
fc54a00.a
fc70a00.a
fc70b00.a
fc70c00.a
fcndecl.ada
fd72a00.a
fdb0a00.a
fxa5a00.a
fxaca00.a
fxacb00.a
fxacc00.a
fxc6a00.a
fxe2a00.a
fxf2a00.a
fxf3a00.a
impdef.a
impdefc.a
impdefd.a
impdefe.a
impdefg.a
impdefh.a
la140010.a
la140011.am
la140012.a
la140020.a
la140021.am
la140022.a
la140030.a
la140031.a
la140032.am
la140033.a
la140040.a
la140041.am
la140042.a
la140050.a
la140051.a
la140052.am
la140053.a
la140060.a
la140061.a
la140062.am
la140063.a
la140070.a
la140071.a
la140072.am
la140073.a
la140080.a
la140081.a
la140082.am
la140083.a
la140090.a
la140091.a
la140092.am
la140093.a
la140100.a
la140101.a
la140102.am
la140103.a
la140110.a
la140111.a
la140112.am
la140113.a
la140120.a
la140121.a
la140122.am
la140123.a
la140130.a
la140131.a
la140132.am
la140133.a
la140140.a
la140141.a
la140142.am
la140143.a
la140150.a
la140151.a
la140152.am
la140153.a
la140160.a
la140161.a
la140162.am
la140163.a
la140170.a
la140171.a
la140172.am
la140173.a
la140180.a
la140181.a
la140182.am
la140183.a
la140190.a
la140191.a
la140192.am
la140193.a
la140200.a
la140201.a
la140202.am
la140203.a
la140210.a
la140211.am
la140212.a
la140220.a
la140221.am
la140222.a
la140240.a
la140241.a
la140242.am
la140243.a
la140250.a
la140251.am
la140252.a
la140260.a
la140261.a
la140262.am
la140263.a
la140270.a
la140271.a
la140272.am
la140273.a
la200010.a
la200011.a
la200012.am
la5001a0.ada
la5001a1.ada
la5001a2.ada
la5001a3.ada
la5001a4.ada
la5001a5.ada
la5001a6.ada
la5001a7.ada
la5007a0.ada
la5007a1.ada
la5007b0.ada
la5007b1.ada
la5007c0.ada
la5007c1.ada
la5007d0.ada
la5007d1.ada
la5007e0.ada
la5007e1.ada
la5007f0.ada
la5007f1.ada
la5007g0.ada
la5007g1.ada
la5008a0.ada
la5008a1.ada
la5008b0.ada
la5008b1.ada
la5008c0.ada
la5008c1.ada
la5008d0.ada
la5008d1.ada
la5008e0.ada
la5008e1.ada
la5008f0.ada
la5008f1.ada
la5008g0.ada
la5008g1.ada
lencheck.ada
lxd70010.a
lxd70011.a
lxd70012.am
lxd70030.a
lxd70031.a
lxd70032.am
lxd70040.a
lxd70041.a
lxd70042.am
lxd70050.a
lxd70051.a
lxd70052.am
lxd70060.a
lxd70061.a
lxd70062.am
lxd70070.a
lxd70071.a
lxd70072.am
lxd70080.a
lxd70081.a
lxd70082.am
lxd70090.a
lxd70091.a
lxd70092.am
lxe30010.am
lxe30011.am
lxe30020.am
lxe30021.am
lxh40010.a
lxh40011.a
lxh40012.am
lxh40020.a
lxh40021.a
lxh40022.am
lxh40030.a
lxh40031.a
lxh40032.a
lxh40033.am
lxh40040.a
lxh40041.a
lxh40042.a
lxh40043.am
lxh40050.a
lxh40051.a
lxh40052.a
lxh40053.am
lxh40060.a
lxh40061.a
lxh40062.a
lxh40063.am
lxh40070.a
lxh40071.a
lxh40072.a
lxh40073.am
lxh40080.a
lxh40081.a
lxh40082.a
lxh40083.a
lxh40084.am
lxh40090.a
lxh40091.a
lxh40092.a
lxh40093.am
lxh40100.a
lxh40101.a
lxh40102.a
lxh40103.am
lxh40110.a
lxh40111.a
lxh40112.am
lxh40120.a
lxh40121.a
lxh40122.a
lxh40123.am
lxh40130.a
lxh40131.a
lxh40132.a
lxh40133.am
lxh40140.a
lxh40141.a
lxh40142.am
macro.dfs
macrosub.ada
repbody.ada
repspec.ada
spprt13s.tst
tctouch.ada
testobj.txt
tsttests.dat
ug-apxa.doc
ug-apxa.pdf
ug-apxa.txt
ug-apxb.doc
ug-apxb.pdf
ug-apxb.txt
ug-apxc.doc
ug-apxc.pdf
ug-apxc.txt
ug-apxd.doc
ug-apxd.pdf
ug-apxd.txt
ug-body.doc
ug-body.pdf
ug-body.txt
widechr.a
/tsttests.dat
0,0 → 1,38
ACATS4GNATDIR/tests/a/a26007a.tst
ACATS4GNATDIR/tests/a/ad8011a.tst
ACATS4GNATDIR/tests/c2/c23003a.tst
ACATS4GNATDIR/tests/c2/c23003b.tst
ACATS4GNATDIR/tests/c2/c23003g.tst
ACATS4GNATDIR/tests/c2/c23003i.tst
ACATS4GNATDIR/tests/c3/c35502d.tst
ACATS4GNATDIR/tests/c3/c35502f.tst
ACATS4GNATDIR/tests/c3/c35503d.tst
ACATS4GNATDIR/tests/c3/c35503f.tst
ACATS4GNATDIR/tests/c4/c45231d.tst
ACATS4GNATDIR/tests/c4/c4a007a.tst
ACATS4GNATDIR/tests/c8/c87b62d.tst
ACATS4GNATDIR/tests/c9/c96005b.tst
ACATS4GNATDIR/tests/cc/cc1225a.tst
ACATS4GNATDIR/tests/cd/cd1009k.tst
ACATS4GNATDIR/tests/cd/cd1009t.tst
ACATS4GNATDIR/tests/cd/cd1009u.tst
ACATS4GNATDIR/tests/cd/cd1c03e.tst
ACATS4GNATDIR/tests/cd/cd1c06a.tst
ACATS4GNATDIR/tests/cd/cd2a83c.tst
ACATS4GNATDIR/tests/cd/cd2a91c.tst
ACATS4GNATDIR/tests/cd/cd2c11a.tst
ACATS4GNATDIR/tests/cd/cd2c11d.tst
ACATS4GNATDIR/tests/cd/cd4041a.tst
ACATS4GNATDIR/tests/cd/cd7101g.tst
ACATS4GNATDIR/tests/ce/ce2102c.tst
ACATS4GNATDIR/tests/ce/ce2102h.tst
ACATS4GNATDIR/tests/ce/ce2103a.tst
ACATS4GNATDIR/tests/ce/ce2103b.tst
ACATS4GNATDIR/tests/ce/ce2203a.tst
ACATS4GNATDIR/tests/ce/ce2403a.tst
ACATS4GNATDIR/tests/ce/ce3002b.tst
ACATS4GNATDIR/tests/ce/ce3002c.tst
ACATS4GNATDIR/tests/ce/ce3102b.tst
ACATS4GNATDIR/tests/ce/ce3107a.tst
ACATS4GNATDIR/tests/ce/ce3304a.tst
ACATS4GNATDIR/support/spprt13s.tst
/widechr.a
0,0 → 1,294
-- WIDECHR.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.
--*
--
-- DESCRIPTION:
--
-- This program reads C250001.AW and C250002.AW; translates a special
-- character sequence into characters and wide characters with positions
-- above ASCII.DEL. The resulting tests are written as C250001.A and
-- C250002.A respectively. This program may need to
-- be modified if the Wide_Character representation recognized by
-- your compiler differs from the Wide_Character
-- representation generated by the package Ada.Wide_Text_IO.
-- Modify this program as needed to translate that file.
--
-- A wide character is represented by an 8 character sequence:
--
-- ["abcd"]
--
-- where the character code represented is specified by four hexadecimal
-- digits, abcd, with letters in upper case. For example the wide
-- character with the code 16#AB13# is represented by the eight
-- character sequence:
--
-- ["AB13"]
--
-- ASSUMPTIONS:
--
-- The path for these files is specified in ImpDef.
--
-- SPECIAL REQUIREMENTS:
--
-- Compile, bind and execute this program. It will process the ".AW"
-- tests, "translating" them to ".A" tests.
--
-- CHANGE HISTORY:
-- 11 DEC 96 SAIC ACVC 2.1 Release
--
-- 11 DEC 96 Keith Constructed initial release version
--!
 
with Ada.Text_IO;
with Ada.Wide_Text_IO;
with Ada.Strings.Fixed;
with Impdef;
 
procedure WideChr is
 
-- Debug
--
-- To have the program generate trace/debugging information, de-comment
-- the call to Put_Line
 
procedure Debug( S: String ) is
begin
null; -- Ada.Text_IO.Put_Line(S);
end Debug;
 
package TIO renames Ada.Text_IO;
package WIO renames Ada.Wide_Text_IO;
package SF renames Ada.Strings.Fixed;
 
In_File : TIO.File_Type;
 
-- This program is actually dual-purpose. It translates the ["xxxx"]
-- notation to Wide_Character, as well as a similar notation ["xx"] into
-- Character. The intent of the latter being the ability to represent
-- literals in the Latin-1 character set that have position numbers
-- greater than ASCII.DEL. The variable Output_Mode drives the algorithms
-- to generate Wide_Character output (Wide) or Character output (Narrow).
 
type Output_Modes is ( Wide, Narrow );
Output_Mode : Output_Modes := Wide;
 
Wide_Out : WIO.File_Type;
Narrow_Out : TIO.File_Type;
 
In_Line : String(1..132); -- SB: $MAX_LINE_LENGTH
 
-- Index variables
--
-- the following index variables: In_Length, Front, Open_Bracket and
-- Close_Bracket are used by the scanning software to keep track of
-- what's where.
--
-- In_Length stores the value returned by Ada.Text_IO.Get_Line indicating
-- the position of the last "useful" character in the string In_Line.
--
-- Front retains the index of the first non-translating character in
-- In_Line, it is used to indicate the starting index of the portion of
-- the string to save without special interpretation. In the example
-- below, where there are two consecutive characters to translate, we see
-- that Front will assume three different values processing the string,
-- these are indicated by the digits '1', '2' & '3' in the comment
-- attached to the declaration. The processing software will dump
-- In_Line(Front..Open_Bracket-1) to the output stream. Note that in
-- the second case, this results in a null string, and in the third case,
-- where Open_Bracket does not obtain a third value, the slice
-- In_Line(Front..In_Length) is used instead.
--
-- Open_Bracket and Close_Bracket are used to retain the starting index
-- of the character pairs [" and "] respectively. For the purposes of
-- this software the character pairs are what are considered to be the
-- "brackets" enclosing the hexadecimal values to be translated.
-- Looking at the example below you will see where these index variables
-- will "point" in the first and second case.
 
In_Length : Natural := 0; ---> Some_["0A12"]["0B13"]_Thing
Front : Natural := 0; -- 1 2 3
Open_Bracket : Natural := 0; -- 1 2
Close_Bracket : Natural := 0; -- 1 2
 
-- Xlation
--
-- This translation table gives an easy way to translate the "decimal"
-- value of a hex digit (as represented by a Latin-1 character)
 
type Xlate is array(Character range '0'..'F') of Natural;
Xlation : constant Xlate :=
('0' => 0, '1' => 1, '2' => 2, '3' => 3, '4' => 4,
'5' => 5, '6' => 6, '7' => 7, '8' => 8, '9' => 9,
'A' => 10, 'B' => 11, 'C' => 12, 'D' => 13, 'E' => 14,
'F' => 15,
others => 0);
 
-- To_Ch
--
-- This function takes a string which is assumed to be trimmed to just a
-- hexadecimal representation of a Latin-1 character. The result of the
-- function is the Latin-1 character at the position designated by the
-- incoming hexadecimal value. (hexadecimal in human readable form)
 
function To_Ch( S:String ) return Character is
Numerical : Natural := 0;
begin
Debug("To Wide: " & S);
for I in S'Range loop
Numerical := Numerical * 16 + Xlation(S(I));
end loop;
return Character'Val(Numerical);
exception
when Constraint_Error => return '_';
end To_Ch;
 
-- To_Wide
--
-- This function takes a string which is assumed to be trimmed to just a
-- hexadecimal representation of a Wide_character. The result of the
-- function is the Wide_character at the position designated by the
-- incoming hexadecimal value. (hexadecimal in human readable form)
 
function To_Wide( S:String ) return Wide_character is
Numerical : Natural := 0;
begin
Debug("To Wide: " & S);
for I in S'Range loop
Numerical := Numerical * 16 + Xlation(S(I));
end loop;
return Wide_Character'Val(Numerical);
exception
when Constraint_Error => return '_';
end To_Wide;
 
-- Make_Wide
--
-- this function converts a String to a Wide_String
 
function Make_Wide( S: String ) return Wide_String is
W: Wide_String(S'Range);
begin
for I in S'Range loop
W(I) := Wide_Character'Val( Character'Pos(S(I)) );
end loop;
return W;
end Make_Wide;
 
-- Close_Files
--
-- Depending on which input we've processed, close the output file
 
procedure Close_Files is
begin
TIO.Close(In_File);
if Output_Mode = Wide then
WIO.Close(Wide_Out);
else
TIO.Close(Narrow_Out);
end if;
end Close_Files;
 
-- Process
--
-- for all lines in the input file
-- scan the file for occurrences of [" and "]
-- for found occurrence, attempt translation of the characters found
-- between the brackets. As a safeguard, unrecognizable character
-- sequences will be replaced with the underscore character. This
-- handles the cases in the tests where the test documentation includes
-- examples that are non-conformant: i.e. ["abcd"] or ["XXXX"]
 
procedure Process( Input_File_Name: String ) is
begin
TIO.Open(In_File,TIO.In_File,Input_File_Name & ".aw" );
 
if Output_Mode = Wide then
WIO.Create(Wide_Out,WIO.Out_File, Input_File_Name & ".a" );
else
TIO.Create(Narrow_Out,TIO.Out_File, Input_File_Name & ".a" );
end if;
 
File: while not TIO.End_Of_File( In_File ) loop
In_Line := (others => ' ');
TIO.Get_Line(In_File,In_Line,In_Length);
Debug(In_Line(1..In_Length));
 
Front := 1;
 
Line: loop
-- scan for next occurrence of ["abcd"]
Open_Bracket := SF.Index( In_Line(Front..In_Length), "[""" );
Close_Bracket := SF.Index( In_Line(Front..In_Length), """]" );
Debug( "[=" & Natural'Image(Open_Bracket) );
Debug( "]=" & Natural'Image(Close_Bracket) );
 
if Open_Bracket = 0 or Close_Bracket = 0 then
-- done with the line, output remaining characters and exit
Debug("Done with line");
if Output_Mode = Wide then
WIO.Put_Line(Wide_Out, Make_Wide(In_Line(Front..In_Length)) );
else
TIO.Put_Line(Narrow_Out, In_Line(Front..In_Length) );
end if;
exit Line;
else
-- output the "normal" stuff up to the bracket
if Output_Mode = Wide then
WIO.Put(Wide_Out, Make_Wide(In_Line(Front..Open_Bracket-1)) );
else
TIO.Put(Narrow_Out, In_Line(Front..Open_Bracket-1) );
end if;
 
-- point beyond the closing bracket
Front := Close_Bracket +2;
 
-- output the translated hexadecimal character
if Output_Mode = Wide then
WIO.Put(Wide_Out,
To_Wide( In_Line(Open_Bracket+2..Close_Bracket-1) ));
else
TIO.Put(Narrow_Out,
To_Ch( In_Line(Open_Bracket+2..Close_Bracket-1)) );
end if;
end if;
end loop Line;
 
end loop File;
Close_Files;
exception
when others =>
Ada.Text_IO.Put_Line("Error in processing " & Input_File_Name);
raise;
end Process;
 
begin
 
Output_Mode := Wide;
Process( Impdef.Wide_Character_Test );
 
Output_Mode := Narrow;
Process( Impdef.Upper_Latin_Test );
 
end WideChr;
/f392c00.a
0,0 → 1,267
-- F392C00.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.
--*
--
-- FOUNDATION DESCRIPTION:
-- This foundation provides a basis for tagged type and dispatching
-- tests. Each test describes the utilizations.
--
-- CHANGE HISTORY:
-- 06 Dec 94 SAIC ACVC 2.0
-- 24 OCT 95 SAIC Updated for ACVC 2.0.1
--
--!
 
package F392C00_1 is -- Switches
 
type Toggle is tagged private; ---------------------------------- Toggle
 
function Create return Toggle;
procedure Flip ( It : in out Toggle );
function On ( It : Toggle'Class ) return Boolean;
function Off ( It : Toggle'Class ) return Boolean;
 
type Dimmer is new Toggle with private; ------------------------- Dimmer
 
type Luminance is range 0..100;
 
function Create return Dimmer;
procedure Flip ( It : in out Dimmer );
procedure Brighten( It : in out Dimmer;
By : in Luminance := 10 );
procedure Dim ( It : in out Dimmer;
By : in Luminance := 10 );
function Intensity( It : Dimmer ) return Luminance;
 
type Auto_Dimmer is new Dimmer with private; --------------- Auto_Dimmer
 
function Create return Auto_Dimmer;
procedure Flip ( It: in out Auto_Dimmer );
procedure Set_Auto ( It: in out Auto_Dimmer );
procedure Clear_Auto( It: in out Auto_Dimmer );
-- procedure Set_Manual( It: in out Auto_Dimmer ) renames Clear_Auto;
procedure Set_Cutin ( It: in out Auto_Dimmer; Lumens: in Luminance );
procedure Set_Cutout( It: in out Auto_Dimmer; Lumens: in Luminance );
 
function Auto ( It: Auto_Dimmer ) return Boolean;
function Cutout_Threshold( It: Auto_Dimmer ) return Luminance;
function Cutin_Threshold ( It: Auto_Dimmer ) return Luminance;
 
function TC_CW_TI( Key : Character ) return Toggle'Class;
 
function TC_Non_Disp( It: Toggle ) return Boolean;
function TC_Non_Disp( It: Dimmer ) return Boolean;
function TC_Non_Disp( It: Auto_Dimmer ) return Boolean;
 
private
 
type Toggle is tagged record
On : Boolean := False;
end record;
 
type Dimmer is new Toggle with record
Intensity : Luminance := 100;
end record;
 
type Auto_Dimmer is new Dimmer with record
Cutout_Threshold : Luminance := 60;
Cutin_Threshold : Luminance := 40;
Auto_Engaged : Boolean := False;
end record;
 
end F392C00_1;
 
with TCTouch;
package body F392C00_1 is
 
function Create return Toggle is
begin
TCTouch.Touch( '1' ); ------------------------------------------------ 1
return Toggle'( On => True );
end Create;
 
function Create return Dimmer is
begin
TCTouch.Touch( '2' ); ------------------------------------------------ 2
return Dimmer'( On => True, Intensity => 75 );
end Create;
 
function Create return Auto_Dimmer is
begin
TCTouch.Touch( '3' ); ------------------------------------------------ 3
return Auto_Dimmer'( On => True, Intensity => 25,
Cutout_Threshold | Cutin_Threshold => 50,
Auto_Engaged => True );
end Create;
 
procedure Flip ( It : in out Toggle ) is
begin
TCTouch.Touch( 'A' ); ------------------------------------------------ A
It.On := not It.On;
end Flip;
 
function On( It : Toggle'Class ) return Boolean is
begin
TCTouch.Touch( 'B' ); ------------------------------------------------ B
return It.On;
end On;
 
function Off( It : Toggle'Class ) return Boolean is
begin
TCTouch.Touch( 'C' ); ------------------------------------------------ C
return not It.On;
end Off;
 
procedure Brighten( It : in out Dimmer;
By : in Luminance := 10 ) is
begin
TCTouch.Touch( 'D' ); ------------------------------------------------ D
if (It.Intensity+By) <= Luminance'Last then
It.Intensity := It.Intensity+By;
else
It.Intensity := Luminance'Last;
end if;
end Brighten;
 
procedure Dim ( It : in out Dimmer;
By : in Luminance := 10 ) is
begin
TCTouch.Touch( 'E' ); ------------------------------------------------ E
if (It.Intensity-By) >= Luminance'First then
It.Intensity := It.Intensity-By;
else
It.Intensity := Luminance'First;
end if;
end Dim;
 
function Intensity( It : Dimmer ) return Luminance is
begin
TCTouch.Touch( 'F' ); ------------------------------------------------ F
if On(It) then
return It.Intensity;
else
return Luminance'First;
end if;
end Intensity;
 
procedure Flip ( It : in out Dimmer ) is
begin
TCTouch.Touch( 'G' ); ------------------------------------------------ G
if On( It ) and (It.Intensity < 50) then
It.Intensity := Luminance'Last - It.Intensity;
else
Flip( Toggle( It ) );
end if;
end Flip;
 
procedure Set_Auto ( It: in out Auto_Dimmer ) is
begin
TCTouch.Touch( 'H' ); ------------------------------------------------ H
It.Auto_Engaged := True;
end Set_Auto;
 
procedure Clear_Auto( It: in out Auto_Dimmer ) is
begin
TCTouch.Touch( 'I' ); ------------------------------------------------ I
It.Auto_Engaged := False;
end Clear_Auto;
 
function Auto ( It: Auto_Dimmer ) return Boolean is
begin
TCTouch.Touch( 'J' ); ------------------------------------------------ J
return It.Auto_Engaged;
end Auto;
 
procedure Flip ( It: in out Auto_Dimmer ) is
begin
TCTouch.Touch( 'K' ); ------------------------------------------------ K
if It.Auto_Engaged then
if Off(It) then
Flip( Dimmer( It ) );
else
It.Auto_Engaged := False;
end if;
else
Flip( Dimmer( It ) );
end if;
end Flip;
 
procedure Set_Cutin ( It : in out Auto_Dimmer;
Lumens : in Luminance) is
begin
TCTouch.Touch( 'L' ); ------------------------------------------------ L
It.Cutin_Threshold := Lumens;
end Set_Cutin;
 
procedure Set_Cutout( It : in out Auto_Dimmer;
Lumens : in Luminance) is
begin
TCTouch.Touch( 'M' ); ------------------------------------------------ M
It.Cutout_Threshold := Lumens;
end Set_Cutout;
 
function Cutout_Threshold( It : Auto_Dimmer ) return Luminance is
begin
TCTouch.Touch( 'N' ); ------------------------------------------------ N
return It.Cutout_Threshold;
end Cutout_Threshold;
 
function Cutin_Threshold ( It : Auto_Dimmer ) return Luminance is
begin
TCTouch.Touch( 'O' ); ------------------------------------------------ O
return It.Cutin_Threshold;
end Cutin_Threshold;
 
function TC_CW_TI( Key : Character ) return Toggle'Class is
begin
TCTouch.Touch( 'W' ); ------------------------------------------------ W
case Key is
when 'T' | 't' => return Toggle'( On => True );
when 'D' | 'd' => return Dimmer'( On => True, Intensity => 75 );
when 'A' | 'a' => return Auto_Dimmer'( On => True, Intensity => 25,
Cutout_Threshold | Cutin_Threshold => 50,
Auto_Engaged => True );
when others => null;
end case;
end TC_CW_TI;
 
function TC_Non_Disp( It: Toggle ) return Boolean is
begin
TCTouch.Touch( 'X' ); ------------------------------------------------ X
return It.On;
end TC_Non_Disp;
 
function TC_Non_Disp( It: Dimmer ) return Boolean is
begin
TCTouch.Touch( 'Y' ); ------------------------------------------------ Y
return It.On;
end TC_Non_Disp;
 
function TC_Non_Disp( It: Auto_Dimmer ) return Boolean is
begin
TCTouch.Touch( 'Z' ); ------------------------------------------------ Z
return It.On;
end TC_Non_Disp;
 
end F392C00_1;
/f392d00.a
0,0 → 1,103
-- F392D00.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.
--*
--
-- FOUNDATION DESCRIPTION:
-- This foundation declares parent tagged types and subprograms for use
-- in tests covering dispatching operations.
--
-- CHANGE HISTORY:
-- 06 Dec 94 SAIC ACVC 2.0
--
--!
 
package F392D00 is
 
type Depth_Of_Field is range 5 .. 100;
type Shutter_Speed is (One, Two_Fifty, Four_Hundred, Thousand);
 
type Remote_Camera is tagged record
DOF : Depth_Of_Field := 10;
Shutter: Shutter_Speed := One;
end record;
 
-- ...Other declarations.
 
procedure Focus (C : in out Remote_Camera;
Depth : in Depth_Of_Field);
 
procedure Self_Test (C: in out Remote_Camera'Class);
 
-- ...Other operations.
 
private
 
procedure Set_Shutter_Speed (C : in out Remote_Camera;
Speed : in Shutter_Speed);
 
-- For the basic remote camera, shutter speed might be set as a function of
-- focus perhaps, thus it is declared as a private operation (usable
-- only internally within the abstraction).
 
 
end F392D00;
 
 
--==================================================================--
 
 
package body F392D00 is
 
procedure Focus (C : in out Remote_Camera;
Depth : in Depth_Of_Field) is
begin
-- Artificial for testing purposes.
C.DOF := 46;
end Focus;
 
-----------------------------------------------------------
procedure Set_Shutter_Speed (C : in out Remote_Camera;
Speed : in Shutter_Speed) is
begin
-- Artificial for testing purposes.
C.Shutter := Thousand;
end Set_Shutter_Speed;
 
-----------------------------------------------------------
procedure Self_Test (C: in out Remote_Camera'Class) is
TC_Dummy_Depth : constant Depth_Of_Field := 23;
TC_Dummy_Speed : constant Shutter_Speed := Four_Hundred;
begin
 
-- Test focus at various depths:
Focus(C, TC_Dummy_Depth);
-- ...Additional calls to Focus.
 
-- Test various shutter speeds:
Set_Shutter_Speed(C, TC_Dummy_Speed);
-- ...Additional calls to Set_Shutter_Speed.
 
end Self_Test;
 
end F392D00;
/f954a00.a
0,0 → 1,134
-- F954A00.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:
-- This file contains foundation code for tests covering the requeue
-- statement.
--
-- TEST DESCRIPTION:
-- See prologues of specific tests.
--
-- CHANGE HISTORY:
-- 06 Dec 94 SAIC ACVC 2.0
--
--!
 
package F954A00 is -- Printer device abstraction.
 
 
-- Model a printer device driver as a protected type. A printer remains
-- unavailable while data is printing. The printer generates an interrupt
-- when printing is complete, after which the printer is again made
-- available.
 
 
type Printers_Info is tagged record
Some_Info : Integer;
end record;
 
--==============================================--
 
protected type Printers is -- Device driver for printer.
 
procedure Start_Printing (File_Name : String); -- Begin printing on
-- printer.
 
procedure Handle_Interrupt; -- Handle interrupt from
-- printer.
 
entry Done_Printing; -- Wait until printer is
-- done.
 
function Available return Boolean; -- Return value of Ready.
function Is_Done return Boolean; -- Return value of Done.
 
private
 
Ready : Boolean := True; -- Entry barrier.
Done : Boolean := True; -- Testing flag.
 
end Printers;
 
--==============================================--
 
Number_Of_Printers : constant := 2;
 
type Printer_ID is range 1 .. Number_Of_Printers;
 
type Printer_Array is array (Printer_ID) of Printers;
type Info_Array is array (Printer_ID) of Printers_Info;
 
Printer : Printer_Array;
Printer_Info : constant Info_Array := ( (Some_Info => 1),
(Some_Info => 2) );
 
end F954A00;
 
 
--==================================================================--
 
 
package body F954A00 is -- Printer server abstraction.
 
 
protected body Printers is
 
procedure Start_Printing (File_Name : String) is
begin
Ready := False; -- Block other requests
Done := False; -- for this printer
-- Send data to the printer... -- and begin printing.
end Start_Printing;
 
 
-- Set the "not ready" one-shot
entry Done_Printing when Ready is -- Callers wait here
begin -- until printing is
Done := True; -- done (signaled by a
end Done_Printing; -- printer interrupt).
 
 
procedure Handle_Interrupt is -- Called when the
begin -- printer interrupts,
Ready := True; -- indicating that
end Handle_Interrupt; -- printing is done.
 
 
function Available return Boolean is -- Artifice for test
begin -- purposes: checks
return (Ready); -- whether printer is
end Available; -- still printing.
 
 
function Is_Done return Boolean is -- Artifice for test
begin -- purposes: checks
return (Done); -- whether Done_Printing
end Is_Done; -- entry was executed.
 
end Printers;
 
 
end F954A00;
/fa21a00.a
0,0 → 1,127
-- FA21A00.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.
--*
--
-- FOUNDATION DESCRIPTION:
-- This foundation declares various supporting types, objects, and
-- subprograms for use in tests checking preelaborability.
--
-- CHANGE HISTORY:
-- 20 Mar 95 SAIC Initial prerelease version.
--
--!
 
with Ada.Finalization; -- Preelaborated library unit.
package FA21A00 is
 
pragma Preelaborate (FA21A00);
 
 
type My_Int is new Integer range 0 .. 100;
function Func return My_Int; -- Non-static function.
 
subtype Idx is Natural range 1 .. 5;
 
Three : constant My_Int := 3;
Ten : My_Int := 10; -- Non-static.
 
type RecWithDisc (D: My_Int) is record
Twice: My_Int := D*2;
end record;
 
type RecCallDefault is record
C : My_Int := Func;
D : My_Int := 0;
end record;
 
type RecPrimDefault is record
C : My_Int := Ten;
end record;
 
type Tag is tagged record
C : My_Int;
end record;
 
type AccTag is access all Tag;
 
Tag1: aliased Tag; -- OK.
 
type My_Controlled is new Ada.Finalization.Controlled with record
C : My_Int;
end record;
 
type ContComp is tagged record
C: My_Controlled;
end record;
 
task type Tsk (D: My_Int);
 
protected type Prot is
entry E;
end Prot;
 
type Priv is tagged private;
 
type PrivComp is array (1 .. 5) of Priv;
 
type Pri_Ext is new Tag with private;
 
type PriExtComp is array (1 .. 5) of Pri_Ext;
 
private
 
type Priv is tagged record
B: Boolean;
end record;
 
type Pri_Ext is new Tag with record
N: String (1 .. 5);
end record;
 
end FA21A00;
 
 
--===================================================================--
 
 
package body FA21A00 is
 
task body Tsk is
begin
null;
end Tsk;
 
protected body Prot is
entry E when False is
begin
null;
end E;
end Prot;
 
function Func return My_Int is
begin
return 0;
end Func;
 
end FA21A00;
/fa13a00.a
0,0 → 1,171
-- FA13A00.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.
--*
--
-- FOUNDATION DESCRIPTION:
-- This foundation code is used to check visibility of separate
-- subunit of child packages.
-- Declares a package containing type definitions; package will be
-- with'ed by the root of the elevator abstraction.
--
-- Declare an elevator abstraction in a parent root package which manages
-- basic operations. This package has a private part. Declare a
-- private child package which calculates the floors for going up or
-- down. Declare a public child package which provides the actual
-- operations.
--
-- CHANGE HISTORY:
-- 06 Dec 94 SAIC ACVC 2.0
--
--!
 
-- Simulates a fragment of an elevator operation application.
 
package FA13A00_0 is -- Building Manager
 
type Electrical_Power is (Off, V120, V240);
Power : Electrical_Power := V120;
 
-- other type definitions and procedure declarations in real application.
 
end FA13A00_0;
 
-- No bodies provided for FA13A00_0.
 
--==================================================================--
 
package FA13A00_1 is -- Basic Elevator Operations
 
type Call_Waiting_Type is private;
type Floor is (Basement, Floor1, Floor2, Floor3, Penthouse);
type Floor_No is range Floor'Pos(Floor'First) .. Floor'Pos(Floor'Last);
Current_Floor : Floor := Floor1;
 
TC_Operation : boolean := true;
 
procedure Call (F : in Floor; C : in out Call_Waiting_Type);
procedure Clear_Calls (C : in out Call_Waiting_Type);
 
private
type Call_Waiting_Type is array (Floor) of boolean;
Call_Waiting : Call_Waiting_Type := (others => false);
 
end FA13A00_1;
 
 
--==================================================================--
 
package body FA13A00_1 is
 
-- Call the elevator.
 
procedure Call (F : in Floor; C : in out Call_Waiting_Type) is
begin
C (F) := true;
end Call;
 
--------------------------------------------
 
-- Clear all calls of the elevator.
 
procedure Clear_Calls (C : in out Call_Waiting_Type) is
begin
C := (others => false);
end Clear_Calls;
 
end FA13A00_1;
 
--==================================================================--
 
-- Private child package of an elevator application. This package calculates
-- how many floors to go up or down.
 
private package FA13A00_1.FA13A00_2 is -- Floor Calculation
 
-- Other type definitions in real application.
 
procedure Up (HowMany : in Floor_No);
procedure Down (HowMany : in Floor_No);
 
end FA13A00_1.FA13A00_2;
 
--==================================================================--
 
package body FA13A00_1.FA13A00_2 is
 
-- Go up from the current floor.
 
procedure Up (HowMany : in Floor_No) is
begin
Current_Floor := Floor'val (Floor'pos (Current_Floor) + HowMany);
end Up;
 
--------------------------------------------
 
-- Go down from the current floor.
 
procedure Down (HowMany : in Floor_No) is
begin
Current_Floor := Floor'val (Floor'pos (Current_Floor) - HowMany);
end Down;
 
end FA13A00_1.FA13A00_2;
 
--==================================================================--
 
-- Public child package of an elevator application. This package provides
-- the actual operation of the elevator.
 
package FA13A00_1.FA13A00_3 is -- Move Elevator
 
-- Other type definitions in real application.
 
procedure Move_Elevator (F : in Floor;
C : in out Call_Waiting_Type);
 
end FA13A00_1.FA13A00_3;
 
--==================================================================--
 
with FA13A00_1.FA13A00_2; -- Floor Calculation
 
package body FA13A00_1.FA13A00_3 is
 
-- Going up or down depends on the current floor.
 
procedure Move_Elevator (F : in Floor;
C : in out Call_Waiting_Type) is
begin
if F > Current_Floor then
FA13A00_1.FA13A00_2.Up (Floor'Pos (F) - Floor'Pos (Current_Floor));
FA13A00_1.Call (F, C);
elsif F < Current_Floor then
FA13A00_1.FA13A00_2.Down (Floor'Pos (Current_Floor) - Floor'Pos (F));
FA13A00_1.Call (F, C);
end if;
 
end Move_Elevator;
 
end FA13A00_1.FA13A00_3;
/fa13b00.a
0,0 → 1,106
-- FA13B00.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.
--*
--
-- FOUNDATION DESCRIPTION:
-- This foundation code is used to check visibility of separate
-- subunit of child packages.
-- Declares a package containing type definitions and a private
-- part; package will be with'ed by the parent's body of the subunits.
--
-- CHANGE HISTORY:
-- 06 Dec 94 SAIC ACVC 2.0
--
--!
 
package FA13B00_0 is
 
-- Type definitions.
 
type Visible_Integer is range 1 .. 10;
 
type Private_Record is private;
 
type Visible_Tagged is tagged
record
PR : Private_Record;
end record;
 
type Private_Tagged is tagged private;
 
Visible_Num : Visible_Integer := 7;
 
-- Subprogram definitions.
 
function Assign_Visible_Tagged (I : Visible_Integer)
return Visible_Tagged;
 
function Assign_Private_Tagged (I : Visible_Integer)
return Private_Tagged;
 
private
 
-- Type definitions.
 
type Private_Integer is range 11 .. 20;
 
type Private_Record is
record
VI : Visible_Integer;
end record;
 
type Private_Tagged is tagged
record
VI : Visible_Integer;
end record;
 
-- Object definitions.
 
Private_Num : Visible_Integer := 6;
 
end FA13B00_0;
 
--==================================================================--
 
package body FA13B00_0 is
 
function Assign_Visible_Tagged(I : Visible_Integer)
return Visible_Tagged is
VT : Visible_Tagged := (PR => (VI => I));
begin
return VT;
end Assign_Visible_Tagged;
 
-------------------------------------------------------
 
function Assign_Private_Tagged (I : Visible_Integer)
return Private_Tagged is
PT : Private_Tagged := (VI => I);
begin
return PT;
end Assign_Private_Tagged;
 
-------------------------------------------------------
 
end FA13B00_0;
/fc51a00.a
0,0 → 1,99
-- FC51A00.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.
--*
--
-- FOUNDATION DESCRIPTION:
-- This foundation defines a fraction type abstraction. Fractions are
-- implemented as records with two scalar components: a numerator
-- of type integer and a denominator of type positive. Fractions are
-- created via an overloaded "/" operator.
--
-- CHANGE HISTORY:
-- 06 Dec 94 SAIC ACVC 2.0
--
--!
 
package FC51A00 is -- Fraction type abstraction.
 
type Fraction_Type is private;
 
-- Create a fraction object by integer division.
function "/" (Left, Right : Integer) return Fraction_Type;
 
-- Change the sign of a fraction.
function "-" (Frac : Fraction_Type) return Fraction_Type;
 
-- Return value of numerator as integer.
function Numerator (Frac : Fraction_Type) return Integer;
 
-- Return value of denominator as integer.
function Denominator (Frac : Fraction_Type) return Integer;
 
-- ... Other operations on fraction types.
 
private
 
type Fraction_Type is record
Numerator : Integer;
Denominator : Positive;
end record;
 
end FC51A00;
 
 
--==================================================================--
 
 
package body FC51A00 is
 
function "/" (Left, Right : Integer) return Fraction_Type is
Result : Fraction_Type;
begin
Result.Numerator := Left;
Result.Denominator := Right;
return Result;
end "/";
 
 
function "-" (Frac : Fraction_Type) return Fraction_Type is
Result : Fraction_Type := Frac;
begin
Result.Numerator := -(Result.Numerator);
return Result;
end "-";
 
 
function Numerator (Frac : Fraction_Type) return Integer is
begin
return (Frac.Numerator);
end Numerator;
 
 
function Denominator (Frac : Fraction_Type) return Integer is
begin
return (Frac.Denominator);
end Denominator;
 
 
end FC51A00;
/fc51b00.a
0,0 → 1,62
-- FC51B00.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.
--*
--
-- FOUNDATION DESCRIPTION:
-- This foundation declares a set of tagged and untagged indefinite
-- subtypes.
--
-- CHANGE HISTORY:
-- 06 Dec 94 SAIC ACVC 2.0
--
--!
 
package FC51B00 is -- Type definitions.
 
subtype Size is Natural range 1 .. 4;
 
type Matrix is array -- Unconstrained array
(Size range <>, Size range <>) of Integer; -- type.
 
type Square (Side : Size) is record -- Unconstrained record
Mat : Matrix (1 .. Side, 1 .. Side); -- with undefaulted
end record; -- discriminants.
 
type Square_Pair (Dimension : Size) is tagged record -- Unconstrained tagged
Left : Square (Dimension); -- type.
Right : Square (Dimension);
end record;
 
type Vector is tagged record -- Constrained tagged
Mat : Matrix (1 .. 3, 1 .. 1); -- type (used to get
end record; -- class-wide type).
 
generic -- Template for a generic formal package.
type Vectors (<>) is new Vector with private; -- Type with unknown
package Signature is end; -- discriminants.
 
end FC51B00;
 
 
-- No body for FC51B00;
/f730a000.a
0,0 → 1,107
-- F730A000.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.
--*
--
-- FOUNDATION DESCRIPTION:
-- This file simulates a generic linked list abstraction for use in tests
-- covering tagged types and type extensions.
--
-- TEST FILES:
-- This foundation consists of the following files:
--
-- => F730A000.A
-- F730A001.A
--
-- CHANGE HISTORY:
-- 06 Dec 94 SAIC ACVC 2.0
-- 03 Aug 96 SAIC ACVC 2.1: Modified prologue. Added pragma
-- Elaborate_Body. Removed extraneous record
-- extension.
--
--!
 
generic -- Singly-linked list abstraction.
type Parent_Type is tagged private; -- Actual is parent
package F730A000 is -- tagged type.
 
pragma Elaborate_Body;
 
 
-- Declarations for private linked list nodes:
 
type Priv_Node_Type is new Parent_Type with private; -- Private extension
-- of parent type.
 
-- Inherits primitive operations of actual parameter corresponding
-- to Parent_Type.
 
 
type Priv_Node_Ptr is access Priv_Node_Type;
 
 
-- Add node at head of list.
procedure Add (Item : in Priv_Node_Ptr;
Head : in out Priv_Node_Ptr);
 
-- Remove node from head of list and return it.
procedure Remove (Head : in out Priv_Node_Ptr;
Item : out Priv_Node_Ptr);
 
private
 
type Priv_Node_Type is new Parent_Type with record
Next : Priv_Node_Ptr := null;
end record;
 
end F730A000;
 
 
--==================================================================--
 
 
package body F730A000 is -- Singly-linked list abstraction.
 
 
procedure Add (Item : in Priv_Node_Ptr;
Head : in out Priv_Node_Ptr) is
begin
if Item /= null then
Item.Next := Head;
Head := Item;
end if;
end Add;
 
 
procedure Remove (Head : in out Priv_Node_Ptr;
Item : out Priv_Node_Ptr) is
begin
Item := Head;
if Head /= null then
Head := Head.Next;
end if;
end Remove;
 
 
end F730A000;
/fc51c00.a
0,0 → 1,112
-- FC51C00.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.
--*
--
-- FOUNDATION DESCRIPTION:
-- This foundation declares a hierarchy of tagged types, which includes
-- both abstract and non-abstract types, and which have both abstract
-- and non-abstract primitive subprograms.
--
-- CHANGE HISTORY:
-- 06 Dec 94 SAIC ACVC 2.0
-- 03 Nov 95 SAIC ACVC 2.0.1 fixes: Deleted primitive operation Proc
-- of Concrete_Root.
-- 11 Aug 96 SAIC ACVC 2.1: Changed procedure bodies to update
-- actual parameters.
--
--!
 
package FC51C00 is
 
--
-- Non-abstract ultimate ancestor type:
--
 
type Concrete_Root is tagged null record;
 
function Func (P: Concrete_Root) return Concrete_Root; -- Abstract when
-- inherited.
 
 
--
-- Abstract descendant of non-abstract ultimate ancestor:
--
 
type Abstract_Child is abstract new Concrete_Root with null record;
 
-- Inherits:
-- function Func (P: Abstract_Child) return Abstract_Child is abstract;
 
procedure Proc (P: in out Abstract_Child) is abstract; -- Abstract.
procedure New_Proc (P : out Abstract_Child) is abstract; -- Abstract.
 
 
--
-- Non-abstract descendant of abstract descendant:
--
 
type Concrete_GrandChild is new Abstract_Child with null record;
 
function Func (P: Concrete_GrandChild) return Concrete_GrandChild;
 
procedure Proc (P: in out Concrete_GrandChild);
procedure New_Proc (P : out Concrete_GrandChild);
 
end FC51C00;
 
 
--===================================================================--
 
 
package body FC51C00 is
 
Value : Concrete_GrandChild;
 
 
function Func (P: Concrete_Root) return Concrete_Root is
begin
return P;
end Func;
 
 
function Func (P: Concrete_GrandChild) return Concrete_GrandChild is
begin
return P;
end Func;
 
 
procedure Proc (P: in out Concrete_GrandChild) is
begin
P := Value;
end Proc;
 
 
procedure New_Proc (P : out Concrete_GrandChild) is
begin
P := Value;
end New_Proc;
 
end FC51C00;
/fc51d00.a
0,0 → 1,82
-- FC51D00.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.
--*
--
-- FOUNDATION DESCRIPTION:
-- This foundation defines a generic list abstraction. List elements can
-- be of any (nonlimited) type. Lists are implemented as arrays of
-- pointers and are only two elements in length.
--
-- CHANGE HISTORY:
-- 06 Dec 94 SAIC ACVC 2.0
--
--!
 
generic
type Element_Type (<>) is private;
package FC51D00 is -- This package simulates a generic list abstraction.
 
-- The definition of List_Type below is purely artificial; its validity
-- in the context of the abstraction is irrelevant to the feature being
-- tested.
 
type Element_Ptr is access Element_Type;
 
subtype List_Size is Natural range 1 .. 2;
type List_Type is array (List_Size) of Element_Ptr;
 
function View_Element (I : List_Size; L : List_Type) return Element_Type;
 
procedure Write_Element (I : in List_Size;
L : in out List_Type;
E : in Element_Type);
 
-- ... Other list operations for Element_Type.
 
end FC51D00;
 
 
--==================================================================--
 
 
package body FC51D00 is
 
-- The implementations of the operations below are purely artificial; the
-- validity of their implementations in the context of the abstraction is
-- irrelevant to the feature being tested.
 
function View_Element (I : List_Size; L : List_Type) return Element_Type is
begin
return L(I).all;
end View_Element;
 
 
procedure Write_Element (I : in List_Size;
L : in out List_Type;
E : in Element_Type) is
begin
L(I) := new Element_Type'(E);
end Write_Element;
 
end FC51D00;
/fd72a00.a
0,0 → 1,84
-- FD72A00.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.
--*
--
-- FOUNDATION DESCRIPTION:
-- This foundation provides a basis for testing package
-- System.Address_To_Access_Conversions
--
-- TEST FILES:
-- The following files comprise this foundation:
--
-- FD72A00.A
--
-- CHANGE HISTORY:
-- 08 FEB 96 SAIC Initial version
--
--!
 
with Impdef;
with System.Storage_Elements;
package FD72A00 is
use System;
 
subtype Number is System.Storage_Elements.Integer_Address;
 
package Num_IO renames Impdef.Address_Value_IO;
 
-- the following conversions To/From Hex are to prevent optimizers from
-- optimizing out the otherwise senseless identity conversions, and
-- given the unknown nature of the type Number, the Identity operations
-- provided in Report will not suffice to this cause.
 
function Address_To_Hex( Adder: System.Address ) return String;
 
function Hex_To_Address( Hex: access String ) return System.Address;
 
end FD72A00;
 
package body FD72A00 is
 
function Address_To_Hex( Adder: System.Address ) return String is
S : String(1..64)
:= "uninitializedDEFuninitializedDEFuninitializedDEFuninitializedDEF";
DeBlank : Positive := S'First;
begin
Num_IO.Put( S, Number( System.Storage_Elements.To_Integer( Adder ) ),
Base => 16 );
while S(DeBlank) = ' ' loop
DeBlank := DeBlank +1;
end loop;
return S(DeBlank..S'Last);
end Address_To_Hex;
 
function Hex_To_Address( Hex: access String ) return System.Address is
The_Number : Number;
Tail : Natural;
begin
Num_IO.Get( Hex.all, The_Number, Tail );
return System.Storage_Elements.To_Address(
System.Storage_Elements.Integer_Address( The_Number ) );
end Hex_To_Address;
 
end FD72A00;
/impdef.a
0,0 → 1,376
-- IMPDEF.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.
--*
--
-- DESCRIPTION:
-- This package provides tailorable entities for a particular
-- implementation. Each entity may be modified to suit the needs
-- of the implementation. Default values are provided to act as
-- a guide.
--
-- The entities in this package are those which are used in at least
-- one core test. Entities which are used exclusively in tests for
-- annexes C-H are located in annex-specific child units of this package.
--
-- CHANGE HISTORY:
-- 12 DEC 93 SAIC Initial PreRelease version
-- 02 DEC 94 SAIC Second PreRelease version
-- 16 May 95 SAIC Added constants specific to tests of the random
-- number generator.
-- 16 May 95 SAIC Added Max_RPC_Call_Time constant.
-- 17 Jul 95 SAIC Added Non_State_String constant.
-- 21 Aug 95 SAIC Created from existing IMPSPEC.ADA and IMPBODY.ADA
-- files.
-- 30 Oct 95 SAIC Added external name string constants.
-- 24 Jan 96 SAIC Added alignment constants.
-- 29 Jan 96 SAIC Moved entities not used in core tests into annex-
-- specific child packages. Adjusted commentary.
-- Renamed Validating_System_Programming_Annex to
-- Validating_Annex_C. Added similar Validating_Annex_?
-- constants for the other non-core annexes (D-H).
-- 01 Mar 96 SAIC Added external name string constants.
-- 21 Mar 96 SAIC Added external name string constants.
-- 02 May 96 SAIC Removed constants for draft test CXA5014, which was
-- removed from the tentative ACVC 2.1 suite.
-- Added constants for use with FXACA00.
-- 06 Jun 96 SAIC Added constants for wide character test files.
-- 11 Dec 96 SAIC Updated constants for wide character test files.
-- 13 Dec 96 SAIC Added Address_Value_IO
-- 13 Sep 99 RLB Added more external name string constants.
-- 16 Sep 99 RLB Corrected definition of Non_State_String constant.
--
--!
 
with Report;
with Ada.Text_IO;
with System.Storage_Elements;
 
package ImpDef is
 
--=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
 
-- The following boolean constants indicate whether this validation will
-- include any of annexes C-H. The values of these booleans affect the
-- behavior of the test result reporting software.
--
-- True means the associated annex IS included in the validation.
-- False means the associated annex is NOT included.
 
Validating_Annex_C : constant Boolean := True;
-- ^^^^^ --- MODIFY HERE AS NEEDED
 
Validating_Annex_D : constant Boolean := True;
-- ^^^^^ --- MODIFY HERE AS NEEDED
 
Validating_Annex_E : constant Boolean := True;
-- ^^^^^ --- MODIFY HERE AS NEEDED
 
Validating_Annex_F : constant Boolean := True;
-- ^^^^^ --- MODIFY HERE AS NEEDED
 
Validating_Annex_G : constant Boolean := True;
-- ^^^^^ --- MODIFY HERE AS NEEDED
 
Validating_Annex_H : constant Boolean := True;
-- ^^^^^ --- MODIFY HERE AS NEEDED
 
--=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
 
-- This is the minimum time required to allow another task to get
-- control. It is expected that the task is on the Ready queue.
-- A duration of 0.0 would normally be sufficient but some number
-- greater than that is expected.
 
Minimum_Task_Switch : constant Duration := 0.001;
-- ^^^ --- MODIFY HERE AS NEEDED
 
Long_Minimum_Task_Switch : constant Duration := 0.1;
 
--=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
 
-- This is the time required to activate another task and allow it
-- to run to its first accept statement. We are considering a simple task
-- with very few Ada statements before the accept. An implementation is
-- free to specify a delay of several seconds, or even minutes if need be.
-- The main effect of specifying a longer delay than necessary will be an
-- extension of the time needed to run the associated tests.
 
Switch_To_New_Task : constant Duration := 0.001;
-- ^^^ -- MODIFY HERE AS NEEDED
 
Long_Switch_To_New_Task : constant Duration := 0.1;
 
--=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
 
-- This is the time which will clear the queues of other tasks
-- waiting to run. It is expected that this will be about five
-- times greater than Switch_To_New_Task.
 
Clear_Ready_Queue : constant Duration := 0.1;
-- ^^^ --- MODIFY HERE AS NEEDED
 
--=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
 
-- Some implementations will boot with the time set to 1901/1/1/0.0
-- When a delay of Delay_For_Time_Past is given, the implementation
-- guarantees that a subsequent call to Ada.Calendar.Time_Of(1901,1,1)
-- will yield a time that has already passed (for example, when used in
-- a delay_until statement).
 
Delay_For_Time_Past : constant Duration := 0.001;
-- ^^^ --- MODIFY HERE AS NEEDED
 
--=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
 
-- Minimum time interval between calls to the time dependent Reset
-- procedures in Float_Random and Discrete_Random packages that is
-- guaranteed to initiate different sequences. See RM A.5.2(45).
 
Time_Dependent_Reset : constant Duration := 0.001;
-- ^^^ --- MODIFY HERE AS NEEDED
 
--=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
 
-- Test CXA5013 will loop, trying to generate the required sequence
-- of random numbers. If the RNG is faulty, the required sequence
-- will never be generated. Delay_Per_Random_Test is a time-out value
-- which allows the test to run for a period of time after which the
-- test is failed if the required sequence has not been produced.
-- This value should be the time allowed for the test to run before it
-- times out. It should be long enough to allow multiple (independent)
-- runs of the testing code, each generating up to 1000 random
-- numbers.
 
Delay_Per_Random_Test : constant Duration := 0.001;
-- ^^^ --- MODIFY HERE AS NEEDED
 
--=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
 
-- The time required to execute this procedure must be greater than the
-- time slice unit on implementations which use time slicing. For
-- implementations which do not use time slicing the body can be null.
 
procedure Exceed_Time_Slice;
 
--=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
 
-- This constant must not depict a random number generator state value.
-- Using this string in a call to function Value from either the
-- Discrete_Random or Float_Random packages will result in
-- Constraint_Error or Program_Error (expected result in test CXA5012).
-- If there is no such string, set it to "**NONE**".
 
Non_State_String : constant String := "By No Means A State";
-- MODIFY HERE AS NEEDED --- ^^^^^^^^^^^^^^^^^^^
 
--=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
 
-- This string constant must be a legal external tag value as used by
-- CD10001 for the type Some_Tagged_Type in the representation
-- specification for the value of 'External_Tag.
 
External_Tag_Value : constant String := "implementation_defined";
-- MODIFY HERE AS NEEDED --- ^^^^^^^^^^^^^^^^^^^^^^
 
--=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
 
-- The following address constant must be a valid address to locate
-- the C program CD30005_1. It is shown here as a named number;
-- the implementation may choose to type the constant as appropriate.
 
function Cd30005_Proc (X : Integer) return Integer;
pragma Import (C, Cd30005_Proc, "_cd30005_1");
pragma Linker_Options ("ACATS4GNATDIR/support/cd300051.o");
CD30005_1_Foreign_Address : constant System.Address:= Cd30005_Proc'Address;
-- CD30005_1_Foreign_Address : constant System.Address:=
-- System.Storage_Elements.To_Address ( 16#0000_0000# )
-- --MODIFY HERE AS REQUIRED --- ^^^^^^^^^^^^^
 
--=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
 
-- The following string constant must be the external name resulting
-- from the C compilation of CD30005_1. The string will be used as an
-- argument to pragma Import.
 
CD30005_1_External_Name : constant String := "_cd30005_1";
-- MODIFY HERE AS NEEDED --- ^^^^^^^^^
 
--=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
 
-- The following constants should represent the largest default alignment
-- value and the largest alignment value supported by the linker.
-- See RM 13.3(35).
 
Max_Default_Alignment : constant := Standard'Maximum_Alignment;
-- ^ --- MODIFY HERE AS NEEDED
 
Max_Linker_Alignment : constant := Standard'Maximum_Alignment;
-- ^ --- MODIFY HERE AS NEEDED
 
--=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
 
-- The following string constants must be the external names resulting
-- from the C compilation of CXB30040.C, CXB30060.C, CXB30130.C, and
-- CXB30131.C. The strings will be used as arguments to pragma Import.
 
CXB30040_External_Name : constant String := "CXB30040";
-- MODIFY HERE AS NEEDED --- ^^^^^^^^
 
CXB30060_External_Name : constant String := "CXB30060";
-- MODIFY HERE AS NEEDED --- ^^^^^^^^
 
CXB30130_External_Name : constant String := "CXB30130";
-- MODIFY HERE AS NEEDED --- ^^^^^^^^
 
CXB30131_External_Name : constant String := "CXB30131";
-- MODIFY HERE AS NEEDED --- ^^^^^^^^
 
--=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
 
-- The following string constants must be the external names resulting
-- from the COBOL compilation of CXB40090.CBL, CXB40091.CBL, and
-- CXB40092.CBL. The strings will be used as arguments to pragma Import.
 
CXB40090_External_Name : constant String := "CXB40090";
-- MODIFY HERE AS NEEDED --- ^^^^^^^^
 
CXB40091_External_Name : constant String := "CXB40091";
-- MODIFY HERE AS NEEDED --- ^^^^^^^^
 
CXB40092_External_Name : constant String := "CXB40092";
-- MODIFY HERE AS NEEDED --- ^^^^^^^^
 
--=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
 
-- The following string constants must be the external names resulting
-- from the Fortran compilation of CXB50040.FTN, CXB50041.FTN,
-- CXB50050.FTN, and CXB50051.FTN.
--
-- The strings will be used as arguments to pragma Import.
--
-- Note that the use of these four string constants will be split between
-- two tests, CXB5004 and CXB5005.
 
CXB50040_External_Name : constant String := "CXB50040";
-- MODIFY HERE AS NEEDED --- ^^^^^^^^
 
CXB50041_External_Name : constant String := "CXB50041";
-- MODIFY HERE AS NEEDED --- ^^^^^^^^
 
CXB50050_External_Name : constant String := "CXB50050";
-- MODIFY HERE AS NEEDED --- ^^^^^^^^
 
CXB50051_External_Name : constant String := "CXB50051";
-- MODIFY HERE AS NEEDED --- ^^^^^^^^
 
--=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
 
-- The following constants have been defined for use with the
-- representation clause in FXACA00 of type Sales_Record_Type.
--
-- Char_Bits should be an integer at least as large as the number
-- of bits needed to hold a character in an array.
-- A value of 6 * Char_Bits will be used in a representation clause
-- to reserve space for a six character string.
--
-- Next_Storage_Slot should indicate the next storage unit in the record
-- representation clause that does not overlap the storage designated for
-- the six character string.
 
Char_Bits : constant := 8;
-- MODIFY HERE AS NEEDED ---^
 
Next_Storage_Slot : constant := 6;
-- MODIFY HERE AS NEEDED ---^
 
--=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
 
-- The following string constant must be the path name for the .AW
-- files that will be processed by the Wide Character processor to
-- create the C250001 and C250002 tests. The Wide Character processor
-- will expect to find the files to process at this location.
 
Test_Path_Root : constant String :=
"ACATS4GNATDIR/tests/c2/";
-- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ --- MODIFY HERE AS NEEDED
 
-- The following two strings must not be modified unless the .AW file
-- names have been changed. The Wide Character processor will use
-- these strings to find the .AW files used in creating the C250001
-- and C250002 tests.
 
Wide_Character_Test : constant String := Test_Path_Root & "c250001";
Upper_Latin_Test : constant String := Test_Path_Root & "c250002";
 
--=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
 
-- The following instance of Integer_IO or Modular_IO must be supplied
-- in order for test CD72A02 to compile correctly.
-- Depending on the choice of base type used for the type
-- System.Storage_Elements.Integer_Address; one of the two instances will
-- be correct. Comment out the incorrect instance.
 
-- package Address_Value_IO is
-- new Ada.Text_IO.Integer_IO(System.Storage_Elements.Integer_Address);
 
package Address_Value_IO is
new Ada.Text_IO.Modular_IO(System.Storage_Elements.Integer_Address);
 
--=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
 
One_Second : constant Duration := 0.001;
One_Long_Second : constant Duration := 0.1;
 
end ImpDef;
 
 
--==================================================================--
 
 
package body ImpDef is
 
-- NOTE: These are example bodies. It is expected that implementors
-- will write their own versions of these routines.
 
--=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
 
-- The time required to execute this procedure must be greater than the
-- time slice unit on implementations which use time slicing. For
-- implementations which do not use time slicing the body can be null.
 
Procedure Exceed_Time_Slice is
T : Integer := 0;
Loop_Max : constant Integer := 4_000;
begin
for I in 1..Loop_Max loop
T := Report.Ident_Int (1) * Report.Ident_Int (2);
end loop;
end Exceed_Time_Slice;
 
--=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
 
end ImpDef;
/fxf2a00.a
0,0 → 1,96
-- FXF2A00.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.
--*
--
-- FOUNDATION DESCRIPTION:
-- This foundation declares supporting objects, types and a generic
-- function for testing decimal fixed point operations.
--
-- The generic function contains a loop which steps through two arrays:
-- one of binary operations and one of operands. For each iteration, the
-- current operation is performed on the current operand and a variable
-- "Result" e.g.:
--
-- Result := Operation(2)(Operand(3), Result);
--
-- The result of each operation is cumulated in Result and returned to
-- the caller when the loop completes.
--
-- CHANGE HISTORY:
-- 12 Mar 96 SAIC Prerelease version for ACVC 2.1.
--
--!
 
package FXF2A00 is
 
Loop_Count : constant := 30000; -- # test iterations.
Optr_Count : constant := 6; -- # operations in op sequence.
Opnd_Count : constant := 5; -- # different operands.
 
type Loop_Range is range 1 .. Loop_Count; -- range 1 .. 30000.
type Optr_Range is mod Optr_Count; -- range 0 .. 5.
type Opnd_Range is mod Opnd_Count; -- range 0 .. 4.
 
 
generic
 
type Decimal_Fixed is delta <> digits <>;
 
type Operator_Ptr is access
function (L, R : Decimal_Fixed) return Decimal_Fixed;
 
type Operator_Table is array (Optr_Range) of Operator_Ptr;
type Operand_Table is array (Opnd_Range) of Decimal_Fixed;
 
function Operations_Loop (Initial : Decimal_Fixed;
Operator: Operator_Table;
Operand : Operand_Table) return Decimal_Fixed;
 
end FXF2A00;
 
 
--==================================================================--
 
 
package body FXF2A00 is
 
function Operations_Loop (Initial : Decimal_Fixed;
Operator: Operator_Table;
Operand : Operand_Table) return Decimal_Fixed is
 
Result : Decimal_Fixed := Initial; -- Cumulator.
Optr_Index : Optr_Range := 0; -- Index into operations table.
Opnd_Index : Opnd_Range := 0; -- Index into operand table.
 
begin
for Count in Loop_Range loop
Result := Operator(Optr_Index) (Result, Operand(Opnd_Index));
Optr_Index := Optr_Index + 1; -- Modular addition.
Opnd_Index := Opnd_Index + 1; -- Modular addition.
end loop;
 
return Result;
end Operations_Loop;
 
end FXF2A00;
/impdefd.a
0,0 → 1,69
-- IMPDEFD.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.
--*
--
-- DESCRIPTION:
-- This package provides tailorable entities for a particular
-- implementation. Each entity may be modified to suit the needs
-- of the implementation. Default values are provided to act as
-- a guide.
--
-- The entities in this package are those which are used exclusively
-- in tests for Annex D (Real-Time Systems).
--
-- APPLICABILITY CRITERIA:
-- This package is only required for implementations validating the
-- Real-Time Systems Annex.
--
-- CHANGE HISTORY:
-- 29 Jan 96 SAIC Initial version for ACVC 2.1.
-- 27 Aug 98 EDS Removed Processor_Type value Time_Slice
--!
package ImpDef.Annex_D is
--=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
 
-- This constant is the maximum storage size that can be specified
-- for a task. A single task that has this size must be able to
-- run. Ideally, this value is large enough that two tasks of this
-- size cannot run at the same time. If the value is too small then
-- test CXDC001 may take longer to run. See the test for further
-- information.
 
Maximum_Task_Storage_Size : constant := 16_000_000;
-- ^^^^^^^^^^ --- MODIFY HERE AS NEEDED
--=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
 
-- Indicates the type of processor on which the tests are running.
 
type Processor_Type is (Uni_Processor, Multi_Processor);
 
Processor : constant Processor_Type := Uni_Processor;
-- ^^^^^^^^^^^ --- MODIFY HERE AS NEEDED
 
--=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====--
 
end ImpDef.Annex_D;
/impdefh.a
0,0 → 1,102
-- IMPDEFH.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.
--*
--
-- DESCRIPTION:
-- This package is used to define those values that are implementation
-- defined for use with validating the Safety and Security special needs
-- annex, Annex-H.
--
-- APPLICABILITY CRITERIA:
-- This package is only required for implementations validating the
-- Safety and Security Annex.
--
-- CHANGE HISTORY:
-- 13 FEB 96 SAIC Initial version
-- 25 NOV 96 SAIC Revised for release 2.1
--
--!
 
package Impdef.Annex_H is
 
type Scalar_To_Normalize is
( Id0, Id1, Id2, Id3, Id4, Id5, Id6, Id7, Id8, Id9,
Id10, Id11, Id12, Id13, Id14, Id15, Id16, Id17, Id18, Id19,
Id20, Id21, Id22, Id23, Id24, Id25, Id26, Id27, Id28, Id29,
Id30, Id31, Id32, Id33, Id34, Id35, Id36, Id37, Id38, Id39,
Id40, Id41, Id42, Id43, Id44, Id45, Id46, Id47, Id48, Id49,
Id50, Id51, Id52, Id53, Id54, Id55, Id56, Id57, Id58, Id59,
Id60, Id61, Id62, Id63, Id64, Id65, Id66, Id67, Id68, Id69,
Id70, Id71, Id72, Id73, Id74, Id75, Id76, Id77, Id78, Id79,
Id80, Id81, Id82, Id83, Id84, Id85, Id86, Id87, Id88, Id89,
Id90, Id91, Id92, Id93, Id94, Id95, Id96, Id97, Id98, Id99,
IdA0, IdA1, IdA2, IdA3, IdA4, IdA5, IdA6, IdA7, IdA8, IdA9,
IdB0, IdB1, IdB2, IdB3, IdB4, IdB5, IdB6 );
 
-- NO MODIFICATION NEEDED TO TYPE SCALAR_TO_NORMALIZE. DO NOT MODIFY.
 
type Small_Number is range 1..100;
 
-- NO MODIFICATION NEEDED TO TYPE SMALL_NUMBER. DO NOT MODIFY.
 
--=====================================================================
-- When the value documented in H.1(5) as the predictable initial value
-- for an uninitialized object of the type Scalar_To_Normalize
-- (an enumeration type containing 127 identifiers) is to be in the range
-- Id0..IdB6, set the following constant to True; otherwise leave it set
-- to False.
 
Default_For_Scalar_To_Normalize_Is_In_Range : constant Boolean := False;
-- MODIFY HERE AS NEEDED --- ^^^^^
 
--=====================================================================
-- If the above constant Default_For_Scalar_To_Normalize_Is_In_Range is
-- set True, the following constant must be set to the value documented
-- in H.1(5) as the predictable initial value for the type
-- Scalar_To_Normalize.
 
Default_For_Scalar_To_Normalize : constant Scalar_To_Normalize := Id0;
-- MODIFY HERE AS NEEDED --- ^^^
 
--=====================================================================
-- When the value documented in H.1(5) as the predictable initial value
-- for an uninitialized object of the type Small_Number
-- (an integer type containing 100 values) is to be in the range
-- 1..100, set the following constant to True; otherwise leave it set
-- to False.
 
Default_For_Small_Number_Is_In_Range : constant Boolean := False;
-- MODIFY HERE AS NEEDED --- ^^^^^
 
--=====================================================================
-- If the above constant Default_For_Small_Number_Is_In_Range is
-- set True, the following constant must be set to the value documented
-- in H.1(5) as the predictable initial value for the type Small_Number.
 
Default_For_Small_Number : constant Small_Number := 100;
-- MODIFY HERE AS NEEDED --- ^^^
 
--=====================================================================
 
end Impdef.Annex_H;
/f341a00.a
0,0 → 1,216
-- F341A00.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.
--*
--
-- FOUNDATION DESCRIPTION:
-- This foundation provides a simple class hierarchy (a root type and two
-- levels of derivation from it) to use in testing the basic OO features
-- related to tagged types.
--
-- CHANGE HISTORY:
-- 06 Dec 94 SAIC ACVC 2.0
--
--!
 
package F341A00_0 is -- package Bank
 
type Dollar_Amount is new Float;
type Account is tagged
record
Current_Balance: Dollar_Amount;
end record;
 
-- Primitive operations.
 
procedure Deposit (A : in out Account;
X : in Dollar_Amount);
procedure Withdrawal (A : in out Account;
X : in Dollar_Amount);
function Balance (A : in Account) return Dollar_Amount;
procedure Service_Charge (A : in out Account);
procedure Add_Interest (A : in out Account);
procedure Open (A : in out Account);
 
end F341A00_0;
 
 
--=================================================================--
 
 
package body F341A00_0 is
 
-- Primitive operations for type Account.
 
procedure Deposit (A : in out Account;
X : in Dollar_Amount) is
begin
A.Current_Balance := A.Current_Balance + X;
end Deposit;
 
--
 
procedure Withdrawal (A : in out Account;
X : in Dollar_Amount) is
begin
A.Current_Balance := A.Current_Balance - X;
end Withdrawal;
 
--
 
function Balance (A : in Account) return Dollar_Amount is
begin
return (A.Current_Balance);
end Balance;
 
--
 
procedure Service_Charge (A : in out Account) is
begin
A.Current_Balance := A.Current_Balance - 5.00;
end Service_Charge;
 
--
 
procedure Add_Interest (A : in out Account) is
-- No interest accumulated on this type of account.
Interest_On_Account : Dollar_Amount := 0.00;
begin
A.Current_Balance := A.Current_Balance + Interest_On_Account;
end Add_Interest;
 
--
 
procedure Open (A : in out Account) is
Initial_Deposit : Dollar_Amount := 10.00;
begin
A.Current_Balance := Initial_Deposit;
end Open;
 
end F341A00_0;
 
 
--=================================================================--
 
 
with F341A00_0;
 
package F341A00_1 is -- package Checking
 
package Bank renames F341A00_0;
 
type Account is new Bank.Account with
record
Overdraft_Fee : Bank.Dollar_Amount;
end record;
 
 
-- Inherited primitive operations.
-- procedure Deposit (A : in out Account; X : in Bank.Dollar_Amount);
-- procedure Withdrawal (A : in out Account; X : in Bank.Dollar_Amount);
-- function Balance (A : in Account) return Bank.Dollar_Amount;
-- procedure Service_Charge(A : in out Account);
-- procedure Add_Interest (A : in out Account);
 
-- Overridden primitive operation.
procedure Open (A : in out Account);
 
end F341A00_1;
 
 
--=================================================================--
 
 
package body F341A00_1 is
 
-- Overridden primitive operation.
 
procedure Open (A : in out Account) is
Check_Guarantee : Bank.Dollar_Amount := 10.00;
Initial_Deposit : Bank.Dollar_Amount := 100.00;
begin
A.Current_Balance := Initial_Deposit;
A.Overdraft_Fee := Check_Guarantee;
end Open;
 
end F341A00_1;
 
 
--=================================================================--
 
 
with F341A00_0; -- package Bank
with F341A00_1; -- package Checking
 
package F341A00_2 is -- package Interest_Checking
 
package Bank renames F341A00_0;
package Checking renames F341A00_1;
 
subtype Interest_Rate is Bank.Dollar_Amount digits 4;
 
Current_Rate : Interest_Rate := 0.030;
 
type Account is new Checking.Account with
record
Rate : Interest_Rate;
end record;
 
-- "Twice" inherited primitive operations (Bank.Account, Checking.Account)
-- procedure Deposit (A : in out Account; X : in Bank.Dollar_Amount);
-- procedure Withdrawal (A : in out Account; X : in Bank.Dollar_Amount);
-- function Balance (A : in Account) return Bank.Dollar_Amount;
-- procedure Service_Charge(A : in out Account);
 
-- Overridden primitive operations.
procedure Add_Interest (A : in out Account);
procedure Open (A : in out Account);
 
end F341A00_2;
 
 
--=================================================================--
 
 
package body F341A00_2 is
 
-- Overridden primitive operations.
 
procedure Add_Interest (A : in out Account) is
use type Bank.Dollar_Amount;
Interest_On_Account : Bank.Dollar_Amount
:= Bank.Dollar_Amount(A.Current_Balance * A.Rate);
begin
A.Current_Balance := A.Current_Balance + Interest_On_Account;
end Add_Interest;
 
procedure Open (A : in out Account) is
Initial_Deposit : Bank.Dollar_Amount := 1000.00;
begin
Checking.Open (Checking.Account (A));
A.Current_Balance := Initial_Deposit;
A.Rate := Current_Rate;
end Open;
 
end F341A00_2;
/fxaca00.a
0,0 → 1,144
-- FXACA00.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.
--*
--
-- FOUNDATION DESCRIPTION:
-- This foundation consists of type definitions and object declarations
-- used by tests of Stream_IO functionality.
-- Objects of both record types specified below (discriminated records
-- with defaults, and discriminated records w/o defaults that have the
-- discriminant included in a representation clause for the type) should
-- have their discriminants included in the stream when using 'Write
-- Likewise, discriminants should be extracted from the stream when
-- using 'Read.
--
-- CHANGE HISTORY:
-- 06 Dec 94 SAIC ACVC 2.0
-- 02 May 96 SAIC Incorporated reviewer comments for ACVC 2.1.
--
--!
 
with ImpDef;
 
package FXACA00 is
 
type Origin_Type is (Foreign, Domestic);
 
for Origin_Type'Size use 1; -- Forces objects of the type to be
-- representable in 1 bit, used in rep clause
-- below for Sales_Record_Type.
 
type Product_Type (Manufacture : Origin_Type := Domestic) is
record
Item : String (1..8);
ID : Natural range 1..100;
case Manufacture is
when Foreign =>
Importer : String (1..10);
when Domestic =>
Distributor : String (1..10);
end case;
end record;
 
 
type Sales_Record_Type (Buyer : Origin_Type) is -- No default provided
record -- for the discriminant.
Name : String (1..6);
Sale_Item : Boolean := False;
case Buyer is
when Foreign =>
Quantity_Discount : Boolean;
when Domestic =>
Cash_Discount : Boolean;
end case;
end record;
 
 
String_Bits : constant := ImpDef.Char_Bits * 6 - 1;
 
-- This discriminated record type has a representation clause that
-- includes the discriminant of the object of this type.
 
for Sales_Record_Type use
record
Name at 0 range 0..String_Bits;
Sale_Item at ImpDef.Next_Storage_Slot range 0..0;
Buyer at ImpDef.Next_Storage_Slot range 1..1;
Quantity_Discount at ImpDef.Next_Storage_Slot range 2..2;
Cash_Discount at ImpDef.Next_Storage_Slot range 3..3;
end record;
 
 
type Timespan_Type is (Week, Month, Year);
 
type Sales_Statistics_Type is
array (Timespan_Type) of natural range 0 .. 500;
 
 
-- Object Declarations
 
 
Product_01 : Product_Type := (Domestic, "Product1", 1, "Distrib 01");
Product_02 : Product_Type (Manufacture => Foreign) := (Foreign,
"Product2",
2,
"Importer02");
Product_03 : Product_Type (Foreign) := (Manufacture => Foreign,
Item => "Product3",
ID => 3,
Importer => "Importer03");
--
 
Sale_Count_01 : Integer := 2;
Sale_Count_02 : Integer := 0;
Sale_Count_03 : Integer := 3;
 
--
 
Sale_Rec_01 : Sales_Record_Type (Domestic) :=
(Domestic, "Buyer1", False, True);
Sale_Rec_02 : Sales_Record_Type (Domestic) :=
(Domestic, "Buyer2", True, False);
 
Sale_Rec_03 : Sales_Record_Type (Buyer => Foreign) :=
(Buyer => Foreign, Name => "Buyer3", Sale_Item => True,
Quantity_Discount => True);
 
Sale_Rec_04 : Sales_Record_Type (Foreign) :=
(Foreign, "Buyer4", True, False);
Sale_Rec_05 : Sales_Record_Type (Buyer => Foreign) := (Foreign,
"Buyer5",
False,
False);
--
 
Product_01_Stats : Sales_Statistics_Type := (2,4,8);
Product_02_Stats : Sales_Statistics_Type := (Week => 0,
Month => 5,
Year => 10);
Product_03_Stats : Sales_Statistics_Type := (3, 6, others => 12);
 
 
end FXACA00;
/fxacb00.a
0,0 → 1,107
-- FXACB00.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.
--*
--
-- FOUNDATION DESCRIPTION:
-- This foundation consists of type definitions and object declarations
-- used by tests of Stream_IO functionality.
-- These types include an unconstrained array type, and a discriminated
-- record without a default discriminant, specifically chosen for use in
-- demonstrating the capabilities of 'Output and 'Input.
--
-- CHANGE HISTORY:
-- 06 Dec 94 SAIC ACVC 2.0
--
--!
 
package FXACB00 is
 
type Customer_Type is (Residence, Apartment, Commercial);
type Electric_Usage_Type is range 0..100000;
type Months_In_Service_Type is range 1..12;
type Quarterly_Period_Type is (Spring, Summer, Autumn, Winter);
subtype Month_In_Quarter_Type is Positive range 1..3;
type Service_History_Type is
array (Quarterly_Period_Type range <>, Month_In_Quarter_Type range <>)
of Electric_Usage_Type;
 
 
type Service_Type (Customer : Customer_Type) is
record
Name : String (1..21);
Account_ID : Natural range 0..100;
case Customer is
when Residence | Apartment =>
Low_Income_Credit : Boolean := False;
when Commercial =>
Baseline_Allowance : Natural range 0..1000;
Quantity_Discount : Boolean := False;
end case;
end record;
 
 
-- Object Declarations
 
 
Customer1 : Service_Type (Residence) :=
(Residence, "1221 Morningstar Lane", 44, False);
Customer2 : Service_Type (Apartment) := (Customer => Apartment,
Account_ID => 67,
Name => "15 South Front St. #8",
Low_Income_Credit => True);
Customer3 : Service_Type (Commercial) := (Commercial,
"12442 Central Avenue ",
100,
Baseline_Allowance => 938,
Quantity_Discount => True);
 
--
 
C1_Months : Months_In_Service_Type := 10;
C2_Months : Months_In_Service_Type := 2;
C3_Months : Months_In_Service_Type := 12;
--
 
C1_Service_History :
Service_History_Type (Quarterly_Period_Type, Month_In_Quarter_Type) :=
(Spring => (1 => 35, 2 => 39, 3 => 32),
Summer => (1 => 34, 2 => 33, 3 => 39),
Autumn => (1 => 45, 2 => 40, 3 => 38),
Winter => (1 => 53, 2 => 0, 3 => 0));
C2_Service_History :
Service_History_Type (Quarterly_Period_Type range Spring..Summer,
Month_In_Quarter_Type) :=
(Spring => (23, 22, 0), Summer => (0, 0, 0));
 
C3_Service_History :
Service_History_Type (Quarterly_Period_Type, Month_In_Quarter_Type) :=
(others => (others => 200));
 
--
 
Total_Customers_In_Service : constant Natural := 3;
 
end FXACB00;
/fxacc00.a
0,0 → 1,115
-- FXACC00.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.
--*
--
-- FOUNDATION DESCRIPTION:
-- This foundation consists of a tagged type definition and several
-- record extensions. Objects of each type have also been declared
-- and given initial values.
--
-- Visual Description of Type Extensions:
--
-- type Ticket_Request
-- |
-- _______________|_________________
-- | |
-- | |
-- type Subscriber_Request type VIP_Request
-- |
-- |
-- type Last_Minute_Request
--
-- CHANGE HISTORY:
-- 06 Dec 94 SAIC ACVC 2.0
--
--!
 
with Ada.Calendar;
 
package FXACC00 is
 
type Location_Type is (Backstage, Orchestra, Center, Back, Balcony);
type Quantity_Type is range 1 .. 100;
subtype Season_Ticket_Type is Positive range 1 .. 1750;
type VIP_Status_Type is (Mayor, City_Council, Visitor);
type Donation_Type is (To_Charity, To_Theatre, Personal);
 
Show_Of_Appreciation : constant Boolean := True;
 
type Ticket_Request is tagged
record
Location : Location_Type;
Number_Of_Tickets : Quantity_Type;
end record;
 
 
type Subscriber_Request is new Ticket_Request with
record
Subscription_Number : Season_Ticket_Type;
end record;
 
 
type VIP_Request is new Ticket_Request with
record
Rank : VIP_Status_Type;
end record;
 
 
type Last_Minute_Request (Special_Consideration : Boolean)
is new VIP_Request with
record
Time_of_Request : Ada.Calendar.Time;
case Special_Consideration is
when True => Donation : Donation_Type;
when False => null;
end case;
end record;
 
 
-- Object Declarations.
 
 
Box_Office_Request : Ticket_Request :=
(Location => Back,
Number_Of_Tickets => 2);
 
Summer_Subscription : Subscriber_Request :=
(Ticket_Request'(Box_Office_Request)
with Subscription_Number => 567);
 
Mayoral_Ticket_Request : VIP_Request :=
(Location => Backstage,
Number_Of_Tickets => 6,
Rank => Mayor);
Late_Request : Last_Minute_Request (Show_Of_Appreciation) :=
(Special_Consideration => Show_Of_Appreciation,
Location => Orchestra,
Number_Of_Tickets => 2,
Rank => City_Council,
Time_Of_Request => Ada.Calendar.Clock,
Donation => To_Charity);
 
 
end FXACC00;
/f393a00.a
0,0 → 1,245
-- F393A00.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.
--*
--
-- FOUNDATION DESCRIPTION:
-- This foundation provides a simple background for a class family
-- based on an abstract type. It is to be used to test the
-- dispatching of various forms of subprogram defined/inherited and
-- overridden with the abstract type.
--
-- type procedures functions
-- ---- ---------- ---------
-- Object Initialize, Swap(abstract) Create(abstract)
-- Object'Class Initialized
-- Windmill is new Object Swap, Stop, Add_Spin Create, Spin
-- Pump is new Windmill Set_Rate Create, Rate
-- Mill is new Windmill Swap, Stop Create
--
-- CHANGE HISTORY:
-- 06 Dec 94 SAIC ACVC 2.0
--
--!
package F393A00_0 is
procedure TC_Touch ( A_Tag : Character );
procedure TC_Validate( Expected: String; Message: String );
end F393A00_0;
with Report;
package body F393A00_0 is
Expectation : String(1..20);
Finger : Natural := 0;
procedure TC_Touch ( A_Tag : Character ) is
begin
Finger := Finger+1;
Expectation(Finger) := A_Tag;
end TC_Touch;
procedure TC_Validate( Expected: String; Message: String ) is
begin
if Expectation(1..Finger) /= Expected then
Report.Failed( Message & " Expecting: " & Expected
& " Got: " & Expectation(1..Finger) );
end if;
Finger := 0;
end TC_Validate;
end F393A00_0;
----------------------------------------------------------------------
package F393A00_1 is
type Object is abstract tagged private;
procedure Initialize( An_Object: in out Object );
function Initialized( An_Object: Object'Class ) return Boolean;
procedure Swap( A,B: in out Object ) is abstract;
function Create return Object is abstract;
private
type Object is abstract tagged record
Initialized : Boolean := False;
end record;
end F393A00_1;
with F393A00_0;
package body F393A00_1 is
procedure Initialize( An_Object: in out Object ) is
begin
An_Object.Initialized := True;
F393A00_0.TC_Touch('a');
end Initialize;
function Initialized( An_Object: Object'Class ) return Boolean is
begin
F393A00_0.TC_Touch('b');
return An_Object.Initialized;
end Initialized;
end F393A00_1;
----------------------------------------------------------------------
with F393A00_1;
package F393A00_2 is
type Rotational_Measurement is range -1_000 .. 1_000;
type Windmill is new F393A00_1.Object with private;
procedure Swap( A,B: in out Windmill );
function Create return Windmill;
procedure Add_Spin( To_Mill : in out Windmill;
RPMs : in Rotational_Measurement );
procedure Stop( Mill : in out Windmill );
function Spin( Mill : Windmill ) return Rotational_Measurement;
private
type Windmill is new F393A00_1.Object with
record
Spin : Rotational_Measurement := 0;
end record;
end F393A00_2;
with F393A00_0;
package body F393A00_2 is
procedure Swap( A,B: in out Windmill ) is
T : constant Windmill := B;
begin
F393A00_0.TC_Touch('c');
B := A;
A := T;
end Swap;
function Create return Windmill is
A_Mill : Windmill;
begin
F393A00_0.TC_Touch('d');
return A_Mill;
end Create;
procedure Add_Spin( To_Mill : in out Windmill;
RPMs : in Rotational_Measurement ) is
begin
F393A00_0.TC_Touch('e');
To_Mill.Spin := To_Mill.Spin + RPMs;
end Add_Spin;
procedure Stop( Mill : in out Windmill ) is
begin
F393A00_0.TC_Touch('f');
Mill.Spin := 0;
end Stop;
function Spin( Mill : Windmill ) return Rotational_Measurement is
begin
F393A00_0.TC_Touch('g');
return Mill.Spin;
end Spin;
end F393A00_2;
----------------------------------------------------------------------
with F393A00_2;
package F393A00_3 is
type Pump is new F393A00_2.Windmill with private;
function Create return Pump;
type Gallons_Per_Revolution is digits 3;
procedure Set_Rate( A_Pump: in out Pump; To_Rate: Gallons_Per_Revolution);
function Rate( Of_Pump: Pump ) return Gallons_Per_Revolution;
private
type Pump is new F393A00_2.Windmill with
record
GPRPM : Gallons_Per_Revolution := 0.0; -- Gallons/RPM
end record;
end F393A00_3;
with F393A00_0;
package body F393A00_3 is
function Create return Pump is
Sump : Pump;
begin
F393A00_0.TC_Touch('h');
return Sump;
end Create;
procedure Set_Rate( A_Pump: in out Pump; To_Rate: Gallons_Per_Revolution)
is
begin
F393A00_0.TC_Touch('i');
A_Pump.GPRPM := To_Rate;
end Set_Rate;
function Rate( Of_Pump: Pump ) return Gallons_Per_Revolution is
begin
F393A00_0.TC_Touch('j');
return Of_Pump.GPRPM;
end Rate;
end F393A00_3;
----------------------------------------------------------------------
 
with F393A00_2;
with F393A00_3;
package F393A00_4 is
type Mill is new F393A00_2.Windmill with private;
procedure Swap( A,B: in out Mill );
function Create return Mill;
procedure Stop( It: in out Mill );
private
type Mill is new F393A00_2.Windmill with
record
Pump: F393A00_3.Pump := F393A00_3.Create;
end record;
end F393A00_4;
with F393A00_0;
package body F393A00_4 is
procedure Swap( A,B: in out Mill ) is
T: constant Mill := A;
begin
F393A00_0.TC_Touch('k');
A := B;
B := T;
end Swap;
function Create return Mill is
A_Mill : Mill;
begin
F393A00_0.TC_Touch('l');
return A_Mill;
end Create;
procedure Stop( It: in out Mill ) is
begin
F393A00_0.TC_Touch('m');
F393A00_3.Stop( It.Pump );
F393A00_2.Stop( F393A00_2.Windmill( It ) );
end Stop;
end F393A00_4;
/f393b00.a
0,0 → 1,101
-- F393B00.A
-- Alert_Foundation
--
-- 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.
--*
--
-- FOUNDATION DESCRIPTION:
-- This package declares three abstract types for use in C660 series
-- tests, Alert, Special_Alert, and Private_Alert.
-- It models (in miniature) an application situation in which an
-- abstraction is defined in terms of structure (record and operations
-- on the record) but not in terms of content (record is null). It
-- also models a situation in which an abstraction includes some
-- specific, implementation dependent, information.
--
-- CHANGE HISTORY:
-- 06 Dec 94 SAIC ACVC 2.0
--
--!
package F393B00 is
type Alert is abstract tagged null record; -- abstract type
-- see procedure Handle below
procedure Handle (A : in out Alert) is abstract;
-- abstract procedure,
-- explicitly declared
type Private_Alert is abstract tagged private;
procedure Handle (PA : in out Private_Alert) is abstract;
-- ensures that Private_Alert
-- is visibly abstract
type Status_Kind is (Practice, Real, Dont_Care);
type Urgency_Kind is (Low, Medium, High);
type Practice_Alert is new Alert with record
Status : Status_Kind := Dont_Care;
Urgency : Urgency_Kind := Low;
end record;
procedure Handle (PA : in out Practice_Alert);
-- overrides inherited Handle
type Device is (Teletype, Console, Big_Screen);
type Special_Alert (Age : Integer) is
abstract new Practice_Alert with record
Display : Device;
end record;
procedure Handle (SA : in out Special_Alert) is abstract;
-- overrides inherited Handle
private
subtype Implementation_Detail is Integer range 1..10;
type Private_Alert is abstract tagged record
Private_Field : Implementation_Detail := 1;
end record;
end F393B00;
--=======================================================================--
package body F393B00 is
procedure Handle (PA : in out Practice_Alert) is
begin
PA.Status := Real;
PA.Urgency := Medium;
end Handle;
end F393B00;
/macrodef.adb
0,0 → 1,11
with Ada.Text_IO;
with System;
procedure Macrodef is
begin
Ada.Text_IO.Put_Line ("Integer'First = " & Integer'Image (Integer'First));
Ada.Text_IO.Put_Line ("Integer'Last = " & Integer'Image (Integer'Last));
Ada.Text_IO.Put_Line ("System.Min_Int = " & Long_Long_Integer'Image (System.Min_Int));
Ada.Text_IO.Put_Line ("System.Max_Int = " & Long_Long_Integer'Image (System.Max_Int));
Ada.Text_IO.Put_Line ("Ada.Text_IO.Count'Last = " & Ada.Text_IO.Count'Image (Ada.Text_IO.Count'Last));
Ada.Text_IO.Put_Line ("Ada.Text_IO.Field'Last = " & Ada.Text_IO.Field'Image (Ada.Text_IO.Field'Last));
end Macrodef;
/f3a2a00.a
0,0 → 1,81
-- F3A2A00.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.
--*
--
-- FOUNDATION DESCRIPTION:
-- This foundation declares support types and subprograms for testing
-- run-time accessibility checks.
--
-- CHANGE HISTORY:
-- 01 May 95 SAIC Initial prerelease version.
--
--!
 
package F3A2A00 is
 
type Tagged_Type is tagged record
C: Integer := 0;
end record;
 
type Array_Type is array (1 .. 10) of Tagged_Type;
 
type AccTag_L0 is access all Tagged_Type;
type AccTagClass_L0 is access all Tagged_Type'Class;
 
type AccArr_L0 is access all Array_Type;
 
X_L0 : Tagged_Type;
 
 
type TC_Result_Kind is (OK, P_E, O_E);
 
procedure TC_Display_Results (Actual : in TC_Result_Kind;
Expected: in TC_Result_Kind;
Message : in String);
end F3A2A00;
 
 
--==================================================================--
 
 
with Report;
package body F3A2A00 is
 
procedure TC_Display_Results (Actual : in TC_Result_Kind;
Expected: in TC_Result_Kind;
Message : in String) is
begin
if Actual /= Expected then
case Actual is
when OK =>
Report.Failed ("No exception raised: " & Message);
when P_E =>
Report.Failed ("Program_Error raised: " & Message);
when O_E =>
Report.Failed ("Unexpected exception raised: " & Message);
end case;
end if;
end TC_Display_Results;
 
end F3A2A00;
/macro.dfs
0,0 → 1,301
-- MACRO.DFS
-- THIS FILE CONTAINS THE MACRO DEFINITIONS USED IN THE ACVC TESTS.
-- THESE DEFINITIONS ARE USED BY THE ACVC TEST PRE-PROCESSOR,
-- MACROSUB. MACROSUB WILL CALCULATE VALUES FOR THOSE MACRO SYMBOLS
-- WHOSE DEFINITIONS DEPEND ON THE VALUE OF MAX_IN_LEN (NAMELY, THE
-- VALUES OF THE MACRO SYMBOLS BIG_ID1, BIG_ID2, BIG_ID3, BIG_ID4,
-- BIG_STRING1, BIG_STRING2, MAX_STRING_LITERAL, BIG_INT_LIT, BIG_REAL_LIT,
-- AND BLANKS). THEREFORE, ANY VALUES GIVEN IN THIS FILE FOR THOSE
-- MACRO SYMBOLS WILL BE IGNORED BY MACROSUB.
 
-- NOTE: AS REQUIRED BY THE MACROSUB PROGRAM, THE FIRST MACRO DEFINED
-- IN THIS FILE IS $MAX_IN_LEN. THE NEXT 5 MACRO DEFINITIONS
-- ARE FOR THOSE MACRO SYMBOLS THAT DEPEND ON THE VALUE OF
-- MAX_IN_LEN. THESE ARE IN ALPHABETIC ORDER. FOLLOWING THESE
-- ARE 36 MORE DEFINITIONS, ALSO IN ALPHABETIC ORDER.
 
-- EACH DEFINITION IS ACCORDING TO THE FOLLOWING FORMAT:
 
-- A. A NUMBER OF LINES PRECEDED BY THE ADA COMMENT DELIMITER, --.
-- THE FIRST OF THESE LINES CONTAINS THE MACRO SYMBOL AS IT APPEARS
-- IN THE TEST FILES (WITH THE DOLLAR SIGN). THE NEXT FEW "COMMENT"
-- LINES CONTAIN A DESCRIPTION OF THE VALUE TO BE SUBSTITUTED.
-- THE REMAINING "COMMENT" LINES, THE FIRST OF WHICH BEGINS WITH THE
-- WORDS "USED IN: " (NO QUOTES), CONTAIN A LIST OF THE TEST FILES
-- (WITHOUT THE .TST EXTENSION) IN WHICH THE MACRO SYMBOL APPEARS.
-- EACH TEST FILE NAME IS PRECEDED BY ONE OR MORE BLANKS.
-- B. A LINE, WITHOUT THE COMMENT DELIMITER, CONSISTING OF THE
-- IDENTIFIER (WITHOUT THE DOLLAR SIGN) OF THE MACRO SYMBOL,
-- FOLLOWED BY A SPACE OR TAB, FOLLOWED BY THE VALUE TO BE
-- SUBSTITUTED. IN THE DISTRIBUTION FILE, A SAMPLE VALUE IS
-- PROVIDED; THIS VALUE MUST BE REPLACED BY A VALUE APPROPRIATE TO
-- THE IMPLEMENTATION.
 
-- DEFINITIONS ARE SEPARATED BY ONE OR MORE EMPTY LINES.
-- THE LIST OF DEFINITIONS BEGINS AFTER THE FOLLOWING EMPTY LINE.
 
-- $MAX_IN_LEN
-- AN INTEGER LITERAL GIVING THE MAXIMUM LENGTH PERMITTED BY THE
-- COMPILER FOR A LINE OF ADA SOURCE CODE (NOT INCLUDING AN END-OF-LINE
-- CHARACTER).
-- USED IN: A26007A
MAX_IN_LEN 200
-- $MAX_STRING_LITERAL
-- A STRING LITERAL CONSISTING OF $MAX_IN_LEN CHARACTERS (INCLUDING THE
-- QUOTE CHARACTERS).
-- USED IN: A26007A
MAX_STRING_LITERAL "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA"
 
-- $BIG_ID1
-- AN IDENTIFIER IN WHICH THE NUMBER OF CHARACTERS IS $MAX_IN_LEN.
-- THE MACROSUB PROGRAM WILL SUPPLY AN IDENTIFIER IN WHICH THE
-- LAST CHARACTER IS '1' AND ALL OTHERS ARE 'A'.
-- USED IN: C23003A C23003B C23003G C23003I
-- C35502D C35502F
BIG_ID1 AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA1
-- $BIG_ID2
-- AN IDENTIFIER IN WHICH THE NUMBER OF CHARACTERS IS $MAX_IN_LEN,
-- DIFFERING FROM $BIG_ID1 ONLY IN THE LAST CHARACTER. THE MACROSUB
-- PROGRAM WILL USE '2' AS THE LAST CHARACTER.
-- USED IN: C23003A C23003B B23003F C23003G C23003I
BIG_ID2 AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA2
 
-- $BIG_ID3
-- AN IDENTIFIER IN WHICH THE NUMBER OF CHARACTERS IS $MAX_IN_LEN.
-- MACROSUB WILL USE '3' AS THE "MIDDLE" CHARACTER; ALL OTHERS ARE 'A'.
-- USED IN: C23003A C23003B C23003G C23003I
BIG_ID3 AAAAAAAAAAAAAAAAAAAAAAAAAAAAA3AAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
 
-- $BIG_ID4
-- AN IDENTIFIER IN WHICH THE NUMBER OF CHARACTERS IS $MAX_IN_LEN,
-- DIFFERING FROM $BIG_ID3 ONLY IN THE MIDDLE CHARACTER. MACROSUB
-- WILL USE '4' AS THE MIDDLE CHARACTER.
-- USED IN: C23003A C23003B C23003G C23003I
BIG_ID4 AAAAAAAAAAAAAAAAAAAAAAAAAAAAA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
-- $BIG_STRING1
-- A STRING LITERAL (WITH QUOTES) WHOSE CATENATION WITH $BIG_STRING2
-- ($BIG_STRING1 & $BIG_STRING2) PRODUCES THE IMAGE OF $BIG_ID1.
-- USED IN: C35502D C35502F
BIG_STRING1 "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAA"
-- $BIG_STRING2
-- A STRING LITERAL (WITH QUOTES) WHOSE CATENATION WITH $BIG_STRING1
-- ($BIG_STRING1 & $BIG_STRING2) PRODUCES THE IMAGE OF $BIG_ID1.
-- USED IN: C35502D C35502F
BIG_STRING2 "AAAAAAAAAAAAAAAAAAAAAAAAAAAAA1"
 
-- $BLANKS
-- A SEQUENCE OF ($MAX_IN_LEN - 20) BLANKS.
-- USED IN: B22001A B22001B B22001C B22001D B22001E B22001F
-- B22001G B22001I B22001J B22001K B22001L B22001M
-- B22001N
-- < LIMITS OF SAMPLE SHOWN BY ANGLE BRACKETS >
BLANKS
-- $ACC_SIZE
-- AN INTEGER LITERAL WHOSE VALUE IS THE MINIMUM NUMBER OF BITS
-- SUFFICIENT TO HOLD ANY VALUE OF AN ACCESS TYPE.
-- USED IN: CD2A83C BD2A02A
ACC_SIZE ACATS4GNATBIT
-- $ALIGNMENT
-- A VALUE THAT IS LEGITIMATE FOR USE IN A RECORD ALIGNMENT CLAUSE.
-- USED IN: CD4041A BD4006A
ALIGNMENT 4
 
-- $COUNT_LAST
-- AN INTEGER LITERAL WHOSE VALUE IS TEXT_IO.COUNT'LAST.
-- USED IN: CE3002B
COUNT_LAST 2147483647
-- $ENTRY_ADDRESS
-- AN EXPRESSION YIELDING A LEGAL ADDRESS FOR A TASK ENTRY
-- (I.E., FOR AN INTERRUPT) FOR THIS IMPLEMENTATION.
-- USED IN: SPPRT13SP
ENTRY_ADDRESS ENTRY_ADDR
 
-- $ENTRY_ADDRESS1
-- AN EXPRESSION YIELDING A LEGAL ADDRESS FOR A TASK ENTRY
-- (I.E., FOR AN INTERRUPT) FOR THIS IMPLEMENTATION. THE ADDRESS
-- MUST BE DISTINCT FROM THAT USED IN $ENTRY_ADDRESS.
-- USED IN: SPPRT13SP
ENTRY_ADDRESS1 ENTRY_ADDR1
-- $ENTRY_ADDRESS2
-- AN EXPRESSION YIELDING A LEGAL ADDRESS FOR A TASK ENTRY
-- (I.E., FOR AN INTERRUPT) FOR THIS IMPLEMENTATION. THE ADDRESS
-- MUST BE DISTINCT FROM THOSE USED IN $ENTRY_ADDRESS
-- AND $ENTRY_ADDRESS1.
-- USED IN: SPPRT13SP
ENTRY_ADDRESS2 ENTRY_ADDR2
-- $FIELD_LAST
-- AN INTEGER LITERAL WHOSE VALUE IS TEXT_IO.FIELD'LAST.
-- USED IN: CE3002C
FIELD_LAST 255
-- $FORM_STRING
-- A STRING LITERAL SPECIFYING THAT THE EXTERNAL FILE MEETS BOTH
-- CONDITIONS: (1) THERE IS A VALUE OF TYPE TEXT_IO.COUNT THAT IS NOT
-- AN APPROPRIATE LINE-LENGTH FOR THE FILE, (2) THERE IS A VALUE
-- OF TYPE TEXT_IO.COUNT THAT IS NOT AN APPROPRIATE PAGE-LENGTH
-- FOR THE FILE.
-- IF IT IS NOT POSSIBLE TO SATISFY BOTH CONDITIONS, THEN SUBSTITUTE
-- A STRING LITERAL SPECIFYING THAT THE EXTERNAL FILE SATISFIES ONE
-- OF THE CONDITIONS. IF IT IS NOT POSSIBLE TO SATISFY EITHER CONDITION,
-- THEN SUBSTITUTE THE NULL STRING ("").
-- USED IN: CE3304A
FORM_STRING ""
-- $FORM_STRING2
-- A STRING LITERAL SPECIFYING THAT THE CAPACITY OF THE FILE IS
-- RESTRICTED TO 4096 CHARACTERS OR LESS. IF THE IMPLEMENTATION
-- CANNOT RESTRICT FILE CAPACITY, $FORM_STRING2 SHOULD EQUAL
-- "CANNOT_RESTRICT_FILE_CAPACITY".
-- USED IN: CE2203A CE2403A
FORM_STRING2 "CANNOT_RESTRICT_FILE_CAPACITY"
-- $GREATER_THAN_DURATION
-- A REAL LITERAL WHOSE VALUE (NOT SUBJECT TO ROUND-OFF ERROR
-- IF POSSIBLE) LIES BETWEEN DURATION'BASE'LAST AND DURATION'LAST. IF
-- NO SUCH VALUES EXIST, USE A VALUE IN DURATION'RANGE.
-- USED IN: C96005B
GREATER_THAN_DURATION 86_000.0
 
-- $ILLEGAL_EXTERNAL_FILE_NAME1
-- AN ILLEGAL EXTERNAL FILE NAME (E.G., TOO LONG, CONTAINING INVALID
-- CHARACTERS, CONTAINING WILD-CARD CHARACTERS, OR SPECIFYING A
-- NONEXISTENT DIRECTORY).
-- USED IN: CE2102C CE2102H CE2103A CE2103B CE3102B CE3107A
ILLEGAL_EXTERNAL_FILE_NAME1 /NODIRECTORY/FILENAME
-- $ILLEGAL_EXTERNAL_FILE_NAME2
-- AN ILLEGAL EXTERNAL FILE NAME, DIFFERENT FROM $ILLEGAL_EXTERNAL_FILE_NAME1.
-- USED IN: CE2102C CE2102H CE2103A CE2103B CE3102B
ILLEGAL_EXTERNAL_FILE_NAME2 /@@/@@/@@\@@\@@\@@
-- $INAPPROPRIATE_LINE_LENGTH
-- A LITERAL OF TYPE COUNT THAT IS INAPPROPRIATE AS THE LINE-LENGTH
-- FOR THE EXTERNAL FILE. IF THERE IS NO SUCH VALUE, THEN USE -1.
-- USED IN: CE3304A
INAPPROPRIATE_LINE_LENGTH -1
-- $INAPPROPRIATE_PAGE_LENGTH
-- A LITERAL OF TYPE COUNT THAT IS INAPPROPRIATE AS THE PAGE-LENGTH
-- FOR THE EXTERNAL FILE. IF THERE IS NO SUCH VALUE, THEN USE -1.
-- USED IN: CE3304A
INAPPROPRIATE_PAGE_LENGTH -1
 
-- $INTEGER_FIRST
-- AN INTEGER LITERAL, WITH SIGN, WHOSE VALUE IS INTEGER'FIRST.
-- THE LITERAL MUST NOT INCLUDE UNDERSCORES OR LEADING OR TRAILING
-- BLANKS.
-- USED IN: C35503F B54B01B
INTEGER_FIRST -2147483648
-- $INTEGER_LAST
-- AN INTEGER LITERAL WHOSE VALUE IS INTEGER'LAST. THE LITERAL MUST
-- NOT INCLUDE UNDERSCORES OR LEADING OR TRAILING BLANKS.
-- USED IN: C35503F B54B01B
INTEGER_LAST 2147483647
 
 
-- $LESS_THAN_DURATION
-- A REAL LITERAL (WITH SIGN) WHOSE VALUE (NOT SUBJECT TO
-- ROUND-OFF ERROR IF POSSIBLE) LIES BETWEEN DURATION'BASE'FIRST AND
-- DURATION'FIRST. IF NO SUCH VALUES EXIST, USE A VALUE IN
-- DURATION'RANGE.
-- USED IN: C96005B
LESS_THAN_DURATION -86_400.0
 
-- $MACHINE_CODE_STATEMENT
-- A VALID MACHINE CODE STATEMENT AS SPECIFIED IN THE PACKAGE
-- MACHINE_CODE. IF THE IMPLEMENTATION DOES NOT SUPPORT MACHINE
-- CODE THEN USE THE ADA NULL STATEMENT (I.E. NULL; ).
-- USED IN: AD8011A BD8001A BD8002A BD8004A BD8004B
MACHINE_CODE_STATEMENT Asm_Insn'(Asm ("ACATS4GNATINSN"));
-- $MAX_INT
-- AN INTEGER LITERAL WHOSE VALUE IS SYSTEM.MAX_INT.
-- THE LITERAL MUST NOT INCLUDE UNDERSCORES OR LEADING OR TRAILING
-- BLANKS.
-- USED IN: C35503D C35503F C4A007A
MAX_INT 9223372036854775807
 
-- $MIN_INT
-- AN INTEGER LITERAL, WITH SIGN, WHOSE VALUE IS SYSTEM.MIN_INT.
-- THE LITERAL MUST NOT CONTAIN UNDERSCORES OR LEADING OR TRAILING
-- BLANKS.
-- USED IN: C35503D C35503F
MIN_INT -9223372036854775808
-- $NAME
-- THE NAME OF A PREDEFINED INTEGER TYPE OTHER THAN INTEGER,
-- SHORT_INTEGER, OR LONG_INTEGER.
-- (IMPLEMENTATIONS WHICH HAVE NO SUCH TYPES SHOULD USE AN UNDEFINED
-- IDENTIFIER SUCH AS NO_SUCH_TYPE_AVAILABLE.)
-- USED IN: C45231D CD7101G
NAME LONG_LONG_INTEGER
-- $OPTIONAL_DISC
-- A DISCRIMINANT USED AS THE DISCRIMINANT PART OF $RECORD_NAME.
-- IF MACHINE CODE INSERTIONS ARE NOT SUPPORTED THEN SUBSTITUTE
-- NO_SUCH_MACHINE_CODE_DISC.
-- USED IN: BD8002A
OPTIONAL_DISC
-- $RECORD_DEFINITION
-- THE RECORD TYPE DEFINITION (WITH FINAL SEMICOLON) FOR THE TYPE THAT
-- WAS USED IN THE MACRO $RECORD_NAME, AS DECLARED IN PACKAGE
-- MACHINE_CODE. IF THE IMPLEMENTATION DOES NOT SUPPORT MACHINE CODE,
-- THEN USE A NULL RECORD DEFINITION
-- USED IN: BD8002A
RECORD_DEFINITION RECORD ASM : STRING (1..4); END RECORD;
-- $RECORD_NAME
-- A VALID RECORD TYPE NAME THAT IS DEFINED IN PACKAGE MACHINE_CODE.
-- IF THE IMPLEMENTATION DOES NOT SUPPORT MACHINE CODE THEN
-- USE THE NAME "NO_SUCH_MACHINE_CODE_TYPE"
-- USED IN: BD8002A
RECORD_NAME Asm_Insn
 
-- $TASK_SIZE
-- AN INTEGER LITERAL WHOSE VALUE IS THE NUMBER OF BITS REQUIRED TO
-- HOLD A TASK OBJECT.
-- USED IN: CD2A91C
TASK_SIZE ACATS4GNATBIT
-- $TASK_STORAGE_SIZE
-- THE NUMBER OF STORAGE UNITS REQUIRED FOR A TASK ACTIVATION.
-- USED IN: BD2C01D BD2C02A BD2C03A C87B62D CD1009K CD1009T
-- CD1009U CD1C03E CD1C06A CD2C11A CC1225A CD2C11D
TASK_STORAGE_SIZE 1024
-- $VARIABLE_ADDRESS
-- AN EXPRESSION YIELDING A LEGAL ADDRESS FOR A VARIABLE FOR THIS
-- IMPLEMENTATION.
-- USED IN: SPPRT13SP
VARIABLE_ADDRESS VAR_ADDR
-- $VARIABLE_ADDRESS1
-- AN EXPRESSION YIELDING A LEGAL ADDRESS FOR A VARIABLE FOR THIS
-- IMPLEMENTATION. THE ADDRESS MUST BE DISTINCT FROM THAT USED IN
-- THE MACRO $VARIABLE_ADDRESS.
-- USED IN: SPPRT13SP
VARIABLE_ADDRESS1 VAR_ADDR1
-- $VARIABLE_ADDRESS2
-- AN EXPRESSION YIELDING A LEGAL ADDRESS FOR A VARIABLE FOR THIS
-- IMPLEMENTATION. THE ADDRESS MUST BE DISTINCT FROM THOSE USED IN
-- THE MACROS $VARIABLE_ADDRESS AND $VARIABLE_ADDRESS1.
-- USED IN: SPPRT13SP
VARIABLE_ADDRESS2 VAR_ADDR2
 
/f340a001.a
0,0 → 1,75
-- F340A001.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.
--*
--
-- FOUNDATION DESCRIPTION:
-- This file declares a tagged type and primitive subprogram for use in
-- tests covering tagged types and type extensions.
--
-- TEST FILES:
-- The following files comprise this foundation:
--
-- F340A000.A
-- => F340A001.A
--
-- CHANGE HISTORY:
-- 06 Dec 94 SAIC ACVC 2.0
--
--!
 
package F340A001 is -- Book definitions.
 
 
type Text_Ptr is access String;
 
type Book_Type is tagged record -- Root tagged type.
Title : Text_Ptr;
Author : Text_Ptr;
end record;
 
 
procedure Create_Book (Title : in Text_Ptr; -- Primitive operation
Author : in Text_Ptr; -- of root tagged type.
Book : out Book_Type);
 
end F340A001;
 
 
--==================================================================--
 
 
package body F340A001 is -- Book definitions.
 
 
procedure Create_Book (Title : in Text_Ptr;
Author : in Text_Ptr;
Book : out Book_Type) is
begin
Book.Title := Title;
Book.Author := Author;
end Create_Book;
 
end F340A001;
/enumchek.ada
0,0 → 1,65
-- THIS GENERIC PROCEDURE IS INTENDED FOR USE IN CONJUNCTION WITH THE ACVC
-- CHAPTER 13 C TESTS. IT IS INSTANTIATED WITH TWO TYPES. THE FIRST IS AN
-- ENUMERATION TYPE FOR WHICH AN ENUMERATION CLAUSE HAS BEEN GIVEN, AND THE
-- SECOND IS AN INTEGER TYPE WHOSE 'SIZE IS THE SAME AS THE 'SIZE OF THIS
-- ENUMERATION TYPE.
 
-- THE PROCEDURE ENUM_CHECK IS THEN CALLED WITH THREE ARGUMENTS. THE FIRST IS
-- AN ENUMERATION LITERAL FROM THE ENUMERATION TYPE, THE SECOND IS AN INTEGER
-- LITERAL WHICH IS THE VALUE OF THE EXPECTED REPRESENTATION (TAKEN FROM THE
-- ENUMERATION REPRESENTATION CLAUSE), AND THE THIRD IS A STRING DESCRIBING OR
-- NAMING THE TYPE (USED IN A CALL TO FAILED IF THE REPRESENTATION CHECK FAILS).
 
-- THE CHECK IS TO CONVERT THE ENUMERATION VALUE TO A BOOLEAN ARRAY WITH A
-- LENGTH CORRESONDING TO THE 'SIZE OF THE ENUMERATION TYPE. AN INTEGER TYPE
-- IS THEN CREATED WITH THIS SAME 'SIZE, AND THE REQUIRED REPRESENTATION VALUE
-- IS CONVERTED FROM THIS TYPE TO A BOOLEAN ARRAY WITH THE SAME LENGTH. THE
-- TWO BOOLEAN ARRAYS ARE THEN COMPARED AND SHOULD BE EQUAL. THE CONVERSIONS
-- ARE PERFORMED USING APPROPRIATE INSTANTIATIONS OF UNCHECKED_CONVERSION.
 
-- AUTHOR: ROBERT B. K. DEWAR, UNCOPYRIGHTED, PUBLIC DOMAIN USE AUTHORIZED
 
GENERIC
 
TYPE ENUM_TYPE IS PRIVATE;
TYPE INT_TYPE IS RANGE <>;
 
PROCEDURE ENUM_CHECK (TEST_VALUE : ENUM_TYPE;
REP_VALUE : INT_TYPE;
TYPE_ID : STRING);
 
 
WITH UNCHECKED_CONVERSION;
WITH REPORT; USE REPORT;
 
PROCEDURE ENUM_CHECK (TEST_VALUE : ENUM_TYPE;
REP_VALUE : INT_TYPE;
TYPE_ID : STRING) IS
 
TYPE BIT_ARRAY_TYPE IS ARRAY (1 .. ENUM_TYPE'SIZE) OF BOOLEAN;
PRAGMA PACK (BIT_ARRAY_TYPE);
 
FUNCTION TO_BITS IS NEW UNCHECKED_CONVERSION (ENUM_TYPE, BIT_ARRAY_TYPE);
FUNCTION TO_BITS IS NEW UNCHECKED_CONVERSION (INT_TYPE, BIT_ARRAY_TYPE);
 
BIT_ARRAY_1 : BIT_ARRAY_TYPE;
BIT_ARRAY_2 : BIT_ARRAY_TYPE;
 
INT_VALUE : INT_TYPE := INT_TYPE (REP_VALUE);
 
BEGIN
 
-- VERIFY CORRECT CALL (THIS IS A SANITY CHECK ON THE TEST ITSELF)
 
IF ENUM_TYPE'SIZE /= INT_TYPE'SIZE THEN
FAILED ("ERROR IN ENUM_CHECK CALL: SIZES DO NOT MATCH");
END IF;
 
BIT_ARRAY_1 := TO_BITS (TEST_VALUE);
BIT_ARRAY_2 := TO_BITS (INT_VALUE);
 
IF BIT_ARRAY_1 /= BIT_ARRAY_2 THEN
FAILED ("CHECK ON REPRESENTATION OF TYPE " & TYPE_ID & " FAILED.");
END IF;
 
END ENUM_CHECK;
/fxa5a00.a
0,0 → 1,121
-- FXA5A00.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.
--*
--
-- FOUNDATION DESCRIPTION:
-- This foundation package contains constants and a function used in
-- the evaluation of the Generic Elementary Functions.
--
-- CHANGE HISTORY:
-- 06 Mar 95 SAIC Initial prerelease version.
-- 03 Apr 95 SAIC Corrected error in context clause.
-- 12 Jun 95 SAIC Added procedure Dont_Optimize. Added New_Float
-- type, and overload of function
-- Result_Within_Range.
--
--!
 
with Ada.Numerics;
with Report;
 
package FXA5A00 is
 
-- Constants.
 
Epsilon : constant Float := Float'Model_Epsilon;
Small : constant Float := Float'Model_Small;
Large : constant Float := Float'Safe_Last;
Minus_Large : constant Float := Float'Safe_First;
 
Half_Pi : constant Float := Ada.Numerics.Pi / 2.0;
Two_Pi : constant Float := Ada.Numerics.Pi * 2.0;
 
Floating_Delta : constant Float := 0.05;
One_Plus_Delta : constant Float := 1.0 + Floating_Delta;
One_Minus_Delta : constant Float := 1.0 - Floating_Delta;
Minus_One_Plus_Delta : constant Float := -1.0 + Floating_Delta;
Minus_One_Minus_Delta : constant Float := -1.0 - Floating_Delta;
 
 
type New_Float is new Float digits 6;
 
function Result_Within_Range (Result : Float;
Expected_Result : Float;
Relative_Error : Float) return Boolean;
 
function Result_Within_Range (Result : New_Float;
Expected_Result : Float;
Relative_Error : Float) return Boolean;
 
-- This procedure is designed to defeat optimization attempts by an
-- implementation in cases where an exception is specifically raised
-- in a test to test a prescribed exception result condition.
-- The parameter Num is a unique identifier for location purposes within
-- the test.
 
generic
type Eval_Type is digits <>;
procedure Dont_Optimize (Check_Result : Eval_Type;
Num : Integer);
 
end FXA5A00;
 
---
 
package body FXA5A00 is
 
 
function Result_Within_Range (Result : Float;
Expected_Result : Float;
Relative_Error : Float) return Boolean is
begin
return (Result <= Expected_Result + Relative_Error) and
(Result >= Expected_Result - Relative_Error);
end Result_Within_Range;
 
 
function Result_Within_Range (Result : New_Float;
Expected_Result : Float;
Relative_Error : Float) return Boolean is
begin
return (Float(Result) <= Expected_Result + Relative_Error) and
(Float(Result) >= Expected_Result - Relative_Error);
end Result_Within_Range;
 
 
procedure Dont_Optimize (Check_Result : Eval_Type;
Num : Integer) is
begin
-- Note that the use of Minus_Large here is simply as a "dummy" value,
-- designed to indicate use of the Check_Result parameter, and has no
-- pass/fail significance to any test using this procedure.
--
if Float(Check_Result) = Minus_Large then
Report.Comment("Attempted Defeat of Optimization ONLY -- Not " &
"a cause for test failure! " &
"Result = Minus_Large, Case:" & Integer'Image(Num));
end if;
end Dont_Optimize;
 
end FXA5A00;
/fxf3a00.a
0,0 → 1,330
-- FXF3A00.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.
--*
--
-- FOUNDATION DESCRIPTION:
-- This foundation contains decimal data values, valid and invalid
-- Picture strings, and Edited Output result strings that will be used
-- in tests of Appendix F.3.
-- Note: In this foundation package, the effect of "Table Driven Data"
-- is achieved using a series of arrays to hold the various data items.
-- Since the data items (Picture strings, Edited Output) are often of
-- different lengths, the arrays are defined to contain pointers to
-- string values, thereby allowing the "tables" to hold string data of
-- different sizes.
--
-- CHANGE HISTORY:
-- 06 Dec 94 SAIC ACVC 2.0
-- 15 Feb 95 SAIC Picture string, decimal data, and edited_output
-- modifications.
-- 23 Feb 95 SAIC Picture string modification.
-- 10 Mar 95 SAIC Added explanatory comments.
-- 15 Nov 95 SAIC Corrected picture string for ACVC 2.0.1.
-- 06 Oct 96 SAIC Corrected invalid picture strings.
-- 13 Feb 97 PWB.CTA Deleted invalid picture string.
-- 17 Feb 97 PWB.CTA Added leading blank to two picture strings
--!
 
with Ada.Text_IO.Editing;
 
package FXF3A00 is
 
Number_Of_NDP_Items : constant := 12; -- No Decimal Places.
Number_Of_2DP_Items : constant := 20; -- Two Decimal Places.
Number_Of_Valid_Strings : constant := 40;
Number_Of_FF_Strings : constant := 4; -- French Francs
Number_Of_DM_Strings : constant := 5; -- Deutchemarks
Number_Of_CHF_Strings : constant := 1; -- Swiss Francs
Number_Of_Foreign_Strings : constant := Number_Of_FF_Strings +
Number_Of_DM_Strings +
Number_Of_CHF_Strings;
Number_Of_Invalid_Strings : constant := 25;
Number_Of_Erroneous_Conditions : constant := 3;
Number_Of_Edited_Output_Strings : constant := 32;
 
-- The following string is to be used as a picture string with length
-- beyond the maximum (Max_Picture_Length) that is supported by the
-- implementation.
 
A_Picture_String_Too_Long : constant
String (1..Ada.Text_IO.Editing.Max_Picture_Length + 1) := (others => '9');
 
 
type Str_Ptr is access String;
 
type Decimal_Type_NDP is delta 1.0 digits 16; -- no decimal places
type Decimal_Type_2DP is delta 0.01 digits 16; -- two decimal places
 
type Data_Array_Type_1 is array (Integer range <>) of Decimal_Type_NDP;
type Data_Array_Type_2 is array (Integer range <>) of Decimal_Type_2DP;
 
 
type Picture_String_Array_Type is
array (Integer range <>) of Str_Ptr;
 
type Edited_Output_Results_Array_Type is
array (Integer range <>) of Str_Ptr;
 
 
 
Data_With_NDP : Data_Array_Type_1 (1..Number_Of_NDP_Items) :=
( 1 => 1234.0,
2 => 51234.0,
3 => -1234.0,
4 => 1234.0,
5 => 1.0,
6 => 0.0,
7 => -10.0,
8 => -1.0,
9 => 1234.0,
10 => 1.0,
11 => 36.0,
12 => 0.0
);
 
 
Data_With_2DP : Data_Array_Type_2 (1..Number_Of_2DP_Items) :=
( 1 => 123456.78,
2 => 123456.78,
3 => 0.0,
4 => 0.20,
5 => 123456.00,
6 => -123456.78,
7 => 123456.78,
8 => -12.34,
9 => 1.23,
10 => 12.34,
 
-- Items 11-20 are used with picture strings in evaluating use of
-- foreign currency symbols.
 
11 => 123456.78,
12 => 123456.78,
13 => 32.10,
14 => -5432.10,
15 => -1234.57,
16 => 123456.78,
17 => 12.34,
18 => 12.34,
19 => 1.23,
20 => 12345.67
);
 
 
 
Valid_Strings : Picture_String_Array_Type
(1..Number_Of_Valid_Strings) :=
 
-- Items 1-10 are used in conjunction with Data_With_2DP values
-- to produce edited output strings, as well as in tests of
-- function Valid.
 
( 1 => new String'("-###**_***_**9.99"),
2 => new String'("-$**_***_**9.99"),
3 => new String'("-$$$$$$.$$"),
4 => new String'("-$$$$$$.$$"),
5 => new String'("+BBBZZ_ZZZ_ZZZ.ZZ"),
6 => new String'("--_---_---_--9"),
7 => new String'("-$_$$$_$$$_$$9.99"),
8 => new String'("<$$_$$$9.99>"),
9 => new String'("$_$$9.99"),
10 => new String'("$$9.99"),
 
-- Items 11-22 are used in conjunction with Data_With_NDP values
-- to produce edited output strings.
 
11 => new String'("ZZZZ9"),
12 => new String'("ZZZZ9"),
13 => new String'("<#Z_ZZ9>"),
14 => new String'("<#Z_ZZ9>"),
15 => new String'("ZZZ.ZZ"),
16 => new String'("ZZZ.ZZ"),
17 => new String'("<###99>"),
18 => new String'("ZZZZZ-"),
19 => new String'("$$$$9"),
20 => new String'("$$$$$"),
21 => new String'("<###99>"),
22 => new String'("$$$$9"),
 
-- Items 23-40 are used in validation of the Valid, To_Picture, and
-- Pic_String subprograms of package Text_IO.Editing, and are not
-- used to generate edited output.
 
23 => new String'("zZzZzZzZzZzZzZzZzZ"),
24 => new String'("999999999999999999"),
25 => new String'("******************"),
26 => new String'("$$$$$$$$$$$$$$$$$$"),
27 => new String'("9999/9999B9999_999909999"),
28 => new String'("+999999999999999999"),
29 => new String'("-999999999999999999"),
30 => new String'("999999999999999999+"),
31 => new String'("999999999999999999-"),
32 => new String'("<<<_<<<_<<<_<<<_<<<_<<9>"),
33 => new String'("++++++++++++++++++++"),
34 => new String'("--------------------"),
35 => new String'("zZzZzZzZzZzZzZzZzZ.zZ"),
36 => new String'("******************.99"),
37 => new String'("$$$$$$$$$$$$$$$$$$.99"),
 
-- The following string has length 30, which is the minimum value
-- that must be supported for Max_Picture_Length.
 
38 => new String'("9_999_999_999_999_999_999BB.99"),
39 => new String'("<<<_<<<_<<<_<<<.99>"),
40 => new String'("ZZZZZZZZZZZZZZZZZ+")
);
 
 
 
Foreign_Strings : Picture_String_Array_Type
(1..Number_Of_Foreign_Strings) :=
 
-- These strings are going to be used in conjunction with non-default
-- values for Currency string, Radix mark, and Separator in calls to
-- Image and Put, as well as in tests of function Valid.
 
( 1 => new String'("-###**_***_**9.99"), -- FF
2 => new String'("-$**_***_**9.99"), -- FF
3 => new String'("<###z_ZZ9.99>"), -- FF
4 => new String'("<###Z_ZZ9.99>"), -- FF
5 => new String'("<<<<_<<<.<<###>"), -- DM
6 => new String'("-$_$$$_$$$_$$9.99"), -- DM
7 => new String'("$z99.99"), -- DM
8 => new String'("$$$9.99"), -- DM
9 => new String'("$_$$9.99"), -- DM
10 => new String'("###_###_##9.99") -- CHF
);
 
 
 
Invalid_Strings : Picture_String_Array_Type
(1..Number_Of_Invalid_Strings) :=
--
-- The RM references to the right of these invalid picture strings
-- indicates which of the composition constraints of picture strings
-- is violated by the particular string (and all following strings
-- until another reference is presented). However, certain strings
-- violate multiple of the constraints.
--
( 1 => new String'("<<<"),
2 => new String'("<<>>"),
3 => new String'("<<<9_B0/$DB"),
4 => new String'("+BB"),
5 => new String'("<-"),
6 => new String'("<CR"),
7 => new String'("<db"),
8 => new String'("<<BBBcr"),
9 => new String'("<<__DB"),
10 => new String'("<<<++++_++-"),
11 => new String'("-999.99>"),
12 => new String'("+++9.99+"),
13 => new String'("++++>>"),
14 => new String'("->"),
15 => new String'("++9-"),
16 => new String'("---999999->"),
17 => new String'("+++-"),
18 => new String'("+++_+++_+.--"),
19 => new String'("--B.BB+>"),
20 => new String'("$$#$"),
21 => new String'("#B$$$$"),
22 => new String'("**Z"),
23 => new String'("ZZZzzz*"),
24 => new String'("9.99DB(2)"),
25 => new String'(A_Picture_String_Too_Long)
);
 
 
Edited_Output : Edited_Output_Results_Array_Type
(1..Number_Of_Edited_Output_Strings) :=
 
-- The following 10 edited output strings result from the first 10
-- valid strings when used with the first 10 Data_With_2DP numeric
-- values.
( 1 => new String'(" $***123,456.78"),
2 => new String'(" $***123,456.78"),
3 => new String'(" "),
4 => new String'(" $.20"),
5 => new String'("+ 123,456.00"),
6 => new String'(" -123,457"),
7 => new String'(" $123,456.78"),
8 => new String'("( $12.34)"),
9 => new String'(" $1.23"),
10 => new String'("$12.34"),
 
-- The following 10 edited output strings correspond to the 10 foreign
-- currency picture strings (the currency string is supplied at the
-- time of the call to Editing.Image or Editing.Put), when used in
-- conjunction with Data_With_2DP items 11-20
 
11 => new String'(" FF***123.456,78"),
12 => new String'(" FF***123.456,78"),
13 => new String'(" FF 32,10 "),
14 => new String'("( FF5.432,10)"),
15 => new String'(" (1,234.57DM )"),
16 => new String'(" DM123,456.78"),
17 => new String'("DM 12.34"),
18 => new String'(" DM12.34"),
19 => new String'(" DM1.23"),
20 => new String'(" CHF12,345.67"),
 
-- The following 12 edited output strings correspond to the 12
-- Data_With_NDP items formatted using Valid_String items 11-22.
-- This combination shows decimal data with no decimal places
-- formatted using picture strings.
 
21 => new String'(" 1234"),
22 => new String'("51234"),
23 => new String'("($1,234)"),
24 => new String'(" $1,234 "),
25 => new String'(" 1.00"),
26 => new String'(" "),
27 => new String'("( $10)"),
28 => new String'(" 1-"),
29 => new String'("$1234"),
30 => new String'(" $1"),
31 => new String'(" $36 "),
32 => new String'(" $0")
);
 
 
 
-- The following data is used to create exception situations in tests of
-- the Edited Output capabilities of package Ada.Text_IO.Editing. The data
-- are not themselves erroneous, but will produce exceptions based on the
-- data/picture string combination used.
 
Erroneous_Data : Data_Array_Type_2 (1..Number_Of_Erroneous_Conditions) :=
( 1 => 12.34,
2 => -12.34,
3 => 51234.0
);
 
Erroneous_Strings : Picture_String_Array_Type
(1..Number_Of_Erroneous_Conditions) :=
( 1 => new String'("9.99"),
2 => new String'("99.99"),
3 => new String'("$$$$9")
);
 
end FXF3A00;
/repbody.ada
0,0 → 1,329
-- REPBODY.ADA
--
-- 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.
--*
--
-- HISTORY:
-- DCB 04/27/80
-- JRK 6/10/80
-- JRK 11/12/80
-- JRK 8/6/81
-- JRK 10/27/82
-- JRK 6/1/84
-- JRK 11/18/85 ADDED PRAGMA ELABORATE.
-- PWB 07/29/87 ADDED STATUS ACTION_REQUIRED AND
-- PROCEDURE SPECIAL_ACTION.
-- TBN 08/20/87 ADDED FUNCTION LEGAL_FILE_NAME.
-- BCB 05/17/90 MODIFIED TO ALLOW OUTPUT TO DIRECT_IO FILE.
-- ADDED TIME-STAMP.
-- LDC 05/17/90 REMOVED OUTPUT TO DIRECT_IO FILE.
-- WMC 08/11/92 UPDATED ACVC VERSION STRING TO "9X BASIC".
-- DTN 07/05/92 UPDATED ACVC VERSION STRING TO
-- "ACVC 2.0 JULY 6 1993 DRAFT".
-- WMC 01/24/94 MODIFIED LEGAL_FILE_NAME TO ALLOW FIVE POSSIBLE
-- FILE NAMES (INCREASED RANGE OF TYPE FILE_NUM TO 1..5).
-- WMC 11/06/94 UPDATED ACVC VERSION STRING TO
-- "ACVC 2.0 NOVEMBER 6 1994 DRAFT".
-- DTN 12/04/94 UPDATED ACVC VERSION STRING TO
-- "ACVC 2.0".
-- KAS 06/19/95 ADDED FUNCTION IDENT_WIDE_CHAR.
-- KAS 06/19/95 ADDED FUNCTION IDENT_WIDE_STR.
-- DTN 11/21/95 UPDATED ACVC VERSION STRING TO
-- "ACVC 2.0.1".
-- DTN 12/14/95 UPDATED ACVC VERSION STRING TO
-- "ACVC 2.1".
-- EDS 12/17/97 UPDATED ACVC VERSION STRING TO
-- "2.2".
-- RLB 3/16/00 UPDATED ACATS VERSION STRING TO "2.3".
-- CHANGED VARIOUS STRINGS TO READ "ACATS".
-- RLB 3/22/01 UPDATED ACATS VERSION STRING TO "2.4".
-- RLB 3/29/01 UPDATED ACATS VERSION STRING TO "2.5".
 
WITH TEXT_IO, CALENDAR;
USE TEXT_IO, CALENDAR;
PRAGMA ELABORATE (TEXT_IO, CALENDAR);
 
PACKAGE BODY REPORT IS
 
TYPE STATUS IS (PASS, FAIL, DOES_NOT_APPLY, ACTION_REQUIRED,
UNKNOWN);
 
TYPE TIME_INTEGER IS RANGE 0 .. 86_400;
 
TEST_STATUS : STATUS := FAIL;
 
MAX_NAME_LEN : CONSTANT := 15; -- MAXIMUM TEST NAME LENGTH.
TEST_NAME : STRING (1..MAX_NAME_LEN);
 
NO_NAME : CONSTANT STRING (1..7) := "NO_NAME";
TEST_NAME_LEN : INTEGER RANGE 0..MAX_NAME_LEN := 0;
 
 
 
ACATS_VERSION : CONSTANT STRING := "2.5";
-- VERSION OF ACATS BEING RUN (X.XX).
 
PROCEDURE PUT_MSG (MSG : STRING) IS
-- WRITE MESSAGE. LONG MESSAGES ARE FOLDED (AND INDENTED).
MAX_LEN : CONSTANT INTEGER RANGE 50..150 := 72; -- MAXIMUM
-- OUTPUT LINE LENGTH.
INDENT : CONSTANT INTEGER := TEST_NAME_LEN + 9; -- AMOUNT TO
-- INDENT CONTINUATION LINES.
I : INTEGER := 0; -- CURRENT INDENTATION.
M : INTEGER := MSG'FIRST; -- START OF MESSAGE SLICE.
N : INTEGER; -- END OF MESSAGE SLICE.
BEGIN
LOOP
IF I + (MSG'LAST-M+1) > MAX_LEN THEN
N := M + (MAX_LEN-I) - 1;
IF MSG (N) /= ' ' THEN
WHILE N >= M AND THEN MSG (N+1) /= ' ' LOOP
N := N - 1;
END LOOP;
IF N < M THEN
N := M + (MAX_LEN-I) - 1;
END IF;
END IF;
ELSE N := MSG'LAST;
END IF;
SET_COL (STANDARD_OUTPUT, TEXT_IO.COUNT (I+1));
PUT_LINE (STANDARD_OUTPUT, MSG (M..N));
I := INDENT;
M := N + 1;
WHILE M <= MSG'LAST AND THEN MSG (M) = ' ' LOOP
M := M + 1;
END LOOP;
EXIT WHEN M > MSG'LAST;
END LOOP;
END PUT_MSG;
 
FUNCTION TIME_STAMP RETURN STRING IS
TIME_NOW : CALENDAR.TIME;
YEAR,
MONTH,
DAY,
HOUR,
MINUTE,
SECOND : TIME_INTEGER := 1;
 
FUNCTION CONVERT (NUMBER : TIME_INTEGER) RETURN STRING IS
STR : STRING (1..2) := (OTHERS => '0');
DEC_DIGIT : CONSTANT STRING := "0123456789";
NUM : TIME_INTEGER := NUMBER;
BEGIN
IF NUM = 0 THEN
RETURN STR;
ELSE
NUM := NUM MOD 100;
STR (2) := DEC_DIGIT (INTEGER (NUM MOD 10 + 1));
NUM := NUM / 10;
STR (1) := DEC_DIGIT (INTEGER (NUM + 1));
RETURN STR;
END IF;
END CONVERT;
BEGIN
TIME_NOW := CALENDAR.CLOCK;
SPLIT (TIME_NOW, YEAR_NUMBER (YEAR), MONTH_NUMBER (MONTH),
DAY_NUMBER (DAY), DAY_DURATION (SECOND));
HOUR := SECOND / 3600;
SECOND := SECOND MOD 3600;
MINUTE := SECOND / 60;
SECOND := SECOND MOD 60;
RETURN (CONVERT (TIME_INTEGER (YEAR)) & "-" &
CONVERT (TIME_INTEGER (MONTH)) & "-" &
CONVERT (TIME_INTEGER (DAY)) & " " &
CONVERT (TIME_INTEGER (HOUR)) & ":" &
CONVERT (TIME_INTEGER (MINUTE)) & ":" &
CONVERT (TIME_INTEGER (SECOND)));
END TIME_STAMP;
 
PROCEDURE TEST (NAME : STRING; DESCR : STRING) IS
BEGIN
TEST_STATUS := PASS;
IF NAME'LENGTH <= MAX_NAME_LEN THEN
TEST_NAME_LEN := NAME'LENGTH;
ELSE TEST_NAME_LEN := MAX_NAME_LEN;
END IF;
TEST_NAME (1..TEST_NAME_LEN) :=
NAME (NAME'FIRST .. NAME'FIRST+TEST_NAME_LEN-1);
 
PUT_MSG ("");
PUT_MSG (",.,. " & TEST_NAME (1..TEST_NAME_LEN) & " " &
"ACATS " & ACATS_VERSION & " " & TIME_STAMP);
PUT_MSG ("---- " & TEST_NAME (1..TEST_NAME_LEN) & " " &
DESCR & ".");
END TEST;
 
PROCEDURE COMMENT (DESCR : STRING) IS
BEGIN
PUT_MSG (" - " & TEST_NAME (1..TEST_NAME_LEN) & " " &
DESCR & ".");
END COMMENT;
 
PROCEDURE FAILED (DESCR : STRING) IS
BEGIN
TEST_STATUS := FAIL;
PUT_MSG (" * " & TEST_NAME (1..TEST_NAME_LEN) & " " &
DESCR & ".");
END FAILED;
 
PROCEDURE NOT_APPLICABLE (DESCR : STRING) IS
BEGIN
IF TEST_STATUS = PASS OR TEST_STATUS = ACTION_REQUIRED THEN
TEST_STATUS := DOES_NOT_APPLY;
END IF;
PUT_MSG (" + " & TEST_NAME (1..TEST_NAME_LEN) & " " &
DESCR & ".");
END NOT_APPLICABLE;
 
PROCEDURE SPECIAL_ACTION (DESCR : STRING) IS
BEGIN
IF TEST_STATUS = PASS THEN
TEST_STATUS := ACTION_REQUIRED;
END IF;
PUT_MSG (" ! " & TEST_NAME (1..TEST_NAME_LEN) & " " &
DESCR & ".");
END SPECIAL_ACTION;
 
PROCEDURE RESULT IS
BEGIN
CASE TEST_STATUS IS
WHEN PASS =>
PUT_MSG ("==== " & TEST_NAME (1..TEST_NAME_LEN) &
" PASSED ============================.");
WHEN DOES_NOT_APPLY =>
PUT_MSG ("++++ " & TEST_NAME (1..TEST_NAME_LEN) &
" NOT-APPLICABLE ++++++++++++++++++++.");
WHEN ACTION_REQUIRED =>
PUT_MSG ("!!!! " & TEST_NAME (1..TEST_NAME_LEN) &
" TENTATIVELY PASSED !!!!!!!!!!!!!!!!.");
PUT_MSG ("!!!! " & (1..TEST_NAME_LEN => ' ') &
" SEE '!' COMMENTS FOR SPECIAL NOTES!!");
WHEN OTHERS =>
PUT_MSG ("**** " & TEST_NAME (1..TEST_NAME_LEN) &
" FAILED ****************************.");
END CASE;
TEST_STATUS := FAIL;
TEST_NAME_LEN := NO_NAME'LENGTH;
TEST_NAME (1..TEST_NAME_LEN) := NO_NAME;
END RESULT;
 
FUNCTION IDENT_INT (X : INTEGER) RETURN INTEGER IS
BEGIN
IF EQUAL (X, X) THEN -- ALWAYS EQUAL.
RETURN X; -- ALWAYS EXECUTED.
END IF;
RETURN 0; -- NEVER EXECUTED.
END IDENT_INT;
 
FUNCTION IDENT_CHAR (X : CHARACTER) RETURN CHARACTER IS
BEGIN
IF EQUAL (CHARACTER'POS(X), CHARACTER'POS(X)) THEN -- ALWAYS
-- EQUAL.
RETURN X; -- ALWAYS EXECUTED.
END IF;
RETURN '0'; -- NEVER EXECUTED.
END IDENT_CHAR;
 
FUNCTION IDENT_WIDE_CHAR (X : WIDE_CHARACTER) RETURN WIDE_CHARACTER IS
BEGIN
IF EQUAL (WIDE_CHARACTER'POS(X), WIDE_CHARACTER'POS(X)) THEN
-- ALWAYS EQUAL.
RETURN X; -- ALWAYS EXECUTED.
END IF;
RETURN '0'; -- NEVER EXECUTED.
END IDENT_WIDE_CHAR;
 
FUNCTION IDENT_BOOL (X : BOOLEAN) RETURN BOOLEAN IS
BEGIN
IF EQUAL (BOOLEAN'POS(X), BOOLEAN'POS(X)) THEN -- ALWAYS
-- EQUAL.
RETURN X; -- ALWAYS EXECUTED.
END IF;
RETURN FALSE; -- NEVER EXECUTED.
END IDENT_BOOL;
 
FUNCTION IDENT_STR (X : STRING) RETURN STRING IS
BEGIN
IF EQUAL (X'LENGTH, X'LENGTH) THEN -- ALWAYS EQUAL.
RETURN X; -- ALWAYS EXECUTED.
END IF;
RETURN ""; -- NEVER EXECUTED.
END IDENT_STR;
 
FUNCTION IDENT_WIDE_STR (X : WIDE_STRING) RETURN WIDE_STRING IS
BEGIN
IF EQUAL (X'LENGTH, X'LENGTH) THEN -- ALWAYS EQUAL.
RETURN X; -- ALWAYS EXECUTED.
END IF;
RETURN ""; -- NEVER EXECUTED.
END IDENT_WIDE_STR;
 
FUNCTION EQUAL (X, Y : INTEGER) RETURN BOOLEAN IS
REC_LIMIT : CONSTANT INTEGER RANGE 1..100 := 3; -- RECURSION
-- LIMIT.
Z : BOOLEAN; -- RESULT.
BEGIN
IF X < 0 THEN
IF Y < 0 THEN
Z := EQUAL (-X, -Y);
ELSE Z := FALSE;
END IF;
ELSIF X > REC_LIMIT THEN
Z := EQUAL (REC_LIMIT, Y-X+REC_LIMIT);
ELSIF X > 0 THEN
Z := EQUAL (X-1, Y-1);
ELSE Z := Y = 0;
END IF;
RETURN Z;
EXCEPTION
WHEN OTHERS =>
RETURN X = Y;
END EQUAL;
 
FUNCTION LEGAL_FILE_NAME (X : FILE_NUM := 1;
NAM : STRING := "")
RETURN STRING IS
SUFFIX : STRING (2..6);
BEGIN
IF NAM = "" THEN
SUFFIX := TEST_NAME(3..7);
ELSE
SUFFIX := NAM(3..7);
END IF;
 
CASE X IS
WHEN 1 => RETURN ('X' & SUFFIX);
WHEN 2 => RETURN ('Y' & SUFFIX);
WHEN 3 => RETURN ('Z' & SUFFIX);
WHEN 4 => RETURN ('V' & SUFFIX);
WHEN 5 => RETURN ('W' & SUFFIX);
END CASE;
END LEGAL_FILE_NAME;
 
BEGIN
 
TEST_NAME_LEN := NO_NAME'LENGTH;
TEST_NAME (1..TEST_NAME_LEN) := NO_NAME;
 
END REPORT;
/fdb0a00.a
0,0 → 1,144
-- FDB0A00.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.
--*
--
-- FOUNDATION DESCRIPTION:
-- This foundation provides the basis for testing package
-- System.Storage_Pools. It provides simple implementations of
-- Allocate and Deallocate that have the side effect of calling
-- TCTouch.Touch when they are called.
--
-- CHANGE HISTORY:
-- 02 JUN 95 SAIC Initial version
-- 05 APR 96 SAIC Fixed header for 2.1
-- 02 JUL 98 EDS Swapped Pool.Avail change with overflow check
--!
 
---------------------------------------------------------------- FDB0A00
 
with Report;
with System.Storage_Pools;
with System.Storage_Elements;
package FDB0A00 is
 
type Stack_Heap( Water_Line: System.Storage_Elements.Storage_Count )
is new System.Storage_Pools.Root_Storage_Pool with private;
 
procedure Allocate(
Pool : in out Stack_Heap;
Storage_Address : out System.Address;
Size_In_Storage_Elements : in System.Storage_Elements.Storage_Count;
Alignment : in System.Storage_Elements.Storage_Count);
 
procedure Deallocate(
Pool : in out Stack_Heap;
Storage_Address : in System.Address;
Size_In_Storage_Elements : in System.Storage_Elements.Storage_Count;
Alignment : in System.Storage_Elements.Storage_Count);
 
function Storage_Size( Pool: in Stack_Heap )
return System.Storage_Elements.Storage_Count;
 
function TC_Largest_Request return System.Storage_Elements.Storage_Count;
 
Pool_Overflow : exception;
 
private
 
type Data_Array is array(System.Storage_Elements.Storage_Count range <>)
of System.Storage_Elements.Storage_Element;
 
type Stack_Heap( Water_Line: System.Storage_Elements.Storage_Count )
is new System.Storage_Pools.Root_Storage_Pool with record
Data : Data_Array(1..Water_Line);
Avail : System.Storage_Elements.Storage_Count := 1;
end record;
 
end FDB0A00;
 
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
 
with TCTouch;
package body FDB0A00 is
 
Largest_Request_On_Record : System.Storage_Elements.Storage_Count := 0;
 
procedure Allocate(
Pool : in out Stack_Heap;
Storage_Address : out System.Address;
Size_In_Storage_Elements : in System.Storage_Elements.Storage_Count;
Alignment : in System.Storage_Elements.Storage_Count) is
use type System.Storage_Elements.Storage_Offset;
begin
TCTouch.Touch('A'); --------------------------------------------------- A
 
-- set the pointer to the next correctly aligned available address
Pool.Avail := Pool.Avail
+ (Alignment - (Pool.Data(Pool.Avail)'Address mod Alignment));
 
-- check for overflow
if Pool.Avail + Size_In_Storage_Elements > Pool.Water_Line then
raise Pool_Overflow;
end if;
 
-- set the resulting address to that address
Storage_Address := Pool.Data(Pool.Avail)'Address;
 
-- update the housekeeping
Pool.Avail := Pool.Avail + Size_In_Storage_Elements;
Largest_Request_On_Record
:= System.Storage_Elements.Storage_Count'Max(Largest_Request_On_Record,
Size_In_Storage_Elements);
exception
when Constraint_Error => raise Pool_Overflow; -- in case I missed an edge
end Allocate;
 
procedure Deallocate(
Pool : in out Stack_Heap;
Storage_Address : in System.Address;
Size_In_Storage_Elements : in System.Storage_Elements.Storage_Count;
Alignment : in System.Storage_Elements.Storage_Count) is
begin
TCTouch.Touch('D'); --------------------------------------------------- D
 
-- for the purposes of validation, the simplest possible implementation
-- of Deallocate is shown below:
 
null;
 
end Deallocate;
 
function Storage_Size( Pool: in Stack_Heap )
return System.Storage_Elements.Storage_Count is
begin
TCTouch.Touch('S'); --------------------------------------------------- S
return Pool.Water_Line;
end Storage_Size;
 
function TC_Largest_Request return System.Storage_Elements.Storage_Count is
begin
return Largest_Request_On_Record;
end TC_Largest_Request;
 
end FDB0A00;
/tctouch.ada
0,0 → 1,264
-- TCTouch.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.
--*
--
-- FOUNDATION DESCRIPTION:
-- The tools in this foundation are not peculiar to any particular
-- aspect of the language, but simplify the test writing and reading
-- process. Assert and Assert_Not are used to reduce the textual
-- overhead of the test-that-this-condition-is-(not)-true paradigm.
-- Touch and Validate are used to simplify tracing an expected path
-- of execution.
-- A tag comment of the form:
--
-- TCTouch.Touch( 'A' ); ----------------------------------------- A
--
-- is recommended to improve readability of this feature.
--
-- Report.Test must be called before any of the procedures in this
-- package with the exception of Touch.
-- The usage paradigm is to call Touch in locations in the test where you
-- want a trace of execution. Each call to Touch should have a unique
-- character associated with it. At each place where a check can
-- reasonably be performed to determine correct execution of a
-- sub-test, a call to Validate should be made. The first parameter
-- passed to Validate is the expected string of characters produced by
-- call(s) to Touch in the subtest just executed. The second parameter
-- is the message to pass to Report.Failed if the expected sequence was
-- not executed.
--
-- Validate should always be called after calls to Touch before a test
-- completes.
--
-- In the event that calls may have been made to Touch that are not
-- intended to be recorded, or, the failure of a previous subtest may
-- leave Touch calls "Unvalidated", the procedure Flush will reset the
-- tracker to the "empty" state. Flush does not make any calls to
-- Report.
--
-- Calls to Assert and Assert_Not are to replace the idiom:
--
-- if BadCondition then -- or if not PositiveTest then
-- Report.Failed(Message);
-- end if;
--
-- with:
--
-- Assert_Not( BadCondition, Message ); -- or
-- Assert( PositiveTest, Message );
--
-- Implementation_Check is for use with tests that cross the boundary
-- between the core and the Special Needs Annexes. There are several
-- instances where language in the core becomes enforceable only when
-- a Special Needs Annex is supported. Implementation_Check should be
-- called in place of Report.Failed in these cases; it examines the
-- constants in Impdef that indicate if the particular Special Needs
-- Annex is being validated with this validation; and acts accordingly.
--
-- The constant Foundation_ID contains the internal change version
-- for this software.
--
-- ERROR CONDITIONS:
--
-- It is an error to perform more than Max_Touch_Count (80) calls to
-- Touch without a subsequent call to Validate. To do so will cause
-- a false test failure.
--
-- CHANGE HISTORY:
-- 02 JUN 94 SAIC Initial version
-- 27 OCT 94 SAIC Revised version
-- 07 AUG 95 SAIC Added Implementation_Check
-- 07 FEB 96 SAIC Changed to match new Impdef for 2.1
-- 16 MAR 00 RLB Changed foundation id to reflect test suite version.
-- 22 MAR 01 RLB Changed foundation id to reflect test suite version.
-- 29 MAR 02 RLB Changed foundation id to reflect test suite version.
--
--!
 
package TCTouch is
Foundation_ID : constant String := "TCTouch ACATS 2.5";
Max_Touch_Count : constant := 80;
 
procedure Assert ( SB_True : Boolean; Message : String );
procedure Assert_Not( SB_False : Boolean; Message : String );
 
procedure Touch ( A_Tag : Character );
procedure Validate( Expected: String;
Message : String;
Order_Meaningful : Boolean := True );
 
procedure Flush;
 
type Special_Needs_Annexes is ( Annex_C, Annex_D, Annex_E,
Annex_F, Annex_G, Annex_H );
 
procedure Implementation_Check( Message : in String;
Annex : in Special_Needs_Annexes
:= Annex_C );
-- If Impdef.Validating_Annex_<Annex> is true, will call Report.Failed
-- otherwise will call Report.Not_Applicable. This is to allow tests
-- which are driven by wording in the core of the language, yet have
-- their functionality dictated by the Special Needs Annexes to perform
-- dual purpose.
-- The default of Annex_C for the Annex parameter is to support early
-- tests written with the assumption that Implementation_Check was
-- expressly for use with the Systems Programming Annex.
 
end TCTouch;
 
with Report;
with Impdef;
package body TCTouch is
 
procedure Assert( SB_True : Boolean; Message : String ) is
begin
if not SB_True then
Report.Failed( "Assertion failed: " & Message );
end if;
end Assert;
 
procedure Assert_Not( SB_False : Boolean; Message : String ) is
begin
if SB_False then
Report.Failed( "Assertion failed: " & Message );
end if;
end Assert_Not;
 
Collection : String(1..Max_Touch_Count);
Finger : Natural := 0;
 
procedure Touch ( A_Tag : Character ) is
begin
Finger := Finger+1;
Collection(Finger) := A_Tag;
exception
when Constraint_Error =>
Report.Failed("Trace Overflow: " & Collection);
Finger := 0;
end Touch;
 
procedure Sort_String( S: in out String ) is
-- algorithm from Booch Components Page 472
No_Swaps : Boolean;
procedure Swap(C1, C2: in out Character) is
T: Character := C1;
begin C1 := C2; C2 := T; end Swap;
begin
for OI in S'First+1..S'Last loop
No_Swaps := True;
for II in reverse OI..S'Last loop
if S(II) < S(II-1) then
Swap(S(II),S(II-1));
No_Swaps := False;
end if;
end loop;
exit when No_Swaps;
end loop;
end Sort_String;
 
procedure Validate( Expected: String;
Message : String;
Order_Meaningful : Boolean := True) is
Want : String(1..Expected'Length) := Expected;
begin
if not Order_Meaningful then
Sort_String( Want );
Sort_String( Collection(1..Finger) );
end if;
if Collection(1..Finger) /= Want then
Report.Failed( Message & " Expecting: " & Want
& " Got: " & Collection(1..Finger) );
end if;
Finger := 0;
end Validate;
 
procedure Flush is
begin
Finger := 0;
end Flush;
 
procedure Implementation_Check( Message : in String;
Annex : in Special_Needs_Annexes
:= Annex_C ) is
-- default to cover some legacy
-- USAGE DISCIPLINE:
-- Implementation_Check is designed to be used in tests that have
-- interdependency on one of the Special Needs Annexes, yet are _really_
-- tests based in the core language. There will be instances where the
-- execution of a test would be failing in the light of the requirements
-- of the annex, yet from the point of view of the core language without
-- the additional requirements of the annex, the test does not apply.
-- In these cases, rather than issuing a call to Report.Failed, calling
-- TCTouch.Implementation_Check will check that sensitivity, and if
-- the implementation is attempting to validate against the specific
-- annex, Report.Failed will be called, otherwise, Report.Not_Applicable
-- will be called.
begin
 
case Annex is
when Annex_C =>
if ImpDef.Validating_Annex_C then
Report.Failed( Message );
else
Report.Not_Applicable( Message & " Annex C not supported" );
end if;
 
when Annex_D =>
if ImpDef.Validating_Annex_D then
Report.Failed( Message );
else
Report.Not_Applicable( Message & " Annex D not supported" );
end if;
 
when Annex_E =>
if ImpDef.Validating_Annex_E then
Report.Failed( Message );
else
Report.Not_Applicable( Message & " Annex E not supported" );
end if;
 
when Annex_F =>
if ImpDef.Validating_Annex_F then
Report.Failed( Message );
else
Report.Not_Applicable( Message & " Annex F not supported" );
end if;
 
when Annex_G =>
if ImpDef.Validating_Annex_G then
Report.Failed( Message );
else
Report.Not_Applicable( Message & " Annex G not supported" );
end if;
 
when Annex_H =>
if ImpDef.Validating_Annex_H then
Report.Failed( Message );
else
Report.Not_Applicable( Message & " Annex H not supported" );
end if;
end case;
end Implementation_Check;
 
end TCTouch;
/f390a00.a
0,0 → 1,94
-- F390A00.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.
--*
--
-- FOUNDATION DESCRIPTION:
-- This file declares the root type and primitive subprograms of an
-- alert system abstraction, to be used for tests covering tagged
-- types and type extensions.
--
-- CHANGE HISTORY:
-- 06 Dec 94 SAIC ACVC 2.0
-- 04 Jun 96 SAIC ACVC 2.1: Added pragma Elaborate for Ada.Calendar.
--
--!
 
with Ada.Calendar;
pragma Elaborate (Ada.Calendar);
 
package F390A00 is -- Alert system abstraction.
 
 
-- Declarations used by component Display_On and procedure Display.
 
type Device_Enum is (Null_Device, Teletype, Console, Big_Screen);
type Display_Counters is array (Device_Enum) of Natural;
 
Display_Count_For : Display_Counters := (others => 0);
 
 
-- Declarations used by component Arrival_Time.
 
Default_Time : constant Ada.Calendar.Time :=
Ada.Calendar.Time_Of (1901, 1, 1);
Alert_Time : constant Ada.Calendar.Time :=
Ada.Calendar.Time_Of (1991, 6, 15);
 
 
 
type Alert_Type is tagged record -- Root tagged type.
Arrival_Time : Ada.Calendar.Time := Default_Time;
Display_On : Device_Enum := Null_Device;
end record;
 
 
procedure Display (A : in Alert_Type); -- To be inherited by
-- all derivatives.
 
procedure Handle (A : in out Alert_Type); -- To be overridden by
-- all derivatives.
 
end F390A00;
 
 
--==================================================================--
 
 
package body F390A00 is -- Alert system abstraction.
 
 
procedure Display (A : in Alert_Type) is
begin
Display_Count_For (A.Display_On) := Display_Count_For (A.Display_On) + 1;
end Display;
 
 
procedure Handle (A : in out Alert_Type) is
begin
A.Arrival_Time := Alert_Time;
Display (A);
end Handle;
 
 
end F390A00;
/f940a00.a
0,0 → 1,97
-- F940A00.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.
--*
--
-- FOUNDATION DESCRIPTION:
-- This foundation contains test control code for tests covering
-- the protected record.
--
-- CHANGE HISTORY:
-- 06 Dec 94 SAIC ACVC 2.0
--
--!
 
package F940A00 is
-- Interlock_Foundation
protected type Interlock_Type is
entry Post;
entry Consume;
private
Int_Count : Integer := 0;
end Interlock_Type;
 
protected Counter is -- used to count the number of
procedure Increment; -- resources that have been granted
procedure Decrement; -- to tasks
function Number return integer;
private
Count : Integer := 0;
end Counter;
 
end F940A00;
-- Interlock_Foundation
 
--===================================--
 
package body F940A00 is
-- Interlock_Foundation
 
protected body Interlock_Type is
 
entry Post when true is
begin
Int_Count := Int_Count + 1;
end Post;
 
entry Consume when Int_Count > 0 is
begin
Int_Count := Int_Count - 1;
end Consume;
 
end Interlock_Type;
 
 
protected body Counter is
 
procedure Increment is
begin
Count := Count + 1;
end Increment;
 
procedure Decrement is
begin
Count := Count - 1;
end Decrement;
 
function Number return Integer is
begin
return Count;
end Number;
 
end Counter;
 
end F940A00;
-- Interlock_Foundation
/fa11a00.a
0,0 → 1,73
-- FA11A00.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.
--*
--
-- FOUNDATION DESCRIPTION:
-- This foundation declares a tagged type and primitive subprograms in
-- a parent package.
--
-- CHANGE HISTORY:
-- 06 Dec 94 SAIC ACVC 2.0
--
--!
 
package FA11A00 is -- Widget_Pkg
-- This package represents processing of widgets in a window system. It
-- contains a tagged type that can be extended by its children.
 
type Widget_Length is range 1 .. 100;
 
type Widget is tagged -- Parent tagged type
record
Width, Height : Widget_Length;
-- More components to be added by extension
end record;
 
-- To be inherited by its children derivatives.
procedure Set_Width (The_Widget : in out Widget;
W : in Widget_Length);
-- To be inherited by its children derivatives.
procedure Set_Height (The_Widget : in out Widget;
H : in Widget_Length);
 
end FA11A00; -- Widget_Pkg
 
--=======================================================================--
 
package body FA11A00 is -- Widget_Pkg
 
procedure Set_Width (The_Widget : in out Widget;
W : in Widget_Length) is
begin
The_Widget.Width := W;
end Set_Width;
-------------------------------------------------------
procedure Set_Height (The_Widget : in out Widget;
H : in Widget_Length) is
begin
The_Widget.Height := H;
end Set_Height;
 
end FA11A00; -- Widget_Pkg
/spprt13s.tst
0,0 → 1,67
-- SPPRT13SP.TST
--
-- 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.
--*
--
-- SPECIFICATION FOR PACKAGE SPPRT13
 
-- PURPOSE:
-- THIS PACKAGE CONTAINS CONSTANTS OF TYPE SYSTEM.ADDRESS.
-- THESE CONSTANTS ARE USED BY SELECTED CHAPTER 13 TESTS,
-- BY PARTS OF THE AVAT SYSTEM, AND BY ISOLATED TESTS FOR
-- OTHER CHAPTERS.
 
-- MACRO SUBSTITUTIONS:
-- $VARIABLE_ADDRESS, $VARIABLE_ADDRESS1, AND $VARIABLE_ADDRESS2 ARE
-- EXPRESSIONS YIELDING LEGAL ADDRESSES FOR VARIABLES FOR THIS
-- IMPLEMENTATION.
 
-- $ENTRY_ADDRESS, $ENTRY_ADDRESS1, AND $ENTRY_ADDRESS2 ARE
-- EXPRESSIONS YIELDING LEGAL ADDRESSES FOR TASK ENTRIES
-- (I.E., FOR INTERRUPTS) FOR THIS IMPLEMENTATION.
 
-- IF NO EXPRESSIONS CAN BE GIVEN THAT ARE SATISFACTORY FOR THE
-- VALUES OF THESE CONSTANTS, THEN DECLARE SUITABLE FUNCTIONS
-- IN THE SPECIFICATION OF PACKAGE FCNDECL, CREATE A PACKAGE BODY
-- CONTAINING BODIES FOR THE FUNCTIONS, AND REPLACE THE MACROS WITH
-- APPROPRIATE FUNCTION CALLS.
 
WITH FCNDECL; USE FCNDECL;
WITH SYSTEM;
PACKAGE SPPRT13 IS
 
VARIABLE_ADDRESS : CONSTANT SYSTEM.ADDRESS :=
$VARIABLE_ADDRESS;
VARIABLE_ADDRESS1 : CONSTANT SYSTEM.ADDRESS :=
$VARIABLE_ADDRESS1;
VARIABLE_ADDRESS2 : CONSTANT SYSTEM.ADDRESS :=
$VARIABLE_ADDRESS2;
 
ENTRY_ADDRESS : CONSTANT SYSTEM.ADDRESS :=
$ENTRY_ADDRESS;
ENTRY_ADDRESS1 : CONSTANT SYSTEM.ADDRESS :=
$ENTRY_ADDRESS1;
ENTRY_ADDRESS2 : CONSTANT SYSTEM.ADDRESS :=
$ENTRY_ADDRESS2;
 
END SPPRT13;
/fb20a00.a
0,0 → 1,101
-- FB20A00.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.
--*
--
-- FOUNDATION DESCRIPTION:
-- This test performs a search for the first instance of a specified
-- substring within a specified string, returning boolean result.
-- (Case insensitive analysis) Both the string and the substring are
-- made upper case. Successive slices are taken from the input string
-- and compared with the substring. If a match is found, the search is
-- terminated immediately. The search continues until the last index
-- position from which a substring-length slice can be constructed is
-- passed.
--
-- CHANGE HISTORY:
-- 06 Dec 94 SAIC ACVC 2.0
--
--!
 
package FB20A00 is
 
function Find ( Str : in String ;
Sub : in String ) return Boolean;
 
end FB20A00;
 
--=================================================================--
 
package body FB20A00 is
function Find ( Str : in String ;
Sub : in String ) return Boolean is
 
New_Str : String (Str'First .. Str'Last);
New_Sub : String (Sub'First .. Sub'Last);
 
Pos : Integer := Str'First ; -- Character index.
 
function Upper_Case (Str : in String) return String is
subtype Upper is Character range 'A' .. 'Z' ;
subtype Lower is Character range 'a' .. 'z' ;
Ret : String (Str'First .. Str'Last) ;
Pos : Integer;
begin
for I in Str'Range loop
if ( Str (I) in Lower ) then
Pos := Upper'Pos (Upper'First) +
( Lower'Pos (Str(I)) - Lower'Pos(Lower'First) ) ;
Ret (I) := Upper'Val (Pos) ;
else
Ret (I) := Str (I);
end if ;
end loop ;
return (Ret) ;
end Upper_Case;
 
begin
 
New_Str := Upper_Case (Str); -- Convert Str and Sub to upper
New_Sub := Upper_Case (Sub); -- case for comparison.
 
while ( Pos <= New_Str'Last-New_Sub'Length+1 ) -- Search until no more
and then -- sub-string-length
( New_Str ( Pos .. Pos+New_Sub'Length-1 ) /= New_Sub ) -- slices
-- remain.
loop
Pos := Pos + 1 ;
end loop ;
 
if ( Pos > New_Str'Last-New_Sub'Length+1 ) then -- Substring not found.
return (False);
else
return (True);
end if ;
 
end Find;
 
end FB20A00;
/fa11b00.a
0,0 → 1,110
-- FA11B00.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.
--*
--
-- FOUNDATION DESCRIPTION:
-- This foundation declares parent types and operations that can
-- be inherited by its children.
--
-- CHANGE HISTORY:
-- 06 Dec 94 SAIC ACVC 2.0
--
--!
 
package FA11B00 is -- Application_One_Widget
-- This foundation simulates code that might be obtained as an already
-- implemented set of objects and services, perhaps from a source code
-- vendor. It represents processing of widgets in a window system.
-- These widgets all have the same characteristics, but they are application
-- specific, so we do not allow assignment of an App_1_Widget to App_2_Widget.
 
-- The dimension measurement is in pixels (dots on the screen).
type Pixels is range 0 .. 10_000;
type Widget_Id is new Integer;
type Widget_Color_Enum is (Amber, Green, White, None);
subtype Widget_Label_Str is string (1 .. 15);
 
type Widget_Location is
record
X_Location, Y_Location : Pixels;
end record;
 
type Widget_Size is
record
X_Length, Y_Length : Pixels;
end record;
 
-- NOTE : not a tagged record.
type App1_Widget (Maximum_Size : Pixels := Pixels'Last)
is record -- Parent type
Size : Widget_Size := (Maximum_Size, Maximum_Size);
ID : Widget_Id := 1;
Location : Widget_Location := (0,0);
Color : Widget_Color_Enum := None;
Label : Widget_Label_Str := " ";
end record;
 
-- Primitive operation of type Widget.
-- To be inherited by its children derivatives.
procedure App1_Widget_Specific_Oper (The_Widget : in out App1_Widget;
I : in Widget_Id;
C : in Widget_Color_Enum;
L : in Widget_Label_Str);
end FA11B00; -- Application_One_Widget
 
--=======================================================================--
 
package body FA11B00 is -- Application_One_Widget
 
procedure Set_Color (The_Widget : in out App1_Widget;
C : in Widget_Color_Enum) is
begin
The_Widget.Color := C;
end Set_Color;
-------------------------------------------------------------
procedure Set_Label (The_Widget : in out App1_Widget;
L : in Widget_Label_Str) is
begin
The_Widget.Label := L;
end Set_Label;
-------------------------------------------------------------
procedure Set_Id (The_Widget : in out App1_Widget;
I : in Widget_Id) is
begin
The_Widget.Id := I;
end Set_Id;
-------------------------------------------------------------
procedure App1_Widget_Specific_Oper
(The_Widget : in out App1_Widget;
I : in Widget_Id;
C : in Widget_Color_Enum;
L : in Widget_Label_Str) is
begin
Set_Color (The_Widget, C);
Set_Label (The_Widget, L);
Set_Id (The_Widget, I);
end App1_Widget_Specific_Oper;
 
end FA11B00; -- Application_One_Widget
/fa11c00.a
0,0 → 1,112
-- FA11C00.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.
--*
--
-- FOUNDATION DESCRIPTION:
-- This foundation declares parent types and operations that can
-- be inherited by its children.
--
-- CHANGE HISTORY:
-- 06 Dec 94 SAIC ACVC 2.0
--
--!
 
package FA11C00_0 is -- Package Animal
 
type Kilogram_Weight_Type is new Natural;
subtype Species_Name_Type is String (1 .. 20);
 
type Animal is tagged
record
Common_Name : Species_Name_Type;
Weight : Kilogram_Weight_Type;
end record;
 
function Image (A : Animal) return String;
 
end FA11C00_0; -- Package Animal
 
--=================================================================--
 
package body FA11C00_0 is -- Package body Animal
 
function Image (A : Animal) return String is
begin
return ("Animal Species: " & A.Common_Name);
end Image;
 
end FA11C00_0; -- Package body Animal
 
--=================================================================--
 
package FA11C00_0.FA11C00_1 is -- Package Animal.Mammal
 
type Hair_Color_Type is (Black, Brown, Blonde, Grey, White, Red);
 
type Mammal is new Animal with
record
Hair_Color : Hair_Color_Type;
end record;
 
function Image (M : Mammal) return String;
 
end FA11C00_0.FA11C00_1; -- Package Animal.Mammal
 
--=================================================================--
 
package body FA11C00_0.FA11C00_1 is -- Package body Animal.Mammal
 
function Image (M : Mammal) return String is
begin
return ("Mammal Species: " & M.Common_Name);
end Image;
 
end FA11C00_0.FA11C00_1; -- Package body Animal.Mammal
 
--=================================================================--
 
package FA11C00_0.FA11C00_1.FA11C00_2 is -- Package Animal.Mammal.Primate
 
type Habitat_Type is (Arboreal, Terrestrial);
 
type Primate is new Mammal with
record
Habitat : Habitat_Type;
end record;
 
function Image (P : Primate) return String;
 
end FA11C00_0.FA11C00_1.FA11C00_2; -- Package Animal.Mammal.Primate
 
--=================================================================--
 
-- Package body Animal.Mammal.Primate
package body FA11C00_0.FA11C00_1.FA11C00_2 is
 
function Image (P : Primate) return String is
begin
return ("Primate Species: " & P.Common_Name);
end Image;
 
end FA11C00_0.FA11C00_1.FA11C00_2; -- Package body Animal.Mammal.Primate
/fa11d00.a
0,0 → 1,78
-- FA11D00.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.
--*
--
-- FOUNDATION DESCRIPTION:
-- This foundation declares parent types and operations that can
-- be inherited by its children.
--
-- CHANGE HISTORY:
-- 06 Dec 94 SAIC ACVC 2.0
-- 21 Dec 94 SAIC Modified type Int_Type
--
--!
 
package FA11D00 is -- Complex_Definition_Pkg
 
-- Simulate a complex number support package. Complex numbers
-- are treated as coordinates in the Cartesian plane.
 
type Int_Type is range -200 .. 100;
 
type Complex_Type is record
Real : Int_Type;
Imag : Int_Type;
end record;
 
Zero : constant Complex_Type := (Real => 0, Imag => 0);
One : constant Complex_Type := (Real => 1, Imag => 0);
Check_Value : constant Complex_Type := (Real => 17, Imag => 23);
 
Add_Error : exception;
Subtract_Error : exception;
Divide_Error : exception;
Multiply_Error : exception;
 
TC_Handled_In_Caller,
TC_Handled_In_Child_Pkg_Proc,
TC_Handled_In_Child_Pkg_Func,
TC_Handled_In_Grandchild_Pkg_Proc,
TC_Handled_In_Grandchild_Pkg_Func,
TC_Handled_In_Child_Sub,
TC_Propagated_To_Caller : boolean := False;
 
function Complex (Real, Imag : Int_Type)
return Complex_Type;
 
end FA11D00; -- Complex_Definition_Pkg
 
--=======================================================================--
 
package body FA11D00 is -- Complex_Definition_Pkg
function Complex (Real, Imag : Int_Type) return Complex_Type is
begin
return (Real, Imag);
end Complex;
 
end FA11D00; -- Complex_Definition_Pkg
/fb40a00.a
0,0 → 1,81
-- FB40A00.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.
--*
--
-- FOUNDATION DESCRIPTION:
-- This foundation package contains global variables, types, a user
-- defined exception, and two subprograms used to increment the
-- global variables.
-- See prologues of specific tests for specific information.
--
-- CHANGE HISTORY:
-- 06 Dec 94 SAIC ACVC 2.0
--
--!
 
 
package FB40A00 is -- package Text_Parser
 
-- Global Variables
 
AlphaNumeric_Count,
Non_AlphaNumeric_Count : Natural := 0;
 
 
-- Types
 
type String_Pointer_Type is access String;
 
 
-- Exceptions
 
Completed_Text_Processing : exception;
 
-- Subprograms
 
procedure Increment_AlphaNumeric_Count;
procedure Increment_Non_AlphaNumeric_Count;
 
end FB40A00;
 
 
--=================================================================--
 
 
package body FB40A00 is
 
 
procedure Increment_AlphaNumeric_Count is
begin
AlphaNumeric_Count := AlphaNumeric_Count + 1;
end Increment_AlphaNumeric_Count;
 
 
procedure Increment_Non_AlphaNumeric_Count is
begin
Non_AlphaNumeric_Count := Non_AlphaNumeric_Count + 1;
end Increment_Non_AlphaNumeric_Count;
 
 
end FB40A00;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.