Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/c5/c52104b.ada @ 111:04ced10e8804

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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 -- C52104B.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 LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
26 -- MORE SPECIFICALLY, TEST THAT ATTEMPTED ASSIGNMENTS BETWEEN
27 -- ARRAYS WITH NON-MATCHING LENGTHS LEAVE THE DESTINATION ARRAY
28 -- INTACT AND CAUSE CONSTRAINT_ERROR TO BE RAISED.
29 -- (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
30 -- ARE TREATED ELSEWHERE.)
31
32 -- THIS IS THE SECOND FILE IN
33 -- DIVISION A : STATICALLY-DETERMINABLE NON-NULL LENGTHS.
34
35
36 -- RM 07/20/81
37 -- SPS 3/22/83
38
39 WITH REPORT;
40 PROCEDURE C52104B IS
41
42 USE REPORT ;
43
44 BEGIN
45
46 TEST( "C52104B" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
47 " ASSIGNMENTS THE LENGTHS MUST MATCH" );
48
49
50 -- ( EACH DIVISION COMPRISES 3 FILES,
51 -- COVERING RESPECTIVELY THE FIRST
52 -- 3 , NEXT 2 , AND LAST 3 OF THE 8
53 -- SELECTIONS FOR THE DIVISION.)
54
55
56 -------------------------------------------------------------------
57
58 -- (13) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
59 -- WERE DEFINED USING THE "BOX" SYMBOL
60 -- AND FOR WHICH THE COMPONENT TYPE IS 'CHARACTER' .
61
62 DECLARE
63
64 TYPE TABOX3 IS ARRAY( INTEGER RANGE <> ) OF CHARACTER ;
65
66 ARRX31 : TABOX3( 2..6 ) := "QUINC" ;
67
68 BEGIN
69
70
71 -- ARRAY ASSIGNMENT (WITH STRING AGGREGATE):
72
73 ARRX31 := "ABCD" ;
74 FAILED( "NO EXCEPTION RAISED (13)" );
75
76 EXCEPTION
77
78 WHEN CONSTRAINT_ERROR =>
79
80 -- CHECKING THE VALUES AFTER THE ASSIGNMENT:
81
82 IF ARRX31 /= "QUINC" OR
83 ARRX31( 2..6 ) /= "QUINC"
84 THEN
85 FAILED( "LHS ARRAY ALTERED (13)" );
86 END IF;
87
88 WHEN OTHERS =>
89 FAILED( "WRONG EXCEPTION RAISED - SUBTEST 13" );
90
91 END ;
92
93
94 -------------------------------------------------------------------
95
96 -- (14) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
97 -- WERE DEFINED USING THE "BOX" SYMBOL
98 -- AND FOR WHICH THE COMPONENT TYPE IS 'CHARACTER' .
99
100 DECLARE
101
102 TYPE TABOX4 IS ARRAY( INTEGER RANGE <> ) OF CHARACTER ;
103
104 SUBTYPE TABOX42 IS TABOX4( 5..9 );
105
106 ARRX42 : TABOX42 ;
107
108 BEGIN
109
110 -- INITIALIZATION OF LHS ARRAY:
111
112 ARRX42 := "QUINC" ;
113
114
115 -- SLICE ASSIGNMENT:
116
117 ARRX42( 6..9 ) := "ABCDEFGH" ;
118 FAILED( "NO EXCEPTION RAISED (14)" );
119
120 EXCEPTION
121
122 WHEN CONSTRAINT_ERROR =>
123
124 -- CHECKING THE VALUES AFTER THE ASSIGNMENT:
125
126 IF ARRX42 /= "QUINC" OR
127 ARRX42( 5..9 ) /= "QUINC"
128 THEN
129 FAILED( "LHS ARRAY ALTERED (14)" );
130 END IF;
131
132 WHEN OTHERS =>
133 FAILED( "WRONG EXCEPTION RAISED - SUBTEST 14" );
134
135 END ;
136
137
138 -------------------------------------------------------------------
139
140
141 RESULT ;
142
143
144 END C52104B;