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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- CE3403B.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 SPACING PARAMETER OF SKIP_LINE IS OPTIONAL,
27
--     AND THAT THE DEFAULT VALUE IS ONE.
28
--     CHECK THAT THE FILE PARAMETER IS ALSO OPTIONAL, AND THAT THE
29
--     FUNCTION IS THEN APPLIED TO THE CURRENT DEFAULT INPUT FILE.
30
 
31
-- APPLICABILITY CRITERIA:
32
--     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
33
--     SUPPORT TEXT FILES.
34
 
35
-- HISTORY:
36
--     ABW 08/26/82
37
--     SPS 12/14/82
38
--     JBG 1/17/83
39
--     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
40
--                   RESULT WHEN FILES ARE NOT SUPPORTED.
41
--     DWC 09/04/87  REVISED EXCEPTION HANDLERS, REMOVED
42
--                   DEPENDENCIES ON RESET, AND ADDED AN ATTEMPT
43
--                   TO DELETE FILE.
44
 
45
WITH REPORT;
46
USE REPORT;
47
WITH TEXT_IO;
48
USE TEXT_IO;
49
 
50
PROCEDURE CE3403B IS
51
 
52
     INCOMPLETE : EXCEPTION;
53
     FILE : FILE_TYPE;
54
     SPAC, TWO : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(2));
55
     A    : INTEGER := CHARACTER'POS('A');
56
     CH   : CHARACTER;
57
 
58
BEGIN
59
 
60
     TEST ("CE3403B" , "CHECK DEFAULT SPACING AND FILE " &
61
                       "OF SKIP_LINE");
62
 
63
     BEGIN
64
          CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
65
     EXCEPTION
66
          WHEN USE_ERROR =>
67
               NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
68
                               "WITH OUT_FILE MODE");
69
               RAISE INCOMPLETE;
70
          WHEN NAME_ERROR =>
71
               NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
72
                               "WITH OUT_FILE MODE");
73
               RAISE INCOMPLETE;
74
          WHEN OTHERS =>
75
               FAILED ("UNEXPECTED EXCEPTION RAISED; TEXT CREATE");
76
               RAISE INCOMPLETE;
77
     END;
78
 
79
     FOR I IN 1 .. 3 LOOP          -- CREATES "BBB#CC#D##F#@%"
80
          FOR J IN 1 .. 4-I LOOP
81
               PUT (FILE, CHARACTER'VAL(A + I));
82
          END LOOP;
83
          NEW_LINE (FILE);
84
     END LOOP;
85
     NEW_LINE (FILE);
86
     PUT (FILE, 'F');
87
 
88
     CLOSE (FILE);
89
 
90
     BEGIN
91
          OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
92
     EXCEPTION
93
          WHEN USE_ERROR =>
94
               NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN " &
95
                               "FOR IN_FILE MODE");
96
               RAISE INCOMPLETE;
97
     END;
98
 
99
     GET (FILE, CH);
100
     IF CH /= CHARACTER'VAL (A + 1) THEN
101
          FAILED ("LINE CONTENT WRONG - 1");
102
     END IF;
103
 
104
     SKIP_LINE (FILE);
105
 
106
     IF LINE (FILE) /= TWO THEN
107
          FAILED ("SPACING DEFAULT NOT ONE");
108
     END IF;
109
 
110
     GET (FILE, CH);
111
     IF CH /= CHARACTER'VAL (A + 2) THEN
112
          FAILED ("LINE CONTENT WRONG - 2");
113
     END IF;
114
 
115
     SET_INPUT (FILE);
116
     SKIP_LINE (FILE);
117
 
118
     IF LINE (FILE) /= 3 THEN
119
          FAILED ("SKIP_LINE DOES NOT OPERATE CORRECTLY ON " &
120
                  "DEFAULT FILE");
121
     END IF;
122
 
123
     GET (FILE, CH);
124
     IF CH /= CHARACTER'VAL (A + 3) THEN
125
          FAILED ("LINE CONTENT WRONG - 3");
126
     END IF;
127
 
128
     SKIP_LINE;
129
 
130
     IF LINE (FILE) /= 4 THEN
131
          FAILED ("LINE COUNT NOT 4; WAS " & COUNT'IMAGE(LINE(FILE)));
132
     END IF;
133
 
134
     GET (FILE, CH);
135
     IF CH /= 'F' THEN
136
          FAILED ("NOT RIGHT LINE");
137
     END IF;
138
 
139
     BEGIN
140
          DELETE (FILE);
141
     EXCEPTION
142
          WHEN USE_ERROR =>
143
               NULL;
144
     END;
145
 
146
     RESULT;
147
 
148
EXCEPTION
149
     WHEN INCOMPLETE =>
150
          RESULT;
151
 
152
END CE3403B;

powered by: WebSVN 2.1.0

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