diff options
Diffstat (limited to 'gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3017c.ada')
| -rw-r--r-- | gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3017c.ada | 336 |
1 files changed, 336 insertions, 0 deletions
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3017c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3017c.ada new file mode 100644 index 000000000..d4649716f --- /dev/null +++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3017c.ada @@ -0,0 +1,336 @@ +-- CC3017C.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 AN INSTANCE OF A GENERIC PROCEDURE MUST DECLARE A +-- PROCEDURE AND THAT AN INSTANCE OF A GENERIC FUNCTION MUST +-- DECLARE A FUNCTION. CHECK THAT SCALAR AND ACCESS PARAMETERS +-- ARE COPIED. +-- +-- SUBTESTS ARE: +-- (A) SCALAR PARAMETERS TO PROCEDURES. +-- (B) SCALAR PARAMETERS TO FUNCTIONS. +-- (C) ACCESS PARAMETERS TO PROCEDURES. +-- (D) ACCESS PARAMETERS TO FUNCTIONS. + +-- HISTORY: +-- EDWARD V. BERARD, 7 AUGUST 1990 +-- CJJ 10/16/90 ADJUSTED LINES THAT WERE TOO LONG; REFORMATTED +-- HEADER TO CONFORM TO ACVC STANDARDS. +-- + +WITH REPORT; +PROCEDURE CC3017C IS + +BEGIN + REPORT.TEST ("CC3017C", "CHECK THAT AN INSTANCE OF A GENERIC " & + "PROCEDURE MUST DECLARE A PROCEDURE AND THAT AN " & + "INSTANCE OF A GENERIC FUNCTION MUST DECLARE A " & + "FUNCTION. CHECK THAT SCALAR AND ACCESS PARAMETERS " & + "ARE COPIED"); + + -------------------------------------------------- + + SCALAR_TO_PROCS: + + DECLARE + +-- (A) SCALAR PARAMETERS TO PROCEDURES. + + TYPE NUMBER IS RANGE 0 .. 120 ; + VALUE : NUMBER ; + E : EXCEPTION ; + + GENERIC + + TYPE SCALAR_ITEM IS RANGE <> ; + + PROCEDURE P (P_IN : IN SCALAR_ITEM ; + P_OUT : OUT SCALAR_ITEM ; + P_IN_OUT : IN OUT SCALAR_ITEM) ; + + PROCEDURE P (P_IN : IN SCALAR_ITEM ; + P_OUT : OUT SCALAR_ITEM ; + P_IN_OUT : IN OUT SCALAR_ITEM) IS + + STORE : SCALAR_ITEM ; + + BEGIN -- P + + STORE := P_IN; -- SAVE VALUE OF P_IN AT PROC ENTRY. + + P_OUT := 10; + IF (P_IN /= STORE) THEN + REPORT.FAILED ("ASSIGNMENT TO SCALAR OUT " & + "PARAMETER CHANGES THE VALUE OF " & + "INPUT PARAMETER"); + STORE := P_IN; -- RESET STORE FOR NEXT CASE. + END IF; + + P_IN_OUT := P_IN_OUT + 100; + IF (P_IN /= STORE) THEN + REPORT.FAILED ("ASSIGNMENT TO SCALAR IN OUT " & + "PARAMETER CHANGES THE VALUE OF " & + "INPUT PARAMETER"); + STORE := P_IN; -- RESET STORE FOR NEXT CASE. + END IF; + + VALUE := VALUE + 1; + IF (P_IN /= STORE) THEN + REPORT.FAILED ("ASSIGNMENT TO SCALAR GLOBAL " & + "PARAMETER CHANGES THE VALUE OF " & + "INPUT PARAMETER"); + END IF; + + RAISE E; -- CHECK EXCEPTION HANDLING. + END P; + + PROCEDURE NEW_P IS NEW P (SCALAR_ITEM => NUMBER) ; + + BEGIN -- SCALAR_TO_PROCS + VALUE := 0; -- INITIALIZE VALUE SO VARIOUS CASES CAN BE DETECTED. + + NEW_P (P_IN => VALUE, + P_OUT => VALUE, + P_IN_OUT => VALUE); + + REPORT.FAILED ("EXCEPTION NOT RAISED - SCALARS TO PROCEDURES"); + EXCEPTION + WHEN E => + IF (VALUE /= 1) THEN + CASE VALUE IS + WHEN 11 => + REPORT.FAILED ("OUT ACTUAL SCALAR " & + "PARAMETER CHANGED GLOBAL VALUE"); + WHEN 101 => + REPORT.FAILED ("IN OUT ACTUAL SCALAR " & + "PARAMETER CHANGED GLOBAL VALUE"); + WHEN 111 => + REPORT.FAILED ("OUT AND IN OUT ACTUAL " & + "SCALAR PARAMETERS CHANGED " & + "GLOBAL VALUE"); + WHEN OTHERS => + REPORT.FAILED ("UNDETERMINED CHANGE TO " & + "GLOBAL VALUE"); + END CASE; + END IF; + WHEN OTHERS => + REPORT.FAILED ("WRONG EXCEPTION RAISED - SCALARS TO PROCEDURES"); + END SCALAR_TO_PROCS ; + + -------------------------------------------------- + + SCALAR_TO_FUNCS: + + DECLARE + +-- (B) SCALAR PARAMETERS TO FUNCTIONS. + + TYPE NUMBER IS RANGE 0 .. 101 ; + FIRST : NUMBER ; + SECOND : NUMBER ; + + GENERIC + + TYPE ITEM IS RANGE <> ; + + FUNCTION F (F_IN : IN ITEM) RETURN ITEM ; + + FUNCTION F (F_IN : IN ITEM) RETURN ITEM IS + + STORE : ITEM := F_IN; + + BEGIN -- F + + FIRST := FIRST + 1; + IF (F_IN /= STORE) THEN + REPORT.FAILED ("ASSIGNMENT TO SCALAR GLOBAL FUNCTION " & + "PARAMETER CHANGES THE VALUE OF " & + "INPUT PARAMETER"); + END IF; + + RETURN (100); + END F; + + FUNCTION NEW_F IS NEW F (ITEM => NUMBER) ; + + BEGIN -- SCALAR_TO_FUNCS + FIRST := 100 ; + SECOND := NEW_F (FIRST) ; + END SCALAR_TO_FUNCS ; + + -------------------------------------------------- + + ACCESS_TO_PROCS: + + DECLARE + +-- (C) ACCESS PARAMETERS TO PROCEDURES. + + TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG, + SEP, OCT, NOV, DEC) ; + TYPE DAY_TYPE IS RANGE 1 .. 31 ; + TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ; + TYPE DATE IS RECORD + MONTH : MONTH_TYPE ; + DAY : DAY_TYPE ; + YEAR : YEAR_TYPE ; + END RECORD ; + + TYPE DATE_ACCESS IS ACCESS DATE ; + DATE_POINTER : DATE_ACCESS ; + + E : EXCEPTION; + + GENERIC + + TYPE ITEM IS PRIVATE ; + TYPE ACCESS_ITEM IS ACCESS ITEM ; + + PROCEDURE P (P_IN : IN ACCESS_ITEM ; + P_OUT : OUT ACCESS_ITEM ; + P_IN_OUT : IN OUT ACCESS_ITEM) ; + + PROCEDURE P (P_IN : IN ACCESS_ITEM ; + P_OUT : OUT ACCESS_ITEM ; + P_IN_OUT : IN OUT ACCESS_ITEM) IS + + STORE : ACCESS_ITEM ; + + BEGIN -- P + + STORE := P_IN ; -- SAVE VALUE OF P_IN AT PROC ENTRY. + + DATE_POINTER := NEW DATE'(YEAR => 1990, + DAY => 7, + MONTH => AUG) ; + IF (P_IN /= STORE) THEN + REPORT.FAILED ("ASSIGNMENT TO ACCESS GLOBAL " & + "PARAMETER CHANGES THE VALUE OF " & + "INPUT PARAMETER"); + STORE := P_IN; -- RESET STORE FOR NEXT CASE. + END IF; + + P_OUT := NEW ITEM ; + IF (P_IN /= STORE) THEN + REPORT.FAILED ("ASSIGNMENT TO ACCESS OUT " & + "PARAMETER CHANGES THE VALUE OF " & + "INPUT PARAMETER"); + STORE := P_IN; -- RESET STORE FOR NEXT CASE. + END IF; + + P_IN_OUT := NEW ITEM ; + IF (P_IN /= STORE) THEN + REPORT.FAILED ("ASSIGNMENT TO ACCESS IN OUT " & + "PARAMETER CHANGES THE VALUE OF " & + "INPUT PARAMETER"); + END IF; + + RAISE E; -- CHECK EXCEPTION HANDLING. + END P ; + + PROCEDURE NEW_P IS NEW P (ITEM => DATE, + ACCESS_ITEM => DATE_ACCESS) ; + + BEGIN -- ACCESS_TO_PROCS + DATE_POINTER := NEW DATE'(MONTH => DEC, + DAY => 25, + YEAR => 2000) ; + + NEW_P (P_IN => DATE_POINTER, + P_OUT => DATE_POINTER, + P_IN_OUT => DATE_POINTER) ; + + REPORT.FAILED ("EXCEPTION NOT RAISED - ACCESS TO PROCEDURES"); + EXCEPTION + WHEN E => + IF (DATE_POINTER.ALL /= (AUG, 7, 1990)) THEN + REPORT.FAILED ("OUT OR IN OUT ACTUAL PROCEDURE " & + "PARAMETER VALUE CHANGED DESPITE " & + "RAISED EXCEPTION"); + END IF; + WHEN OTHERS => + REPORT.FAILED ("WRONG EXCEPTION RAISED - ACCESS TO PROCEDURES"); + END ACCESS_TO_PROCS ; + + -------------------------------------------------- + + ACCESS_TO_FUNCS: + + DECLARE + +-- (D) ACCESS PARAMETERS TO FUNCTIONS. + + TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG, + SEP, OCT, NOV, DEC) ; + TYPE DAY_TYPE IS RANGE 1 .. 31 ; + TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ; + TYPE DATE IS RECORD + MONTH : MONTH_TYPE ; + DAY : DAY_TYPE ; + YEAR : YEAR_TYPE ; + END RECORD ; + + TYPE DATE_ACCESS IS ACCESS DATE ; + DATE_POINTER : DATE_ACCESS ; + NEXT_DATE : DATE_ACCESS ; + + GENERIC + + TYPE ITEM IS PRIVATE ; + TYPE ACCESS_ITEM IS ACCESS ITEM ; + + FUNCTION F (F_IN : IN ACCESS_ITEM) RETURN ACCESS_ITEM ; + + FUNCTION F (F_IN : IN ACCESS_ITEM) RETURN ACCESS_ITEM IS + + STORE : ACCESS_ITEM := F_IN ; + + BEGIN -- F + + DATE_POINTER := NEW DATE'(YEAR => 1990, + DAY => 7, + MONTH => AUG) ; + IF (F_IN /= STORE) THEN + REPORT.FAILED ("ASSIGNMENT TO ACCESS GLOBAL FUNCTION " & + "PARAMETER CHANGES THE VALUE OF " & + "INPUT PARAMETER"); + END IF; + + RETURN (NULL); + END F ; + + FUNCTION NEW_F IS NEW F (ITEM => DATE, + ACCESS_ITEM => DATE_ACCESS) ; + + BEGIN -- ACCESS_TO_FUNCS + DATE_POINTER := NULL ; + NEXT_DATE := NEW_F(F_IN => DATE_POINTER) ; + END ACCESS_TO_FUNCS ; + + -------------------------------------------------- + + REPORT.RESULT; + +END CC3017C; |