annotate gcc/testsuite/ada/acats/support/lencheck.ada @ 111:04ced10e8804

gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
111
kono
parents:
diff changeset
1 -- THIS GENERIC PROCEDURE IS INTENDED FOR USE IN CONJUNCTION WITH THE
kono
parents:
diff changeset
2 -- ACVC CHAPTER 13 C TESTS. IT IS INSTANTIATED FOR A TYPE WHOSE
kono
parents:
diff changeset
3 -- REPRESENTATION IS TO BE CHECKED, AND THEN THE PROCEDURE REP_CHECK
kono
parents:
diff changeset
4 -- IS CALLED WITH TWO ARGUMENTS, THE FIRST IS A VALUE OF THE TYPE TO
kono
parents:
diff changeset
5 -- BE CHECKED, AND THE SECOND IS A STRING DESCRIBING OR NAMING THE
kono
parents:
diff changeset
6 -- TYPE (FOR USE IN A CALL TO FAILED IF THE REPRESENTATION CHECK FAILS)
kono
parents:
diff changeset
7
kono
parents:
diff changeset
8 -- THE CHECK IS TO CONVERT THE VALUE TO A PACKED BOOLEAN ARRAY WITH A
kono
parents:
diff changeset
9 -- LENGTH CORRESPONDING TO THE 'SIZE OF THE TYPE, AND THEN CONVERT IT
kono
parents:
diff changeset
10 -- BACK AGAIN AND CHECK THAT THE SAME VALUE IS OBTAINED. THE
kono
parents:
diff changeset
11 -- CONVERSIONS ARE PERFORMED USING APPROPRIATE INSTANTIATIONS OF
kono
parents:
diff changeset
12 -- UNCHECKED_CONVERSION.
kono
parents:
diff changeset
13
kono
parents:
diff changeset
14 -- AUTHOR: ROBERT B. K. DEWAR, UNCOPYRIGHTED, PUBLIC DOMAIN USE
kono
parents:
diff changeset
15 -- AUTHORIZED
kono
parents:
diff changeset
16 -- DHH 03/27/89 CHANGED REP_CHECK TO LENGTH_CHECK BY ADDING A THIRD
kono
parents:
diff changeset
17 -- PARAMETER TO GIVE LENGTH EXPECTED AND BY DOING A BIT TO
kono
parents:
diff changeset
18 -- BIT COPY OF THE UNCHECKED CONVERSION BOOLEAN ARRAY SO
kono
parents:
diff changeset
19 -- A STRAIGHT COMPARE OF THE TWO VALUES CAN BE DONE.
kono
parents:
diff changeset
20
kono
parents:
diff changeset
21 GENERIC
kono
parents:
diff changeset
22
kono
parents:
diff changeset
23 TYPE TEST_TYPE IS PRIVATE;
kono
parents:
diff changeset
24
kono
parents:
diff changeset
25 PROCEDURE LENGTH_CHECK (TEST_VALUE : TEST_TYPE;
kono
parents:
diff changeset
26 EXPECTED_LENGTH : INTEGER;
kono
parents:
diff changeset
27 TYPE_ID : STRING);
kono
parents:
diff changeset
28
kono
parents:
diff changeset
29 WITH UNCHECKED_CONVERSION;
kono
parents:
diff changeset
30 WITH REPORT; USE REPORT;
kono
parents:
diff changeset
31
kono
parents:
diff changeset
32 PROCEDURE LENGTH_CHECK (TEST_VALUE : TEST_TYPE;
kono
parents:
diff changeset
33 EXPECTED_LENGTH : INTEGER;
kono
parents:
diff changeset
34 TYPE_ID : STRING) IS
kono
parents:
diff changeset
35 LEN : CONSTANT INTEGER := EXPECTED_LENGTH;
kono
parents:
diff changeset
36 TYPE BIT_ARRAY_TYPE IS ARRAY (1 .. LEN) OF BOOLEAN;
kono
parents:
diff changeset
37 PRAGMA PACK (BIT_ARRAY_TYPE);
kono
parents:
diff changeset
38 TYPE NEW_BIT_ARRAY_TYPE IS ARRAY (1 .. 3) OF BIT_ARRAY_TYPE;
kono
parents:
diff changeset
39
kono
parents:
diff changeset
40 FUNCTION TO_BITS IS NEW UNCHECKED_CONVERSION (TEST_TYPE,
kono
parents:
diff changeset
41 BIT_ARRAY_TYPE);
kono
parents:
diff changeset
42 FUNCTION FROM_BITS IS NEW UNCHECKED_CONVERSION (BIT_ARRAY_TYPE,
kono
parents:
diff changeset
43 TEST_TYPE);
kono
parents:
diff changeset
44
kono
parents:
diff changeset
45 BIT_ARRAY : BIT_ARRAY_TYPE := (OTHERS => FALSE);
kono
parents:
diff changeset
46
kono
parents:
diff changeset
47 BIT_ARRAY_NEW : NEW_BIT_ARRAY_TYPE := (OTHERS => (OTHERS => FALSE));
kono
parents:
diff changeset
48 BEGIN
kono
parents:
diff changeset
49
kono
parents:
diff changeset
50 BIT_ARRAY := TO_BITS (TEST_VALUE);
kono
parents:
diff changeset
51
kono
parents:
diff changeset
52 FOR I IN 1 .. LEN LOOP
kono
parents:
diff changeset
53 BIT_ARRAY_NEW(IDENT_INT(1)) (IDENT_INT(I)) := BIT_ARRAY(I);
kono
parents:
diff changeset
54 END LOOP;
kono
parents:
diff changeset
55
kono
parents:
diff changeset
56 IF TEST_VALUE /= FROM_BITS (BIT_ARRAY_NEW(1)) THEN
kono
parents:
diff changeset
57 FAILED ("CHECK ON REPRESENTATION FOR " & TYPE_ID & " FAILED.");
kono
parents:
diff changeset
58 END IF;
kono
parents:
diff changeset
59
kono
parents:
diff changeset
60 END LENGTH_CHECK;