• R/O
  • SSH

Ada95FL: 提交

Ada 95 foundation library


Commit MetaInfo

修订版fd8191a042f7504bdd5ac05c5e1f739d1c14c722 (tree)
时间2019-10-26 14:35:18
作者Sergey Dukov <dukov54@live...>
CommiterSergey Dukov

Log Message

#32764 Реализация пакета File_Stream_IO

更改概述

差异

diff -r 76b51d045233 -r fd8191a042f7 File_Stream/file_stream_io.adb
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/File_Stream/file_stream_io.adb Sat Oct 26 09:35:18 2019 +0400
@@ -0,0 +1,272 @@
1+
2+with Unbounded_Array; use Unbounded_Array;
3+
4+package body File_Stream_IO is
5+
6+ procedure Free (X : in out File_Stream_Access)
7+ is
8+ procedure Deallocate is
9+ new Ada.Unchecked_Deallocation
10+ (File_Stream_Referenced, File_Stream_Access);
11+ begin
12+ Deallocate (X);
13+ end Free;
14+
15+ procedure Reference (Item : File_Stream_Access)
16+ is
17+ begin
18+ Increment(Item.Counter);
19+ end Reference;
20+
21+ procedure Unreference (Item : in out File_Stream_Access)
22+ is
23+ Released : Boolean;
24+ begin
25+ Decrement(Item.Counter, Released);
26+ if Released then
27+ if Is_Open(Item.File) then
28+ Close(Item.File);
29+ end if;
30+ Free(Item);
31+ end if;
32+ end Unreference;
33+
34+ function Open (Name : String_32;
35+ Mode : File_Mode) return File_Stream
36+ is
37+ Result : File_Stream;
38+ String_Buffer : Unbounded_Array_Type;
39+ begin
40+ From_Utf32_To_Utf8(String_Buffer, Name, False, True);
41+ Result.Reference := new File_Stream_Referenced;
42+ Open(Result.Reference.File,
43+ Mode,
44+ To_String(String_Buffer)
45+ );
46+ return Result;
47+ end Open;
48+
49+ function Create (Name : String_32;
50+ Mode : File_Mode := Out_File) return File_Stream
51+ is
52+ Result : File_Stream;
53+ String_Buffer : Unbounded_Array_Type;
54+ begin
55+ From_Utf32_To_Utf8(String_Buffer, Name, False, True);
56+ Result.Reference := new File_Stream_Referenced;
57+ Create(Result.Reference.File,
58+ Mode,
59+ To_String(String_Buffer)
60+ );
61+ return Result;
62+ end Create;
63+
64+ procedure Adjust(Object : in out File_Stream)
65+ is
66+ begin
67+ if Object.Reference /= null then
68+ Reference(Object.Reference);
69+ end if;
70+ end Adjust;
71+
72+ procedure Finalize(Object : in out File_Stream)
73+ is
74+ begin
75+ if Object.Reference /= null then
76+ Unreference(Object.Reference);
77+ end if;
78+ end Finalize;
79+
80+ procedure Delete (File : in out File_Stream)
81+ is
82+ begin
83+ if File.Reference = null then
84+ Raise_Exception(Status_Error'Identity,
85+ "file not open");
86+ end if;
87+ Delete(File.Reference.File);
88+ Unreference(File.Reference);
89+ end Delete;
90+
91+ procedure Reset (File : in out File_Stream; Mode : File_Mode)
92+ is
93+ begin
94+ if File.Reference = null then
95+ Raise_Exception(Status_Error'Identity,
96+ "file not open");
97+ end if;
98+ Reset(File.Reference.File, Mode);
99+ end Reset;
100+
101+ procedure Reset (File : in out File_Stream)
102+ is
103+ begin
104+ if File.Reference = null then
105+ Raise_Exception(Status_Error'Identity,
106+ "file not open");
107+ end if;
108+ Reset(File.Reference.File);
109+ end Reset;
110+
111+ function Mode (File : File_Stream) return File_Mode
112+ is
113+ begin
114+ if File.Reference = null then
115+ Raise_Exception(Status_Error'Identity,
116+ "Mode: file not open");
117+ end if;
118+ return Mode(File.Reference.File);
119+ end Mode;
120+
121+ function Name (File : File_Stream) return String_32
122+ is
123+ String_Buffer : Unbounded_Array_Type;
124+ begin
125+ if File.Reference = null then
126+ Raise_Exception(Status_Error'Identity,
127+ "Name: file not open");
128+ end if;
129+ declare
130+ Name_8 : String_8 := Name(File.Reference.File);
131+ begin
132+ if Name_8'Length = 0 then
133+ return Null_String_32;
134+ end if;
135+ From_Utf8_To_Utf32(String_Buffer, Name_8);
136+ end;
137+ return To_String_32(String_Buffer);
138+ end Name;
139+
140+ function Is_Open (File : File_Stream) return Boolean
141+ is
142+ begin
143+ if File.Reference = null then
144+ return False;
145+ end if;
146+ return Is_Open(File.Reference.File);
147+ end Is_Open;
148+
149+ function End_Of_File (File : File_Stream) return Boolean
150+ is
151+ begin
152+ if File.Reference = null then
153+ Raise_Exception(Status_Error'Identity,
154+ "file not open");
155+ end if;
156+ return End_Of_File(File.Reference.File);
157+ end End_Of_File;
158+
159+ function Stream (File : File_Stream) return Stream_Access
160+ is
161+ begin
162+ if File.Reference = null then
163+ Raise_Exception(Status_Error'Identity,
164+ "file not open");
165+ end if;
166+ return Stream(File.Reference.File);
167+ end Stream;
168+
169+ procedure Read
170+ (File : File_Stream;
171+ Item : out Stream_Element_Array;
172+ Last : out Stream_Element_Offset;
173+ From : Positive_Count)
174+ is
175+ begin
176+ if File.Reference = null then
177+ Raise_Exception(Status_Error'Identity,
178+ "file not open");
179+ end if;
180+ Read(File.Reference.File, Item, Last, From);
181+ end Read;
182+
183+ procedure Read
184+ (File : File_Stream;
185+ Item : out Stream_Element_Array;
186+ Last : out Stream_Element_Offset)
187+ is
188+ begin
189+ if File.Reference = null then
190+ Raise_Exception(Status_Error'Identity,
191+ "file not open");
192+ end if;
193+ Read(File.Reference.File, Item, Last);
194+ end Read;
195+
196+ procedure Write
197+ (File : File_Stream;
198+ Item : Stream_Element_Array;
199+ To : Positive_Count)
200+ is
201+ begin
202+ if File.Reference = null then
203+ Raise_Exception(Status_Error'Identity,
204+ "file not open");
205+ end if;
206+ Write(File.Reference.File, Item, To);
207+ end Write;
208+
209+ procedure Write
210+ (File : File_Stream;
211+ Item : Stream_Element_Array)
212+ is
213+ begin
214+ if File.Reference = null then
215+ Raise_Exception(Status_Error'Identity,
216+ "file not open");
217+ end if;
218+ Write(File.Reference.File, Item);
219+ end Write;
220+
221+ procedure Set_Index (File : File_Stream; To : Positive_Count)
222+ is
223+ begin
224+ if File.Reference = null then
225+ Raise_Exception(Status_Error'Identity,
226+ "file not open");
227+ end if;
228+ Set_Index(File.Reference.File, To);
229+ end Set_Index;
230+
231+ function Index (File : File_Stream) return Positive_Count
232+ is
233+ begin
234+ if File.Reference = null then
235+ Raise_Exception(Status_Error'Identity,
236+ "file not open");
237+ end if;
238+ return Index(File.Reference.File);
239+ end Index;
240+
241+ function Size (File : File_Stream) return Ada.Streams.Stream_IO.Count
242+ is
243+ begin
244+ if File.Reference = null then
245+ Raise_Exception(Status_Error'Identity,
246+ "file not open");
247+ end if;
248+ return Size(File.Reference.File);
249+ end Size;
250+
251+ procedure Set_Mode (File : in out File_Stream; Mode : File_Mode)
252+ is
253+ begin
254+ if File.Reference = null then
255+ Raise_Exception(Status_Error'Identity,
256+ "file not open");
257+ end if;
258+ Set_Mode(File.Reference.File, Mode);
259+ end Set_Mode;
260+
261+ procedure Flush (File : File_Stream)
262+ is
263+ begin
264+ if File.Reference = null then
265+ Raise_Exception(Status_Error'Identity,
266+ "file not open");
267+ end if;
268+ Flush(File.Reference.File);
269+ end Flush;
270+
271+
272+end File_Stream_IO;
diff -r 76b51d045233 -r fd8191a042f7 File_Stream/file_stream_io.ads
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/File_Stream/file_stream_io.ads Sat Oct 26 09:35:18 2019 +0400
@@ -0,0 +1,82 @@
1+
2+with Ada.Streams; use Ada.Streams;
3+with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO;
4+with Ada.Finalization; use Ada.Finalization;
5+with Ada.Unchecked_Deallocation;
6+with Ada.Exceptions; use Ada.Exceptions;
7+with Atomic_Counters; use Atomic_Counters;
8+with Ada_Magic_Forward.Character_32s;
9+use Ada_Magic_Forward.Character_32s;
10+with Ada_Magic_Forward.Strings; use Ada_Magic_Forward.Strings;
11+
12+package File_Stream_IO is
13+
14+ type File_Stream is tagged private;
15+
16+ function Open (Name : String_32;
17+ Mode : File_Mode) return File_Stream;
18+
19+ function Create (Name : String_32;
20+ Mode : File_Mode := Out_File) return File_Stream;
21+
22+ procedure Delete (File : in out File_Stream);
23+ procedure Reset (File : in out File_Stream; Mode : File_Mode);
24+ procedure Reset (File : in out File_Stream);
25+
26+ function Mode (File : File_Stream) return File_Mode;
27+ function Name (File : File_Stream) return String_32;
28+
29+ function Is_Open (File : File_Stream) return Boolean;
30+ function End_Of_File (File : File_Stream) return Boolean;
31+
32+ function Stream (File : File_Stream) return Stream_Access;
33+
34+ procedure Read
35+ (File : File_Stream;
36+ Item : out Stream_Element_Array;
37+ Last : out Stream_Element_Offset;
38+ From : Positive_Count);
39+
40+ procedure Read
41+ (File : File_Stream;
42+ Item : out Stream_Element_Array;
43+ Last : out Stream_Element_Offset);
44+
45+ procedure Write
46+ (File : File_Stream;
47+ Item : Stream_Element_Array;
48+ To : Positive_Count);
49+
50+ procedure Write
51+ (File : File_Stream;
52+ Item : Stream_Element_Array);
53+
54+ procedure Set_Index (File : File_Stream; To : Positive_Count);
55+
56+ function Index (File : File_Stream) return Positive_Count;
57+ function Size (File : File_Stream) return Ada.Streams.Stream_IO.Count;
58+
59+ procedure Set_Mode (File : in out File_Stream; Mode : File_Mode);
60+
61+ procedure Flush (File : File_Stream);
62+
63+private
64+ type File_Stream_Referenced is limited record
65+ Counter : Atomic_Counter;
66+ File : File_Type;
67+ end record;
68+ type File_Stream_Access is access all File_Stream_Referenced;
69+ procedure Reference (Item : File_Stream_Access);
70+ -- Increment reference counter
71+ procedure Unreference (Item : in out File_Stream_Access);
72+ -- Decrement reference counter, deallocate Item when counter goes to zero
73+
74+ type File_Stream is new Controlled with
75+ record
76+ Reference : File_Stream_Access := null;
77+ end record;
78+ procedure Adjust(Object : in out File_Stream);
79+ procedure Finalize(Object : in out File_Stream);
80+
81+
82+end File_Stream_IO;
diff -r 76b51d045233 -r fd8191a042f7 file_stream.gpr
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/file_stream.gpr Sat Oct 26 09:35:18 2019 +0400
@@ -0,0 +1,17 @@
1+with "unbounded_array.gpr";
2+
3+project File_Stream is
4+
5+ for Source_Dirs use ("File_Stream");
6+ for Object_Dir use "obj";
7+
8+ package Naming is
9+ for Dot_Replacement use ".";
10+ end Naming;
11+
12+ package Compiler is
13+ for Switches ("ada") use ("-g", "-gnata", "-gnat95", "-fcallgraph-info=su,da");
14+ end Compiler;
15+
16+end File_Stream;
17+
Show on old repository browser