Mercurial > hg > CbC > CbC_gcc

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