OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c6/] [c64109b.ada] - Blame information for rev 149

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- C64109B.ADA
2
 
3
--                             Grant of Unlimited Rights
4
--
5
--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
6
--     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
7
--     unlimited rights in the software and documentation contained herein.
8
--     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
9
--     this public release, the Government intends to confer upon all 
10
--     recipients unlimited rights  equal to those held by the Government.  
11
--     These rights include rights to use, duplicate, release or disclose the 
12
--     released technical data and computer software in whole or in part, in 
13
--     any manner and for any purpose whatsoever, and to have or permit others 
14
--     to do so.
15
--
16
--                                    DISCLAIMER
17
--
18
--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
19
--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
20
--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
21
--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
22
--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
23
--     PARTICULAR PURPOSE OF SAID MATERIAL.
24
--*
25
-- CHECK THAT ARRAYS THAT ARE COMPONENTS OF RECORDS ARE PASSED CORRECTLY
26
-- TO SUBPROGRAMS.  SPECIFICALLY,
27
--   (B) CHECK MULTIDIMENSIONAL ARRAYS.
28
 
29
-- CPP 8/20/84
30
 
31
WITH REPORT;  USE REPORT;
32
PROCEDURE C64109B IS
33
 
34
BEGIN
35
     TEST ("C64109B", "CHECK THAT ARRAYS WHICH ARE COMPONENTS OF " &
36
           "RECORDS ARE PASSED CORRECTLY TO SUBPROGRAMS - " &
37
           "MULTIDIMENSIONAL ARRAYS");
38
 
39
     DECLARE   -- (B)
40
 
41
          TYPE MULTI_TYPE IS ARRAY (POSITIVE RANGE <>,
42
                                    POSITIVE RANGE <>) OF BOOLEAN;
43
          SUBTYPE MULTI_SUBTYPE IS MULTI_TYPE (1..2, 1..3);
44
          TYPE RECORD_TYPE IS
45
               RECORD
46
                    I : BOOLEAN;
47
                    A : MULTI_SUBTYPE;
48
               END RECORD;
49
          REC : RECORD_TYPE :=
50
                    (I => FALSE,
51
                     A => (1..2 => (1..3 => IDENT_BOOL(TRUE))));
52
          BOOL : BOOLEAN;
53
 
54
          PROCEDURE P1 (ARR : MULTI_TYPE) IS
55
          BEGIN
56
               IF ARR /= (1..2 => (1..3 => TRUE)) THEN
57
                    FAILED ("IN PARAM NOT PASSED CORRECTLY");
58
               END IF;
59
 
60
               IF ARR'FIRST /= 1 OR ARR'LAST /= IDENT_INT(2) THEN
61
                    FAILED ("FIRST DIM NOT CORRECT - IN PARAMETER");
62
               ELSIF ARR'FIRST(2) /= IDENT_INT(1) OR ARR'LAST(2) /= 3
63
                  THEN
64
                    FAILED ("2ND DIM NOT CORRECT - IN PARAMETER");
65
               END IF;
66
          END P1;
67
 
68
          FUNCTION F1 (ARR : MULTI_TYPE) RETURN BOOLEAN IS
69
          BEGIN
70
               IF ARR /= (1..2 => (1..3 => TRUE)) THEN
71
                    FAILED ("IN PARAM NOT PASSED CORRECTLY TO FN");
72
               END IF;
73
 
74
               IF ARR'FIRST /= 1 OR ARR'LAST /= IDENT_INT(2) THEN
75
                    FAILED ("FIRST DIM NOT CORRECT - IN PARAMETER FN");
76
               ELSIF ARR'FIRST(2) /= IDENT_INT(1) OR ARR'LAST(2) /= 3
77
                  THEN
78
                    FAILED ("2ND DIM NOT CORRECT - IN PARAMETER FN");
79
               END IF;
80
               RETURN TRUE;
81
          END F1;
82
 
83
          PROCEDURE P2 (ARR : IN OUT MULTI_TYPE) IS
84
          BEGIN
85
               IF ARR /= (1..2 => (1..3 => TRUE)) THEN
86
                    FAILED ("IN OUT PARAM NOT PASSED CORRECTLY");
87
               END IF;
88
 
89
               IF ARR'FIRST /= 1 OR ARR'LAST /= IDENT_INT(2) THEN
90
                    FAILED ("FIRST DIM NOT CORRECT - IN OUT PARAMETER");
91
               ELSIF ARR'FIRST(2) /= IDENT_INT(1) OR ARR'LAST(2) /= 3
92
                  THEN
93
                    FAILED ("2ND DIM NOT CORRECT - IN OUT PARAMETER");
94
               END IF;
95
               ARR := (ARR'RANGE(1) => (ARR'RANGE(2) => FALSE));
96
          END P2;
97
 
98
          PROCEDURE P3 (ARR : OUT MULTI_TYPE) IS
99
          BEGIN
100
               FOR I IN 1 .. 2 LOOP
101
                    FOR J IN 1 .. 3 LOOP
102
                         IF (J MOD 2) = 0 THEN
103
                              ARR(I, J) := TRUE;
104
                         ELSE
105
                              ARR(I, J) := FALSE;
106
                         END IF;
107
                    END LOOP;
108
               END LOOP;
109
 
110
               IF ARR'FIRST /= 1 OR ARR'LAST /= IDENT_INT(2) THEN
111
                    FAILED ("FIRST DIM NOT CORRECT - OUT PARAMETER");
112
               ELSIF ARR'FIRST(2) /= IDENT_INT(1) OR ARR'LAST(2) /= 3
113
                  THEN
114
                    FAILED ("2ND DIM NOT CORRECT - OUT PARAMETER");
115
               END IF;
116
          END P3;
117
 
118
     BEGIN     -- (B)
119
 
120
          P1 (REC.A);
121
          IF REC.A /= (1..2 => (1..3 => TRUE)) THEN
122
               FAILED ("IN PARAM CHANGED BY PROCEDURE");
123
          END IF;
124
 
125
          BOOL := F1 (REC.A);
126
          IF REC.A /= (1..2 => (1..3 => TRUE)) THEN
127
               FAILED ("IN PARAM CHANGED BY FUNCTION");
128
          END IF;
129
 
130
          P2 (REC.A);
131
          IF REC.A /= (1..2 => (1..3 => FALSE)) THEN
132
               FAILED ("IN OUT PARAM CHANGED BY PROCEDURE");
133
          END IF;
134
 
135
          P3 (REC.A);
136
          FOR I IN 1 .. 2 LOOP
137
               FOR J IN 1 .. 3 LOOP
138
                    IF (J MOD 2) = 0 THEN
139
                         IF REC.A(I, J) /= TRUE THEN
140
                              FAILED ("OUT PARAM RETURNED " &
141
                                      "INCORRECTLY - (B)");
142
                         END IF;
143
                    ELSE
144
                         IF REC.A(I, J) /= FALSE THEN
145
                              FAILED ("OUT PARAM RETURNED " &
146
                                      "INCORRECTLY - (B)2");
147
                         END IF;
148
                    END IF;
149
               END LOOP;
150
          END LOOP;
151
 
152
     END; -- (B)
153
 
154
     RESULT;
155
END C64109B;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.