URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [ce/] [ce3809b.ada] - Blame information for rev 720

Details | Compare with Previous | View Log


-- CE3809B.ADA
 
--                             Grant of Unlimited Rights
--
--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
--     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
--     unlimited rights in the software and documentation contained herein.
--     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
--     this public release, the Government intends to confer upon all 
--     recipients unlimited rights  equal to those held by the Government.  
--     These rights include rights to use, duplicate, release or disclose the 
--     released technical data and computer software in whole or in part, in 
--     any manner and for any purpose whatsoever, and to have or permit others 
--     to do so.
--
--                                    DISCLAIMER
--
--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
--     PARTICULAR PURPOSE OF SAID MATERIAL.
--*
-- HISTORY:
--     CHECK THAT FIXED I/O GET CAN READ A VALUE FROM A STRING.
--     CHECK THAT END_ERROR IS RAISED WHEN CALLED WITH A NULL STRING
--     OR A STRING CONTAINING SPACES AND/OR HORIZONTAL TABULATION
--     CHARACTERS.  CHECK THAT LAST CONTAINS THE INDEX OF THE LAST
--     CHARACTER READ FROM THE STRING.
 
-- HISTORY:
--     SPS 10/07/82
--     SPS 12/14/82
--     JBG 12/21/82
--     DWC 09/15/87  ADDED CASE TO INCLUDE ONLY TABS IN STRING AND
--                   CHECKED THAT END_ERROR IS RAISED.
 
WITH REPORT; USE REPORT;
WITH TEXT_IO; USE TEXT_IO;
 
PROCEDURE CE3809B IS
BEGIN
 
     TEST ("CE3809B", "CHECK THAT FIXED_IO GET " &
                      "OPERATES CORRECTLY ON STRINGS");
 
     DECLARE
          TYPE FX IS DELTA 0.001 RANGE -2.0 .. 1000.0;
          PACKAGE FXIO IS NEW FIXED_IO (FX);
          USE FXIO;
          X : FX;
          L : POSITIVE;
          STR : STRING (1..10) := "   10.25  ";
     BEGIN
 
