lencheck.ada

来自「用于进行gcc测试」· ADA 代码 · 共 61 行

-- THIS GENERIC PROCEDURE IS INTENDED FOR USE IN CONJUNCTION WITH THE 
-- ACVC CHAPTER 13 C TESTS. IT IS INSTANTIATED FOR A TYPE WHOSE 
-- REPRESENTATION IS TO BE CHECKED, AND THEN THE PROCEDURE REP_CHECK 
-- IS CALLED WITH TWO ARGUMENTS, THE FIRST IS A VALUE OF THE TYPE TO 
-- BE CHECKED, AND THE SECOND IS A STRING DESCRIBING OR NAMING THE 
-- TYPE (FOR USE IN A CALL TO FAILED IF THE REPRESENTATION CHECK FAILS)

-- THE CHECK IS TO CONVERT THE VALUE TO A PACKED BOOLEAN ARRAY WITH A 
-- LENGTH CORRESPONDING TO THE 'SIZE OF THE TYPE, AND THEN CONVERT IT 
-- BACK AGAIN AND CHECK THAT THE SAME VALUE IS OBTAINED. THE 
-- CONVERSIONS ARE PERFORMED USING APPROPRIATE INSTANTIATIONS OF 
-- UNCHECKED_CONVERSION.

-- AUTHOR: ROBERT B. K. DEWAR, UNCOPYRIGHTED, PUBLIC DOMAIN USE 
--                             AUTHORIZED
-- DHH 03/27/89 CHANGED REP_CHECK TO LENGTH_CHECK BY ADDING A THIRD
--              PARAMETER TO GIVE LENGTH EXPECTED AND BY DOING A BIT TO
--              BIT COPY OF THE UNCHECKED CONVERSION BOOLEAN ARRAY SO 
--              A STRAIGHT COMPARE OF THE TWO VALUES CAN BE DONE.

GENERIC

   TYPE TEST_TYPE IS PRIVATE;

PROCEDURE LENGTH_CHECK (TEST_VALUE      : TEST_TYPE; 
                        EXPECTED_LENGTH : INTEGER;
                        TYPE_ID         : STRING);

WITH UNCHECKED_CONVERSION;
WITH REPORT; USE REPORT;

PROCEDURE LENGTH_CHECK (TEST_VALUE      : TEST_TYPE; 
                        EXPECTED_LENGTH : INTEGER;
                        TYPE_ID         : STRING) IS
   LEN : CONSTANT INTEGER := EXPECTED_LENGTH;
   TYPE BIT_ARRAY_TYPE IS ARRAY (1 .. LEN) OF BOOLEAN;
   PRAGMA PACK (BIT_ARRAY_TYPE);
   TYPE NEW_BIT_ARRAY_TYPE IS ARRAY (1 .. 3) OF BIT_ARRAY_TYPE;

   FUNCTION TO_BITS IS NEW UNCHECKED_CONVERSION (TEST_TYPE,
                                                 BIT_ARRAY_TYPE);
   FUNCTION FROM_BITS IS NEW UNCHECKED_CONVERSION (BIT_ARRAY_TYPE,
                                                   TEST_TYPE);

   BIT_ARRAY : BIT_ARRAY_TYPE := (OTHERS => FALSE);

   BIT_ARRAY_NEW : NEW_BIT_ARRAY_TYPE := (OTHERS => (OTHERS => FALSE));
BEGIN

   BIT_ARRAY := TO_BITS (TEST_VALUE);

   FOR I IN 1 .. LEN LOOP
        BIT_ARRAY_NEW(IDENT_INT(1)) (IDENT_INT(I)) := BIT_ARRAY(I);
   END LOOP;

   IF TEST_VALUE /= FROM_BITS (BIT_ARRAY_NEW(1)) THEN
      FAILED ("CHECK ON REPRESENTATION FOR " & TYPE_ID & " FAILED.");
   END IF;

END LENGTH_CHECK;