1-- C35508P.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 'FIRST' AND 'LAST' YIELD THE CORRECT RESULTS WHEN THE
27--     PREFIX IS A GENERIC FORMAL DISCRETE TYPE WHOSE ACTUAL PARAMETER
28--     IS A BOOLEAN TYPE.
29
30-- HISTORY:
31--     RJW 03/19/86 CREATED ORIGINAL TEST.
32--     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
33
34WITH REPORT; USE REPORT;
35
36PROCEDURE C35508P IS
37
38BEGIN
39     TEST ("C35508P", "CHECK THAT 'FIRST' AND 'LAST' YIELD THE " &
40                      "CORRECT RESULTS WHEN THE PREFIX IS A " &
41                      "GENERIC FORMAL DISCRETE TYPE WHOSE ACTUAL " &
42                      "PARAMETER IS A BOOLEAN TYPE" );
43     DECLARE
44          SUBTYPE TBOOL IS BOOLEAN
45               RANGE IDENT_BOOL(TRUE) .. IDENT_BOOL(TRUE);
46          SUBTYPE FBOOL IS BOOLEAN
47               RANGE IDENT_BOOL(FALSE) .. IDENT_BOOL(FALSE);
48          SUBTYPE NOBOOL IS BOOLEAN
49               RANGE IDENT_BOOL(TRUE) .. IDENT_BOOL(FALSE);
50          TYPE NEWBOOL IS NEW BOOLEAN;
51
52          GENERIC
53               TYPE BOOL IS (<>);
54               F, L : BOOL;
55          PROCEDURE P ( STR : STRING );
56
57          PROCEDURE P ( STR : STRING ) IS
58          BEGIN
59               IF BOOL'FIRST /= F THEN
60                    FAILED ( "WRONG VALUE FOR " & STR & "'FIRST" );
61               END IF;
62               IF BOOL'LAST /= L THEN
63                    FAILED ( "WRONG VALUE FOR " & STR & "'LAST" );
64               END IF;
65          END P;
66
67          GENERIC
68               TYPE BOOL IS (<>);
69          PROCEDURE Q;
70
71          PROCEDURE Q IS
72          BEGIN
73               IF BOOL'FIRST /= BOOL'VAL (IDENT_INT(1)) THEN
74                    FAILED ( "WRONG 'FIRST FOR NOBOOL" );
75               END IF;
76               IF BOOL'LAST /= BOOL'VAL (IDENT_INT(0)) THEN
77                    FAILED ( "WRONG 'LAST FOR NOBOOL" );
78               END IF;
79          END Q;
80
81          GENERIC
82               TYPE BOOL IS (<>);
83               F, L : BOOL;
84          PROCEDURE R;
85
86          PROCEDURE R IS
87               SUBTYPE SBOOL IS BOOL
88                              RANGE BOOL'VAL (0) .. BOOL'VAL (1);
89          BEGIN
90               IF SBOOL'FIRST /= F THEN
91                    FAILED ( "WRONG VALUE FOR BOOLEAN'FIRST AS " &
92                             "SUBTYPE " );
93               END IF;
94               IF SBOOL'LAST /= L THEN
95                    FAILED ( "WRONG VALUE FOR BOOLEAN'LAST AS " &
96                             "SUBTYPE" );
97               END IF;
98          END R;
99
100          PROCEDURE P1 IS NEW P
101          ( BOOL => BOOLEAN, F => IDENT_BOOL(FALSE),
102                                              L => IDENT_BOOL(TRUE) );
103
104          PROCEDURE P2 IS NEW P
105          ( BOOL => TBOOL, F => IDENT_BOOL(TRUE),
106                                              L => IDENT_BOOL(TRUE) );
107
108          PROCEDURE P3 IS NEW P
109          ( BOOL => FBOOL, F => IDENT_BOOL(FALSE),
110                                             L => IDENT_BOOL(FALSE) );
111
112          PROCEDURE P4 IS NEW P
113                         (BOOL => NEWBOOL, F => FALSE, L => TRUE );
114
115          PROCEDURE Q1 IS NEW Q
116                         ( BOOL => NOBOOL );
117
118          PROCEDURE R1 IS NEW R
119                         ( BOOL => BOOLEAN, F => FALSE, L => TRUE );
120
121     BEGIN
122          P1 ( "BOOLEAN" );
123          P2 ( "TBOOL" );
124          P3 ( "FBOOL" );
125          P4 ( "NEWBOOL" );
126          Q1;
127          R1;
128     END;
129
130     RESULT;
131END C35508P;
132