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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- CE3806E.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 FLOAT_IO PUT RAISE LAYOUT_ERROR WHEN THE NUMBER
27
--     OF CHARACTERS TO BE OUTPUT EXCEEDS THE MAXIMUM LINE LENGTH.
28
--     CHECK THAT IT IS NOT RAISED, BUT RATHER NEW_LINE IS CALLED,
29
--     WHEN THE NUMBER DOES NOT EXCEED THE MAX, BUT WHEN ADDED TO
30
--     THE CURRENT COLUMN NUMBER, THE TOTAL EXCEEDS THE MAX.
31
 
32
-- APPLICABILITY CRITERIA:
33
--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
34
--     TEXT FILES.
35
 
36
-- HISTORY:
37
--     SPS 10/07/82
38
--     SPS 12/14/82
39
--     VKG 01/13/83
40
--     SPS 02/18/83
41
--     JBG 08/30/83
42
--     RJW 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
43
--                   RESULT WHEN FILES ARE NOT SUPPORTED.
44
--     JLH 09/14/87  REMOVED DEPENDENCE ON RESET AND CORRECTED
45
--                   EXCEPTION HANDLING.
46
 
47
WITH REPORT;
48
USE REPORT;
49
WITH TEXT_IO;
50
USE TEXT_IO;
51
WITH CHECK_FILE;
52
 
53
PROCEDURE CE3806E IS
54
 
55
BEGIN
56
 
57
     TEST ("CE3806E", "CHECK THAT FLOAT_IO PUT RAISES " &
58
                      "LAYOUT_ERROR CORRECTLY");
59
 
60
     DECLARE
61
          TYPE FL IS DIGITS 3 RANGE 100.0 .. 200.0;
62
          PACKAGE FLIO IS NEW FLOAT_IO (FL);
63
          USE FLIO;
64
          X : FL := 126.0;
65
          Y : FL := 134.0;
66
          Z : FL := 120.0;
67
          INCOMPLETE : EXCEPTION;
68
          FT : FILE_TYPE;
69
     BEGIN
70
 
71
          BEGIN
72
               CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
73
          EXCEPTION
74
               WHEN USE_ERROR =>
75
                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
76
                                    "WITH OUT_FILE MODE");
77
                    RAISE INCOMPLETE;
78
               WHEN NAME_ERROR =>
79
                    NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
80
                                    "CREATE WITH OUT_FILE MODE");
81
                    RAISE INCOMPLETE;
82
          END;
83
 
84
          SET_LINE_LENGTH (FT, 8);
85
 
86
          BEGIN
87
               PUT (FT, X);        -- " 1.26E+02"
88
               FAILED ("LAYOUT_ERROR NOT RAISED - FLOAT");
89
          EXCEPTION
90
               WHEN LAYOUT_ERROR =>
91
                    NULL;
92
               WHEN OTHERS =>
93
                    FAILED ("WRONG EXCEPTION RAISED - FLOAT");
94
 
95
          END;
96
 
97
          BEGIN
98
               PUT (FT, Y, FORE => 1); -- "1.34E+02"
99
          EXCEPTION
100
               WHEN LAYOUT_ERROR =>
101
                    FAILED ("LAYOUT_ERROR RAISED SECOND PUT " &
102
                            "- FLOAT");
103
               WHEN OTHERS =>
104
                    FAILED ("EXCEPTION RAISED SECOND PUT - FLOAT");
105
          END;
106
 
107
          BEGIN
108
               PUT (FT,Z, FORE => 1, AFT => 0); -- "1.2E+02"
109
               IF LINE (FT) /= 2 THEN
110
                    FAILED ("NEW_LINE NOT CALLED - FLOAT");
111
               END IF;
112
          EXCEPTION
113
               WHEN LAYOUT_ERROR =>
114
                    FAILED ("LAYOUT_ERROR RAISED THIRD " &
115
                            "PUT - FLOAT");
116
               WHEN OTHERS =>
117
                    FAILED ("EXCEPTION RAISED THIRD PUT - FLOAT");
118
          END;
119
 
120
          SET_LINE_LENGTH ( FT,7);
121
 
122
          BEGIN
123
               PUT (FT, "X");
124
               PUT (FT, Y, FORE => 1, AFT => 2,
125
                    EXP => 1);          -- 1.34E+2
126
          EXCEPTION
127
               WHEN LAYOUT_ERROR =>
128
                    FAILED ("LAYOUT_ERROR RAISED - 3 FLOAT");
129
          END;
130
 
131
          BEGIN
132
               PUT (FT, "Z");
133
               PUT (FT, Z, FORE => 1);
134
               FAILED ("LAYOUT_ERROR NOT RAISED - FLOAT 2");
135
          EXCEPTION
136
               WHEN LAYOUT_ERROR =>
137
                    NULL;
138
               WHEN OTHERS =>
139
                    FAILED ("SOME EXCEPTION RAISED - 3 FLOAT");
140
          END;
141
 
142
          CHECK_FILE (FT, "1.34E+02#1.2E+02#X#1.34E+2#Z#@%");
143
 
144
          BEGIN
145
               DELETE (FT);
146
          EXCEPTION
147
               WHEN USE_ERROR =>
148
                    NULL;
149
          END;
150
 
151
     EXCEPTION
152
          WHEN INCOMPLETE =>
153
               NULL;
154
 
155
     END;
156
 
157
     RESULT;
158
 
159
END CE3806E;

powered by: WebSVN 2.1.0

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