-- LEFT-JUSTIFIED IN STRING, POSITIVE, NO EXPONENT
          BEGIN
               GET ("896.5  ", X, L);
               IF X /= 896.5 THEN
                    FAILED ("FIXED VALUE FROM STRING INCORRECT");
               END IF;
          EXCEPTION
               WHEN DATA_ERROR =>
                    FAILED ("DATA_ERROR RAISED - FIXED - 1");
               WHEN OTHERS =>
                    FAILED ("UNEXPECTED EXCEPTION RAISED - FIXED - 1");
          END;
 
          IF L /= IDENT_INT (5) THEN
               FAILED ("VALUE OF LAST INCORRECT - FIXED - 1.  " &
                       "LAST IS" & INTEGER'IMAGE(L));
          END IF;
 
-- STRING LITERAL WITH BLANKS
          BEGIN
               GET ("   ", X, L);
               FAILED ("END_ERROR NOT RAISED - FIXED - 2");
          EXCEPTION
               WHEN END_ERROR =>
                    IF L /= 5 THEN
                         FAILED ("AFTER END_ERROR, VALUE OF LAST " &
                                 "INCORRECT - 2.  LAST IS"  &
                                 INTEGER'IMAGE(L));
                    END IF;
               WHEN DATA_ERROR =>
                    FAILED ("DATA_ERROR RAISED - FIXED - 2");
               WHEN OTHERS =>
                    FAILED ("WRONG EXCEPTION RAISED - FIXED - 2");
          END;
 
-- NULL STRING LITERAL
          BEGIN
               GET ("", X, L);
               FAILED ("END_ERROR NOT RAISED - FIXED - 3");
          EXCEPTION
               WHEN END_ERROR =>
                    IF L /= 5 THEN
                         FAILED ("AFTER END_ERROR, VALUE OF LAST " &
                                 "INCORRECT - 3.  LAST IS"  &
                                 INTEGER'IMAGE(L));
                    END IF;
               WHEN DATA_ERROR =>
                    FAILED ("DATA_ERROR RAISED - FIXED - 3");
               WHEN OTHERS =>
                    FAILED ("WRONG EXCEPTION RAISED - FIXED - 3");
          END;
 
-- NULL SLICE
          BEGIN
               GET (STR(5..IDENT_INT(2)), X, L);
               FAILED ("END_ERROR NOT RAISED - FIXED - 4");
          EXCEPTION
               WHEN END_ERROR =>
                    IF L /= 5 THEN
                         FAILED ("AFTER END_ERROR, VALUE OF LAST " &
                                 "INCORRECT - 4.  LAST IS"  &
                                 INTEGER'IMAGE(L));
                    END IF;
               WHEN DATA_ERROR =>
                    FAILED ("DATA_ERROR RAISED - FIXED - 4");
               WHEN OTHERS =>
                    FAILED ("WRONG EXCEPTION RAISED - FIXED - 4");
          END;
 
-- SLICE WITH BLANKS
          BEGIN
               GET (STR(IDENT_INT(9)..10), X, L);
               FAILED ("END_ERROR NOT RAISED - FIXED - 5");
          EXCEPTION
               WHEN END_ERROR =>
                    IF L /= IDENT_INT(5) THEN
                         FAILED ("AFTER END_ERROR, VALUE OF LAST " &
                                 "INCORRECT - 5.  LAST IS"  &
                                 INTEGER'IMAGE(L));
                    END IF;
               WHEN DATA_ERROR =>
                    FAILED ("DATA_ERROR RAISED - FIXED - 5");
               WHEN OTHERS =>
                    FAILED ("WRONG EXCEPTION RAISED - FIXED - 5");
          END;
 
-- NON-NULL SLICE
          BEGIN
               GET (STR(2..IDENT_INT(8)), X, L);
               IF X /= 10.25 THEN
                    FAILED ("FIXED VALUE INCORRECT - 6");
               END IF;
               IF L /= 8 THEN
                    FAILED ("LAST INCORRECT FOR SLICE - 6.  " &
                            "LAST IS" & INTEGER'IMAGE(L));
               END IF;
          EXCEPTION
               WHEN OTHERS =>
                    FAILED ("EXCEPTION RAISED - 6");
          END;
 
-- LEFT-JUSTIFIED, POSITIVE EXPONENT
          BEGIN
               GET ("1.34E+02", X, L);
               IF X /= 134.0 THEN
                    FAILED ("FIXED WITH EXP FROM STRING INCORRECT - 7");
               END IF;
 
               IF L /= 8 THEN
                    FAILED ("VALUE OF LAST INCORRECT - FIXED - 7.  " &
                            "LAST IS" & INTEGER'IMAGE(L));
               END IF;
          EXCEPTION
               WHEN DATA_ERROR =>
                    FAILED ("DATA_EROR RAISED - FIXED - 7");
               WHEN OTHERS =>
                    FAILED ("UNEXPECTED EXCEPTION RAISED - FIXED - 7");
          END;
 
-- RIGHT-JUSTIFIED, NEGATIVE EXPONENT
          BEGIN
               GET (" 25.0E-2", X, L);
               IF X /= 0.25 THEN
                    FAILED ("NEG EXPONENT INCORRECT - 8");
               END IF;
               IF L /= 8 THEN
                    FAILED ("LAST INCORRECT - 8.  " &
                            "LAST IS" & INTEGER'IMAGE(L));
               END IF;
          EXCEPTION
               WHEN OTHERS =>
                    FAILED ("EXCEPTION RAISED - 8");
          END;
 
-- RIGHT-JUSTIFIED, NEGATIVE
          GET ("  -1.50", X, L);
          IF X /= -1.5 THEN
               FAILED ("FIXED IN RIGHT JUSTIFIED STRING INCORRECT - 9");
          END IF;
          IF L /= 7 THEN
               FAILED ("LAST INCORRECT - 9.  " &
                       "LAST IS" & INTEGER'IMAGE(L));
          END IF;
 
-- HORIZONTAL TAB WITH BLANK
          BEGIN
               GET (" " & ASCII.HT & "2.3E+2", X, L);
               IF X /= 230.0 THEN
                    FAILED ("FIXED WITH TAB IN STRING INCORRECT - 10");
               END IF;
               IF L /= 8 THEN
                    FAILED ("LAST INCORRECT FOR TAB - 10.  " &
                            "LAST IS" & INTEGER'IMAGE(L));
               END IF;
          EXCEPTION
               WHEN DATA_ERROR =>
                    FAILED ("DATA_ERROR FOR STRING WITH TAB - 10");
               WHEN OTHERS =>
                    FAILED ("EXCEPTION FOR STRING WITH TAB - 10");
          END;
 
-- HORIZONTAL TABS ONLY
 
          BEGIN
               GET (ASCII.HT & ASCII.HT, X, L);
               FAILED ("END_ERROR NOT RAISED - FIXED - 11");
          EXCEPTION
               WHEN END_ERROR =>
                    IF L /= IDENT_INT(8) THEN
                         FAILED ("AFTER END_ERROR, VALUE OF LAST " &
                                 "INCORRECT - 11.  LAST IS"  &
                                 INTEGER'IMAGE(L));
                    END IF;
               WHEN DATA_ERROR =>
                    FAILED ("DATA_ERROR RAISED - FIXED - 11");
               WHEN OTHERS =>
                    FAILED ("WRONG EXCEPTION RAISED - FIXED - 11");
          END;
     END;
 
     RESULT;
 
END CE3809B;

Browse

Tools

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [ce/] [ce3809b.ada] - Blame information for rev 720

Line No.	Rev	Author	Line
1	720	jeremybenn	`-- CE3809B.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			`-- HISTORY:`
26			`-- CHECK THAT FIXED I/O GET CAN READ A VALUE FROM A STRING.`
27			`-- CHECK THAT END_ERROR IS RAISED WHEN CALLED WITH A NULL STRING`
28			`-- OR A STRING CONTAINING SPACES AND/OR HORIZONTAL TABULATION`
29			`-- CHARACTERS. CHECK THAT LAST CONTAINS THE INDEX OF THE LAST`
30			`-- CHARACTER READ FROM THE STRING.`
31
32			`-- HISTORY:`
33			`-- SPS 10/07/82`
34			`-- SPS 12/14/82`
35			`-- JBG 12/21/82`
36			`-- DWC 09/15/87 ADDED CASE TO INCLUDE ONLY TABS IN STRING AND`
37			`-- CHECKED THAT END_ERROR IS RAISED.`
38
39			`WITH REPORT; USE REPORT;`
40			`WITH TEXT_IO; USE TEXT_IO;`
41
42			`PROCEDURE CE3809B IS`
43			`BEGIN`
44
45			`TEST ("CE3809B", "CHECK THAT FIXED_IO GET " &`
46			`"OPERATES CORRECTLY ON STRINGS");`
47
48			`DECLARE`
49			`TYPE FX IS DELTA 0.001 RANGE -2.0 .. 1000.0;`
50			`PACKAGE FXIO IS NEW FIXED_IO (FX);`
51			`USE FXIO;`
52			`X : FX;`
53			`L : POSITIVE;`
54			`STR : STRING (1..10) := " 10.25 ";`
55			`BEGIN`
56
57			`-- LEFT-JUSTIFIED IN STRING, POSITIVE, NO EXPONENT`
58			`BEGIN`
59			`GET ("896.5 ", X, L);`
60			`IF X /= 896.5 THEN`
61			`FAILED ("FIXED VALUE FROM STRING INCORRECT");`
62			`END IF;`
63			`EXCEPTION`
64			`WHEN DATA_ERROR =>`
65			`FAILED ("DATA_ERROR RAISED - FIXED - 1");`
66			`WHEN OTHERS =>`
67			`FAILED ("UNEXPECTED EXCEPTION RAISED - FIXED - 1");`
68			`END;`
69
70			`IF L /= IDENT_INT (5) THEN`
71			`FAILED ("VALUE OF LAST INCORRECT - FIXED - 1. " &`
72			`"LAST IS" & INTEGER'IMAGE(L));`
73			`END IF;`
74
75			`-- STRING LITERAL WITH BLANKS`
76			`BEGIN`
77			`GET (" ", X, L);`
78			`FAILED ("END_ERROR NOT RAISED - FIXED - 2");`
79			`EXCEPTION`
80			`WHEN END_ERROR =>`
81			`IF L /= 5 THEN`
82			`FAILED ("AFTER END_ERROR, VALUE OF LAST " &`
83			`"INCORRECT - 2. LAST IS" &`
84			`INTEGER'IMAGE(L));`
85			`END IF;`
86			`WHEN DATA_ERROR =>`
87			`FAILED ("DATA_ERROR RAISED - FIXED - 2");`
88			`WHEN OTHERS =>`
89			`FAILED ("WRONG EXCEPTION RAISED - FIXED - 2");`
90			`END;`
91
92			`-- NULL STRING LITERAL`
93			`BEGIN`
94			`GET ("", X, L);`
95			`FAILED ("END_ERROR NOT RAISED - FIXED - 3");`
96			`EXCEPTION`
97			`WHEN END_ERROR =>`
98			`IF L /= 5 THEN`
99			`FAILED ("AFTER END_ERROR, VALUE OF LAST " &`
100			`"INCORRECT - 3. LAST IS" &`
101			`INTEGER'IMAGE(L));`
102			`END IF;`
103			`WHEN DATA_ERROR =>`
104			`FAILED ("DATA_ERROR RAISED - FIXED - 3");`
105			`WHEN OTHERS =>`
106			`FAILED ("WRONG EXCEPTION RAISED - FIXED - 3");`
107			`END;`
108
109			`-- NULL SLICE`
110			`BEGIN`
111			`GET (STR(5..IDENT_INT(2)), X, L);`
112			`FAILED ("END_ERROR NOT RAISED - FIXED - 4");`
113			`EXCEPTION`
114			`WHEN END_ERROR =>`
115			`IF L /= 5 THEN`
116			`FAILED ("AFTER END_ERROR, VALUE OF LAST " &`
117			`"INCORRECT - 4. LAST IS" &`
118			`INTEGER'IMAGE(L));`
119			`END IF;`
120			`WHEN DATA_ERROR =>`
121			`FAILED ("DATA_ERROR RAISED - FIXED - 4");`
122			`WHEN OTHERS =>`
123			`FAILED ("WRONG EXCEPTION RAISED - FIXED - 4");`
124			`END;`
125
126			`-- SLICE WITH BLANKS`
127			`BEGIN`
128			`GET (STR(IDENT_INT(9)..10), X, L);`
129			`FAILED ("END_ERROR NOT RAISED - FIXED - 5");`
130			`EXCEPTION`
131			`WHEN END_ERROR =>`
132			`IF L /= IDENT_INT(5) THEN`
133			`FAILED ("AFTER END_ERROR, VALUE OF LAST " &`
134			`"INCORRECT - 5. LAST IS" &`
135			`INTEGER'IMAGE(L));`
136			`END IF;`
137			`WHEN DATA_ERROR =>`
138			`FAILED ("DATA_ERROR RAISED - FIXED - 5");`
139			`WHEN OTHERS =>`
140			`FAILED ("WRONG EXCEPTION RAISED - FIXED - 5");`
141			`END;`
142
143			`-- NON-NULL SLICE`
144			`BEGIN`
145			`GET (STR(2..IDENT_INT(8)), X, L);`
146			`IF X /= 10.25 THEN`
147			`FAILED ("FIXED VALUE INCORRECT - 6");`
148			`END IF;`
149			`IF L /= 8 THEN`
150			`FAILED ("LAST INCORRECT FOR SLICE - 6. " &`
151			`"LAST IS" & INTEGER'IMAGE(L));`
152			`END IF;`
153			`EXCEPTION`
154			`WHEN OTHERS =>`
155			`FAILED ("EXCEPTION RAISED - 6");`
156			`END;`
157
158			`-- LEFT-JUSTIFIED, POSITIVE EXPONENT`
159			`BEGIN`
160			`GET ("1.34E+02", X, L);`
161			`IF X /= 134.0 THEN`
162			`FAILED ("FIXED WITH EXP FROM STRING INCORRECT - 7");`
163			`END IF;`
164
165			`IF L /= 8 THEN`
166			`FAILED ("VALUE OF LAST INCORRECT - FIXED - 7. " &`
167			`"LAST IS" & INTEGER'IMAGE(L));`
168			`END IF;`
169			`EXCEPTION`
170			`WHEN DATA_ERROR =>`
171			`FAILED ("DATA_EROR RAISED - FIXED - 7");`
172			`WHEN OTHERS =>`
173			`FAILED ("UNEXPECTED EXCEPTION RAISED - FIXED - 7");`
174			`END;`
175
176			`-- RIGHT-JUSTIFIED, NEGATIVE EXPONENT`
177			`BEGIN`
178			`GET (" 25.0E-2", X, L);`
179			`IF X /= 0.25 THEN`
180			`FAILED ("NEG EXPONENT INCORRECT - 8");`
181			`END IF;`
182			`IF L /= 8 THEN`
183			`FAILED ("LAST INCORRECT - 8. " &`
184			`"LAST IS" & INTEGER'IMAGE(L));`
185			`END IF;`
186			`EXCEPTION`
187			`WHEN OTHERS =>`
188			`FAILED ("EXCEPTION RAISED - 8");`
189			`END;`
190
191			`-- RIGHT-JUSTIFIED, NEGATIVE`
192			`GET (" -1.50", X, L);`
193			`IF X /= -1.5 THEN`
194			`FAILED ("FIXED IN RIGHT JUSTIFIED STRING INCORRECT - 9");`
195			`END IF;`
196			`IF L /= 7 THEN`
197			`FAILED ("LAST INCORRECT - 9. " &`
198			`"LAST IS" & INTEGER'IMAGE(L));`
199			`END IF;`
200
201			`-- HORIZONTAL TAB WITH BLANK`
202			`BEGIN`
203			`GET (" " & ASCII.HT & "2.3E+2", X, L);`
204			`IF X /= 230.0 THEN`
205			`FAILED ("FIXED WITH TAB IN STRING INCORRECT - 10");`
206			`END IF;`
207			`IF L /= 8 THEN`
208			`FAILED ("LAST INCORRECT FOR TAB - 10. " &`
209			`"LAST IS" & INTEGER'IMAGE(L));`
210			`END IF;`
211			`EXCEPTION`
212			`WHEN DATA_ERROR =>`
213			`FAILED ("DATA_ERROR FOR STRING WITH TAB - 10");`
214			`WHEN OTHERS =>`
215			`FAILED ("EXCEPTION FOR STRING WITH TAB - 10");`
216			`END;`
217
218			`-- HORIZONTAL TABS ONLY`
219
220			`BEGIN`
221			`GET (ASCII.HT & ASCII.HT, X, L);`
222			`FAILED ("END_ERROR NOT RAISED - FIXED - 11");`
223			`EXCEPTION`
224			`WHEN END_ERROR =>`
225			`IF L /= IDENT_INT(8) THEN`
226			`FAILED ("AFTER END_ERROR, VALUE OF LAST " &`
227			`"INCORRECT - 11. LAST IS" &`
228			`INTEGER'IMAGE(L));`
229			`END IF;`
230			`WHEN DATA_ERROR =>`
231			`FAILED ("DATA_ERROR RAISED - FIXED - 11");`
232			`WHEN OTHERS =>`
233			`FAILED ("WRONG EXCEPTION RAISED - FIXED - 11");`
234			`END;`
235			`END;`
236
237			`RESULT;`
238
239			`END CE3809B;`