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

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

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

powered by: WebSVN 2.1.0

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