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