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/] [cc/] [cc1301a.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
-- CC1301A.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 DEFAULT GENERIC SUBPROGRAM PARAMETERS WORK CORRECTLY,
26
-- INCLUDING OVERLOADED AND PREDEFINED OPERATOR_SYMBOLS,
27
-- AND SUBPROGRAMS HIDDEN AT THE INSTANTIATION.
28
-- BOTH KINDS OF DEFAULTS ARE TESTED, FOR BOTH PROCEDURES
29
-- AND FUNCTIONS.
30
 
31
-- DAT 8/14/81
32
-- JBG 5/5/83
33
-- JBG 8/3/83
34
 
35
WITH REPORT; USE REPORT;
36
 
37
PROCEDURE CC1301A IS
38
 
39
     FUNCTION "-" (R, S : INTEGER) RETURN INTEGER;
40
 
41
     FUNCTION NEXT (X : INTEGER) RETURN INTEGER;
42
 
43
     PROCEDURE BUMP (X : IN OUT INTEGER);
44
 
45
     GENERIC
46
          WITH FUNCTION "*" (A, B : INTEGER) RETURN INTEGER IS "-";
47
          WITH FUNCTION "+" (R, S: INTEGER) RETURN INTEGER IS
48
                                                       STANDARD."+";
49
          WITH FUNCTION "-" (A, B : INTEGER) RETURN INTEGER IS <> ;
50
          WITH FUNCTION NEXTO (Q : INTEGER) RETURN INTEGER IS NEXT ;
51
          WITH PROCEDURE BUMPO (A : IN OUT INTEGER) IS BUMP;
52
          WITH FUNCTION NEXT (Q : INTEGER) RETURN INTEGER  IS <> ;
53
          WITH PROCEDURE BUMP (Q : IN OUT INTEGER) IS <> ;
54
          TYPE INTEGER IS RANGE <> ;
55
          WITH FUNCTION "*" (A , B : INTEGER) RETURN INTEGER IS <> ;
56
          WITH FUNCTION "-" (A, B : INTEGER) RETURN INTEGER IS <> ;
57
          WITH FUNCTION NEXT (Q : INTEGER) RETURN INTEGER IS <> ;
58
          WITH PROCEDURE BUMP (Z : IN OUT INTEGER) IS <> ;
59
     PACKAGE PKG IS
60
          SUBTYPE INT IS STANDARD.INTEGER;
61
          DIFF : INT := -999;
62
     END PKG;
63
 
64
     TYPE NEWINT IS NEW INTEGER RANGE -1000 .. 1000;
65
 
66
     FUNCTION PLUS (Q1, Q2 : INTEGER) RETURN INTEGER RENAMES "+";
67
 
68
     FUNCTION "+" (X, Y : INTEGER) RETURN INTEGER IS
69
     BEGIN
70
          RETURN PLUS (X, PLUS (Y, -10));
71
          -- (X + Y - 10)
72
     END "+";
73
 
74
     FUNCTION "-" (R, S : INTEGER) RETURN INTEGER IS
75
     BEGIN
76
          RETURN - R + S;
77
          -- (-R + S - 10)
78
     END "-";
79
 
80
     FUNCTION NEXT (X : INTEGER) RETURN INTEGER IS
81
     BEGIN
82
          RETURN X + 1;
83
          -- (X + 1 - 10)
84
          -- (X - 9)
85
     END NEXT;
86
 
87
     PROCEDURE BUMP (X : IN OUT INTEGER) IS
88
     BEGIN
89
          X := NEXT (X);
90
          -- (X := X - 9)
91
     END BUMP;
92
 
93
     PACKAGE BODY PKG IS
94
          W : INTEGER;
95
          WI : INT;
96
     BEGIN
97
          W := NEXT (INTEGER'(3) * 4 - 2);
98
          -- (W := (4 ** 3 - 2) - 1)
99
          -- (W := 61)
100
          BUMP (W);
101
          -- (W := 61 + 7)
102
          -- (W := 68)
103
          WI := NEXT (INT'(3) * 4 - 2 + NEXTO (0));
104
          -- (3 * 4) => (3 - 4) => (-3 + 4 - 10) = -9
105
          -- ((-9) - 2) => (2 + 2 - (-9) - 20) = -7
106
          -- (-7 + (-9)) => -16
107
          -- (WI := 7 - (-16)) => (WI := 23)
108
          BUMPO (WI);
109
          -- (WI := 23 - 9) (= 14)
110
          BUMP (WI);
111
          -- (WI := 14 - 9) (= 5)
112
          DIFF := STANDARD."-" (INT(W), WI);
113
          -- (DIFF := 68 - 5) (= 63)
114
     END PKG;
115
 
116
     FUNCTION "*" (Y, X : NEWINT) RETURN NEWINT IS
117
     BEGIN
118
          RETURN X ** INTEGER(Y);
119
          -- (X,Y) (Y ** X)
120
     END "*";
121
 
122
     FUNCTION NEXT (Z : NEWINT) RETURN NEWINT IS
123
     BEGIN
124
          RETURN Z - 1;
125
          -- (Z - 1)
126
     END NEXT;
127
 
128
     PROCEDURE BUMP (ZZ : IN OUT NEWINT) IS
129
     BEGIN
130
          FAILED ("WRONG PROCEDURE CALLED");
131
     END BUMP;
132
BEGIN
133
     TEST ("CC1301A", "DEFAULT GENERIC SUBPROGRAM PARAMETERS");
134
 
135
     DECLARE
136
          PROCEDURE BUMP (QQQ : IN OUT NEWINT) IS
137
          BEGIN
138
               QQQ := QQQ + 7;
139
               -- (QQQ + 7)
140
          END BUMP;
141
 
142
          FUNCTION NEXT (Q7 : INTEGER) RETURN INTEGER IS
143
          BEGIN
144
               RETURN Q7 - 17;
145
               -- (-Q7 + 17 - 10)
146
               -- (7 - Q7)
147
          END NEXT;
148
 
149
          FUNCTION "-" (Q3, Q4 : INTEGER) RETURN INTEGER IS
150
          BEGIN
151
               RETURN -Q3 + Q4 + Q4;
152
               -- (-Q3 + Q4 - 10 + Q4 - 10) = (Q4 + Q4 - Q3 - 20)
153
          END "-";
154
 
155
          PACKAGE P1 IS NEW PKG (INTEGER => NEWINT);
156
 
157
     BEGIN
158
          IF P1.DIFF /= 63 THEN
159
               FAILED ("WRONG DEFAULT SUBPROGRAM PARAMETERS");
160
          END IF;
161
     END;
162
 
163
     RESULT;
164
END CC1301A;

powered by: WebSVN 2.1.0

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