From 554fd8c5195424bdbcabf5de30fdc183aba391bd Mon Sep 17 00:00:00 2001 From: upstream source tree Date: Sun, 15 Mar 2015 20:14:05 -0400 Subject: obtained gcc-4.6.4.tar.bz2 from upstream website; verified gcc-4.6.4.tar.bz2.sig; imported gcc-4.6.4 source tree from verified upstream tarball. downloading a git-generated archive based on the 'upstream' tag should provide you with a source tree that is binary identical to the one extracted from the above tarball. if you have obtained the source via the command 'git clone', however, do note that line-endings of files in your working directory might differ from line-endings of the respective files in the upstream repository. --- gcc/testsuite/ada/acats/tests/c4/c43210a.ada | 142 +++++++++++++++++++++++++++ 1 file changed, 142 insertions(+) create mode 100644 gcc/testsuite/ada/acats/tests/c4/c43210a.ada (limited to 'gcc/testsuite/ada/acats/tests/c4/c43210a.ada') diff --git a/gcc/testsuite/ada/acats/tests/c4/c43210a.ada b/gcc/testsuite/ada/acats/tests/c4/c43210a.ada new file mode 100644 index 000000000..549021e60 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/c4/c43210a.ada @@ -0,0 +1,142 @@ +-- C43210A.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. +--* +-- CHECK THAT A NON-AGGREGATE EXPRESSION IN A NAMED COMPONENT +-- ASSOCIATION IS EVALUATED ONCE FOR EACH COMPONENT SPECIFIED +-- BY THE ASSOCIATION. + +-- EG 02/02/84 + +WITH REPORT; + +PROCEDURE C43210A IS + + USE REPORT; + +BEGIN + + TEST("C43210A", "CHECK THAT A NON-AGGREGATE IN A NAMED " & + "COMPONENT ASSOCIATION IS EVALUATED ONCE " & + "FOR EACH COMPONENT SPECIFIED BY THE " & + "ASSOCIATION"); + + DECLARE + + TYPE T1 IS ARRAY(1 .. 10) OF INTEGER; + TYPE T2 IS ARRAY(1 .. 8, 1 .. 2) OF INTEGER; + TYPE T3 IS ARRAY(1 .. 2, 1 .. 8) OF INTEGER; + TYPE T4 IS ARRAY(1 .. 8, 1 .. 8) OF INTEGER; + + A1 : T1; + A2 : T2; + A3 : T3; + A4 : T4; + CC : INTEGER; + + FUNCTION CALC (A : INTEGER) RETURN INTEGER IS + BEGIN + CC := CC + 1; + RETURN IDENT_INT(A); + END CALC; + + PROCEDURE CHECK (A : STRING; B : INTEGER) IS + BEGIN + IF CC /= B THEN + FAILED ("CASE " & A & " : INCORRECT NUMBER OF " & + "EVALUATIONS. NUMBER OF EVALUATIONS " & + "SHOULD BE " & INTEGER'IMAGE(B) & + ", BUT IS " & INTEGER'IMAGE(CC)); + END IF; + END CHECK; + + BEGIN + +CASE_A : BEGIN + + CC := 0; + A1 := T1'(4 .. 5 => CALC(2), 6 .. 8 => CALC(4), + OTHERS => 5); + CHECK ("A", 5); + + END CASE_A; + +CASE_B : BEGIN + + CC := 0; + A1 := T1'(1 | 4 .. 6 | 3 | 2 => CALC(-1), OTHERS => -2); + CHECK ("B", 6); + + END CASE_B; + +CASE_C : BEGIN + + CC := 0; + A1 := T1'(1 | 3 | 5 | 7 .. 9 => -1, OTHERS => CALC(-2)); + CHECK ("C", 4); + + END CASE_C; + +CASE_D : BEGIN + + CC := 0; + A2 := T2'(4 .. 6 | 8 | 2 .. 3 => (1 .. 2 => CALC(1)), + OTHERS => (1 .. 2 => -1)); + CHECK ("D", 12); + + END CASE_D; + +CASE_E : BEGIN + + CC := 0; + A3 := T3'(1 .. 2 => (2 | 4 | 6 .. 8 => CALC(-1), + OTHERS => -2)); + CHECK ("E", 10); + + END CASE_E; + +CASE_F : BEGIN + + CC := 0; + A4 := T4'(7 .. 8 | 3 .. 5 => + (1 | 2 | 4 | 6 .. 8 => CALC(1), OTHERS => -2), + OTHERS => (OTHERS => -2)); + CHECK ("F", 30); + + END CASE_F; + +CASE_G : BEGIN + + CC := 0; + A4 := T4'(5 .. 8 | 3 | 1 => (7 | 1 .. 5 | 8 => -1, + OTHERS => CALC(-2)), + OTHERS => (OTHERS => CALC(-2))); + CHECK ("G", 22); + + END CASE_G; + + END; + + RESULT; + +END C43210A; -- cgit v1.2.3