diff options
Diffstat (limited to 'gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35507e.ada')
| -rw-r--r-- | gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35507e.ada | 194 |
1 files changed, 194 insertions, 0 deletions
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35507e.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35507e.ada new file mode 100644 index 000000000..93979902c --- /dev/null +++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c35507e.ada @@ -0,0 +1,194 @@ +-- 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; |