Subversion Repositories openrisc

-- C35507E.ADA

--                             Grant of Unlimited Rights

--

--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,

--     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 

--     unlimited rights in the software and documentation contained herein.

--     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 

--     this public release, the Government intends to confer upon all 

--     recipients unlimited rights  equal to those held by the Government.  

--     These rights include rights to use, duplicate, release or disclose the 

--     released technical data and computer software in whole or in part, in 

--     any manner and for any purpose whatsoever, and to have or permit others 

--     to do so.

--

--                                    DISCLAIMER

--

--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR

--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 

--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE

--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 

--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A

--     PARTICULAR PURPOSE OF SAID MATERIAL.

--*

-- OBJECTIVE:

--     CHECK THAT THE ATTRIBUTES 'IMAGE' AND 'VALUE YIELD THE CORRECT

--     RESULTS WHEN THE PREFIX IS A FORMAL DISCRETE TYPE WHOSE ACTUAL

--     PARAMETER IS A CHARACTER TYPE.

--     SUBTESTS ARE:

--         (A). TESTS FOR IMAGE.

--         (B). TESTS FOR VALUE.

-- HISTORY:

--     RJW  05/29/86  CREATED ORIGINAL TEST.

--     VCL  10/23/87  MODIFIED THIS HEADER, CHANGED THE CALLS TO

--                    PROCEDURE 'PCH', IN THE SECOND PART OF SUBTEST B,

--                    TO INCLUDE ANOTHER CALL TO PROCEDURE 'PCHAR' AND

--                    CALLS TO PROCEDURE 'PNCHAR'.

WITH REPORT; USE REPORT;

PROCEDURE  C35507E  IS

     TYPE CHAR IS ('A', 'a');

     TYPE NEWCHAR IS NEW CHAR;

     PROCEDURE CHECK_LOWER_BOUND (STR1, STR2 : STRING) IS

     BEGIN

          IF STR1'FIRST /= 1 THEN

               FAILED ( "INCORRECT LOWER BOUND FOR " & STR2 & "'(" &

                        STR1 & ")" );

          END IF;

     END CHECK_LOWER_BOUND;

BEGIN

     TEST( "C35507E" , "THE ATTRIBUTES 'IMAGE' AND " &

                       "'VALUE' YIELD THE CORRECT RESULTS WHEN THE " &

                       "PREFIX IS A FORMAL DISCRETE TYPE WHOSE " &

                       "ACTUAL PARAMETER IS A CHARACTER TYPE" );

     DECLARE -- (A).

          GENERIC

               TYPE CHTYPE IS (<>);

               STR1 : STRING;

          PROCEDURE P (CH : CHTYPE; STR2 : STRING);

          PROCEDURE P (CH : CHTYPE; STR2 : STRING) IS

               SUBTYPE SUBCH IS CHTYPE;

          BEGIN

               IF SUBCH'IMAGE (CH) /= STR2 THEN

                    FAILED ( "INCORRECT IMAGE FOR " & STR1 & "'(" &

                              STR2 & ")" );

               END IF;

               CHECK_LOWER_BOUND (SUBCH'IMAGE (CH), STR1);

          END P;

          PROCEDURE PCHAR  IS NEW P (CHAR, "CHAR");

          PROCEDURE PNCHAR IS NEW P (NEWCHAR, "NEWCHAR");

          PROCEDURE PCH    IS NEW P (CHARACTER, "CHARACTER");

     BEGIN

          PCHAR ('A', "'A'");

          PCHAR ('a', "'a'");

          PNCHAR ('A', "'A'");

          PNCHAR ('a', "'a'");

          FOR CH IN CHARACTER'VAL (32) .. CHARACTER'VAL (126) LOOP

               PCH (CH, ("'" & CH) & "'" );

          END LOOP;

     END;

     DECLARE

          GENERIC

               TYPE CHTYPE IS (<>);

          PROCEDURE P (CH : CHTYPE; STR : STRING);

          PROCEDURE P (CH : CHTYPE; STR : STRING) IS

               SUBTYPE SUBCH IS CHTYPE;

          BEGIN

               CHECK_LOWER_BOUND (CHTYPE'IMAGE (CH), "CHARACTER");

          END P;

          PROCEDURE PN IS NEW P (CHARACTER);

     BEGIN

          FOR CH IN CHARACTER'VAL (0) .. CHARACTER'VAL (31) LOOP

               PN (CH, CHARACTER'IMAGE (CH));

          END LOOP;

          PN (ASCII.DEL, CHARACTER'IMAGE (ASCII.DEL));

     END;

     ---------------------------------------------------------------

     DECLARE -- (B).

          GENERIC

               TYPE CHTYPE IS (<>);

               STR1 : STRING;

          PROCEDURE P (STR2 : STRING; CH : CHTYPE);

          PROCEDURE P (STR2 : STRING; CH : CHTYPE) IS

               SUBTYPE SUBCH IS CHTYPE;

          BEGIN

               IF SUBCH'VALUE (STR2) /= CH THEN

                    FAILED ( "INCORRECT " & STR1 & "'VALUE FOR " &

                              STR2 );

               END IF;

          END P;

          PROCEDURE PCH IS NEW P (CHARACTER, "CHARACTER");

          PROCEDURE PCHAR IS NEW P (CHAR, "CHAR");

          PROCEDURE PNCHAR IS NEW P (NEWCHAR, "NEWCHAR");

     BEGIN

          FOR CH IN CHARACTER'VAL (0) .. CHARACTER'VAL (31) LOOP

                PCH (CHARACTER'IMAGE (CH), CH );

          END LOOP;

          PCH (CHARACTER'IMAGE (CHARACTER'VAL (127)),

               CHARACTER'VAL (127));

          PCHAR ("'A'", 'A');

          PCHAR ("'a'", 'a' );

          PNCHAR ("'A'", 'A');

          PNCHAR ("'a'", 'a');

     END;

     DECLARE

          GENERIC

               TYPE CHTYPE IS (<>);

               STR1 : STRING;

          PROCEDURE P (STR2 : STRING);

          PROCEDURE P (STR2 : STRING) IS

               SUBTYPE SUBCH IS CHTYPE;

          BEGIN

               IF SUBCH'VALUE (STR2) = SUBCH'VAL (0) THEN

                    FAILED ( "NO EXCEPTION RAISED FOR " &

                              STR1 & "'VALUE (" & STR2 & ") - 1" );

               ELSE

                    FAILED ( "NO EXCEPTION RAISED FOR " &

                              STR1 & "'VALUE (" & STR2 & ") - 2" );

               END IF;

          EXCEPTION

               WHEN CONSTRAINT_ERROR =>

                    NULL;

               WHEN OTHERS =>

                    FAILED ( "WRONG EXCEPTION RAISED " &

                             "FOR " & STR1 & "'VALUE (" & STR2 & ")" );

          END P;

          PROCEDURE PCH IS NEW P (CHARACTER, "CHARACTER");

          PROCEDURE PCHAR IS NEW P (CHAR, "CHAR");

          PROCEDURE PNCHAR IS NEW P (NEWCHAR, "NEWCHAR");

     BEGIN

          PCHAR ("'B'");

          PCH (ASCII.HT & "'A'");

          PCH ("'B'" & ASCII.HT);

          PCH ("'C'" & ASCII.BEL);

          PCH ("'");

          PNCHAR ("''");

          PCHAR ("'A");

          PNCHAR ("A'");

          PCH ("'AB'");

     END;

     RESULT;

END C35507E;