OpenCores
URL https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk

Subversion Repositories openrisc_2011-10-31

[/] [openrisc/] [tags/] [gnu-src/] [gcc-4.5.1/] [gcc-4.5.1-or32-1.0rc1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c3/] [c35508e.ada] - Blame information for rev 338

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn 
-- C35508E.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 THE ATTRIBUTES 'IMAGE' AND 'VALUE' YIELD THE CORRECT
27 
--     RESULTS WHEN THE PREFIX IS A GENERIC FORMAL DISCRETE TYPE WHOSE
28 
--     ACTUAL ARGUMENT IS A BOOLEAN TYPE.
29 
 
30 
--     SUBTESTS ARE:
31 
--         (A). TESTS FOR IMAGE.
32 
--         (B). TESTS FOR VALUE.
33 
 
34 
-- HISTORY:
35 
--     RJW 03/19/86 CREATED ORIGINAL TEST.
36 
--     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
37 
 
38 
WITH REPORT; USE REPORT;
39 
 
40 
PROCEDURE  C35508E  IS
41 
 
42 
BEGIN
43 
 
44 
     TEST( "C35508E" , "CHECK THAT THE ATTRIBUTES 'IMAGE' AND " &
45 
                       "'VALUE' YIELD THE CORRECT RESULTS  WHEN THE " &
46 
                       "PREFIX IS A GENERIC FORMAL DISCRETE TYPE " &
47 
                       "WHOSE ACTUAL ARGUMENT IS A BOOLEAN TYPE" );
48 
-- PART (A).
49 
 
50 
     DECLARE
51 
          TYPE NEWBOOL IS NEW BOOLEAN;
52 
 
53 
          GENERIC
54 
               TYPE BOOL IS (<>);
55 
          PROCEDURE P (B : BOOL; STR : STRING );
56 
 
57 
          PROCEDURE P (B : BOOL; STR : STRING) IS
58 
               SUBTYPE SUBBOOL IS BOOL
59 
                    RANGE BOOL'VAL (IDENT_INT(0)) ..
60 
                                               BOOL'VAL (IDENT_INT(0));
61 
          BEGIN
62 
 
63 
               IF BOOL'IMAGE (B) /= STR THEN
64 
                    FAILED ( "INCORRECT BOOL'IMAGE OF " & STR );
65 
               END IF;
66 
               IF BOOL'IMAGE (B)'FIRST /= 1 THEN
67 
                    FAILED ( "INCORRECT BOOL'FIRST FOR " & STR );
68 
               END IF;
69 
 
70 
               IF SUBBOOL'IMAGE (B) /= STR THEN
71 
                    FAILED ( "INCORRECT SUBBOOL'IMAGE OF " & STR );
72 
               END IF;
73 
               IF SUBBOOL'IMAGE (B)'FIRST /= 1 THEN
74 
                    FAILED ( "INCORRECT SUBBOOL'FIRST FOR " & STR );
75 
               END IF;
76 
          END P;
77 
 
78 
          PROCEDURE NP1 IS NEW P ( BOOLEAN );
79 
          PROCEDURE NP2 IS NEW P ( NEWBOOL );
80 
     BEGIN
81 
          NP1 ( TRUE, "TRUE" );
82 
          NP2 ( FALSE, "FALSE" );
83 
 
84 
     END;
85 
 
86 
-----------------------------------------------------------------------
87 
 
88 
-- PART (B).
89 
 
90 
     DECLARE
91 
          TYPE NEWBOOL IS NEW BOOLEAN;
92 
 
93 
          GENERIC
94 
               TYPE BOOL IS (<>);
95 
          PROCEDURE P (STR : STRING; B : BOOL );
96 
 
97 
          PROCEDURE P (STR : STRING; B : BOOL) IS
98 
               SUBTYPE SUBBOOL IS BOOL
99 
                    RANGE BOOL'VAL (IDENT_INT(0)) ..
100 
                                               BOOL'VAL (IDENT_INT(0));
101 
 
102 
          BEGIN
103 
               BEGIN
104 
                    IF BOOL'VALUE (STR) /= B THEN
