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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- CE3602B.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 GET (FOR CHARACTER AND STRINGS) PROPERLY SETS THE
27
--     PAGE, LINE, AND COLUMN NUMBERS AFTER EACH OPERATION.
28
 
29
-- APPLICABILITY CRITERIA:
30
--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
31
--     TEXT FILES.
32
 
33
-- HISTORY:
34
--     SPS 08/30/82
35
--     SPS 12/17/82
36
--     JBG 02/22/84  CHANGED TO .ADA TEST
37
--     RJW 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
38
--                   RESULT WHEN FILES ARE NOT SUPPORTED.
39
--     JLH 09/04/87  REMOVED DEPENDENCE ON UNBOUNDED LINE LENGTH AND
40
--                   CORRECTED EXCEPTION HANDLING.
41
--     BCB 11/13/87  GAVE SET_LINE_LENGTH PROCEDURE THE FILE VARIABLE
42
--                   AS A PARAMETER.  REMOVED LINE WHICH SAVED AND
43
--                   RESTORED THE LINE LENGTH.
44
 
45
 
46
WITH REPORT; USE REPORT;
47
WITH TEXT_IO; USE TEXT_IO;
48
WITH CHECK_FILE;
49
 
50
PROCEDURE CE3602B IS
51
     INCOMPLETE : EXCEPTION;
52
 
53
BEGIN
54
 
55
     TEST ("CE3602B", "CHECK THAT GET PROPERLY SETS PAGE, LINE, AND " &
56
                      "COLUMN NUMBERS");
57
 
58
     DECLARE
59
          FILE1 : FILE_TYPE;
60
          LINE1 : CONSTANT STRING := "LINE ONE OF TEST DATA FILE";
61
          LINE2 : CONSTANT STRING := "LINE TWO";
62
          LINE3 : CONSTANT STRING := "LINE THREE";
63
          CN, LN : POSITIVE_COUNT;
64
          CH : CHARACTER;
65
          ST: STRING (1 .. 5);
66
          ORIGINAL_LINE_LENGTH : COUNT;
67
 
68
     BEGIN
69
 
70
-- CREATE AND INITIALIZE TEST DATA FILE
71
 
72
          BEGIN
73
               CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
74
          EXCEPTION
75
               WHEN USE_ERROR =>
76
                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
77
                                    "WITH OUT_FILE MODE");
78
                    RAISE INCOMPLETE;
79
               WHEN NAME_ERROR =>
80
                    NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
81
                                    "CREATE WITH OUT_FILE MODE");
82
                    RAISE INCOMPLETE;
83
               WHEN OTHERS =>
84
                    FAILED ("UNEXPECTED EXCEPTION RAISED ON " &
85
                            "TEXT CREATE");
86
                    RAISE INCOMPLETE;
87
          END;
88
 
89
          ORIGINAL_LINE_LENGTH := LINE_LENGTH;
