1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2000-2005 AdaCore --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 2, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
32 ------------------------------------------------------------------------------
34 pragma Style_Checks
(All_Checks
);
35 -- Turn off alpha ordering check for subprograms, since we cannot
36 -- Put Finalize and Initialize in alpha order (see comments).
40 with Ada
.Strings
.Unbounded
;
41 with Ada
.Strings
.Fixed
;
42 with Ada
.Strings
.Maps
;
43 with Ada
.Unchecked_Deallocation
;
45 with GNAT
.Directory_Operations
;
46 with GNAT
.Dynamic_Tables
;
49 package body GNAT
.AWK
is
52 use Ada
.Strings
.Unbounded
;
60 type Mode
is abstract tagged null record;
61 -- This is the main type which is declared abstract. This type must be
62 -- derived for each split style.
64 type Mode_Access
is access Mode
'Class;
66 procedure Current_Line
(S
: Mode
; Session
: Session_Type
)
68 -- Split current line of Session using split mode S
70 ------------------------
71 -- Split on separator --
72 ------------------------
74 type Separator
(Size
: Positive) is new Mode
with record
75 Separators
: String (1 .. Size
);
78 procedure Current_Line
80 Session
: Session_Type
);
86 type Column
(Size
: Positive) is new Mode
with record
87 Columns
: Widths_Set
(1 .. Size
);
90 procedure Current_Line
(S
: Column
; Session
: Session_Type
);
94 procedure Free
is new Unchecked_Deallocation
95 (Split
.Mode
'Class, Split
.Mode_Access
);
101 type AWK_File
is access String;
103 package File_Table
is
104 new Dynamic_Tables
(AWK_File
, Natural, 1, 5, 50);
105 -- List of file names associated with a Session
107 procedure Free
is new Unchecked_Deallocation
(String, AWK_File
);
113 type Field_Slice
is record
117 -- This is a field slice (First .. Last) in session's current line
119 package Field_Table
is
120 new Dynamic_Tables
(Field_Slice
, Natural, 1, 10, 100);
121 -- List of fields for the current line
127 -- Define all patterns style: exact string, regular expression, boolean
132 type Pattern
is abstract tagged null record;
133 -- This is the main type which is declared abstract. This type must be
134 -- derived for each patterns style.
136 type Pattern_Access
is access Pattern
'Class;
140 Session
: Session_Type
) return Boolean
142 -- Returns True if P match for the current session and False otherwise
144 procedure Release
(P
: in out Pattern
);
145 -- Release memory used by the pattern structure
147 --------------------------
148 -- Exact string pattern --
149 --------------------------
151 type String_Pattern
is new Pattern
with record
152 Str
: Unbounded_String
;
158 Session
: Session_Type
) return Boolean;
160 --------------------------------
161 -- Regular expression pattern --
162 --------------------------------
164 type Pattern_Matcher_Access
is access Regpat
.Pattern_Matcher
;
166 type Regexp_Pattern
is new Pattern
with record
167 Regx
: Pattern_Matcher_Access
;
173 Session
: Session_Type
) return Boolean;
175 procedure Release
(P
: in out Regexp_Pattern
);
177 ------------------------------
178 -- Boolean function pattern --
179 ------------------------------
181 type Callback_Pattern
is new Pattern
with record
182 Pattern
: Pattern_Callback
;
186 (P
: Callback_Pattern
;
187 Session
: Session_Type
) return Boolean;
191 procedure Free
is new Unchecked_Deallocation
192 (Patterns
.Pattern
'Class, Patterns
.Pattern_Access
);
198 -- Define all action style : simple call, call with matches
202 type Action
is abstract tagged null record;
203 -- This is the main type which is declared abstract. This type must be
204 -- derived for each action style.
206 type Action_Access
is access Action
'Class;
210 Session
: Session_Type
) is abstract;
211 -- Call action A as required
217 type Simple_Action
is new Action
with record
218 Proc
: Action_Callback
;
223 Session
: Session_Type
);
225 -------------------------
226 -- Action with matches --
227 -------------------------
229 type Match_Action
is new Action
with record
230 Proc
: Match_Action_Callback
;
235 Session
: Session_Type
);
239 procedure Free
is new Unchecked_Deallocation
240 (Actions
.Action
'Class, Actions
.Action_Access
);
242 --------------------------
243 -- Pattern/Action table --
244 --------------------------
246 type Pattern_Action
is record
247 Pattern
: Patterns
.Pattern_Access
; -- If Pattern is True
248 Action
: Actions
.Action_Access
; -- Action will be called
251 package Pattern_Action_Table
is
252 new Dynamic_Tables
(Pattern_Action
, Natural, 1, 5, 50);
258 type Session_Data
is record
259 Current_File
: Text_IO
.File_Type
;
260 Current_Line
: Unbounded_String
;
261 Separators
: Split
.Mode_Access
;
262 Files
: File_Table
.Instance
;
263 File_Index
: Natural := 0;
264 Fields
: Field_Table
.Instance
;
265 Filters
: Pattern_Action_Table
.Instance
;
268 Matches
: Regpat
.Match_Array
(0 .. 100);
269 -- Latest matches for the regexp pattern
273 new Unchecked_Deallocation
(Session_Data
, Session_Data_Access
);
279 procedure Initialize
(Session
: in out Session_Type
) is
281 Session
.Data
:= new Session_Data
;
283 -- Initialize separators
285 Session
.Data
.Separators
:=
286 new Split
.Separator
'(Default_Separators'Length, Default_Separators);
288 -- Initialize all tables
290 File_Table.Init (Session.Data.Files);
291 Field_Table.Init (Session.Data.Fields);
292 Pattern_Action_Table.Init (Session.Data.Filters);
295 -----------------------
296 -- Session Variables --
297 -----------------------
299 -- These must come after the body of Initialize, since they make
300 -- implicit calls to Initialize at elaboration time.
302 Def_Session : Session_Type;
303 Cur_Session : Session_Type;
309 -- Note: Finalize must come after Initialize and the definition
310 -- of the Def_Session and Cur_Session variables, since it references
313 procedure Finalize (Session : in out Session_Type) is
315 -- We release the session data only if it is not the default session
317 if Session.Data /= Def_Session.Data then
320 -- Since we have closed the current session, set it to point now to
321 -- the default session.
323 Cur_Session.Data := Def_Session.Data;
327 ----------------------
328 -- Private Services --
329 ----------------------
331 function Always_True return Boolean;
332 -- A function that always returns True
334 function Apply_Filters
335 (Session : Session_Type := Current_Session) return Boolean;
336 -- Apply any filters for which the Pattern is True for Session. It returns
337 -- True if a least one filters has been applied (i.e. associated action
338 -- callback has been called).
340 procedure Open_Next_File
341 (Session : Session_Type := Current_Session);
342 pragma Inline (Open_Next_File);
343 -- Open next file for Session closing current file if needed. It raises
344 -- End_Error if there is no more file in the table.
346 procedure Raise_With_Info
347 (E : Exceptions.Exception_Id;
349 Session : Session_Type);
350 pragma No_Return (Raise_With_Info);
351 -- Raises exception E with the message prepended with the current line
352 -- number and the filename if possible.
354 procedure Read_Line (Session : Session_Type);
355 -- Read a line for the Session and set Current_Line
357 procedure Split_Line (Session : Session_Type);
358 -- Split session's Current_Line according to the session separators and
359 -- set the Fields table. This procedure can be called at any time.
361 ----------------------
362 -- Private Packages --
363 ----------------------
369 package body Actions is
377 Session : Session_Type)
379 pragma Unreferenced (Session);
390 Session : Session_Type)
393 A.Proc (Session.Data.Matches);
402 package body Patterns is
410 Session : Session_Type) return Boolean
413 return P.Str = Field (P.Rank, Session);
422 Session : Session_Type) return Boolean
424 use type Regpat.Match_Location;
427 (P.Regx.all, Field (P.Rank, Session), Session.Data.Matches);
428 return Session.Data.Matches (0) /= Regpat.No_Match;
436 (P : Callback_Pattern;
437 Session : Session_Type) return Boolean
439 pragma Unreferenced (Session);
441 return P.Pattern.all;
448 procedure Release (P : in out Pattern) is
449 pragma Unreferenced (P);
458 procedure Release (P : in out Regexp_Pattern) is
459 procedure Free is new Unchecked_Deallocation
460 (Regpat.Pattern_Matcher, Pattern_Matcher_Access);
471 package body Split is
479 procedure Current_Line (S : Separator; Session : Session_Type) is
480 Line : constant String := To_String (Session.Data.Current_Line);
481 Fields : Field_Table.Instance renames Session.Data.Fields;
486 Seps : constant Maps.Character_Set := Maps.To_Set (S.Separators);
489 -- First field start here
493 -- Record the first field start position which is the first character
496 Field_Table.Increment_Last (Fields);
497 Fields.Table (Field_Table.Last (Fields)).First := Start;
500 -- Look for next separator
503 (Source => Line (Start .. Line'Last),
508 Fields.Table (Field_Table.Last (Fields)).Last := Stop - 1;
510 -- If separators are set to the default (space and tab) we skip
511 -- all spaces and tabs following current field.
513 if S.Separators = Default_Separators then
515 (Line (Stop + 1 .. Line'Last),
516 Maps.To_Set (Default_Separators),
527 -- Record in the field table the start of this new field
529 Field_Table.Increment_Last (Fields);
530 Fields.Table (Field_Table.Last (Fields)).First := Start;
534 Fields.Table (Field_Table.Last (Fields)).Last := Line'Last;
541 procedure Current_Line (S : Column; Session : Session_Type) is
542 Line : constant String := To_String (Session.Data.Current_Line);
543 Fields : Field_Table.Instance renames Session.Data.Fields;
544 Start : Positive := Line'First;
547 -- Record the first field start position which is the first character
550 for C in 1 .. S.Columns'Length loop
552 Field_Table.Increment_Last (Fields);
554 Fields.Table (Field_Table.Last (Fields)).First := Start;
556 Start := Start + S.Columns (C);
558 Fields.Table (Field_Table.Last (Fields)).Last := Start - 1;
562 -- If there is some remaining character on the line, add them in a
565 if Start - 1 < Line'Length then
567 Field_Table.Increment_Last (Fields);
569 Fields.Table (Field_Table.Last (Fields)).First := Start;
571 Fields.Table (Field_Table.Last (Fields)).Last := Line'Last;
583 Session : Session_Type := Current_Session)
585 Files : File_Table.Instance renames Session.Data.Files;
588 if OS_Lib.Is_Regular_File (Filename) then
589 File_Table.Increment_Last (Files);
590 Files.Table (File_Table.Last (Files)) := new String'(Filename
);
593 (File_Error
'Identity,
594 "File " & Filename
& " not found.",
606 Number_Of_Files_Added
: out Natural;
607 Session
: Session_Type
:= Current_Session
)
609 use Directory_Operations
;
612 Filename
: String (1 .. 200);
616 Number_Of_Files_Added
:= 0;
618 Open
(Dir
, Directory
);
621 Read
(Dir
, Filename
, Last
);
624 Add_File
(Filename
(1 .. Last
), Session
);
625 Number_Of_Files_Added
:= Number_Of_Files_Added
+ 1;
633 (File_Error
'Identity,
634 "Error scaning directory " & Directory
635 & " for files " & Filenames
& '.',
643 function Always_True
return Boolean is
652 function Apply_Filters
653 (Session
: Session_Type
:= Current_Session
) return Boolean
655 Filters
: Pattern_Action_Table
.Instance
renames Session
.Data
.Filters
;
656 Results
: Boolean := False;
659 -- Iterate through the filters table, if pattern match call action
661 for F
in 1 .. Pattern_Action_Table
.Last
(Filters
) loop
662 if Patterns
.Match
(Filters
.Table
(F
).Pattern
.all, Session
) then
664 Actions
.Call
(Filters
.Table
(F
).Action
.all, Session
);
675 procedure Close
(Session
: Session_Type
) is
676 Filters
: Pattern_Action_Table
.Instance
renames Session
.Data
.Filters
;
677 Files
: File_Table
.Instance
renames Session
.Data
.Files
;
680 -- Close current file if needed
682 if Text_IO
.Is_Open
(Session
.Data
.Current_File
) then
683 Text_IO
.Close
(Session
.Data
.Current_File
);
686 -- Release separators
688 Free
(Session
.Data
.Separators
);
690 -- Release Filters table
692 for F
in 1 .. Pattern_Action_Table
.Last
(Filters
) loop
693 Patterns
.Release
(Filters
.Table
(F
).Pattern
.all);
694 Free
(Filters
.Table
(F
).Pattern
);
695 Free
(Filters
.Table
(F
).Action
);
698 for F
in 1 .. File_Table
.Last
(Files
) loop
699 Free
(Files
.Table
(F
));
702 File_Table
.Set_Last
(Session
.Data
.Files
, 0);
703 Field_Table
.Set_Last
(Session
.Data
.Fields
, 0);
704 Pattern_Action_Table
.Set_Last
(Session
.Data
.Filters
, 0);
706 Session
.Data
.NR
:= 0;
707 Session
.Data
.FNR
:= 0;
708 Session
.Data
.File_Index
:= 0;
709 Session
.Data
.Current_Line
:= Null_Unbounded_String
;
712 ---------------------
713 -- Current_Session --
714 ---------------------
716 function Current_Session
return Session_Type
is
721 ---------------------
722 -- Default_Session --
723 ---------------------
725 function Default_Session
return Session_Type
is
734 function Discrete_Field
736 Session
: Session_Type
:= Current_Session
) return Discrete
739 return Discrete
'Value (Field
(Rank
, Session
));
747 (Session
: Session_Type
:= Current_Session
) return Boolean
750 return Session
.Data
.File_Index
= File_Table
.Last
(Session
.Data
.Files
)
751 and then End_Of_File
(Session
);
759 (Session
: Session_Type
:= Current_Session
) return Boolean
762 return Text_IO
.End_Of_File
(Session
.Data
.Current_File
);
771 Session
: Session_Type
:= Current_Session
) return String
773 Fields
: Field_Table
.Instance
renames Session
.Data
.Fields
;
776 if Rank
> Number_Of_Fields
(Session
) then
778 (Field_Error
'Identity,
779 "Field number" & Count
'Image (Rank
) & " does not exist.",
784 -- Returns the whole line, this is what $0 does under Session_Type
786 return To_String
(Session
.Data
.Current_Line
);
789 return Slice
(Session
.Data
.Current_Line
,
790 Fields
.Table
(Positive (Rank
)).First
,
791 Fields
.Table
(Positive (Rank
)).Last
);
797 Session
: Session_Type
:= Current_Session
) return Integer
800 return Integer'Value (Field
(Rank
, Session
));
803 when Constraint_Error
=>
805 (Field_Error
'Identity,
806 "Field number" & Count
'Image (Rank
)
807 & " cannot be converted to an integer.",
813 Session
: Session_Type
:= Current_Session
) return Float
816 return Float'Value (Field
(Rank
, Session
));
819 when Constraint_Error
=>
821 (Field_Error
'Identity,
822 "Field number" & Count
'Image (Rank
)
823 & " cannot be converted to a float.",
832 (Session
: Session_Type
:= Current_Session
) return String
834 Files
: File_Table
.Instance
renames Session
.Data
.Files
;
837 if Session
.Data
.File_Index
= 0 then
840 return Files
.Table
(Session
.Data
.File_Index
).all;
848 procedure For_Every_Line
849 (Separators
: String := Use_Current
;
850 Filename
: String := Use_Current
;
851 Callbacks
: Callback_Mode
:= None
;
852 Session
: Session_Type
:= Current_Session
)
857 Open
(Separators
, Filename
, Session
);
859 while not End_Of_Data
(Session
) loop
861 Split_Line
(Session
);
863 if Callbacks
in Only
.. Pass_Through
then
866 pragma Unreferenced
(Discard
);
868 Discard
:= Apply_Filters
(Session
);
872 if Callbacks
/= Only
then
887 (Callbacks
: Callback_Mode
:= None
;
888 Session
: Session_Type
:= Current_Session
)
890 Filter_Active
: Boolean;
893 if not Text_IO
.Is_Open
(Session
.Data
.Current_File
) then
899 Split_Line
(Session
);
907 Filter_Active
:= Apply_Filters
(Session
);
908 exit when not Filter_Active
;
911 Filter_Active
:= Apply_Filters
(Session
);
918 ----------------------
919 -- Number_Of_Fields --
920 ----------------------
922 function Number_Of_Fields
923 (Session
: Session_Type
:= Current_Session
) return Count
926 return Count
(Field_Table
.Last
(Session
.Data
.Fields
));
927 end Number_Of_Fields
;
929 --------------------------
930 -- Number_Of_File_Lines --
931 --------------------------
933 function Number_Of_File_Lines
934 (Session
: Session_Type
:= Current_Session
) return Count
937 return Count
(Session
.Data
.FNR
);
938 end Number_Of_File_Lines
;
940 ---------------------
941 -- Number_Of_Files --
942 ---------------------
944 function Number_Of_Files
945 (Session
: Session_Type
:= Current_Session
) return Natural
947 Files
: File_Table
.Instance
renames Session
.Data
.Files
;
949 return File_Table
.Last
(Files
);
952 ---------------------
953 -- Number_Of_Lines --
954 ---------------------
956 function Number_Of_Lines
957 (Session
: Session_Type
:= Current_Session
) return Count
960 return Count
(Session
.Data
.NR
);
968 (Separators
: String := Use_Current
;
969 Filename
: String := Use_Current
;
970 Session
: Session_Type
:= Current_Session
)
973 if Text_IO
.Is_Open
(Session
.Data
.Current_File
) then
977 if Filename
/= Use_Current
then
978 File_Table
.Init
(Session
.Data
.Files
);
979 Add_File
(Filename
, Session
);
982 if Separators
/= Use_Current
then
983 Set_Field_Separators
(Separators
, Session
);
986 Open_Next_File
(Session
);
997 procedure Open_Next_File
998 (Session
: Session_Type
:= Current_Session
)
1000 Files
: File_Table
.Instance
renames Session
.Data
.Files
;
1003 if Text_IO
.Is_Open
(Session
.Data
.Current_File
) then
1004 Text_IO
.Close
(Session
.Data
.Current_File
);
1007 Session
.Data
.File_Index
:= Session
.Data
.File_Index
+ 1;
1009 -- If there are no mores file in the table, raise End_Error
1011 if Session
.Data
.File_Index
> File_Table
.Last
(Files
) then
1016 (File
=> Session
.Data
.Current_File
,
1017 Name
=> Files
.Table
(Session
.Data
.File_Index
).all,
1018 Mode
=> Text_IO
.In_File
);
1026 (Separators
: String := Use_Current
;
1027 Filename
: String := Use_Current
;
1028 Session
: Session_Type
:= Current_Session
)
1030 Filter_Active
: Boolean;
1031 pragma Unreferenced
(Filter_Active
);
1034 Open
(Separators
, Filename
, Session
);
1036 while not End_Of_Data
(Session
) loop
1037 Get_Line
(None
, Session
);
1038 Filter_Active
:= Apply_Filters
(Session
);
1044 ---------------------
1045 -- Raise_With_Info --
1046 ---------------------
1048 procedure Raise_With_Info
1049 (E
: Exceptions
.Exception_Id
;
1051 Session
: Session_Type
)
1053 function Filename
return String;
1054 -- Returns current filename and "??" if this information is not
1057 function Line
return String;
1058 -- Returns current line number without the leading space
1064 function Filename
return String is
1065 File
: constant String := AWK
.File
(Session
);
1078 function Line
return String is
1079 L
: constant String := Natural'Image (Session
.Data
.FNR
);
1081 return L
(2 .. L
'Last);
1084 -- Start of processing for Raise_With_Info
1087 Exceptions
.Raise_Exception
1089 '[' & Filename
& ':' & Line
& "] " & Message
);
1090 raise Constraint_Error
; -- to please GNAT as this is a No_Return proc
1091 end Raise_With_Info
;
1097 procedure Read_Line
(Session
: Session_Type
) is
1099 function Read_Line
return String;
1100 -- Read a line in the current file. This implementation is recursive
1101 -- and does not have a limitation on the line length.
1103 NR
: Natural renames Session
.Data
.NR
;
1104 FNR
: Natural renames Session
.Data
.FNR
;
1110 function Read_Line
return String is
1111 Buffer
: String (1 .. 1_024
);
1115 Text_IO
.Get_Line
(Session
.Data
.Current_File
, Buffer
, Last
);
1117 if Last
= Buffer
'Last then
1118 return Buffer
& Read_Line
;
1120 return Buffer
(1 .. Last
);
1124 -- Start of processing for Read_Line
1127 if End_Of_File
(Session
) then
1128 Open_Next_File
(Session
);
1132 Session
.Data
.Current_Line
:= To_Unbounded_String
(Read_Line
);
1145 Action
: Action_Callback
;
1146 Session
: Session_Type
:= Current_Session
)
1148 Filters
: Pattern_Action_Table
.Instance
renames Session
.Data
.Filters
;
1149 U_Pattern
: constant Unbounded_String
:= To_Unbounded_String
(Pattern
);
1152 Pattern_Action_Table
.Increment_Last
(Filters
);
1154 Filters
.Table
(Pattern_Action_Table
.Last
(Filters
)) :=
1155 (Pattern
=> new Patterns
.String_Pattern
'(U_Pattern, Field),
1156 Action => new Actions.Simple_Action'(Proc
=> Action
));
1161 Pattern
: GNAT
.Regpat
.Pattern_Matcher
;
1162 Action
: Action_Callback
;
1163 Session
: Session_Type
:= Current_Session
)
1165 Filters
: Pattern_Action_Table
.Instance
renames Session
.Data
.Filters
;
1167 A_Pattern
: constant Patterns
.Pattern_Matcher_Access
:=
1168 new Regpat
.Pattern_Matcher
'(Pattern);
1170 Pattern_Action_Table.Increment_Last (Filters);
1172 Filters.Table (Pattern_Action_Table.Last (Filters)) :=
1173 (Pattern => new Patterns.Regexp_Pattern'(A_Pattern
, Field
),
1174 Action
=> new Actions
.Simple_Action
'(Proc => Action));
1179 Pattern : GNAT.Regpat.Pattern_Matcher;
1180 Action : Match_Action_Callback;
1181 Session : Session_Type := Current_Session)
1183 Filters : Pattern_Action_Table.Instance renames Session.Data.Filters;
1185 A_Pattern : constant Patterns.Pattern_Matcher_Access :=
1186 new Regpat.Pattern_Matcher'(Pattern
);
1188 Pattern_Action_Table
.Increment_Last
(Filters
);
1190 Filters
.Table
(Pattern_Action_Table
.Last
(Filters
)) :=
1191 (Pattern
=> new Patterns
.Regexp_Pattern
'(A_Pattern, Field),
1192 Action => new Actions.Match_Action'(Proc
=> Action
));
1196 (Pattern
: Pattern_Callback
;
1197 Action
: Action_Callback
;
1198 Session
: Session_Type
:= Current_Session
)
1200 Filters
: Pattern_Action_Table
.Instance
renames Session
.Data
.Filters
;
1203 Pattern_Action_Table
.Increment_Last
(Filters
);
1205 Filters
.Table
(Pattern_Action_Table
.Last
(Filters
)) :=
1206 (Pattern
=> new Patterns
.Callback_Pattern
'(Pattern => Pattern),
1207 Action => new Actions.Simple_Action'(Proc
=> Action
));
1211 (Action
: Action_Callback
;
1212 Session
: Session_Type
:= Current_Session
)
1215 Register
(Always_True
'Access, Action
, Session
);
1222 procedure Set_Current
(Session
: Session_Type
) is
1224 Cur_Session
.Data
:= Session
.Data
;
1227 --------------------------
1228 -- Set_Field_Separators --
1229 --------------------------
1231 procedure Set_Field_Separators
1232 (Separators
: String := Default_Separators
;
1233 Session
: Session_Type
:= Current_Session
)
1236 Free
(Session
.Data
.Separators
);
1238 Session
.Data
.Separators
:=
1239 new Split
.Separator
'(Separators'Length, Separators);
1241 -- If there is a current line read, split it according to the new
1244 if Session.Data.Current_Line /= Null_Unbounded_String then
1245 Split_Line (Session);
1247 end Set_Field_Separators;
1249 ----------------------
1250 -- Set_Field_Widths --
1251 ----------------------
1253 procedure Set_Field_Widths
1254 (Field_Widths : Widths_Set;
1255 Session : Session_Type := Current_Session)
1258 Free (Session.Data.Separators);
1260 Session.Data.Separators :=
1261 new Split.Column'(Field_Widths
'Length, Field_Widths
);
1263 -- If there is a current line read, split it according to
1264 -- the new separators.
1266 if Session
.Data
.Current_Line
/= Null_Unbounded_String
then
1267 Split_Line
(Session
);
1269 end Set_Field_Widths
;
1275 procedure Split_Line
(Session
: Session_Type
) is
1276 Fields
: Field_Table
.Instance
renames Session
.Data
.Fields
;
1278 Field_Table
.Init
(Fields
);
1279 Split
.Current_Line
(Session
.Data
.Separators
.all, Session
);
1283 -- We have declared two sessions but both should share the same data.
1284 -- The current session must point to the default session as its initial
1285 -- value. So first we release the session data then we set current
1286 -- session data to point to default session data.
1288 Free
(Cur_Session
.Data
);
1289 Cur_Session
.Data
:= Def_Session
.Data
;