1-- C35503K.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 'POS' AND 'VAL' YIELD THE CORRECT RESULTS WHEN THE
27--     PREFIX IS AN INTEGER TYPE.
28
29-- HISTORY:
30--     RJW 03/17/86 CREATED ORIGINAL TEST.
31--     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
32--     PWN 11/30/94 REMOVED ATTRIBUTE TESTS ILLEGAL IN ADA 9X.
33
34WITH SYSTEM; USE SYSTEM;
35WITH REPORT; USE REPORT;
36
37PROCEDURE C35503K IS
38
39BEGIN
40     TEST ("C35503K", "CHECK THAT 'POS' AND 'VAL' YIELD THE " &
41                      "CORRECT RESULTS WHEN THE PREFIX IS AN " &
42                      "INTEGER TYPE" );
43
44     DECLARE
45          TYPE INT IS RANGE -6 .. 6;
46          SUBTYPE SINT IS INT RANGE -4 .. 4;
47
48          PROCEDURE P (I : INTEGER; STR : STRING) IS
49          BEGIN
50               BEGIN
51                    IF INTEGER'POS (I) /= I THEN
52                         FAILED ( "WRONG POS FOR " & STR);
53                    END IF;
54               EXCEPTION
55                    WHEN OTHERS =>
56                         FAILED ( "EXCEPTION RAISED FOR POS OF " &
57                                   STR);
58               END;
59               BEGIN
60                    IF INTEGER'VAL (I) /= I THEN
61                         FAILED ( "WRONG VAL FOR " & STR);
62                    END IF;
63               EXCEPTION
64                    WHEN OTHERS =>
65                         FAILED ( "EXCEPTION RAISED FOR VAL OF " &
66                                   STR);
67               END;
68          END P;
69
70     BEGIN
71          P ( INTEGER'FIRST, "INTEGER'FIRST");
72          P ( INTEGER'LAST,  "INTEGER'LAST");
73          P ( 0, "'0'");
74
75          FOR I IN INT'FIRST .. INT'LAST LOOP
76               BEGIN
77                    IF SINT'POS (I) /= I THEN
78                         FAILED ( "WRONG POS FOR "
79                                   & INT'IMAGE (I));
80                    END IF;
81               EXCEPTION
82                    WHEN OTHERS =>
83                         FAILED ( "EXCEPTION RAISED FOR POS OF "
84                                  & INT'IMAGE (I));
85               END;
86               BEGIN
87                    IF SINT'VAL (I) /= I THEN
88                         FAILED ( "WRONG VAL FOR "
89                                  & INT'IMAGE (I));
90                    END IF;
91               EXCEPTION
92                    WHEN OTHERS =>
93                         FAILED ( "EXCEPTION RAISED FOR VAL OF "
94                                  & INT'IMAGE (I));
95               END;
96          END LOOP;
97
98          BEGIN
99               IF INT'VAL (INTEGER'(0)) /= 0 THEN
100                    FAILED ( "WRONG VAL FOR INT WITH INTEGER" );
101               END IF;
102          EXCEPTION
103               WHEN OTHERS =>
104                    FAILED ( "EXCEPTION RAISED FOR VAL OF " &
105                             "INT WITH INTEGER" );
106          END;
107
108          BEGIN
109               IF INTEGER'VAL (INT'(0)) /= 0 THEN
110                    FAILED ( "WRONG VAL FOR INTEGER WITH INT" );
111               END IF;
112          EXCEPTION
113               WHEN OTHERS =>
114                    FAILED ( "EXCEPTION RAISED FOR VAL OF " &
115                             "INTEGER WITH INT" );
116          END;
117     END;
118
119     RESULT;
120END C35503K;
121