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/] [cc/] [cc1302a.ada] - Blame information for rev 309

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

Line No. Rev Author Line
1 294 jeremybenn 
-- CC1302A.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 GENERIC DEFAULT SUBPROGRAM PARAMETERS MAY BE ATTRIBUTES
26 
-- OF TYPES, INCLUDING GENERIC FORMAL TYPES IN SAME GENERIC PART,
27 
-- OR IN GENERIC PART OF ENCLOSING UNIT.
28 
 
29 
-- DAT 8/27/81
30 
-- SPS 2/9/83
31 
-- JBG 2/15/83
32 
-- JBG 4/29/83
33 
 
34 
WITH REPORT; USE REPORT;
35 
 
36 
PROCEDURE CC1302A IS
37 
BEGIN
38 
     TEST ("CC1302A", "GENERIC DEFAULT SUBPROGRAMS MAY BE"
39 
          & " FUNCTION ATTRIBUTES OF TYPES");
40 
 
41 
     DECLARE
42 
          GENERIC
43 
               TYPE T IS ( <> );
44 
               T_LAST : T;
45 
               WITH FUNCTION SUCC (X : T) RETURN T IS T'SUCC;
46 
          PACKAGE PK1 IS
47 
          END PK1;
48 
 
49 
          SUBTYPE CH IS CHARACTER RANGE CHARACTER'FIRST .. '~';
50 
          SUBTYPE BL IS BOOLEAN RANGE FALSE .. FALSE;
51 
          SUBTYPE INT IS INTEGER RANGE -10 .. 10;
52 
 
53 
          PACKAGE BODY PK1 IS
54 
               GENERIC
55 
                    TYPE TT IS ( <> );
56 
                    TT_LAST : TT;
57 
                    WITH FUNCTION PRED (X : TT) RETURN TT IS TT'PRED;
58 
                    WITH FUNCTION IM(X : T) RETURN STRING IS T'IMAGE;
59 
                    WITH FUNCTION VAL(X : STRING) RETURN TT IS TT'VALUE;
60 
               PACKAGE PK2 IS END PK2;
61 
 
62 
               PACKAGE BODY PK2 IS
63 
               BEGIN
64 
 
65 
-- CHECK THAT 'LAST GIVES RIGHT ANSWER
66 
                    IF T'LAST /= T_LAST THEN
67 
                         FAILED ("T'LAST INCORRECT");
68 
                    END IF;
69 
 
70 
                    IF TT'LAST /= TT_LAST THEN
71 
                         FAILED ("TT'LAST INCORRECT");
72 
                    END IF;
73 
 
74 
-- CHECK SUCC FUNCTION
75 
                    BEGIN
76 
                         IF T'PRED(SUCC(T'LAST)) /= T'LAST THEN
77 
                              FAILED ("'PRED OR SUCC GIVES WRONG " &
78 
                                      "RESULT");
79 
                         END IF;
80 
                    EXCEPTION
81 
                         WHEN CONSTRAINT_ERROR =>
82 
                              FAILED ("SUCC HAS CONSTRAINTS OF " &
83 
                                      "SUBTYPE");
84 
                         WHEN OTHERS =>
85 
                              FAILED ("SOME EXCEPTION RAISED - 1");
86 
                    END;
87 
 
88 
-- CHECK 'SUCC ATTRIBUTE
89 
                    BEGIN
90 
                         IF T'PRED(T'SUCC(T'LAST)) /= T'LAST THEN
91 
                              FAILED ("'PRED OR 'SUCC GIVES WRONG " &
92 
                                      "RESULT");
93 
                         END IF;
94 
                    EXCEPTION
95 
                         WHEN CONSTRAINT_ERROR =>
96 
                              FAILED ("'PRED OR 'SUCC HAS CONSTRAINTS "&
97 
                                      "OF SUBTYPE");
98 
                         WHEN OTHERS =>
99 
                              FAILED ("SOME EXCEPTION RAISED - 2");
100 
                    END;
101 
 
102 
-- CHECK VAL ATTRIBUTE
103 
                    BEGIN
104 
                         IF T'VAL(T'POS(T'SUCC(T'LAST))) /=
105 
                            T'VAL(T'POS(T'LAST)+1) THEN
106 
                              FAILED ("VAL OR POS ATTRIBUTE HAS " &
107 
                                      "INCONSISTENT RESULTS");
108 
                         END IF;
109 
                    EXCEPTION
110 
                         WHEN CONSTRAINT_ERROR =>
111 
                              FAILED ("VAL OR POS ATTRIBUTE HAS " &
112 
                                      "CONSTRAINTS OF SUBTYPE");
113 
                         WHEN OTHERS =>
114 
                              FAILED ("SOME EXCEPTION RAISED - 4");
115 
                    END;
116 
 
117 
-- CHECK VAL FUNCTION
118 
                    BEGIN
119 
                         IF TT'VAL(TT'POS(TT'SUCC(TT'LAST))) /=
120 
                            TT'VAL(TT'POS(TT'LAST)+1) THEN
121 
                              FAILED ("VAL FUNCTION GIVES INCORRECT " &
122 
                                      "RESULTS");
123 
                         END IF;
124 
                    EXCEPTION
125 
                         WHEN CONSTRAINT_ERROR =>
126 
                              FAILED ("VAL FUNCTION HAS CONSTRAINTS " &
127 
                                      "OF SUBTYPE");
128 
                         WHEN OTHERS =>
129 
                              FAILED ("SOME EXCEPTION RAISED - 6");
130 
                    END;
131 
 
132 
-- CHECK IM FUNCTION
133 
                    BEGIN
134 
                         IF T'IMAGE(T'SUCC(T'LAST)) /=
135 
                              IM   (T'SUCC(T'LAST)) THEN
136 
                              FAILED ("IM FUNCTION GIVES INCORRECT " &
137 
                                      "RESULTS");
138 
                         END IF;
139 
                    EXCEPTION
140 
                         WHEN CONSTRAINT_ERROR =>
141 
                              FAILED ("IM FUNCTION HAS CONSTRAINTS " &
142 
                                      "OF SUBTYPE");
143 
                         WHEN OTHERS =>
144 
                              FAILED ("SOME EXCEPTION RAISED - 7");
145 
                    END;
146 
 
147 
-- CHECK PRED FUNCTION
148 
                    BEGIN
149 
                         IF PRED(TT'SUCC(TT'LAST)) /= TT'LAST THEN
150 
                              FAILED ("PRED FUNCTION GIVES INCORRECT " &
151 
                                      "RESULTS");
152 
                         END IF;
153 
                    EXCEPTION
154 
                         WHEN CONSTRAINT_ERROR =>
155 
                              FAILED ("PRED FUNCTION HAS CONSTRAINTS " &
156 
                                      "OF SUBTYPE");
157 
                         WHEN OTHERS =>
158 
                              FAILED ("SOME EXCEPTION RAISED - 8");
159 
                    END;
160 
 
161 
               END PK2;
162 
 
163 
               PACKAGE PK3 IS NEW PK2 (T, T'LAST);
164 
          END PK1;
165 
 
166 
          PACKAGE PKG1 IS NEW PK1 (CH, CH'LAST);
167 
          PACKAGE PKG2 IS NEW PK1 (BL, BL'LAST);
168 
          PACKAGE PKG3 IS NEW PK1 (INT, INT'LAST);
169 
     BEGIN
170 
          NULL;
171 
     END;
172 
 
173 
     RESULT;
174 
END CC1302A;

powered by: WebSVN 2.1.0

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