1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
|
-- CXAB003.AU
--
-- Grant of Unlimited Rights
--
-- AdaCore holds unlimited rights in the software and documentation
-- contained herein. Unlimited rights are the same as those granted
-- by the U.S. Government for older parts of the Ada Conformity
-- Assessment Test Suite, and are defined in DFAR 252.227-7013(a)(19).
-- By making this public release, AdaCore intends to confer upon all
-- recipients unlimited rights equal to those held by the Ada Conformity
-- Assessment Authority. 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. ADACORE 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.
--
-- Notice
--
-- The ACAA has created and maintains the Ada Conformity Assessment Test
-- Suite for the purpose of conformity assessments conducted in accordance
-- with the International Standard ISO/IEC 18009 - Ada: Conformity
-- assessment of a language processor. This test suite should not be used
-- to make claims of conformance unless used in accordance with
-- ISO/IEC 18009 and any applicable ACAA procedures.
--
-- This test is based on one submitted by AdaCore; AdaCore retains
-- the copyright on the test.
--
--*
-- OBJECTIVE:
-- Check file operations defined in Wide_Wide_Text_IO.Wide_Wide_Bounded_IO.
--
-- CHANGE HISTORY:
-- 06 Dec 2005 H K Initial Version.
-- 22 Dec 2014 RLB Renamed, split into multiple tests as different
-- clauses are involved, added missing applicability
-- check, corrected to use file name generator, added
-- short and long string examples, included Unicode
-- characters in string.
--!
with Ada.Strings.Wide_Wide_Bounded; use Ada.Strings.Wide_Wide_Bounded;
with Ada.Wide_Wide_Text_IO;
with Ada.Wide_Wide_Text_IO.Wide_Wide_Bounded_IO;
with Report; use Report;
procedure CXAB003 is
begin
Test ("CXAB003", "Check file operations defined in Wide_Wide_Text_IO.Wide_Wide_Bounded_IO");
declare
package BWW_Str is new
Ada.Strings.Wide_Wide_Bounded.Generic_Bounded_Length (6);
package BWW_Str_IO is new
Ada.Wide_Wide_Text_IO.Wide_Wide_Bounded_IO (BWW_Str);
use Ada.Wide_Wide_Text_IO;
use BWW_Str;
use BWW_Str_IO;
B : Bounded_Wide_Wide_String := To_Bounded_Wide_Wide_String ("junk");
F : File_Type;
S1 : Bounded_Wide_Wide_String := To_Bounded_Wide_Wide_String ("Εύρηκα");
-- It's all Greek to me! :-)
S2 : Bounded_Wide_Wide_String := To_Bounded_Wide_Wide_String ("KLM");
Long : Wide_Wide_String := "Double-wide Long";
begin
-- Put (File_Type; Bounded_Wide_Wide_String
begin
Create (F, Out_File, Report.Legal_File_Name(X => 1));
exception
when others =>
Report.Not_Applicable ("Unable to create Out mode Wide_Wide_Text_IO file");
goto Done;
end;
Put (F, S1);
Close (F);
-- Put_Line (File_Type; Bounded_Wide_Wide_String)
Create (F, Out_File, Report.Legal_File_Name(X => 2));
Put_Line (F, S1);
Put_Line (F, S2);
Put_Line (F, Long);
Close (F);
-- Get_Line (File_Type) return Bounded_Wide_Wide_String);
Open (F, In_File, Report.Legal_File_Name(X => 1));
B := Get_Line (F);
Delete (F);
if B /= S1 then
Failed ("Get_Line (File_Type) return Bounded_Wide_Wide_String");
end if;
-- Get_Line (File_Type; out Bounded_Wide_Wide_String)
Open (F, In_File, Report.Legal_File_Name(X => 2));
Get_Line (F, B);
if B /= S1 then
Failed ("Get_Line (File_Type; out Bounded_Wide_Wide_String) - S1");
end if;
Get_Line (F, B);
if B /= S2 then
Failed ("Get_Line (File_Type; out Bounded_Wide_Wide_String) - S2");
end if;
begin
Get_Line (F, B);
Failed ("Exception not raised by Get_Line of too long string");
if B /= S2 then -- Stop dead code elimination.
Failed ("Get_Line (File_Type; out Bounded_Wide_Wide_String) - Long");
end if;
exception
when Ada.Strings.Length_Error => null; -- Expected exception.
end;
Delete (F);
end;
<<Done>>
Result;
end CXAB003;
|
