1 files changed, 60 insertions, 0 deletions
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/support/lencheck.ada b/gcc-4.9/gcc/testsuite/ada/acats/support/lencheck.ada
new file mode 100644
index 000000000..f8ed1385b
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/support/lencheck.ada
@@ -0,0 +1,60 @@
+-- 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;