| -- 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; |