1-- CC3221A.ADA
2
3--                             Grant of Unlimited Rights
4--
5--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
6--     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
7--     unlimited rights in the software and documentation contained herein.
8--     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
9--     this public release, the Government intends to confer upon all
10--     recipients unlimited rights  equal to those held by the Government.
11--     These rights include rights to use, duplicate, release or disclose the
12--     released technical data and computer software in whole or in part, in
13--     any manner and for any purpose whatsoever, and to have or permit others
14--     to do so.
15--
16--                                    DISCLAIMER
17--
18--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
19--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
20--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
21--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
22--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
23--     PARTICULAR PURPOSE OF SAID MATERIAL.
24--*
25-- CHECK THAT AN INTEGER FORMAL TYPE DENOTES ITS ACTUAL PARAMETER, AND
26-- OPERATIONS OF THE FORMAL TYPE ARE IDENTIFIED WITH CORRESPONDING
27-- OPERATIONS OF THE ACTUAL TYPE.
28
29-- TBN  10/09/86
30
31WITH REPORT; USE REPORT;
32PROCEDURE CC3221A IS
33
34     GENERIC
35          TYPE T IS RANGE <>;
36     PACKAGE P IS
37          SUBTYPE SUB_T IS T;
38          PAC_VAR : T;
39     END P;
40
41BEGIN
42     TEST ("CC3221A", "CHECK THAT AN INTEGER FORMAL TYPE DENOTES ITS " &
43                      "ACTUAL PARAMETER, AND OPERATIONS OF THE " &
44                      "FORMAL TYPE ARE IDENTIFIED WITH CORRESPONDING " &
45                      "OPERATIONS OF THE ACTUAL TYPE");
46
47     DECLARE
48          TYPE FIXED IS DELTA 0.125 RANGE 0.0 .. 10.0;
49
50          OBJ_INT : INTEGER := 1;
51          OBJ_FLO : FLOAT := 1.0;
52          OBJ_FIX : FIXED := 1.0;
53
54          PACKAGE P1 IS NEW P (INTEGER);
55          USE P1;
56
57          TYPE NEW_T IS NEW SUB_T;
58          OBJ_NEWT : NEW_T;
59     BEGIN
60          PAC_VAR := SUB_T'(1);
61          IF PAC_VAR /= OBJ_INT THEN
62               FAILED ("INCORRECT RESULTS - 1");
63          END IF;
64          OBJ_INT := PAC_VAR + OBJ_INT;
65          IF OBJ_INT <= PAC_VAR THEN
66               FAILED ("INCORRECT RESULTS - 2");
67          END IF;
68          PAC_VAR := PAC_VAR * OBJ_INT;
69          IF PAC_VAR NOT IN INTEGER THEN
70               FAILED ("INCORRECT RESULTS - 3");
71          END IF;
72          IF OBJ_INT NOT IN SUB_T THEN
73               FAILED ("INCORRECT RESULTS - 4");
74          END IF;
75          IF INTEGER'POS(2) /= SUB_T'POS(2) THEN
76               FAILED ("INCORRECT RESULTS - 5");
77          END IF;
78          PAC_VAR := 1;
79          OBJ_FIX := PAC_VAR * OBJ_FIX;
80          IF OBJ_FIX /= 1.0 THEN
81               FAILED ("INCORRECT RESULTS - 6");
82          END IF;
83          OBJ_INT := 1;
84          OBJ_FIX := OBJ_FIX / OBJ_INT;
85          IF OBJ_FIX /= 1.0 THEN
86               FAILED ("INCORRECT RESULTS - 7");
87          END IF;
88          OBJ_INT := OBJ_INT ** PAC_VAR;
89          IF OBJ_INT /= 1 THEN
90               FAILED ("INCORRECT RESULTS - 8");
91          END IF;
92          OBJ_FLO := OBJ_FLO ** PAC_VAR;
93          IF OBJ_FLO /= 1.0 THEN
94               FAILED ("INCORRECT RESULTS - 9");
95          END IF;
96          OBJ_NEWT := 1;
97          OBJ_NEWT := OBJ_NEWT - 1;
98          IF OBJ_NEWT NOT IN NEW_T THEN
99               FAILED ("INCORRECT RESULTS - 10");
100          END IF;
101          IF NEW_T'SUCC(2) /= 3 THEN
102               FAILED ("INCORRECT RESULTS - 11");
103          END IF;
104     END;
105
106     RESULT;
107END CC3221A;
108