diff gcc/testsuite/ada/acats/tests/c7/c72002a.ada @ 111:04ced10e8804

gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gcc/testsuite/ada/acats/tests/c7/c72002a.ada	Fri Oct 27 22:46:09 2017 +0900
@@ -0,0 +1,229 @@
+-- C72002A.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 DECLARATIVE ITEMS IN A PACKAGE SPECIFICATION ARE
+--     ELABORATED IN THE ORDER DECLARED.
+
+-- HISTORY:
+--     DHH 03/09/88 CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C72002A IS
+
+     A : INTEGER := 0;
+     TYPE ORDER_ARRAY IS ARRAY(1 .. 14) OF INTEGER;
+     OBJECT_ARRAY : ORDER_ARRAY;
+     TYPE REAL IS DIGITS 4;
+     TYPE ENUM IS (RED,YELLOW,BLUE);
+
+     TYPE ARR IS ARRAY(1 ..2) OF BOOLEAN;
+     D : ARR := (TRUE, TRUE);
+     E : ARR := (FALSE, FALSE);
+
+     TYPE REC IS
+          RECORD
+               I : INTEGER;
+          END RECORD;
+     B : REC := (I => IDENT_INT(1));
+     C : REC := (I => IDENT_INT(2));
+
+     FUNCTION GIVEN_ORDER(X : INTEGER) RETURN INTEGER IS
+          Y : INTEGER;
+     BEGIN
+          Y := X + 1;
+          RETURN Y;
+     END GIVEN_ORDER;
+
+     FUNCTION BOOL(X : INTEGER) RETURN BOOLEAN IS
+     BEGIN
+          IF X = IDENT_INT(1) THEN
+               A := GIVEN_ORDER(A);
+               OBJECT_ARRAY(X) := A;
+               RETURN TRUE;
+          ELSIF X = IDENT_INT(8) THEN
+               A := GIVEN_ORDER(A);
+               OBJECT_ARRAY(X) := A;
+               RETURN FALSE;
+          END IF;
+     END BOOL;
+
+     FUNCTION INT(X : INTEGER) RETURN INTEGER IS
+     BEGIN
+          IF X = IDENT_INT(2) THEN
+               A := GIVEN_ORDER(A);
+               OBJECT_ARRAY(X) := A;
+               RETURN IDENT_INT(1);
+          ELSIF X = IDENT_INT(9) THEN
+               A := GIVEN_ORDER(A);
+               OBJECT_ARRAY(X) := A;
+               RETURN IDENT_INT(2);
+          END IF;
+     END INT;
+
+     FUNCTION FLOAT(X : INTEGER) RETURN REAL IS
+     BEGIN
+          IF X = IDENT_INT(3) THEN
+               A := GIVEN_ORDER(A);
+               OBJECT_ARRAY(X) := A;
+               RETURN 1.0;
+          ELSIF X = IDENT_INT(10) THEN
+               A := GIVEN_ORDER(A);
+               OBJECT_ARRAY(X) := A;
+               RETURN 2.0;
+          END IF;
+     END FLOAT;
+
+     FUNCTION CHAR(X : INTEGER) RETURN CHARACTER IS
+     BEGIN
+          IF X = IDENT_INT(4) THEN
+               A := GIVEN_ORDER(A);
+               OBJECT_ARRAY(X) := A;
+               RETURN 'A';
+          ELSIF X = IDENT_INT(11) THEN
+               A := GIVEN_ORDER(A);
+               OBJECT_ARRAY(X) := A;
+               RETURN 'Z';
+          END IF;
+     END CHAR;
+
+     FUNCTION ENUMR(X : INTEGER) RETURN ENUM IS
+     BEGIN
+          IF X = IDENT_INT(5) THEN
+               A := GIVEN_ORDER(A);
+               OBJECT_ARRAY(X) := A;
+               RETURN RED;
+          ELSIF X = IDENT_INT(12) THEN
+               A := GIVEN_ORDER(A);
+               OBJECT_ARRAY(X) := A;
+               RETURN YELLOW;
+          END IF;
+     END ENUMR;
+
+     FUNCTION ARRY(X : INTEGER) RETURN ARR IS
+     BEGIN
+          IF X = IDENT_INT(6) THEN
+               A := GIVEN_ORDER(A);
+               OBJECT_ARRAY(X) := A;
+               RETURN D;
+          ELSIF X = IDENT_INT(13) THEN
+               A := GIVEN_ORDER(A);
+               OBJECT_ARRAY(X) := A;
+               RETURN E;
+          END IF;
+     END ARRY;
+
+     FUNCTION RECOR(X : INTEGER) RETURN REC IS
+     BEGIN
+          IF X = IDENT_INT(7) THEN
+               A := GIVEN_ORDER(A);
+               OBJECT_ARRAY(X) := A;
+               RETURN B;
+          ELSIF X = IDENT_INT(14) THEN
+               A := GIVEN_ORDER(A);
+               OBJECT_ARRAY(X) := A;
+               RETURN C;
+          END IF;
+     END RECOR;
+
+     PACKAGE PACK IS
+          A : BOOLEAN   := BOOL(1);
+          B : INTEGER   := INT(2);
+          C : REAL      := FLOAT(3);
+          D : CHARACTER := CHAR(4);
+          E : ENUM      := ENUMR(5);
+          F : ARR       := ARRY(6);
+          G : REC       := RECOR(7);
+          H : BOOLEAN   := BOOL(8);
+          I : INTEGER   := INT(9);
+          J : REAL      := FLOAT(10);
+          K : CHARACTER := CHAR(11);
+          L : ENUM      := ENUMR(12);
+          M : ARR       := ARRY(13);
+          N : REC       := RECOR(14);
+     END PACK;
+
+BEGIN
+     TEST("C72002A", "CHECK THAT THE DECLARATIVE ITEMS IN A PACKAGE " &
+                     "SPECIFICATION ARE ELABORATED IN THE ORDER " &
+                     "DECLARED");
+
+     IF OBJECT_ARRAY(1) /= IDENT_INT(1) THEN
+          FAILED("BOOLEAN 1 ELABORATED OUT OF ORDER");
+     END IF;
+
+     IF OBJECT_ARRAY(2) /= IDENT_INT(2) THEN
+          FAILED("INTEGER 1 ELABORATED OUT OF ORDER");
+     END IF;
+
+     IF OBJECT_ARRAY(3) /= IDENT_INT(3) THEN
+          FAILED("REAL 1 ELABORATED OUT OF ORDER");
+     END IF;
+
+     IF OBJECT_ARRAY(4) /= IDENT_INT(4) THEN
+          FAILED("CHARACTER 1 ELABORATED OUT OF ORDER");
+     END IF;
+
+     IF OBJECT_ARRAY(5) /= IDENT_INT(5) THEN
+          FAILED("ENUMERATION 1 ELABORATED OUT OF ORDER");
+     END IF;
+
+     IF OBJECT_ARRAY(6) /= IDENT_INT(6) THEN
+          FAILED("ARRAY 1 ELABORATED OUT OF ORDER");
+     END IF;
+
+     IF OBJECT_ARRAY(7) /= IDENT_INT(7) THEN
+          FAILED("RECORD 1 ELABORATED OUT OF ORDER");
+     END IF;
+
+     IF OBJECT_ARRAY(8) /= IDENT_INT(8) THEN
+          FAILED("BOOLEAN 2 ELABORATED OUT OF ORDER");
+     END IF;
+
+     IF OBJECT_ARRAY(9) /= IDENT_INT(9) THEN
+          FAILED("INTEGER 2 ELABORATED OUT OF ORDER");
+     END IF;
+
+     IF OBJECT_ARRAY(10) /= IDENT_INT(10) THEN
+          FAILED("REAL 2 ELABORATED OUT OF ORDER");
+     END IF;
+
+     IF OBJECT_ARRAY(11) /= IDENT_INT(11) THEN
+          FAILED("CHARACTER 2 ELABORATED OUT OF ORDER");
+     END IF;
+
+     IF OBJECT_ARRAY(12) /= IDENT_INT(12) THEN
+          FAILED("ENUMERATION 2 ELABORATED OUT OF ORDER");
+     END IF;
+
+     IF OBJECT_ARRAY(13) /= IDENT_INT(13) THEN
+          FAILED("ARRAY 2 ELABORATED OUT OF ORDER");
+     END IF;
+
+     IF OBJECT_ARRAY(14) /= IDENT_INT(14) THEN
+          FAILED("RECORD 2 ELABORATED OUT OF ORDER");
+     END IF;
+
+     RESULT;
+END C72002A;