105 
                         FAILED ( "INCORRECT BOOL'VALUE OF """ &
106 
                                  STR & """" );
107 
                    END IF;
108 
               EXCEPTION
109 
                    WHEN OTHERS =>
110 
                         FAILED ( "EXCEPTION RAISED BOOL'VALUE OF """ &
111 
                                  STR & """" );
112 
               END;
113 
               BEGIN
114 
                    IF SUBBOOL'VALUE (STR) /= B THEN
115 
                         FAILED ( "INCORRECT SUBBOOL'VALUE OF """ &
116 
                                  STR & """" );
117 
                    END IF;
118 
               EXCEPTION
119 
                    WHEN OTHERS =>
120 
                         FAILED ( "EXCEPTION RAISED SUBBOOL'VALUE " &
121 
                                  "OF """ & STR & """" );
122 
               END;
123 
          END P;
124 
 
125 
          PROCEDURE NP1 IS NEW P ( BOOLEAN );
126 
          PROCEDURE NP2 IS NEW P ( NEWBOOL );
127 
 
128 
     BEGIN
129 
          NP1 ( "TRUE", TRUE );
130 
          NP2 ( "FALSE", FALSE );
131 
          NP2 ( "true", TRUE );
132 
          NP1 ( "false", FALSE );
133 
          NP1 ( "         TRUE", TRUE );
134 
          NP2 ( "FALSE        ", FALSE );
135 
     END;
136 
 
137 
     DECLARE
138 
          GENERIC
139 
               TYPE BOOL IS (<>);
140 
          PROCEDURE P (STR1 : STRING; B : BOOL; STR2 : STRING);
141 
 
142 
          PROCEDURE P (STR1 : STRING; B : BOOL; STR2 : STRING) IS
143 
               SUBTYPE SUBBOOL IS BOOL
144 
                    RANGE BOOL'VAL (IDENT_INT(0)) ..
145 
                                                BOOL'VAL (IDENT_INT(0));
146 
 
147 
          BEGIN
148 
               BEGIN
149 
                    IF BOOL'VALUE (STR1) = B THEN
150 
                         FAILED ( "NO EXCEPTION RAISED - " &
151 
                                  "BOOL'VALUE WITH " & STR2 &
152 
                                  "- EQUAL " );
153 
                    ELSE
154 
                         FAILED ( "NO EXCEPTION RAISED - " &
155 
                                  "BOOL'VALUE WITH " & STR2 &
156 
                                  " - NOT EQUAL" );
157 
                    END IF;
158 
               EXCEPTION
159 
                    WHEN CONSTRAINT_ERROR =>
160 
                         NULL;
161 
                    WHEN OTHERS =>
162 
                         FAILED ( "WRONG EXCEPTION RAISED - " &
163 
                                  "BOOL'VALUE WITH " & STR2 );
164 
               END;
165 
               BEGIN
166 
                    IF SUBBOOL'VALUE (STR1) /= B THEN
167 
                         FAILED ( "NO EXCEPTION RAISED - " &
168 
                                  "SUBBOOL'VALUE WITH " &
169 
                                  STR2 & " - EQUAL");
170 
                    ELSE
171 
                         FAILED ( "NO EXCEPTION RAISED - " &
172 
                                  "SUBBOOL'VALUE WITH " &
173 
                                  STR2 & " - NOT EQUAL");
174 
                    END IF;
175 
               EXCEPTION
176 
                    WHEN CONSTRAINT_ERROR =>
177 
                         NULL;
178 
                    WHEN OTHERS =>
179 
                         FAILED ( "WRONG EXCEPTION RAISED - " &
180 
                                  "SUBBOOL'VALUE WITH " & STR2 );
181 
               END;
182 
          END P;
183 
 
184 
          PROCEDURE NP IS NEW P ( BOOLEAN );
185 
     BEGIN
186 
          NP ( "MAYBE", TRUE, "NON-BOOLEAN VALUE");
187 
          NP ( ASCII.HT & "TRUE", TRUE, "LEADING 'HT'" );
188 
          NP ( "FALSE" & ASCII.HT , FALSE, "TRAILING 'HT'" );
189 
     END;
190 
 
191 
     RESULT;
192 
END C35508E;

powered by: WebSVN 2.1.0

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