Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/c5/c52103g.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 -- C52103G.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 ARRAY ASSIGNMENTS WITH MATCHING
27 -- LENGTHS DO NOT CAUSE CONSTRAINT_ERROR TO BE RAISED AND
28 -- ARE PERFORMED CORRECTLY.
29 -- (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
30 -- ARE TREATED ELSEWHERE.)
31
32 -- THIS IS THE SECOND FILE IN
33 -- DIVISION B : STATICALLY-DETERMINABLE NULL LENGTHS.
34
35
36 -- RM 07/20/81
37 -- SPS 3/22/83
38
39
40 WITH REPORT;
41 PROCEDURE C52103G IS
42
43 USE REPORT ;
44
45 BEGIN
46
47 TEST( "C52103G" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
48 " ASSIGNMENTS THE LENGTHS MUST MATCH" );
49
50
51 -- ( EACH DIVISION COMPRISES 3 FILES,
52 -- COVERING RESPECTIVELY THE FIRST
53 -- 3 , NEXT 2 , AND LAST 3 OF THE 8
54 -- SELECTIONS FOR THE DIVISION.)
55
56
57 -------------------------------------------------------------------
58
59 -- (5) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
60 -- WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
61 -- AND FOR WHICH THE COMPONENT TYPE IS 'CHARACTER' .
62 --
63
64 DECLARE
65
66 TYPE TA51 IS ARRAY( INTEGER RANGE 11..10 ) OF CHARACTER ;
67
68 ARR51 : TA51 ;
69
70 BEGIN
71
72
73 -- ARRAY ASSIGNMENT (WITH STRING AGGREGATE):
74
75 ARR51 := "" ;
76
77
78 -- CHECKING THE VALUES AFTER THE ASSIGNMENT:
79
80 IF ARR51 /= ""
81 THEN
82 FAILED( "ARRAY ASSIGNMENT NOT CORRECT (5)" );
83 END IF;
84
85
86 EXCEPTION
87
88 WHEN OTHERS =>
89 FAILED( "EXCEPTION RAISED - SUBTEST 5" );
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( 11..15 );
105
106 ARRX42 : TABOX42 ;
107
108 BEGIN
109
110 -- INITIALIZATION OF LHS ARRAY:
111
112 ARRX42 := "QUINC" ;
113
114
115 -- NULL SLICE ASSIGNMENT:
116
117 ARRX42( 13..12 ) := "" ;
118
119
120 -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
121
122 IF ARRX42 /= "QUINC" OR
123 ARRX42( 11..15 ) /= "QUINC"
124 THEN
125 FAILED( "SLICE ASSIGNMENT NOT CORRECT (14)" );
126 END IF;
127
128 EXCEPTION
129
130 WHEN OTHERS =>
131 FAILED( "EXCEPTION RAISED - SUBTEST 14" );
132
133 END ;
134
135
136 -------------------------------------------------------------------
137
138
139 RESULT ;
140
141
142 END C52103G;