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

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c3/] [c38102e.ada] - Blame information for rev 294

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- C38102E.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 AN INCOMPLETE TYPE CAN BE REDECLARED AS A DERIVED GENERIC 
26
-- FORMAL TYPE.
27
 
28
-- AH     8/15/86
29
-- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
30
-- DNT 11/28/95  CHANGED TO FLAG1 := F4.
31
 
32
WITH REPORT; USE REPORT;
33
PROCEDURE C38102E IS
34
     TYPE RAINBOW IS (RED, ORANGE, YELLOW, GREEN, BLUE, INDIGO, VIOLET);
35
     TYPE T_FLOAT IS DIGITS 5 RANGE -4.0 .. 4.0;
36
     TYPE T_FIXED IS DELTA 0.01 RANGE 0.0 .. 1.5;
37
     SUBTYPE P1 IS INTEGER;
38
     TYPE P2 IS RANGE 0 .. 10;
39
     TYPE P3 IS ARRAY (P2) OF INTEGER;
40
     TYPE P4 IS ARRAY (P2, P2) OF INTEGER;
41
 
42
     F1, F2 : BOOLEAN;
43
 
44
     GENERIC
45
          TYPE G1 IS (<>);
46
          TYPE G2 IS RANGE <>;
47
     FUNCTION G_DISCRETE RETURN BOOLEAN;
48
 
49
     FUNCTION G_DISCRETE RETURN BOOLEAN IS
50
          TYPE INC1;
51
          TYPE INC2;
52
          TYPE F1 IS NEW G1;
53
          TYPE INC1 IS NEW G1;
54
          TYPE INC2 IS NEW G2;
55
 
56
          OBJ1_0 : INC1;
57
          OBJ1_1 : INC1;
58
          OBJ2_0 : INC2;
59
          OBJ2_1 : INC2;
60
          OBJ3 : F1;
61
 
62
          RESULT_VALUE1 : BOOLEAN := FALSE;
63
          RESULT_VALUE2 : BOOLEAN := FALSE;
64
     BEGIN
65
          OBJ3 := F1'LAST;
66
          OBJ3 := F1'PRED(OBJ3);
67
          IF INC1(OBJ3) = INC1'PRED(INC1'LAST) THEN
68
               RESULT_VALUE1 := TRUE;
69
          END IF;
70
          OBJ2_0 := INC2'FIRST;
71
          OBJ2_1 := INC2'LAST;
72
          IF (OBJ2_0 + OBJ2_1) = (INC2'SUCC(OBJ2_0) +
73
                                  INC2'PRED(OBJ2_1)) THEN
74
               RESULT_VALUE2 := TRUE;
75
          END IF;
76
 
77
          RETURN (RESULT_VALUE1 AND RESULT_VALUE2);
78
     END G_DISCRETE;
79
 
80
     GENERIC
81
          TYPE G3 IS DIGITS <>;
82
          TYPE G4 IS DELTA <>;
83
     PROCEDURE REALS (FLAG1, FLAG2 : OUT BOOLEAN);
84
 
85
     PROCEDURE REALS (FLAG1, FLAG2 : OUT BOOLEAN) IS
86
          F1, F2, F3, F4, F5, F6, F7, F8 : BOOLEAN;
87
          TYPE INC3;
88
          TYPE INC4;
89
          TYPE P1 IS NEW G3;
90
          TYPE P2 IS NEW G4;
91
          TYPE INC3 IS NEW G3;
92
          TYPE INC4 IS NEW G4;
93
     BEGIN
94
          F4 := P1'LAST = P1(INC3'LAST) AND P1'FIRST = P1(INC3'FIRST);
95
 
96
          F5 := P2'FORE = INC4'FORE;
97
          F6 := P2'AFT = INC4'AFT;
98
          F7 := ABS(P2'LAST - P2'FIRST) = P2(ABS(INC4'LAST -
99
                                                 INC4'FIRST));
100
          F8 := INC4(P2'LAST / P2'LAST) = INC4(INC4'LAST / INC4'LAST);
101
 
102
          FLAG1 := F4;
103
          FLAG2 := F5 AND F6 AND F7 AND F8;
104
     END REALS;
105
 
106
     GENERIC
107
          TYPE ITEM IS PRIVATE;
108
          TYPE INDEX IS RANGE <>;
109
          TYPE G5 IS ARRAY (INDEX) OF ITEM;
110
          TYPE G6 IS ARRAY (INDEX, INDEX) OF ITEM;
111
     PACKAGE DIMENSIONS IS
112
          TYPE INC5;
113
          TYPE INC6;
114
          TYPE D1 IS NEW G5;
115
          TYPE D2 IS NEW G6;
116
          TYPE INC5 IS NEW G5;
117
          TYPE INC6 IS NEW G6;
118
          FUNCTION CHECK RETURN BOOLEAN;
119
     END DIMENSIONS;
120
 
121
     PACKAGE BODY DIMENSIONS IS
122
          FUNCTION CHECK RETURN BOOLEAN IS
123
               A1 : INC5;
124
               A2 : INC6;
125
               DIM1 : D1;
126
               DIM2 : D2;
127
               F1, F2 : BOOLEAN;
128
          BEGIN
129
               F1 := A1(INDEX'FIRST)'SIZE = DIM1(INDEX'FIRST)'SIZE;
130
               F2 := A2(INDEX'FIRST, INDEX'LAST)'SIZE =
131
                     DIM2(INDEX'FIRST, INDEX'LAST)'SIZE;
132
 
133
               RETURN (F1 AND F2);
134
          END CHECK;
135
     END DIMENSIONS;
136
 
137
     PROCEDURE PROC IS NEW REALS (G3 => T_FLOAT, G4 => T_FIXED);
138
     FUNCTION DISCRETE IS NEW G_DISCRETE (G1 => RAINBOW, G2 => P2);
139
     PACKAGE PKG IS NEW DIMENSIONS (ITEM => P1, INDEX => P2, G5 => P3,
140
                                    G6 => P4);
141
 
142
     USE PKG;
143
BEGIN
144
     TEST ("C38102E", "INCOMPLETE TYPES CAN BE DERIVED GENERIC " &
145
                      "FORMAL TYPES");
146
 
147
     IF NOT DISCRETE THEN
148
          FAILED ("INTEGER AND ENUMERATED TYPES NOT DERIVED");
149
     END IF;
150
 
151
     PROC (F1, F2);
152
     IF (NOT F1) THEN
153
          FAILED ("FLOAT TYPES NOT DERIVED");
154
     END IF;
155
     IF (NOT F2) THEN
156
          FAILED ("FIXED TYPES NOT DERIVED");
157
     END IF;
158
 
159
     IF NOT CHECK THEN
160
          FAILED ("ONE AND TWO DIMENSIONAL ARRAY TYPES NOT DERIVED");
161
     END IF;
162
 
163
     RESULT;
164
END C38102E;

powered by: WebSVN 2.1.0

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