Mercurial > hg > CbC > CbC_gcc
comparison gcc/testsuite/ada/acats/tests/cd/cd40001.a @ 111:04ced10e8804
gcc 7
| author | kono |
|---|---|
| date | Fri, 27 Oct 2017 22:46:09 +0900 |
| parents | |
| children |
comparison
equal
deleted
inserted
replaced
| 68:561a7518be6b | 111:04ced10e8804 |
|---|---|
| 1 -- CD40001.A | |
| 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 -- | |
| 26 -- OBJECTIVE: | |
| 27 -- Check that Enumeration_Representation_Clauses are supported for | |
| 28 -- codes in the range System.Min_Int..System.Max_Int. | |
| 29 -- | |
| 30 -- TEST DESCRIPTION: | |
| 31 -- This test defines several types, and checks that the range of the | |
| 32 -- enumeration clause is as expected. | |
| 33 -- | |
| 34 -- APPLICABILITY CRITERIA: | |
| 35 -- All implementations must attempt to compile this test. | |
| 36 -- | |
| 37 -- For implementations validating against Systems Programming Annex (C): | |
| 38 -- this test must execute and report PASSED. | |
| 39 -- | |
| 40 -- For implementations not validating against Annex C: | |
| 41 -- this test may report compile time errors at one or more points | |
| 42 -- indicated by "-- ANX-C RQMT", in which case it may be graded as inapplicable. | |
| 43 -- Otherwise, the test must execute and report PASSED. | |
| 44 -- | |
| 45 -- | |
| 46 -- CHANGE HISTORY: | |
| 47 -- 22 JUL 95 SAIC Initial version | |
| 48 -- 07 MAY 96 SAIC Revised for 2.1 | |
| 49 -- 16 FEB 98 EDS Modified Documentation. | |
| 50 --! | |
| 51 | |
| 52 with System; | |
| 53 with Ada.Unchecked_Conversion; | |
| 54 package CD40001_0 is | |
| 55 | |
| 56 type Press_The_Bounds is ( Negative_Large, Positive_Large ); | |
| 57 | |
| 58 for Press_The_Bounds use | |
| 59 ( Negative_Large => System.Min_Int, -- ANX-C RQMT. | |
| 60 Positive_Large => System.Max_Int ); -- ANX-C RQMT. | |
| 61 | |
| 62 type Add_The_Bounds is | |
| 63 ( Monday, Tuesday, Wednesday, Thursday, Friday, Saturday); | |
| 64 | |
| 65 for Add_The_Bounds use | |
| 66 ( Monday => System.Min_Int, -- ANX-C RQMT. | |
| 67 Tuesday => System.Min_Int + 1, -- ANX-C RQMT. | |
| 68 Wednesday => System.Min_Int + 2, -- ANX-C RQMT. | |
| 69 Thursday => System.Min_Int + 3, -- ANX-C RQMT. | |
| 70 Friday => System.Min_Int + 4, -- ANX-C RQMT. | |
| 71 Saturday => System.Min_Int + 5 ); -- ANX-C RQMT. | |
| 72 | |
| 73 type Minus_The_Bounds is ( Jan, Feb, Mar, Apr); | |
| 74 | |
| 75 for Minus_The_Bounds use | |
| 76 ( Apr => System.Max_Int, -- ANX-C RQMT. | |
| 77 Mar => System.Max_Int - 1, -- ANX-C RQMT. | |
| 78 Feb => System.Max_Int - 2, -- ANX-C RQMT. | |
| 79 Jan => System.Max_Int - 3 ); -- ANX-C RQMT. | |
| 80 | |
| 81 type TC_Integer is range System.Min_Int..System.Max_Int; | |
| 82 | |
| 83 procedure TC_Check_Press; | |
| 84 | |
| 85 procedure TC_Check_Add; | |
| 86 | |
| 87 procedure TC_Check_Minus; | |
| 88 | |
| 89 function TC_Compare_Press is new Ada.Unchecked_Conversion | |
| 90 (Press_The_Bounds, TC_Integer); | |
| 91 | |
| 92 function TC_Compare_Add is new Ada.Unchecked_Conversion | |
| 93 (Add_The_Bounds, TC_Integer); | |
| 94 | |
| 95 function TC_Compare_Minus is new Ada.Unchecked_Conversion | |
| 96 (Minus_The_Bounds, TC_Integer); | |
| 97 | |
| 98 end CD40001_0; | |
| 99 | |
| 100 --==================================================================-- | |
| 101 | |
| 102 with Report; | |
| 103 package body CD40001_0 is | |
| 104 | |
| 105 procedure TC_Check_Press is | |
| 106 My_Press_First : Press_The_Bounds := Negative_Large; | |
| 107 My_Press_Last : Press_The_Bounds := Positive_Large; | |
| 108 begin | |
| 109 if TC_Compare_Press (My_Press_First) /= System.Min_Int or | |
| 110 TC_Compare_Press (My_Press_Last) /= System.Max_Int | |
| 111 then | |
| 112 Report.Failed | |
| 113 ("Expected enumeration size of System.Min_Int and System.Max_Int " & | |
| 114 "not available for this implementation"); | |
| 115 end if; | |
| 116 end TC_Check_Press; | |
| 117 | |
| 118 --------------------------------------------------------------------------- | |
| 119 procedure TC_Check_Add is | |
| 120 My_Monday : Add_The_Bounds := Monday; | |
| 121 My_Tuesday : Add_The_Bounds := Tuesday; | |
| 122 My_Wednesday : Add_The_Bounds := Wednesday; | |
| 123 My_Thursday : Add_The_Bounds := Thursday; | |
| 124 My_Friday : Add_The_Bounds := Friday; | |
| 125 My_Saturday : Add_The_Bounds := Saturday; | |
| 126 begin | |
| 127 if TC_Compare_Add (My_Monday) /= (System.Min_Int) or | |
| 128 TC_Compare_Add (My_Thursday) /= (System.Min_Int + 3) or | |
| 129 TC_Compare_Add (My_Wednesday) /= (System.Min_Int + 2) or | |
| 130 TC_Compare_Add (My_Tuesday) /= (System.Min_Int + 1) or | |
| 131 TC_Compare_Add (My_Saturday) /= (System.Min_Int + 5) or | |
| 132 TC_Compare_Add (My_Friday) /= (System.Min_Int + 4) | |
| 133 then | |
| 134 Report.Failed | |
| 135 ("Expected enumeration size of System.Min_Int, System.Min_Int + 1 " & | |
| 136 "through System.Min_Int + 5 not available for this implementation"); | |
| 137 end if; | |
| 138 end TC_Check_Add; | |
| 139 | |
| 140 --------------------------------------------------------------------------- | |
| 141 procedure TC_Check_Minus is | |
| 142 My_Jan : Minus_The_Bounds := Jan; | |
| 143 My_Feb : Minus_The_Bounds := Feb; | |
| 144 My_Mar : Minus_The_Bounds := Mar; | |
| 145 My_Apr : Minus_The_Bounds := Apr; | |
| 146 begin | |
| 147 if TC_Compare_Minus (My_Jan) /= (System.Max_Int - 3) or | |
| 148 TC_Compare_Minus (My_Feb) /= (System.Max_Int - 2) or | |
| 149 TC_Compare_Minus (My_Mar) /= (System.Max_Int - 1) or | |
| 150 TC_Compare_Minus (My_Apr) /= (System.Max_Int) | |
| 151 then | |
| 152 Report.Failed | |
| 153 ("Expected enumeration size of System.Max_Int, System.Max_Int - 1 " & | |
| 154 "through System.Max_Int - 3 not available for this implementation"); | |
| 155 end if; | |
| 156 end TC_Check_Minus; | |
| 157 | |
| 158 end CD40001_0; | |
| 159 | |
| 160 --==================================================================-- | |
| 161 | |
| 162 with Report; | |
| 163 with CD40001_0; | |
| 164 | |
| 165 procedure CD40001 is | |
| 166 | |
| 167 begin -- Main test procedure. | |
| 168 | |
| 169 Report.Test ("CD40001", "Check that Enumeration_Representation_Clauses " & | |
| 170 "are supported for codes in the range " & | |
| 171 "System.Min_Int..System.Max_Int" ); | |
| 172 | |
| 173 CD40001_0.TC_Check_Press; | |
| 174 | |
| 175 CD40001_0.TC_Check_Add; | |
| 176 | |
| 177 CD40001_0.TC_Check_Minus; | |
| 178 | |
| 179 Report.Result; | |
| 180 | |
| 181 end CD40001; |