-- CC3019A.ADA
|
-- CC3019A.ADA
|
|
|
-- Grant of Unlimited Rights
|
-- Grant of Unlimited Rights
|
--
|
--
|
-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
|
-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
|
-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
|
-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
|
-- unlimited rights in the software and documentation contained herein.
|
-- unlimited rights in the software and documentation contained herein.
|
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
|
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
|
-- this public release, the Government intends to confer upon all
|
-- this public release, the Government intends to confer upon all
|
-- recipients unlimited rights equal to those held by the Government.
|
-- recipients unlimited rights equal to those held by the Government.
|
-- These rights include rights to use, duplicate, release or disclose the
|
-- These rights include rights to use, duplicate, release or disclose the
|
-- released technical data and computer software in whole or in part, in
|
-- released technical data and computer software in whole or in part, in
|
-- any manner and for any purpose whatsoever, and to have or permit others
|
-- any manner and for any purpose whatsoever, and to have or permit others
|
-- to do so.
|
-- to do so.
|
--
|
--
|
-- DISCLAIMER
|
-- DISCLAIMER
|
--
|
--
|
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
|
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
|
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
|
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
|
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
|
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
|
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
|
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
|
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
|
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
|
-- PARTICULAR PURPOSE OF SAID MATERIAL.
|
-- PARTICULAR PURPOSE OF SAID MATERIAL.
|
--*
|
--*
|
-- CHECK THAT INSTANTIATIONS OF NESTED GENERIC UNITS ARE PROCESSED
|
-- CHECK THAT INSTANTIATIONS OF NESTED GENERIC UNITS ARE PROCESSED
|
-- CORRECTLY.
|
-- CORRECTLY.
|
|
|
-- JBG 11/6/85
|
-- JBG 11/6/85
|
|
|
GENERIC
|
GENERIC
|
TYPE ELEMENT_TYPE IS PRIVATE;
|
TYPE ELEMENT_TYPE IS PRIVATE;
|
PACKAGE CC3019A_QUEUES IS
|
PACKAGE CC3019A_QUEUES IS
|
|
|
TYPE QUEUE_TYPE IS PRIVATE;
|
TYPE QUEUE_TYPE IS PRIVATE;
|
|
|
PROCEDURE ADD (TO_Q : IN OUT QUEUE_TYPE;
|
PROCEDURE ADD (TO_Q : IN OUT QUEUE_TYPE;
|
VALUE : ELEMENT_TYPE);
|
VALUE : ELEMENT_TYPE);
|
|
|
GENERIC
|
GENERIC
|
WITH PROCEDURE APPLY (VAL : ELEMENT_TYPE);
|
WITH PROCEDURE APPLY (VAL : ELEMENT_TYPE);
|
PROCEDURE ITERATOR (TO_Q : QUEUE_TYPE);
|
PROCEDURE ITERATOR (TO_Q : QUEUE_TYPE);
|
|
|
PRIVATE
|
PRIVATE
|
|
|
TYPE CONTENTS_TYPE IS ARRAY (1..3) OF ELEMENT_TYPE;
|
TYPE CONTENTS_TYPE IS ARRAY (1..3) OF ELEMENT_TYPE;
|
TYPE QUEUE_TYPE IS
|
TYPE QUEUE_TYPE IS
|
RECORD
|
RECORD
|
CONTENTS : CONTENTS_TYPE;
|
CONTENTS : CONTENTS_TYPE;
|
SIZE : NATURAL := 0;
|
SIZE : NATURAL := 0;
|
END RECORD;
|
END RECORD;
|
|
|
END CC3019A_QUEUES;
|
END CC3019A_QUEUES;
|
|
|
PACKAGE BODY CC3019A_QUEUES IS
|
PACKAGE BODY CC3019A_QUEUES IS
|
|
|
PROCEDURE ADD (TO_Q : IN OUT QUEUE_TYPE;
|
PROCEDURE ADD (TO_Q : IN OUT QUEUE_TYPE;
|
VALUE : ELEMENT_TYPE) IS
|
VALUE : ELEMENT_TYPE) IS
|
BEGIN
|
BEGIN
|
TO_Q.SIZE := TO_Q.SIZE + 1;
|
TO_Q.SIZE := TO_Q.SIZE + 1;
|
TO_Q.CONTENTS(TO_Q.SIZE) := VALUE;
|
TO_Q.CONTENTS(TO_Q.SIZE) := VALUE;
|
END ADD;
|
END ADD;
|
|
|
-- GENERIC
|
-- GENERIC
|
-- WITH PROCEDURE APPLY (VAL : ELEMENT_TYPE);
|
-- WITH PROCEDURE APPLY (VAL : ELEMENT_TYPE);
|
PROCEDURE ITERATOR (TO_Q : QUEUE_TYPE) IS
|
PROCEDURE ITERATOR (TO_Q : QUEUE_TYPE) IS
|
BEGIN
|
BEGIN
|
FOR I IN TO_Q.CONTENTS'FIRST .. TO_Q.SIZE LOOP
|
FOR I IN TO_Q.CONTENTS'FIRST .. TO_Q.SIZE LOOP
|
APPLY (TO_Q.CONTENTS(I));
|
APPLY (TO_Q.CONTENTS(I));
|
END LOOP;
|
END LOOP;
|
END ITERATOR;
|
END ITERATOR;
|
|
|
END CC3019A_QUEUES;
|
END CC3019A_QUEUES;
|
|
|
WITH REPORT; USE REPORT;
|
WITH REPORT; USE REPORT;
|
WITH CC3019A_QUEUES;
|
WITH CC3019A_QUEUES;
|
PROCEDURE CC3019A IS
|
PROCEDURE CC3019A IS
|
|
|
SUBTYPE STR6 IS STRING (1..6);
|
SUBTYPE STR6 IS STRING (1..6);
|
|
|
TYPE STR6_ARR IS ARRAY (1..3) OF STR6;
|
TYPE STR6_ARR IS ARRAY (1..3) OF STR6;
|
STR6_VALS : STR6_ARR := ("111111", "222222",
|
STR6_VALS : STR6_ARR := ("111111", "222222",
|
IDENT_STR("333333"));
|
IDENT_STR("333333"));
|
CUR_STR_INDEX : NATURAL := 1;
|
CUR_STR_INDEX : NATURAL := 1;
|
|
|
TYPE INT_ARR IS ARRAY (1..3) OF INTEGER;
|
TYPE INT_ARR IS ARRAY (1..3) OF INTEGER;
|
INT_VALS : INT_ARR := (-1, 3, IDENT_INT(3));
|
INT_VALS : INT_ARR := (-1, 3, IDENT_INT(3));
|
CUR_INT_INDEX : NATURAL := 1;
|
CUR_INT_INDEX : NATURAL := 1;
|
|
|
-- THIS PROCEDURE IS CALLED ONCE FOR EACH ELEMENT OF THE QUEUE
|
-- THIS PROCEDURE IS CALLED ONCE FOR EACH ELEMENT OF THE QUEUE
|
--
|
--
|
PROCEDURE CHECK_STR (VAL : STR6) IS
|
PROCEDURE CHECK_STR (VAL : STR6) IS
|
BEGIN
|
BEGIN
|
IF VAL /= STR6_VALS(CUR_STR_INDEX) THEN
|
IF VAL /= STR6_VALS(CUR_STR_INDEX) THEN
|
FAILED ("STR6 ITERATOR FOR INDEX =" &
|
FAILED ("STR6 ITERATOR FOR INDEX =" &
|
INTEGER'IMAGE(CUR_STR_INDEX) & " WITH VALUE " &
|
INTEGER'IMAGE(CUR_STR_INDEX) & " WITH VALUE " &
|
"""" & VAL & """");
|
"""" & VAL & """");
|
END IF;
|
END IF;
|
CUR_STR_INDEX := CUR_STR_INDEX + 1;
|
CUR_STR_INDEX := CUR_STR_INDEX + 1;
|
EXCEPTION
|
EXCEPTION
|
WHEN CONSTRAINT_ERROR =>
|
WHEN CONSTRAINT_ERROR =>
|
FAILED ("STR6 - CONSTRAINT_ERROR RAISED");
|
FAILED ("STR6 - CONSTRAINT_ERROR RAISED");
|
WHEN OTHERS =>
|
WHEN OTHERS =>
|
FAILED ("STR6 - UNEXPECTED EXCEPTION");
|
FAILED ("STR6 - UNEXPECTED EXCEPTION");
|
END CHECK_STR;
|
END CHECK_STR;
|
|
|
PROCEDURE CHECK_INT (VAL : INTEGER) IS
|
PROCEDURE CHECK_INT (VAL : INTEGER) IS
|
BEGIN
|
BEGIN
|
IF VAL /= INT_VALS(CUR_INT_INDEX) THEN
|
IF VAL /= INT_VALS(CUR_INT_INDEX) THEN
|
FAILED ("INTEGER ITERATOR FOR INDEX =" &
|
FAILED ("INTEGER ITERATOR FOR INDEX =" &
|
INTEGER'IMAGE(CUR_INT_INDEX) & " WITH VALUE " &
|
INTEGER'IMAGE(CUR_INT_INDEX) & " WITH VALUE " &
|
"""" & INTEGER'IMAGE(VAL) & """");
|
"""" & INTEGER'IMAGE(VAL) & """");
|
END IF;
|
END IF;
|
CUR_INT_INDEX := CUR_INT_INDEX + 1;
|
CUR_INT_INDEX := CUR_INT_INDEX + 1;
|
EXCEPTION
|
EXCEPTION
|
WHEN CONSTRAINT_ERROR =>
|
WHEN CONSTRAINT_ERROR =>
|
FAILED ("INTEGER - CONSTRAINT_ERROR RAISED");
|
FAILED ("INTEGER - CONSTRAINT_ERROR RAISED");
|
WHEN OTHERS =>
|
WHEN OTHERS =>
|
FAILED ("INTEGER - UNEXPECTED EXCEPTION");
|
FAILED ("INTEGER - UNEXPECTED EXCEPTION");
|
END CHECK_INT;
|
END CHECK_INT;
|
|
|
PACKAGE STR6_QUEUE IS NEW CC3019A_QUEUES (STR6);
|
PACKAGE STR6_QUEUE IS NEW CC3019A_QUEUES (STR6);
|
USE STR6_QUEUE;
|
USE STR6_QUEUE;
|
|
|
PACKAGE INT_QUEUE IS NEW CC3019A_QUEUES (INTEGER);
|
PACKAGE INT_QUEUE IS NEW CC3019A_QUEUES (INTEGER);
|
USE INT_QUEUE;
|
USE INT_QUEUE;
|
|
|
BEGIN
|
BEGIN
|
|
|
TEST ("CC3019A", "CHECK NESTED GENERICS - ITERATORS");
|
TEST ("CC3019A", "CHECK NESTED GENERICS - ITERATORS");
|
|
|
DECLARE
|
DECLARE
|
Q1 : STR6_QUEUE.QUEUE_TYPE;
|
Q1 : STR6_QUEUE.QUEUE_TYPE;
|
|
|
PROCEDURE CHK_STR IS NEW STR6_QUEUE.ITERATOR (CHECK_STR);
|
PROCEDURE CHK_STR IS NEW STR6_QUEUE.ITERATOR (CHECK_STR);
|
|
|
BEGIN
|
BEGIN
|
|
|
ADD (Q1, "111111");
|
ADD (Q1, "111111");
|
ADD (Q1, "222222");
|
ADD (Q1, "222222");
|
ADD (Q1, "333333");
|
ADD (Q1, "333333");
|
|
|
CUR_STR_INDEX := 1;
|
CUR_STR_INDEX := 1;
|
CHK_STR (Q1);
|
CHK_STR (Q1);
|
|
|
EXCEPTION
|
EXCEPTION
|
WHEN OTHERS =>
|
WHEN OTHERS =>
|
FAILED ("UNEXPECTED EXCEPTION - Q1");
|
FAILED ("UNEXPECTED EXCEPTION - Q1");
|
END;
|
END;
|
|
|
-- REPEAT FOR INTEGERS
|
-- REPEAT FOR INTEGERS
|
|
|
DECLARE
|
DECLARE
|
Q2 : INT_QUEUE.QUEUE_TYPE;
|
Q2 : INT_QUEUE.QUEUE_TYPE;
|
|
|
PROCEDURE CHK_INT IS NEW INT_QUEUE.ITERATOR (CHECK_INT);
|
PROCEDURE CHK_INT IS NEW INT_QUEUE.ITERATOR (CHECK_INT);
|
|
|
BEGIN
|
BEGIN
|
|
|
ADD (Q2, -1);
|
ADD (Q2, -1);
|
ADD (Q2, 3);
|
ADD (Q2, 3);
|
ADD (Q2, 3);
|
ADD (Q2, 3);
|
|
|
CUR_INT_INDEX := 1;
|
CUR_INT_INDEX := 1;
|
CHK_INT (Q2);
|
CHK_INT (Q2);
|
|
|
EXCEPTION
|
EXCEPTION
|
WHEN OTHERS =>
|
WHEN OTHERS =>
|
FAILED ("UNEXPECTED EXCEPTION - Q2");
|
FAILED ("UNEXPECTED EXCEPTION - Q2");
|
END;
|
END;
|
|
|
RESULT;
|
RESULT;
|
|
|
END CC3019A;
|
END CC3019A;
|
|
|