90
          SET_LINE_LENGTH (FILE1, LINE1'LENGTH);
91
 
92
          PUT (FILE1, LINE1);
93
          SET_LINE_LENGTH (FILE1, LINE2'LENGTH);
94
          PUT (FILE1, LINE2);
95
          NEW_LINE (FILE1, 2);
96
          NEW_PAGE (FILE1);
97
          SET_LINE_LENGTH (FILE1, LINE3'LENGTH);
98
          PUT (FILE1, LINE3);
99
          CLOSE (FILE1);
100
 
101
-- BEGIN TEST
102
 
103
          BEGIN
104
               OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
105
          EXCEPTION
106
               WHEN USE_ERROR =>
107
                    NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN " &
108
                                    "WITH IN_FILE MODE");
109
                    RAISE INCOMPLETE;
110
          END;
111
 
112
          IF COL (FILE1) /= 1 THEN
113
               FAILED ("COLUMN NUMBER NOT INITIALLY ONE");
114
          END IF;
115
 
116
          IF LINE (FILE1) /= 1 THEN
117
               FAILED ("LINE NUMBER NOT INITIALLY ONE");
118
          END IF;
119
 
120
          IF PAGE (FILE1) /= 1 THEN
121
               FAILED ("PAGE NUMBER NOT INITIALLY ONE");
122
          END IF;
123
 
124
-- TEST COLUMN NUMBER FOR CHARACTER
125
 
126
          GET (FILE1, CH);
127
          IF CH /= 'L' THEN
128
               FAILED ("CHARACTER NOT EQUAL TO L - 1");
129
          END IF;
130
          CN := COL (FILE1);
131
          IF CN /= 2 THEN
132
               FAILED ("COLUMN NUMBER NOT SET CORRECTLY " &
133
                       "- GET CHARACTER.  COL NUMBER IS" &
134
                       COUNT'IMAGE(CN));
135
          END IF;
136
 
137
-- TEST COLUMN NUMBER FOR STRING
138
 
139
          GET (FILE1, ST);
140
          CN := COL (FILE1);
141
          IF CN /= 7 THEN
142
               FAILED ("COLUMN NUMBER NOT SET CORRECTLY " &
143
                       "- GET STRING.  COL NUMBER IS" &
144
                       COUNT'IMAGE(CN));
145
          END IF;
146
 
147
-- POSITION CURRENT INDEX TO END OF LINE
148
 
149
          WHILE NOT END_OF_LINE (FILE1) LOOP
150
               GET (FILE1, CH);
151
          END LOOP;
152
 
153
          IF CH /= 'E' THEN
154
               FAILED ("CHARACTER NOT EQUAL TO E");
155
          END IF;
156
 
157
-- TEST LINE NUMBER FOR CHARACTER
158
 
159
          GET(FILE1, CH);
160
          IF CH /= 'L' THEN
161
               FAILED ("CHARACTER NOT EQUAL TO L - 2");
162
          END IF;
163
          LN := LINE (FILE1);
164
          IF LN /= 2 THEN
165
               FAILED ("LINE NUMBER NOT SET CORRECTLY " &
166
                       "- GET CHARACTER.  LINE NUMBER IS" &
167
                       COUNT'IMAGE(LN));
168
          END IF;
169
          IF PAGE (FILE1) /= POSITIVE_COUNT(IDENT_INT(1)) THEN
170
               FAILED ("PAGE NUMBER NOT CORRECT - 1.  PAGE IS" &
171
                       COUNT'IMAGE(PAGE(FILE1)));
172
          END IF;
173
 
174
-- TEST LINE NUMBER FOR STRING
175
 
176
          WHILE NOT END_OF_LINE (FILE1) LOOP
177
               GET (FILE1, CH);
178
          END LOOP;
179
          GET (FILE1, ST);
180
          IF ST /= "LINE " THEN
181
               FAILED ("INCORRECT VALUE READ - ST");
182
          END IF;
183
          LN := LINE (FILE1);
184
          CN := COL (FILE1);
185
          IF CN /= 6 THEN
186
               FAILED ("COLUMN NUMBER NOT SET CORRECTLY " &
187
                       "- GET STRING.  COL NUMBER IS" &
188
                       COUNT'IMAGE(CN));
189
          END IF;
190
          IF LN /= 1 THEN
191
               FAILED ("LINE NUMBER NOT SET CORRECTLY " &
192
                       "- GET STRING.  LINE NUMBER IS" &
193
                       COUNT'IMAGE(LN));
194
          END IF;
195
          IF PAGE (FILE1) /= POSITIVE_COUNT(IDENT_INT(2)) THEN
196
               FAILED ("PAGE NUMBER NOT CORRECT - 2.  PAGE IS" &
197
                       COUNT'IMAGE(PAGE(FILE1)));
198
          END IF;
199
 
200
          BEGIN
201
               DELETE (FILE1);
202
          EXCEPTION
203
               WHEN USE_ERROR =>
204
                    NULL;
205
          END;
206
 
207
     EXCEPTION
208
          WHEN INCOMPLETE =>
209
               NULL;
210
 
211
     END;
212
 
213
     RESULT;
214
 
215
END CE3602B;

powered by: WebSVN 2.1.0

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