1-- CD2A32C.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-- OBJECTIVE:
26--     CHECK THAT A SIZE SPECIFICATION FOR AN INTEGER TYPE OF THE
27--     SMALLEST APPROPRIATE SIGNED SIZE CAN BE GIVEN:
28--        IN THE VISIBLE OR PRIVATE PART OF A PACKAGE FOR A TYPE
29--          DECLARED IN THE VISIBLE PART;
30--        FOR A DERIVED INTEGER TYPE;
31--        FOR A DERIVED PRIVATE TYPE WHOSE FULL DECLARATION IS AS
32--          AN INTEGER TYPE;
33--        FOR AN INTEGER TYPE IN A GENERIC UNIT.
34
35-- HISTORY:
36--     JET 08/12/87  CREATED ORIGINAL TEST.
37--     DHH 04/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA', CHANGED
38--                   SIZE CLAUSE VALUE TO 7, CHANGED OPERATOR ON 'SIZE
39--                   CHECKS, ADDED REPRESENTAION CLAUSE CHECK, AND
40--                   ADDED CHECK ON INTEGER IN A GENERIC UNIT.
41--     BCB 10/03/90  CHANGED FAILED MESSAGES FROM "SHOULD NOT BE GREATER
42--                   THAN" TO "MUST BE EQUAL TO".
43--     JRL 03/27/92  REMOVED TESTING OF NONOBJECTIVE TYPES.
44
45WITH REPORT; USE REPORT;
46PROCEDURE CD2A32C IS
47
48     TYPE BASIC_INT IS RANGE -63 .. 63;
49     SPECIFIED_SIZE : CONSTANT := 7;
50
51     TYPE DERIVED_INT IS NEW BASIC_INT;
52     FOR DERIVED_INT'SIZE USE SPECIFIED_SIZE;
53
54     PACKAGE P IS
55          TYPE INT_IN_P IS RANGE -63 .. 63;
56          FOR INT_IN_P'SIZE USE SPECIFIED_SIZE;
57          TYPE PRIVATE_INT IS PRIVATE;
58          TYPE ALT_INT_IN_P IS RANGE -63 .. 63;
59     PRIVATE
60          TYPE PRIVATE_INT IS RANGE -63 .. 63;
61          FOR ALT_INT_IN_P'SIZE USE SPECIFIED_SIZE;
62     END P;
63
64     USE P;
65
66     GENERIC
67     PACKAGE GENPACK IS
68          TYPE GEN_CHECK_INT IS RANGE -63 .. 63;
69          FOR GEN_CHECK_INT'SIZE USE SPECIFIED_SIZE;
70     END GENPACK;
71
72     PACKAGE NEWPACK IS NEW GENPACK;
73
74     USE NEWPACK;
75     TYPE DERIVED_PRIVATE_INT IS NEW PRIVATE_INT;
76     FOR DERIVED_PRIVATE_INT'SIZE USE SPECIFIED_SIZE;
77
78     MINIMUM_SIZE : INTEGER := IDENT_INT(SPECIFIED_SIZE);
79
80BEGIN
81
82     TEST("CD2A32C", "CHECK THAT A SIZE SPECIFICATION " &
83                     "FOR AN INTEGER TYPE OF THE SMALLEST " &
84                     "APPROPRIATE SIGNED SIZE CAN BE GIVEN: IN THE " &
85                     "VISIBLE OR PRIVATE PART OF A PACKAGE FOR A " &
86                     "TYPE DECLARED IN THE VISIBLE PART; FOR A " &
87                     "DERIVED INTEGER TYPE; FOR A DERIVED PRIVATE " &
88                     "TYPE WHOSE FULL DECLARATION IS AS AN INTEGER " &
89                     "TYPE; FOR AN INTEGER TYPE IN A GENERIC UNIT");
90
91     IF DERIVED_INT'SIZE /= MINIMUM_SIZE THEN
92          FAILED ("DERIVED_INT'SIZE MUST BE EQUAL TO" &
93                  INTEGER'IMAGE(MINIMUM_SIZE) &
94                  ".  ACTUAL SIZE IS" &
95                  INTEGER'IMAGE(DERIVED_INT'SIZE));
96     END IF;
97
98     IF INT_IN_P'SIZE /= MINIMUM_SIZE THEN
99          FAILED ("INT_IN_P'SIZE MUST BE EQUAL TO" &
100                  INTEGER'IMAGE(MINIMUM_SIZE) &
101                  ".  ACTUAL SIZE IS" &
102                  INTEGER'IMAGE(INT_IN_P'SIZE));
103     END IF;
104
105     IF ALT_INT_IN_P'SIZE /= MINIMUM_SIZE THEN
106          FAILED ("ALT_INT_IN_P'SIZE MUST BE EQUAL TO" &
107                  INTEGER'IMAGE(MINIMUM_SIZE) &
108                  ".  ACTUAL SIZE IS" &
109                  INTEGER'IMAGE(ALT_INT_IN_P'SIZE));
110     END IF;
111
112     IF DERIVED_PRIVATE_INT'SIZE /= MINIMUM_SIZE THEN
113          FAILED ("DERIVED_PRIVATE_INT'SIZE MUST BE EQUAL TO " &
114                  INTEGER'IMAGE(MINIMUM_SIZE) &
115                  ".  ACTUAL SIZE IS" &
116                  INTEGER'IMAGE(DERIVED_PRIVATE_INT'SIZE));
117     END IF;
118
119     IF GEN_CHECK_INT'SIZE /= MINIMUM_SIZE THEN
120          FAILED ("GEN_CHECK_INT'SIZE MUST BE EQUAL TO" &
121                  INTEGER'IMAGE(MINIMUM_SIZE) &
122                  ".  ACTUAL SIZE IS" &
123                  INTEGER'IMAGE(GEN_CHECK_INT'SIZE));
124     END IF;
125
126     RESULT;
127
128END CD2A32C;
129