-- C38102E.ADA
|
-- C38102E.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 AN INCOMPLETE TYPE CAN BE REDECLARED AS A DERIVED GENERIC
|
-- CHECK THAT AN INCOMPLETE TYPE CAN BE REDECLARED AS A DERIVED GENERIC
|
-- FORMAL TYPE.
|
-- FORMAL TYPE.
|
|
|
-- AH 8/15/86
|
-- AH 8/15/86
|
-- PWN 01/31/95 REMOVED INCONSISTENCIES WITH ADA 9X.
|
-- PWN 01/31/95 REMOVED INCONSISTENCIES WITH ADA 9X.
|
-- DNT 11/28/95 CHANGED TO FLAG1 := F4.
|
-- DNT 11/28/95 CHANGED TO FLAG1 := F4.
|
|
|
WITH REPORT; USE REPORT;
|
WITH REPORT; USE REPORT;
|
PROCEDURE C38102E IS
|
PROCEDURE C38102E IS
|
TYPE RAINBOW IS (RED, ORANGE, YELLOW, GREEN, BLUE, INDIGO, VIOLET);
|
TYPE RAINBOW IS (RED, ORANGE, YELLOW, GREEN, BLUE, INDIGO, VIOLET);
|
TYPE T_FLOAT IS DIGITS 5 RANGE -4.0 .. 4.0;
|
TYPE T_FLOAT IS DIGITS 5 RANGE -4.0 .. 4.0;
|
TYPE T_FIXED IS DELTA 0.01 RANGE 0.0 .. 1.5;
|
TYPE T_FIXED IS DELTA 0.01 RANGE 0.0 .. 1.5;
|
SUBTYPE P1 IS INTEGER;
|
SUBTYPE P1 IS INTEGER;
|
TYPE P2 IS RANGE 0 .. 10;
|
TYPE P2 IS RANGE 0 .. 10;
|
TYPE P3 IS ARRAY (P2) OF INTEGER;
|
TYPE P3 IS ARRAY (P2) OF INTEGER;
|
TYPE P4 IS ARRAY (P2, P2) OF INTEGER;
|
TYPE P4 IS ARRAY (P2, P2) OF INTEGER;
|
|
|
F1, F2 : BOOLEAN;
|
F1, F2 : BOOLEAN;
|
|
|
GENERIC
|
GENERIC
|
TYPE G1 IS (<>);
|
TYPE G1 IS (<>);
|
TYPE G2 IS RANGE <>;
|
TYPE G2 IS RANGE <>;
|
FUNCTION G_DISCRETE RETURN BOOLEAN;
|
FUNCTION G_DISCRETE RETURN BOOLEAN;
|
|
|
FUNCTION G_DISCRETE RETURN BOOLEAN IS
|
FUNCTION G_DISCRETE RETURN BOOLEAN IS
|
TYPE INC1;
|
TYPE INC1;
|
TYPE INC2;
|
TYPE INC2;
|
TYPE F1 IS NEW G1;
|
TYPE F1 IS NEW G1;
|
TYPE INC1 IS NEW G1;
|
TYPE INC1 IS NEW G1;
|
TYPE INC2 IS NEW G2;
|
TYPE INC2 IS NEW G2;
|
|
|
OBJ1_0 : INC1;
|
OBJ1_0 : INC1;
|
OBJ1_1 : INC1;
|
OBJ1_1 : INC1;
|
OBJ2_0 : INC2;
|
OBJ2_0 : INC2;
|
OBJ2_1 : INC2;
|
OBJ2_1 : INC2;
|
OBJ3 : F1;
|
OBJ3 : F1;
|
|
|
RESULT_VALUE1 : BOOLEAN := FALSE;
|
RESULT_VALUE1 : BOOLEAN := FALSE;
|
RESULT_VALUE2 : BOOLEAN := FALSE;
|
RESULT_VALUE2 : BOOLEAN := FALSE;
|
BEGIN
|
BEGIN
|
OBJ3 := F1'LAST;
|
OBJ3 := F1'LAST;
|
OBJ3 := F1'PRED(OBJ3);
|
OBJ3 := F1'PRED(OBJ3);
|
IF INC1(OBJ3) = INC1'PRED(INC1'LAST) THEN
|
IF INC1(OBJ3) = INC1'PRED(INC1'LAST) THEN
|
RESULT_VALUE1 := TRUE;
|
RESULT_VALUE1 := TRUE;
|
END IF;
|
END IF;
|
OBJ2_0 := INC2'FIRST;
|
OBJ2_0 := INC2'FIRST;
|
OBJ2_1 := INC2'LAST;
|
OBJ2_1 := INC2'LAST;
|
IF (OBJ2_0 + OBJ2_1) = (INC2'SUCC(OBJ2_0) +
|
IF (OBJ2_0 + OBJ2_1) = (INC2'SUCC(OBJ2_0) +
|
INC2'PRED(OBJ2_1)) THEN
|
INC2'PRED(OBJ2_1)) THEN
|
RESULT_VALUE2 := TRUE;
|
RESULT_VALUE2 := TRUE;
|
END IF;
|
END IF;
|
|
|
RETURN (RESULT_VALUE1 AND RESULT_VALUE2);
|
RETURN (RESULT_VALUE1 AND RESULT_VALUE2);
|
END G_DISCRETE;
|
END G_DISCRETE;
|
|
|
GENERIC
|
GENERIC
|
TYPE G3 IS DIGITS <>;
|
TYPE G3 IS DIGITS <>;
|
TYPE G4 IS DELTA <>;
|
TYPE G4 IS DELTA <>;
|
PROCEDURE REALS (FLAG1, FLAG2 : OUT BOOLEAN);
|
PROCEDURE REALS (FLAG1, FLAG2 : OUT BOOLEAN);
|
|
|
PROCEDURE REALS (FLAG1, FLAG2 : OUT BOOLEAN) IS
|
PROCEDURE REALS (FLAG1, FLAG2 : OUT BOOLEAN) IS
|
F1, F2, F3, F4, F5, F6, F7, F8 : BOOLEAN;
|
F1, F2, F3, F4, F5, F6, F7, F8 : BOOLEAN;
|
TYPE INC3;
|
TYPE INC3;
|
TYPE INC4;
|
TYPE INC4;
|
TYPE P1 IS NEW G3;
|
TYPE P1 IS NEW G3;
|
TYPE P2 IS NEW G4;
|
TYPE P2 IS NEW G4;
|
TYPE INC3 IS NEW G3;
|
TYPE INC3 IS NEW G3;
|
TYPE INC4 IS NEW G4;
|
TYPE INC4 IS NEW G4;
|
BEGIN
|
BEGIN
|
F4 := P1'LAST = P1(INC3'LAST) AND P1'FIRST = P1(INC3'FIRST);
|
F4 := P1'LAST = P1(INC3'LAST) AND P1'FIRST = P1(INC3'FIRST);
|
|
|
F5 := P2'FORE = INC4'FORE;
|
F5 := P2'FORE = INC4'FORE;
|
F6 := P2'AFT = INC4'AFT;
|
F6 := P2'AFT = INC4'AFT;
|
F7 := ABS(P2'LAST - P2'FIRST) = P2(ABS(INC4'LAST -
|
F7 := ABS(P2'LAST - P2'FIRST) = P2(ABS(INC4'LAST -
|
INC4'FIRST));
|
INC4'FIRST));
|
F8 := INC4(P2'LAST / P2'LAST) = INC4(INC4'LAST / INC4'LAST);
|
F8 := INC4(P2'LAST / P2'LAST) = INC4(INC4'LAST / INC4'LAST);
|
|
|
FLAG1 := F4;
|
FLAG1 := F4;
|
FLAG2 := F5 AND F6 AND F7 AND F8;
|
FLAG2 := F5 AND F6 AND F7 AND F8;
|
END REALS;
|
END REALS;
|
|
|
GENERIC
|
GENERIC
|
TYPE ITEM IS PRIVATE;
|
TYPE ITEM IS PRIVATE;
|
TYPE INDEX IS RANGE <>;
|
TYPE INDEX IS RANGE <>;
|
TYPE G5 IS ARRAY (INDEX) OF ITEM;
|
TYPE G5 IS ARRAY (INDEX) OF ITEM;
|
TYPE G6 IS ARRAY (INDEX, INDEX) OF ITEM;
|
TYPE G6 IS ARRAY (INDEX, INDEX) OF ITEM;
|
PACKAGE DIMENSIONS IS
|
PACKAGE DIMENSIONS IS
|
TYPE INC5;
|
TYPE INC5;
|
TYPE INC6;
|
TYPE INC6;
|
TYPE D1 IS NEW G5;
|
TYPE D1 IS NEW G5;
|
TYPE D2 IS NEW G6;
|
TYPE D2 IS NEW G6;
|
TYPE INC5 IS NEW G5;
|
TYPE INC5 IS NEW G5;
|
TYPE INC6 IS NEW G6;
|
TYPE INC6 IS NEW G6;
|
FUNCTION CHECK RETURN BOOLEAN;
|
FUNCTION CHECK RETURN BOOLEAN;
|
END DIMENSIONS;
|
END DIMENSIONS;
|
|
|
PACKAGE BODY DIMENSIONS IS
|
PACKAGE BODY DIMENSIONS IS
|
FUNCTION CHECK RETURN BOOLEAN IS
|
FUNCTION CHECK RETURN BOOLEAN IS
|
A1 : INC5;
|
A1 : INC5;
|
A2 : INC6;
|
A2 : INC6;
|
DIM1 : D1;
|
DIM1 : D1;
|
DIM2 : D2;
|
DIM2 : D2;
|
F1, F2 : BOOLEAN;
|
F1, F2 : BOOLEAN;
|
BEGIN
|
BEGIN
|
F1 := A1(INDEX'FIRST)'SIZE = DIM1(INDEX'FIRST)'SIZE;
|
F1 := A1(INDEX'FIRST)'SIZE = DIM1(INDEX'FIRST)'SIZE;
|
F2 := A2(INDEX'FIRST, INDEX'LAST)'SIZE =
|
F2 := A2(INDEX'FIRST, INDEX'LAST)'SIZE =
|
DIM2(INDEX'FIRST, INDEX'LAST)'SIZE;
|
DIM2(INDEX'FIRST, INDEX'LAST)'SIZE;
|
|
|
RETURN (F1 AND F2);
|
RETURN (F1 AND F2);
|
END CHECK;
|
END CHECK;
|
END DIMENSIONS;
|
END DIMENSIONS;
|
|
|
PROCEDURE PROC IS NEW REALS (G3 => T_FLOAT, G4 => T_FIXED);
|
PROCEDURE PROC IS NEW REALS (G3 => T_FLOAT, G4 => T_FIXED);
|
FUNCTION DISCRETE IS NEW G_DISCRETE (G1 => RAINBOW, G2 => P2);
|
FUNCTION DISCRETE IS NEW G_DISCRETE (G1 => RAINBOW, G2 => P2);
|
PACKAGE PKG IS NEW DIMENSIONS (ITEM => P1, INDEX => P2, G5 => P3,
|
PACKAGE PKG IS NEW DIMENSIONS (ITEM => P1, INDEX => P2, G5 => P3,
|
G6 => P4);
|
G6 => P4);
|
|
|
USE PKG;
|
USE PKG;
|
BEGIN
|
BEGIN
|
TEST ("C38102E", "INCOMPLETE TYPES CAN BE DERIVED GENERIC " &
|
TEST ("C38102E", "INCOMPLETE TYPES CAN BE DERIVED GENERIC " &
|
"FORMAL TYPES");
|
"FORMAL TYPES");
|
|
|
IF NOT DISCRETE THEN
|
IF NOT DISCRETE THEN
|
FAILED ("INTEGER AND ENUMERATED TYPES NOT DERIVED");
|
FAILED ("INTEGER AND ENUMERATED TYPES NOT DERIVED");
|
END IF;
|
END IF;
|
|
|
PROC (F1, F2);
|
PROC (F1, F2);
|
IF (NOT F1) THEN
|
IF (NOT F1) THEN
|
FAILED ("FLOAT TYPES NOT DERIVED");
|
FAILED ("FLOAT TYPES NOT DERIVED");
|
END IF;
|
END IF;
|
IF (NOT F2) THEN
|
IF (NOT F2) THEN
|
FAILED ("FIXED TYPES NOT DERIVED");
|
FAILED ("FIXED TYPES NOT DERIVED");
|
END IF;
|
END IF;
|
|
|
IF NOT CHECK THEN
|
IF NOT CHECK THEN
|
FAILED ("ONE AND TWO DIMENSIONAL ARRAY TYPES NOT DERIVED");
|
FAILED ("ONE AND TWO DIMENSIONAL ARRAY TYPES NOT DERIVED");
|
END IF;
|
END IF;
|
|
|
RESULT;
|
RESULT;
|
END C38102E;
|
END C38102E;
|
|
|