1-- CD1C04A.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 CLAUSE CAN BE GIVEN FOR A DERIVED TYPE, A 27-- DERIVED PRIVATE TYPE, AND A DERIVED LIMITED PRIVATE TYPE EVEN 28-- IF THE SIZE IS INHERITED FROM THE PARENT, AND THAT THE SIZE 29-- CLAUSES FOR THE DERIVED TYPES OVERRIDE THE PARENTS'. 30 31-- HISTORY: 32-- PWB 03/25/89 MODIFIED METHOD OF CHECKING OBJECT SIZE AGAINST 33-- TYPE SIZE; CHANGED EXTENSION FROM '.ADA' TO '.DEP'. 34-- JET 09/16/87 CREATED ORIGINAL TEST. 35 36WITH REPORT; USE REPORT; 37PROCEDURE CD1C04A IS 38 39 SPECIFIED_SIZE : CONSTANT := INTEGER'SIZE / 2; 40 41 TYPE PARENT_TYPE IS RANGE 0 .. 100; 42 43 FOR PARENT_TYPE'SIZE USE INTEGER'SIZE; 44 45 TYPE DERIVED_TYPE IS NEW PARENT_TYPE; 46 47 FOR DERIVED_TYPE'SIZE USE SPECIFIED_SIZE; 48 49 PACKAGE P IS 50 TYPE PRIVATE_PARENT IS PRIVATE; 51 TYPE LIM_PRIV_PARENT IS LIMITED PRIVATE; 52 PRIVATE 53 TYPE PRIVATE_PARENT IS RANGE 0 .. 100; 54 FOR PRIVATE_PARENT'SIZE USE INTEGER'SIZE; 55 TYPE LIM_PRIV_PARENT IS RANGE 0 .. 100; 56 FOR LIM_PRIV_PARENT'SIZE USE INTEGER'SIZE; 57 END P; 58 59 USE P; 60 61 TYPE DERIVED_PRIVATE_TYPE IS NEW PRIVATE_PARENT; 62 63 FOR DERIVED_PRIVATE_TYPE'SIZE USE SPECIFIED_SIZE; 64 65 TYPE DERIVED_LIM_PRIV_TYPE IS NEW LIM_PRIV_PARENT; 66 67 FOR DERIVED_LIM_PRIV_TYPE'SIZE USE SPECIFIED_SIZE; 68 69 DT : DERIVED_TYPE := 100; 70 DPT : DERIVED_PRIVATE_TYPE; 71 DLPT : DERIVED_LIM_PRIV_TYPE; 72 73BEGIN 74 75 TEST("CD1C04A", "CHECK THAT A SIZE CLAUSE CAN BE GIVEN FOR " & 76 "A DERIVED TYPE, A DERIVED PRIVATE TYPE, AND " & 77 "A DERIVED LIMITED PRIVATE TYPE EVEN IF THE " & 78 "SIZE IS INHERITED FROM THE PARENT, AND THAT " & 79 "THE SIZE CLAUSES FOR THE DERIVED TYPES " & 80 "OVERRIDE THE PARENTS'"); 81 82 IF PARENT_TYPE'SIZE /= IDENT_INT (INTEGER'SIZE) THEN 83 FAILED ("PARENT_TYPE'SIZE SHOULD BE " & 84 INTEGER'IMAGE(INTEGER'SIZE) & 85 ". ACTUAL SIZE IS" & 86 INTEGER'IMAGE(PARENT_TYPE'SIZE)); 87 END IF; 88 89 IF DERIVED_TYPE'SIZE /= IDENT_INT (SPECIFIED_SIZE) THEN 90 FAILED ("DERIVED_TYPE'SIZE SHOULD BE " & 91 INTEGER'IMAGE(SPECIFIED_SIZE) & 92 ". ACTUAL SIZE IS" & 93 INTEGER'IMAGE(DERIVED_TYPE'SIZE)); 94 END IF; 95 96 IF DT'SIZE < IDENT_INT (SPECIFIED_SIZE) THEN 97 FAILED ("DT'SIZE SHOULD NOT BE LESS THAN" & 98 INTEGER'IMAGE(SPECIFIED_SIZE) & 99 ". ACTUAL SIZE IS" & 100 INTEGER'IMAGE(DT'SIZE)); 101 END IF; 102 103 IF PRIVATE_PARENT'SIZE < IDENT_INT (INTEGER'SIZE) THEN 104 FAILED ("PRIVATE_PARENT'SIZE SHOULD NOT BE LESS THAN" & 105 INTEGER'IMAGE(INTEGER'SIZE) & 106 ". ACTUAL SIZE IS" & 107 INTEGER'IMAGE(PRIVATE_PARENT'SIZE)); 108 END IF; 109 110 IF DERIVED_PRIVATE_TYPE'SIZE /= IDENT_INT (SPECIFIED_SIZE) THEN 111 FAILED ("DERIVED_PRIVATE_TYPE'SIZE SHOULD BE " & 112 INTEGER'IMAGE(SPECIFIED_SIZE) & 113 ". ACTUAL SIZE IS" & 114 INTEGER'IMAGE(DERIVED_PRIVATE_TYPE'SIZE)); 115 END IF; 116 117 IF DPT'SIZE < IDENT_INT (SPECIFIED_SIZE) THEN 118 FAILED ("DPT'SIZE SHOULD NOT BE LESS THAN" & 119 INTEGER'IMAGE(SPECIFIED_SIZE) & 120 ". ACTUAL SIZE IS" & 121 INTEGER'IMAGE(DPT'SIZE)); 122 END IF; 123 124 IF LIM_PRIV_PARENT'SIZE /= IDENT_INT (INTEGER'SIZE) THEN 125 FAILED ("LIM_PRIV_PARENT'SIZE SHOULD BE" & 126 INTEGER'IMAGE(INTEGER'SIZE) & 127 ". ACTUAL SIZE IS" & 128 INTEGER'IMAGE(LIM_PRIV_PARENT'SIZE)); 129 END IF; 130 131 IF DERIVED_LIM_PRIV_TYPE'SIZE /= IDENT_INT (SPECIFIED_SIZE) THEN 132 FAILED ("DERIVED_LIM_PRIV_TYPE'SIZE SHOULD BE " & 133 INTEGER'IMAGE(SPECIFIED_SIZE) & 134 ". ACTUAL SIZE IS" & 135 INTEGER'IMAGE(DERIVED_LIM_PRIV_TYPE'SIZE)); 136 END IF; 137 138 IF DLPT'SIZE < IDENT_INT (SPECIFIED_SIZE) THEN 139 FAILED ("DLPT'SIZE SHOULD NOT BE LESS THAN" & 140 INTEGER'IMAGE(SPECIFIED_SIZE) & 141 ". ACTUAL SIZE IS" & 142 INTEGER'IMAGE(DLPT'SIZE)); 143 END IF; 144 145 RESULT; 146 147END CD1C04A; 148