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/] [c64109i.ada] - Blame information for rev 816

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- C64109I.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
-- OBJECTIVE:
26
--    CHECK THAT SLICES OF ARRAYS WHICH ARE COMPONENTS OF RECORDS ARE
27
--    PASSED CORRECTLY TO SUBPROGRAMS.  SPECIFICALLY,
28
--    (C) CHECK RECORDS HAVING A DISCRIMINANT, WITH MORE THAN ONE ARRAY
29
--       COMPONENT, WHERE THE BOUNDS OF THE ARRAY DEPEND ON THE
30
--       DISCRIMINANT.
31
 
32
-- HISTORY:
33
--    TBN 07/10/86          CREATED ORIGINAL TEST.
34
--    JET 08/04/87          REMOVED PARTIAL ARRAY REFERENCES IN
35
--                          RECORD FIELDS.
36
 
37
WITH REPORT;  USE REPORT;
38
PROCEDURE C64109I IS
39
 
40
BEGIN
41
     TEST ("C64109I", "CHECK THAT SLICES OF ARRAYS WHICH ARE " &
42
                      "COMPONENTS OF RECORDS ARE PASSED CORRECTLY " &
43
                      "TO SUBPROGRAMS - RECORDS WITH DISCRIMINANTS");
44
 
45
     DECLARE   -- (C)
46
 
47
          SUBTYPE SUBINT IS INTEGER RANGE 1..6;
48
          TYPE ARRAY_TYPE IS ARRAY (SUBINT RANGE <>) OF INTEGER;
49
          TYPE RECORD_TYPE (BOUND : INTEGER) IS
50
               RECORD
51
                    B : BOOLEAN;
52
                    A : ARRAY_TYPE (1..BOUND);
53
                    AA : ARRAY_TYPE (BOUND..6);
54
               END RECORD;
55
          REC : RECORD_TYPE (BOUND => IDENT_INT(4)) :=
56
                               (BOUND => 4,
57
                                B => TRUE,
58
                                A => (1..IDENT_INT(4) => 6),
59
                                AA => (4..6 => 8));
60
          BOOL : BOOLEAN;
61
 
62
          PROCEDURE P1 (ARR : ARRAY_TYPE) IS
63
          BEGIN
64
               IF ARR /= (6, 6, 6) THEN
65
                    FAILED ("IN PARAM NOT PASSED CORRECTLY");
66
               END IF;
67
 
68
               IF ARR'FIRST /= 1 OR ARR'LAST /= IDENT_INT(3) THEN
69
                    FAILED ("WRONG BOUNDS - IN PARAMETER");
70
               END IF;
71
          EXCEPTION
72
               WHEN OTHERS =>
73
                    FAILED ("EXCEPTION RAISED IN PROCEDURE P1");
74
          END P1;
75
 
76
          FUNCTION F1 (ARR : ARRAY_TYPE) RETURN BOOLEAN IS
77
          BEGIN
78
               IF ARR /= (6, 6, 6) THEN
79
                    FAILED ("IN PARAM NOT PASSED CORRECTLY TO FN");
80
               END IF;
81
 
82
               IF ARR'FIRST /= 2 OR ARR'LAST /= IDENT_INT(4) THEN
83
                    FAILED ("WRONG BOUNDS - IN PARAMETER FOR FN");
84
               END IF;
85
               RETURN TRUE;
86
          EXCEPTION
87
               WHEN OTHERS =>
88
                    FAILED ("EXCEPTION RAISED IN FUNCTION F1");
89
          END F1;
90
 
91
          PROCEDURE P2 (ARR : IN OUT ARRAY_TYPE) IS
92
          BEGIN
93
               IF ARR /= (8, 8) THEN
94
                    FAILED ("IN OUT PARAM NOT PASSED CORRECTLY");
95
               END IF;
96
 
97
               IF ARR'FIRST /= 4 OR ARR'LAST /= IDENT_INT(5) THEN
98
                    FAILED ("WRONG BOUNDS - IN OUT PARAMETER");
99
               END IF;
100
 
101
               ARR := (ARR'RANGE => 10);
102
          EXCEPTION
103
               WHEN OTHERS =>
104
                    FAILED ("EXCEPTION RAISED IN PROCEDURE P2");
105
          END P2;
106
 
107
          PROCEDURE P3 (ARR : OUT ARRAY_TYPE) IS
108
          BEGIN
109
               IF ARR'FIRST /= 2 OR ARR'LAST /= IDENT_INT(3) THEN
110
                    FAILED ("WRONG BOUNDS - OUT PARAMETER");
111
               END IF;
112
               ARR := (ARR'RANGE => 4);
113
          EXCEPTION
114
               WHEN OTHERS =>
115
                    FAILED ("EXCEPTION RAISED IN PROCEDURE P3");
116
          END P3;
117
 
118
     BEGIN     -- (C)
119
 
120
          BEGIN     -- (D)
121
               P1 (REC.A (1..3));
122
               IF REC.A /= (6, 6, 6, 6) THEN
123
                    FAILED ("IN PARAM CHANGED BY PROCEDURE");
124
               END IF;
125
          EXCEPTION
126
               WHEN OTHERS =>
127
                    FAILED ("EXCEPTION RAISED DURING CALL OF P1");
128
          END;     -- (D)
129
 
130
          BEGIN     -- (E)
131
               BOOL := F1 (REC.A (2..4));
132
               IF REC.A /= (6, 6, 6, 6) THEN
133
                    FAILED ("IN PARAM CHANGED BY FUNCTION");
134
               END IF;
135
          EXCEPTION
136
               WHEN OTHERS =>
137
                    FAILED ("EXCEPTION RAISED DURING CALL OF F1");
138
          END;     -- (E)
139
 
140
          BEGIN     -- (F)
141
               P2 (REC.AA (4..5));
142
               IF REC.AA /= (10, 10, 8) THEN
143
                    FAILED ("IN OUT PARAM NOT RETURNED CORRECTLY");
144
               END IF;
145
          EXCEPTION
146
               WHEN OTHERS =>
147
                    FAILED ("EXCEPTION RAISED DURING CALL OF P2");
148
          END;     -- (F)
149
 
150
          BEGIN     -- (G)
151
               P3 (REC.A (2..3));
152
               IF REC.A /= (6, 4, 4, 6) THEN
153
                    FAILED ("OUT PARAM NOT RETURNED CORRECTLY");
154
               END IF;
155
          EXCEPTION
156
               WHEN OTHERS =>
157
                    FAILED ("EXCEPTION RAISED DURING CALL OF P3");
158
          END;     -- (G)
159
 
160
     END; -- (C)
161
 
162
     RESULT;
163
END C64109I;

powered by: WebSVN 2.1.0

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