Subversion Repositories openrisc_me

-- C38102E.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.

--*

-- CHECK THAT AN INCOMPLETE TYPE CAN BE REDECLARED AS A DERIVED GENERIC 

-- FORMAL TYPE.

-- AH     8/15/86

-- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.

-- DNT 11/28/95  CHANGED TO FLAG1 := F4.

WITH REPORT; USE REPORT;

PROCEDURE C38102E IS

     TYPE RAINBOW IS (RED, ORANGE, YELLOW, GREEN, BLUE, INDIGO, VIOLET);

     TYPE T_FLOAT IS DIGITS 5 RANGE -4.0 .. 4.0;

     TYPE T_FIXED IS DELTA 0.01 RANGE 0.0 .. 1.5;

     SUBTYPE P1 IS INTEGER;

     TYPE P2 IS RANGE 0 .. 10;

     TYPE P3 IS ARRAY (P2) OF INTEGER;

     TYPE P4 IS ARRAY (P2, P2) OF INTEGER;

     F1, F2 : BOOLEAN;

     GENERIC

          TYPE G1 IS (<>);

          TYPE G2 IS RANGE <>;

     FUNCTION G_DISCRETE RETURN BOOLEAN;

     FUNCTION G_DISCRETE RETURN BOOLEAN IS

          TYPE INC1;

          TYPE INC2;

          TYPE F1 IS NEW G1;

          TYPE INC1 IS NEW G1;

          TYPE INC2 IS NEW G2;

          OBJ1_0 : INC1;

          OBJ1_1 : INC1;

          OBJ2_0 : INC2;

          OBJ2_1 : INC2;

          OBJ3 : F1;

          RESULT_VALUE1 : BOOLEAN := FALSE;

          RESULT_VALUE2 : BOOLEAN := FALSE;

     BEGIN

          OBJ3 := F1'LAST;

          OBJ3 := F1'PRED(OBJ3);

          IF INC1(OBJ3) = INC1'PRED(INC1'LAST) THEN

               RESULT_VALUE1 := TRUE;

          END IF;

          OBJ2_0 := INC2'FIRST;

          OBJ2_1 := INC2'LAST;

          IF (OBJ2_0 + OBJ2_1) = (INC2'SUCC(OBJ2_0) +

                                  INC2'PRED(OBJ2_1)) THEN

               RESULT_VALUE2 := TRUE;

          END IF;

          RETURN (RESULT_VALUE1 AND RESULT_VALUE2);

     END G_DISCRETE;

     GENERIC

          TYPE G3 IS DIGITS <>;

          TYPE G4 IS DELTA <>;

     PROCEDURE REALS (FLAG1, FLAG2 : OUT BOOLEAN);

     PROCEDURE REALS (FLAG1, FLAG2 : OUT BOOLEAN) IS

          F1, F2, F3, F4, F5, F6, F7, F8 : BOOLEAN;

          TYPE INC3;

          TYPE INC4;

          TYPE P1 IS NEW G3;

          TYPE P2 IS NEW G4;

          TYPE INC3 IS NEW G3;

          TYPE INC4 IS NEW G4;

     BEGIN

          F4 := P1'LAST = P1(INC3'LAST) AND P1'FIRST = P1(INC3'FIRST);

          F5 := P2'FORE = INC4'FORE;

          F6 := P2'AFT = INC4'AFT;

          F7 := ABS(P2'LAST - P2'FIRST) = P2(ABS(INC4'LAST -

                                                 INC4'FIRST));

          F8 := INC4(P2'LAST / P2'LAST) = INC4(INC4'LAST / INC4'LAST);

          FLAG1 := F4;

          FLAG2 := F5 AND F6 AND F7 AND F8;

     END REALS;

     GENERIC

          TYPE ITEM IS PRIVATE;

          TYPE INDEX IS RANGE <>;

          TYPE G5 IS ARRAY (INDEX) OF ITEM;

          TYPE G6 IS ARRAY (INDEX, INDEX) OF ITEM;

     PACKAGE DIMENSIONS IS

          TYPE INC5;

          TYPE INC6;

          TYPE D1 IS NEW G5;

          TYPE D2 IS NEW G6;

          TYPE INC5 IS NEW G5;

          TYPE INC6 IS NEW G6;

          FUNCTION CHECK RETURN BOOLEAN;

     END DIMENSIONS;

     PACKAGE BODY DIMENSIONS IS

          FUNCTION CHECK RETURN BOOLEAN IS

               A1 : INC5;

               A2 : INC6;

               DIM1 : D1;

               DIM2 : D2;

               F1, F2 : BOOLEAN;

          BEGIN

               F1 := A1(INDEX'FIRST)'SIZE = DIM1(INDEX'FIRST)'SIZE;

               F2 := A2(INDEX'FIRST, INDEX'LAST)'SIZE =

                     DIM2(INDEX'FIRST, INDEX'LAST)'SIZE;

               RETURN (F1 AND F2);

          END CHECK;

     END DIMENSIONS;

     PROCEDURE PROC IS NEW REALS (G3 => T_FLOAT, G4 => T_FIXED);

     FUNCTION DISCRETE IS NEW G_DISCRETE (G1 => RAINBOW, G2 => P2);

     PACKAGE PKG IS NEW DIMENSIONS (ITEM => P1, INDEX => P2, G5 => P3,

                                    G6 => P4);

     USE PKG;

BEGIN

     TEST ("C38102E", "INCOMPLETE TYPES CAN BE DERIVED GENERIC " &

                      "FORMAL TYPES");

     IF NOT DISCRETE THEN

          FAILED ("INTEGER AND ENUMERATED TYPES NOT DERIVED");

     END IF;

     PROC (F1, F2);

     IF (NOT F1) THEN

          FAILED ("FLOAT TYPES NOT DERIVED");

     END IF;

     IF (NOT F2) THEN

          FAILED ("FIXED TYPES NOT DERIVED");

     END IF;

     IF NOT CHECK THEN

          FAILED ("ONE AND TWO DIMENSIONAL ARRAY TYPES NOT DERIVED");

     END IF;

     RESULT;

END C38102E;