1-- C42006A.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-- CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN A STRING LITERAL OF AN
26-- ARRAY TYPE CONTAINS A CHARACTER THAT DOES NOT BELONG TO THE COMPONENT
27-- SUBTYPE.
28
29-- SPS 2/22/84
30-- EDS 12/02/97  MODIFIED THE COMPONENT SUBTYPES SO THAT THEY ARE NON-STATIC.
31-- EDS 7/14/98    AVOID OPTIMIZATION
32
33WITH REPORT;
34USE REPORT;
35PROCEDURE C42006A IS
36BEGIN
37
38     TEST ("C42006A", "CHECK THAT THE VALUES OF STRING LITERALS MUST" &
39           " BELONG TO THE COMPONENT SUBTYPE.");
40
41     DECLARE
42
43          TYPE CHAR_COMP IS ('A', 'B', 'C', 'D', 'E', 'F');
44
45          ASCIINUL : CHARACTER := ASCII.NUL;
46          SUBTYPE NON_GRAPHIC_CHAR IS CHARACTER
47               RANGE ASCIINUL .. ASCII.BEL;
48
49          BEE : CHAR_COMP := 'B';
50          TYPE CHAR_STRING IS ARRAY (POSITIVE RANGE <>)
51               OF CHAR_COMP RANGE BEE..'C';
52          TYPE NON_GRAPHIC_CHAR_STRING IS ARRAY (POSITIVE RANGE <>)
53               OF NON_GRAPHIC_CHAR;
54
55          C_STR : CHAR_STRING (1 .. 1);
56          C_STR_5 : CHAR_STRING (1 .. 5) := "BBBBB";
57          N_G_STR : NON_GRAPHIC_CHAR_STRING (1 .. 1) :=
58                    (OTHERS => NON_GRAPHIC_CHAR'FIRST);
59
60     BEGIN
61
62          BEGIN
63               C_STR_5 := "BABCC";      -- 'A' NOT IN COMPONENT SUBTYPE.
64               FAILED ("CONSTRAINT_ERROR NOT RAISED - 1 " &
65                       CHAR_COMP'IMAGE(C_STR_5(1)));
66          EXCEPTION
67               WHEN CONSTRAINT_ERROR =>
68                    NULL;
69               WHEN OTHERS =>
70                    FAILED ("SOME EXCEPTION RAISED - 1");
71          END;
72
73          BEGIN
74               C_STR_5 := "BCBCD";      -- 'D' NOT IN COMPONENT SUBTYPE.
75               FAILED ("CONSTRAINT_ERROR NOT RAISED - 2 " &
76                       CHAR_COMP'IMAGE(C_STR_5(1)));
77          EXCEPTION
78               WHEN CONSTRAINT_ERROR =>
79                    NULL;
80               WHEN OTHERS =>
81                    FAILED ("SOME EXCEPTION RAISED - 2");
82          END;
83
84          BEGIN
85               N_G_STR := "Z";
86               FAILED ("CONSTRAINT_ERROR NOT RAISED - 3 " &
87                       INTEGER'IMAGE(CHARACTER'POS(N_G_STR(1))));
88          EXCEPTION
89               WHEN CONSTRAINT_ERROR =>
90                    NULL;
91               WHEN OTHERS =>
92                    FAILED ("SOME EXCEPTION RAISED - 3");
93          END;
94
95     END;
96
97     RESULT;
98
99END C42006A;
100