-- C36205J.ADA
|
-- C36205J.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 ATTRIBUTES GIVE THE CORRECT VALUES FOR
|
-- CHECK THAT ATTRIBUTES GIVE THE CORRECT VALUES FOR
|
-- UNCONSTRAINED FORMAL PARAMETERS.
|
-- UNCONSTRAINED FORMAL PARAMETERS.
|
|
|
-- ATTRIBUTES OF SLICES AND AGGREGATES OF MORE COMPLEX FORMS
|
-- ATTRIBUTES OF SLICES AND AGGREGATES OF MORE COMPLEX FORMS
|
|
|
-- DAT 2/17/81
|
-- DAT 2/17/81
|
-- JBG 9/11/81
|
-- JBG 9/11/81
|
-- JWC 6/28/85 RENAMED TO -AB
|
-- JWC 6/28/85 RENAMED TO -AB
|
|
|
WITH REPORT;
|
WITH REPORT;
|
PROCEDURE C36205J IS
|
PROCEDURE C36205J IS
|
|
|
USE REPORT;
|
USE REPORT;
|
|
|
TYPE I_A IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
|
TYPE I_A IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
|
TYPE I_A_2 IS ARRAY (INTEGER RANGE <> ,
|
TYPE I_A_2 IS ARRAY (INTEGER RANGE <> ,
|
INTEGER RANGE <> ) OF INTEGER;
|
INTEGER RANGE <> ) OF INTEGER;
|
A10 : I_A (1 .. 10);
|
A10 : I_A (1 .. 10);
|
A20 : I_A (18 .. 20);
|
A20 : I_A (18 .. 20);
|
I10 : INTEGER := IDENT_INT (10);
|
I10 : INTEGER := IDENT_INT (10);
|
A2_10 : I_A_2 (1 .. I10, 3+I10 .. I10+I10); -- 1..10, 13..20
|
A2_10 : I_A_2 (1 .. I10, 3+I10 .. I10+I10); -- 1..10, 13..20
|
A2_20 : I_A_2 (11 .. 3*I10, I10+11 .. I10+I10); -- 11..30, 21..20
|
A2_20 : I_A_2 (11 .. 3*I10, I10+11 .. I10+I10); -- 11..30, 21..20
|
TYPE STR IS NEW STRING;
|
TYPE STR IS NEW STRING;
|
ALF : CONSTANT STR := STR(IDENT_STR("ABCDE"));
|
ALF : CONSTANT STR := STR(IDENT_STR("ABCDE"));
|
ARF : STR(5 .. 9) := ALF;
|
ARF : STR(5 .. 9) := ALF;
|
|
|
PROCEDURE P1 (A : I_A; FIR, LAS: INTEGER; S : STRING) IS
|
PROCEDURE P1 (A : I_A; FIR, LAS: INTEGER; S : STRING) IS
|
BEGIN
|
BEGIN
|
IF A'FIRST /= FIR
|
IF A'FIRST /= FIR
|
OR A'FIRST(1) /= FIR
|
OR A'FIRST(1) /= FIR
|
THEN
|
THEN
|
FAILED ("'FIRST IS WRONG " & S);
|
FAILED ("'FIRST IS WRONG " & S);
|
END IF;
|
END IF;
|
|
|
IF A'LAST /= LAS
|
IF A'LAST /= LAS
|
OR A'LAST(1) /= LAS
|
OR A'LAST(1) /= LAS
|
THEN
|
THEN
|
FAILED ("'LAST IS WRONG " & S);
|
FAILED ("'LAST IS WRONG " & S);
|
END IF;
|
END IF;
|
|
|
IF A'LENGTH /= LAS - FIR + 1
|
IF A'LENGTH /= LAS - FIR + 1
|
OR A'LENGTH /= A'LENGTH(1)
|
OR A'LENGTH /= A'LENGTH(1)
|
THEN
|
THEN
|
FAILED ("'LENGTH IS WRONG " & S);
|
FAILED ("'LENGTH IS WRONG " & S);
|
END IF;
|
END IF;
|
|
|
IF (LAS NOT IN A'RANGE AND LAS >= FIR)
|
IF (LAS NOT IN A'RANGE AND LAS >= FIR)
|
OR (FIR NOT IN A'RANGE AND LAS >= FIR)
|
OR (FIR NOT IN A'RANGE AND LAS >= FIR)
|
OR FIR - 1 IN A'RANGE
|
OR FIR - 1 IN A'RANGE
|
OR LAS + 1 IN A'RANGE(1)
|
OR LAS + 1 IN A'RANGE(1)
|
THEN
|
THEN
|
FAILED ("'RANGE IS WRONG " & S);
|
FAILED ("'RANGE IS WRONG " & S);
|
END IF;
|
END IF;
|
|
|
END P1;
|
END P1;
|
|
|
PROCEDURE P2 (A : I_A_2; F1,L1,F2,L2 : INTEGER; S : STRING) IS
|
PROCEDURE P2 (A : I_A_2; F1,L1,F2,L2 : INTEGER; S : STRING) IS
|
BEGIN
|
BEGIN
|
IF A'FIRST /= A'FIRST(1)
|
IF A'FIRST /= A'FIRST(1)
|
OR A'FIRST /= F1
|
OR A'FIRST /= F1
|
THEN
|
THEN
|
FAILED ("'FIRST(1) IS WRONG " & S);
|
FAILED ("'FIRST(1) IS WRONG " & S);
|
END IF;
|
END IF;
|
|
|
IF A'LAST(1) /= L1 THEN
|
IF A'LAST(1) /= L1 THEN
|
FAILED ("'LAST(1) IS WRONG " & S);
|
FAILED ("'LAST(1) IS WRONG " & S);
|
END IF;
|
END IF;
|
|
|
IF A'LENGTH(1) /= A'LENGTH
|
IF A'LENGTH(1) /= A'LENGTH
|
OR A'LENGTH /= L1 - F1 + 1
|
OR A'LENGTH /= L1 - F1 + 1
|
THEN
|
THEN
|
FAILED ("'LENGTH(1) IS WRONG " & S);
|
FAILED ("'LENGTH(1) IS WRONG " & S);
|
END IF;
|
END IF;
|
|
|
IF F1 - 1 IN A'RANGE
|
IF F1 - 1 IN A'RANGE
|
OR (F1 NOT IN A'RANGE AND F1 <= L1)
|
OR (F1 NOT IN A'RANGE AND F1 <= L1)
|
OR (L1 NOT IN A'RANGE(1) AND F1 <= L1)
|
OR (L1 NOT IN A'RANGE(1) AND F1 <= L1)
|
OR L1 + 1 IN A'RANGE(1)
|
OR L1 + 1 IN A'RANGE(1)
|
THEN
|
THEN
|
FAILED ("'RANGE(1) IS WRONG " & S);
|
FAILED ("'RANGE(1) IS WRONG " & S);
|
END IF;
|
END IF;
|
|
|
IF A'FIRST(2) /= F2 THEN
|
IF A'FIRST(2) /= F2 THEN
|
FAILED ("'FIRST(2) IS WRONG " & S);
|
FAILED ("'FIRST(2) IS WRONG " & S);
|
END IF;
|
END IF;
|
|
|
IF A'LAST(2) /= L2 THEN
|
IF A'LAST(2) /= L2 THEN
|
FAILED ("'LAST(2) IS WRONG " & S);
|
FAILED ("'LAST(2) IS WRONG " & S);
|
END IF;
|
END IF;
|
|
|
IF L2 - F2 /= A'LENGTH(2) - 1 THEN
|
IF L2 - F2 /= A'LENGTH(2) - 1 THEN
|
FAILED ("'LENGTH(2) IS WRONG " & S);
|
FAILED ("'LENGTH(2) IS WRONG " & S);
|
END IF;
|
END IF;
|
|
|
IF F2 - 1 IN A'RANGE(2)
|
IF F2 - 1 IN A'RANGE(2)
|
OR (F2 NOT IN A'RANGE(2) AND A'LENGTH(2) > 0)
|
OR (F2 NOT IN A'RANGE(2) AND A'LENGTH(2) > 0)
|
OR (L2 NOT IN A'RANGE(2) AND A'LENGTH(2) /= 0)
|
OR (L2 NOT IN A'RANGE(2) AND A'LENGTH(2) /= 0)
|
OR L2 + 1 IN A'RANGE(2)
|
OR L2 + 1 IN A'RANGE(2)
|
THEN
|
THEN
|
FAILED ("'RANGE(2) IS WRONG " & S);
|
FAILED ("'RANGE(2) IS WRONG " & S);
|
END IF;
|
END IF;
|
END P2;
|
END P2;
|
|
|
PROCEDURE S1 (S:STR; F,L:INTEGER; MESS:STRING) IS
|
PROCEDURE S1 (S:STR; F,L:INTEGER; MESS:STRING) IS
|
BEGIN
|
BEGIN
|
IF S'FIRST /= F THEN
|
IF S'FIRST /= F THEN
|
FAILED ("STRING 'FIRST IS WRONG " & MESS);
|
FAILED ("STRING 'FIRST IS WRONG " & MESS);
|
END IF;
|
END IF;
|
|
|
IF S'LAST(1) /= L THEN
|
IF S'LAST(1) /= L THEN
|
FAILED ("STRING 'LAST IS WRONG " & MESS);
|
FAILED ("STRING 'LAST IS WRONG " & MESS);
|
END IF;
|
END IF;
|
|
|
IF S'LENGTH /= L - F + 1
|
IF S'LENGTH /= L - F + 1
|
OR S'LENGTH(1) /= S'LENGTH
|
OR S'LENGTH(1) /= S'LENGTH
|
THEN
|
THEN
|
FAILED ("STRING 'LENGTH IS WRONG " & MESS);
|
FAILED ("STRING 'LENGTH IS WRONG " & MESS);
|
END IF;
|
END IF;
|
|
|
IF (F <= L AND
|
IF (F <= L AND
|
(F NOT IN S'RANGE
|
(F NOT IN S'RANGE
|
OR L NOT IN S'RANGE
|
OR L NOT IN S'RANGE
|
OR F NOT IN S'RANGE(1)
|
OR F NOT IN S'RANGE(1)
|
OR L NOT IN S'RANGE(1)))
|
OR L NOT IN S'RANGE(1)))
|
OR F - 1 IN S'RANGE
|
OR F - 1 IN S'RANGE
|
OR L + 1 IN S'RANGE(1)
|
OR L + 1 IN S'RANGE(1)
|
THEN
|
THEN
|
FAILED ("STRING 'RANGE IS WRONG " & MESS);
|
FAILED ("STRING 'RANGE IS WRONG " & MESS);
|
END IF;
|
END IF;
|
END S1;
|
END S1;
|
|
|
BEGIN
|
BEGIN
|
TEST ( "C36205J", "CHECKING ATTRIBUTE VALUES POSSESSED BY FORMAL "&
|
TEST ( "C36205J", "CHECKING ATTRIBUTE VALUES POSSESSED BY FORMAL "&
|
"PARAMETERS WHOSE ACTUALS ARE UNCONSTRAINED " &
|
"PARAMETERS WHOSE ACTUALS ARE UNCONSTRAINED " &
|
"ARRAYS - COMPLEX MIXTURE OF SLICES/AGGREGATES");
|
"ARRAYS - COMPLEX MIXTURE OF SLICES/AGGREGATES");
|
|
|
FOR J IN IDENT_INT (-3) .. IDENT_INT (3) LOOP
|
FOR J IN IDENT_INT (-3) .. IDENT_INT (3) LOOP
|
FOR K IN J - 1 .. 2 LOOP
|
FOR K IN J - 1 .. 2 LOOP
|
P1 ((J .. K => 0), J, K, "X");
|
P1 ((J .. K => 0), J, K, "X");
|
P1 (A10 (J + 4 .. K + 4), J+4, K+4, "Y");
|
P1 (A10 (J + 4 .. K + 4), J+4, K+4, "Y");
|
END LOOP;
|
END LOOP;
|
END LOOP;
|
END LOOP;
|
FOR I IN 18 .. 20 LOOP
|
FOR I IN 18 .. 20 LOOP
|
FOR J IN I-1 .. 20 LOOP
|
FOR J IN I-1 .. 20 LOOP
|
P1 (A20 (I .. J), I, J, "A20 88");
|
P1 (A20 (I .. J), I, J, "A20 88");
|
END LOOP;
|
END LOOP;
|
END LOOP;
|
END LOOP;
|
FOR I IN 1 .. 5 LOOP
|
FOR I IN 1 .. 5 LOOP
|
FOR J IN I - 1 .. 5 LOOP
|
FOR J IN I - 1 .. 5 LOOP
|
S1( ALF (I .. J), I, J, "ALF 1");
|
S1( ALF (I .. J), I, J, "ALF 1");
|
S1 (ARF (I+4..J+4), I+4, J+4, "ARF 4");
|
S1 (ARF (I+4..J+4), I+4, J+4, "ARF 4");
|
END LOOP;
|
END LOOP;
|
END LOOP;
|
END LOOP;
|
|
|
RESULT;
|
RESULT;
|
END C36205J;
|
END C36205J;
|
|
|