-- --
-- B o d y --
-- --
--- $Revision: 1.10 $
--- --
--- Copyright (C) 2000-2001 Ada Core Technologies, Inc. --
+-- Copyright (C) 2000-2008, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
--- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
--- MA 02111-1307, USA. --
+-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
+-- Boston, MA 02110-1301, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
--- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-pragma Style_Checks (All_Checks);
--- Turn off alpha ordering check for subprograms, since we cannot
--- Put Finalize and Initialize in alpha order (see comments).
+pragma Ada_95;
+-- This is needed because the pragmas Warnings (Off) in Current_Session and
+-- Default_Session (see below) do not work when compiling clients of this
+-- package that instantiate generic units herein.
with Ada.Exceptions;
with Ada.Text_IO;
use Ada;
use Ada.Strings.Unbounded;
+ -----------------------
+ -- Local subprograms --
+ -----------------------
+
+ -- The following two subprograms provide a functional interface to the
+ -- two special session variables, that are manipulated explicitly by
+ -- Finalize, but must be declared after Finalize to prevent static
+ -- elaboration warnings.
+
+ function Get_Def return Session_Data_Access;
+ procedure Set_Cur;
+
----------------
-- Split mode --
----------------
procedure Current_Line (S : Mode; Session : Session_Type)
is abstract;
- -- Split Session's current line using split mode.
+ -- Split current line of Session using split mode S
------------------------
-- Split on separator --
package File_Table is
new Dynamic_Tables (AWK_File, Natural, 1, 5, 50);
- -- List of filename associated with a Session.
+ -- List of file names associated with a Session
procedure Free is new Unchecked_Deallocation (String, AWK_File);
First : Positive;
Last : Natural;
end record;
- -- This is a field slice (First .. Last) in session's current line.
+ -- This is a field slice (First .. Last) in session's current line
package Field_Table is
new Dynamic_Tables (Field_Slice, Natural, 1, 10, 100);
- -- List of fields for the current line.
+ -- List of fields for the current line
--------------
-- Patterns --
--------------
- -- Define all patterns style : exact string, regular expression, boolean
+ -- Define all patterns style: exact string, regular expression, boolean
-- function.
package Patterns is
function Match
(P : Pattern;
- Session : Session_Type)
- return Boolean
+ Session : Session_Type) return Boolean
is abstract;
- -- Returns True if P match for the current session and False otherwise.
+ -- Returns True if P match for the current session and False otherwise
procedure Release (P : in out Pattern);
- -- Release memory used by the pattern structure.
+ -- Release memory used by the pattern structure
--------------------------
-- Exact string pattern --
function Match
(P : String_Pattern;
- Session : Session_Type)
- return Boolean;
+ Session : Session_Type) return Boolean;
--------------------------------
-- Regular expression pattern --
function Match
(P : Regexp_Pattern;
- Session : Session_Type)
- return Boolean;
+ Session : Session_Type) return Boolean;
procedure Release (P : in out Regexp_Pattern);
function Match
(P : Callback_Pattern;
- Session : Session_Type)
- return Boolean;
+ Session : Session_Type) return Boolean;
end Patterns;
procedure Call
(A : Action;
- Session : Session_Type)
- is abstract;
- -- Call action A as required.
+ Session : Session_Type) is abstract;
+ -- Call action A as required
-------------------
-- Simple action --
NR : Natural := 0;
FNR : Natural := 0;
Matches : Regpat.Match_Array (0 .. 100);
- -- latest matches for the regexp pattern
+ -- Latest matches for the regexp pattern
end record;
procedure Free is
new Unchecked_Deallocation (Session_Data, Session_Data_Access);
+ --------------
+ -- Finalize --
+ --------------
+
+ procedure Finalize (Session : in out Session_Type) is
+ begin
+ -- We release the session data only if it is not the default session
+
+ if Session.Data /= Get_Def then
+ Free (Session.Data);
+
+ -- Since we have closed the current session, set it to point now to
+ -- the default session.
+
+ Set_Cur;
+ end if;
+ end Finalize;
+
----------------
-- Initialize --
----------------
-- Session Variables --
-----------------------
- -- These must come after the body of Initialize, since they make
- -- implicit calls to Initialize at elaboration time.
-
Def_Session : Session_Type;
Cur_Session : Session_Type;
- --------------
- -- Finalize --
- --------------
-
- -- Note: Finalize must come after Initialize and the definition
- -- of the Def_Session and Cur_Session variables, since it references
- -- the latter.
-
- procedure Finalize (Session : in out Session_Type) is
- begin
- -- We release the session data only if it is not the default session.
-
- if Session.Data /= Def_Session.Data then
- Free (Session.Data);
-
- -- Since we have closed the current session, set it to point
- -- now to the default session.
-
- Cur_Session.Data := Def_Session.Data;
- end if;
- end Finalize;
-
----------------------
-- Private Services --
----------------------
function Always_True return Boolean;
- -- A function that always returns True.
+ -- A function that always returns True
function Apply_Filters
- (Session : Session_Type := Current_Session)
- return Boolean;
+ (Session : Session_Type) return Boolean;
-- Apply any filters for which the Pattern is True for Session. It returns
-- True if a least one filters has been applied (i.e. associated action
-- callback has been called).
procedure Open_Next_File
- (Session : Session_Type := Current_Session);
+ (Session : Session_Type);
pragma Inline (Open_Next_File);
-- Open next file for Session closing current file if needed. It raises
-- End_Error if there is no more file in the table.
-- number and the filename if possible.
procedure Read_Line (Session : Session_Type);
- -- Read a line for the Session and set Current_Line.
+ -- Read a line for the Session and set Current_Line
procedure Split_Line (Session : Session_Type);
-- Split session's Current_Line according to the session separators and
(A : Simple_Action;
Session : Session_Type)
is
+ pragma Unreferenced (Session);
begin
A.Proc.all;
end Call;
function Match
(P : String_Pattern;
- Session : Session_Type)
- return Boolean
+ Session : Session_Type) return Boolean
is
begin
return P.Str = Field (P.Rank, Session);
function Match
(P : Regexp_Pattern;
- Session : Session_Type)
- return Boolean
+ Session : Session_Type) return Boolean
is
use type Regpat.Match_Location;
-
begin
Regpat.Match
(P.Regx.all, Field (P.Rank, Session), Session.Data.Matches);
function Match
(P : Callback_Pattern;
- Session : Session_Type)
- return Boolean
+ Session : Session_Type) return Boolean
is
+ pragma Unreferenced (Session);
begin
return P.Pattern.all;
end Match;
-------------
procedure Release (P : in out Pattern) is
+ pragma Unreferenced (P);
begin
null;
end Release;
procedure Release (P : in out Regexp_Pattern) is
procedure Free is new Unchecked_Deallocation
(Regpat.Pattern_Matcher, Pattern_Matcher_Access);
-
begin
Free (P.Regx);
end Release;
Line : constant String := To_String (Session.Data.Current_Line);
Fields : Field_Table.Instance renames Session.Data.Fields;
- Start : Positive;
+ Start : Natural;
Stop : Natural;
- Seps : Maps.Character_Set := Maps.To_Set (S.Separators);
+ Seps : constant Maps.Character_Set := Maps.To_Set (S.Separators);
begin
-- First field start here
Fields.Table (Field_Table.Last (Fields)).Last := Stop - 1;
- -- if separators are set to the default (space and tab) we skip
+ -- If separators are set to the default (space and tab) we skip
-- all spaces and tabs following current field.
if S.Separators = Default_Separators then
Maps.To_Set (Default_Separators),
Outside,
Strings.Forward);
+
+ if Start = 0 then
+ Start := Stop + 1;
+ end if;
else
Start := Stop + 1;
end if;
procedure Add_File
(Filename : String;
- Session : Session_Type := Current_Session)
+ Session : Session_Type)
is
Files : File_Table.Instance renames Session.Data.Files;
end if;
end Add_File;
+ procedure Add_File
+ (Filename : String)
+ is
+
+ begin
+ Add_File (Filename, Cur_Session);
+ end Add_File;
+
---------------
-- Add_Files --
---------------
(Directory : String;
Filenames : String;
Number_Of_Files_Added : out Natural;
- Session : Session_Type := Current_Session)
+ Session : Session_Type)
is
use Directory_Operations;
when others =>
Raise_With_Info
(File_Error'Identity,
- "Error scaning directory " & Directory
+ "Error scanning directory " & Directory
& " for files " & Filenames & '.',
Session);
end Add_Files;
+ procedure Add_Files
+ (Directory : String;
+ Filenames : String;
+ Number_Of_Files_Added : out Natural)
+ is
+
+ begin
+ Add_Files (Directory, Filenames, Number_Of_Files_Added, Cur_Session);
+ end Add_Files;
+
-----------------
-- Always_True --
-----------------
-------------------
function Apply_Filters
- (Session : Session_Type := Current_Session)
- return Boolean
+ (Session : Session_Type) return Boolean
is
Filters : Pattern_Action_Table.Instance renames Session.Data.Filters;
Results : Boolean := False;
begin
- -- Iterate throught the filters table, if pattern match call action.
+ -- Iterate through the filters table, if pattern match call action
for F in 1 .. Pattern_Action_Table.Last (Filters) loop
if Patterns.Match (Filters.Table (F).Pattern.all, Session) then
function Current_Session return Session_Type is
begin
+ pragma Warnings (Off);
return Cur_Session;
+ -- ???The above return statement violates the Ada 2005 rule forbidding
+ -- copying of limited objects (see RM-7.5(2.8/2)). When compiled with
+ -- -gnatg, the compiler gives a warning instead of an error, so we can
+ -- turn it off.
+ pragma Warnings (On);
end Current_Session;
---------------------
function Default_Session return Session_Type is
begin
+ pragma Warnings (Off);
return Def_Session;
+ -- ???The above return statement violates the Ada 2005 rule forbidding
+ -- copying of limited objects (see RM-7.5(2.8/2)). When compiled with
+ -- -gnatg, the compiler gives a warning instead of an error, so we can
+ -- turn it off.
+ pragma Warnings (On);
end Default_Session;
--------------------
function Discrete_Field
(Rank : Count;
- Session : Session_Type := Current_Session)
- return Discrete
+ Session : Session_Type) return Discrete
is
begin
return Discrete'Value (Field (Rank, Session));
end Discrete_Field;
+ function Discrete_Field_Current_Session
+ (Rank : Count) return Discrete is
+ function Do_It is new Discrete_Field (Discrete);
+ begin
+ return Do_It (Rank, Cur_Session);
+ end Discrete_Field_Current_Session;
+
-----------------
-- End_Of_Data --
-----------------
function End_Of_Data
- (Session : Session_Type := Current_Session)
- return Boolean
+ (Session : Session_Type) return Boolean
is
begin
return Session.Data.File_Index = File_Table.Last (Session.Data.Files)
and then End_Of_File (Session);
end End_Of_Data;
+ function End_Of_Data
+ return Boolean
+ is
+ begin
+ return End_Of_Data (Cur_Session);
+ end End_Of_Data;
+
-----------------
-- End_Of_File --
-----------------
function End_Of_File
- (Session : Session_Type := Current_Session)
- return Boolean
+ (Session : Session_Type) return Boolean
is
begin
return Text_IO.End_Of_File (Session.Data.Current_File);
end End_Of_File;
+ function End_Of_File
+ return Boolean
+ is
+ begin
+ return End_Of_File (Cur_Session);
+ end End_Of_File;
+
-----------
-- Field --
-----------
function Field
(Rank : Count;
- Session : Session_Type := Current_Session)
- return String
+ Session : Session_Type) return String
is
Fields : Field_Table.Instance renames Session.Data.Fields;
elsif Rank = 0 then
- -- Returns the whole line, this is what $0 does under Session_Type.
+ -- Returns the whole line, this is what $0 does under Session_Type
return To_String (Session.Data.Current_Line);
end Field;
function Field
+ (Rank : Count) return String
+ is
+ begin
+ return Field (Rank, Cur_Session);
+ end Field;
+
+ function Field
(Rank : Count;
- Session : Session_Type := Current_Session)
- return Integer
+ Session : Session_Type) return Integer
is
begin
return Integer'Value (Field (Rank, Session));
end Field;
function Field
+ (Rank : Count) return Integer
+ is
+ begin
+ return Field (Rank, Cur_Session);
+ end Field;
+
+ function Field
(Rank : Count;
- Session : Session_Type := Current_Session)
- return Float
+ Session : Session_Type) return Float
is
begin
return Float'Value (Field (Rank, Session));
Session);
end Field;
+ function Field
+ (Rank : Count) return Float
+ is
+ begin
+ return Field (Rank, Cur_Session);
+ end Field;
+
----------
-- File --
----------
function File
- (Session : Session_Type := Current_Session)
- return String
+ (Session : Session_Type) return String
is
Files : File_Table.Instance renames Session.Data.Files;
end if;
end File;
+ function File
+ return String
+ is
+ begin
+ return File (Cur_Session);
+ end File;
+
--------------------
-- For_Every_Line --
--------------------
(Separators : String := Use_Current;
Filename : String := Use_Current;
Callbacks : Callback_Mode := None;
- Session : Session_Type := Current_Session)
+ Session : Session_Type)
is
- Filter_Active : Boolean;
- Quit : Boolean;
+ Quit : Boolean;
begin
Open (Separators, Filename, Session);
Split_Line (Session);
if Callbacks in Only .. Pass_Through then
- Filter_Active := Apply_Filters (Session);
+ declare
+ Discard : Boolean;
+ pragma Unreferenced (Discard);
+ begin
+ Discard := Apply_Filters (Session);
+ end;
end if;
if Callbacks /= Only then
Close (Session);
end For_Every_Line;
+ procedure For_Every_Line_Current_Session
+ (Separators : String := Use_Current;
+ Filename : String := Use_Current;
+ Callbacks : Callback_Mode := None)
+ is
+ procedure Do_It is new For_Every_Line (Action);
+ begin
+ Do_It (Separators, Filename, Callbacks, Cur_Session);
+ end For_Every_Line_Current_Session;
+
--------------
-- Get_Line --
--------------
procedure Get_Line
(Callbacks : Callback_Mode := None;
- Session : Session_Type := Current_Session)
+ Session : Session_Type)
is
Filter_Active : Boolean;
Read_Line (Session);
Split_Line (Session);
- if Callbacks in Only .. Pass_Through then
- Filter_Active := Apply_Filters (Session);
- end if;
+ case Callbacks is
- exit when Callbacks = None
- or else Callbacks = Pass_Through
- or else (Callbacks = Only and then not Filter_Active);
+ when None =>
+ exit;
+ when Only =>
+ Filter_Active := Apply_Filters (Session);
+ exit when not Filter_Active;
+
+ when Pass_Through =>
+ Filter_Active := Apply_Filters (Session);
+ exit;
+
+ end case;
end loop;
end Get_Line;
+ procedure Get_Line
+ (Callbacks : Callback_Mode := None)
+ is
+ begin
+ Get_Line (Callbacks, Cur_Session);
+ end Get_Line;
+
----------------------
-- Number_Of_Fields --
----------------------
function Number_Of_Fields
- (Session : Session_Type := Current_Session)
- return Count
+ (Session : Session_Type) return Count
is
begin
return Count (Field_Table.Last (Session.Data.Fields));
end Number_Of_Fields;
+ function Number_Of_Fields
+ return Count
+ is
+ begin
+ return Number_Of_Fields (Cur_Session);
+ end Number_Of_Fields;
+
--------------------------
-- Number_Of_File_Lines --
--------------------------
function Number_Of_File_Lines
- (Session : Session_Type := Current_Session)
- return Count
+ (Session : Session_Type) return Count
is
begin
return Count (Session.Data.FNR);
end Number_Of_File_Lines;
+ function Number_Of_File_Lines
+ return Count
+ is
+ begin
+ return Number_Of_File_Lines (Cur_Session);
+ end Number_Of_File_Lines;
+
---------------------
-- Number_Of_Files --
---------------------
function Number_Of_Files
- (Session : Session_Type := Current_Session)
- return Natural
+ (Session : Session_Type) return Natural
is
Files : File_Table.Instance renames Session.Data.Files;
-
begin
return File_Table.Last (Files);
end Number_Of_Files;
+ function Number_Of_Files
+ return Natural
+ is
+ begin
+ return Number_Of_Files (Cur_Session);
+ end Number_Of_Files;
+
---------------------
-- Number_Of_Lines --
---------------------
function Number_Of_Lines
- (Session : Session_Type := Current_Session)
- return Count
+ (Session : Session_Type) return Count
is
begin
return Count (Session.Data.NR);
end Number_Of_Lines;
+ function Number_Of_Lines
+ return Count
+ is
+ begin
+ return Number_Of_Lines (Cur_Session);
+ end Number_Of_Lines;
+
----------
-- Open --
----------
procedure Open
(Separators : String := Use_Current;
Filename : String := Use_Current;
- Session : Session_Type := Current_Session)
+ Session : Session_Type)
is
begin
if Text_IO.Is_Open (Session.Data.Current_File) then
raise File_Error;
end Open;
+ procedure Open
+ (Separators : String := Use_Current;
+ Filename : String := Use_Current)
+ is
+ begin
+ Open (Separators, Filename, Cur_Session);
+ end Open;
+
--------------------
-- Open_Next_File --
--------------------
procedure Open_Next_File
- (Session : Session_Type := Current_Session)
+ (Session : Session_Type)
is
Files : File_Table.Instance renames Session.Data.Files;
procedure Parse
(Separators : String := Use_Current;
Filename : String := Use_Current;
- Session : Session_Type := Current_Session)
+ Session : Session_Type)
is
Filter_Active : Boolean;
+ pragma Unreferenced (Filter_Active);
+
begin
Open (Separators, Filename, Session);
Close (Session);
end Parse;
+ procedure Parse
+ (Separators : String := Use_Current;
+ Filename : String := Use_Current)
+ is
+ begin
+ Parse (Separators, Filename, Cur_Session);
+ end Parse;
+
---------------------
-- Raise_With_Info --
---------------------
Session : Session_Type)
is
function Filename return String;
- -- Returns current filename and "??" if the informations is not
+ -- Returns current filename and "??" if this information is not
-- available.
function Line return String;
function Filename return String is
File : constant String := AWK.File (Session);
-
begin
if File = "" then
return "??";
function Line return String is
L : constant String := Natural'Image (Session.Data.FNR);
-
begin
return L (2 .. L'Last);
end Line;
NR : Natural renames Session.Data.NR;
FNR : Natural renames Session.Data.FNR;
+ ---------------
+ -- Read_Line --
+ ---------------
+
function Read_Line return String is
Buffer : String (1 .. 1_024);
Last : Natural;
(Field : Count;
Pattern : String;
Action : Action_Callback;
- Session : Session_Type := Current_Session)
+ Session : Session_Type)
is
Filters : Pattern_Action_Table.Instance renames Session.Data.Filters;
U_Pattern : constant Unbounded_String := To_Unbounded_String (Pattern);
procedure Register
(Field : Count;
+ Pattern : String;
+ Action : Action_Callback)
+ is
+ begin
+ Register (Field, Pattern, Action, Cur_Session);
+ end Register;
+
+ procedure Register
+ (Field : Count;
Pattern : GNAT.Regpat.Pattern_Matcher;
Action : Action_Callback;
- Session : Session_Type := Current_Session)
+ Session : Session_Type)
is
Filters : Pattern_Action_Table.Instance renames Session.Data.Filters;
- A_Pattern : Patterns.Pattern_Matcher_Access :=
+ A_Pattern : constant Patterns.Pattern_Matcher_Access :=
new Regpat.Pattern_Matcher'(Pattern);
begin
Pattern_Action_Table.Increment_Last (Filters);
procedure Register
(Field : Count;
Pattern : GNAT.Regpat.Pattern_Matcher;
+ Action : Action_Callback)
+ is
+ begin
+ Register (Field, Pattern, Action, Cur_Session);
+ end Register;
+
+ procedure Register
+ (Field : Count;
+ Pattern : GNAT.Regpat.Pattern_Matcher;
Action : Match_Action_Callback;
- Session : Session_Type := Current_Session)
+ Session : Session_Type)
is
Filters : Pattern_Action_Table.Instance renames Session.Data.Filters;
- A_Pattern : Patterns.Pattern_Matcher_Access :=
+ A_Pattern : constant Patterns.Pattern_Matcher_Access :=
new Regpat.Pattern_Matcher'(Pattern);
begin
Pattern_Action_Table.Increment_Last (Filters);
end Register;
procedure Register
+ (Field : Count;
+ Pattern : GNAT.Regpat.Pattern_Matcher;
+ Action : Match_Action_Callback)
+ is
+ begin
+ Register (Field, Pattern, Action, Cur_Session);
+ end Register;
+
+ procedure Register
(Pattern : Pattern_Callback;
Action : Action_Callback;
- Session : Session_Type := Current_Session)
+ Session : Session_Type)
is
Filters : Pattern_Action_Table.Instance renames Session.Data.Filters;
end Register;
procedure Register
+ (Pattern : Pattern_Callback;
+ Action : Action_Callback)
+ is
+ begin
+ Register (Pattern, Action, Cur_Session);
+ end Register;
+
+ procedure Register
(Action : Action_Callback;
- Session : Session_Type := Current_Session)
+ Session : Session_Type)
is
begin
Register (Always_True'Access, Action, Session);
end Register;
+ procedure Register
+ (Action : Action_Callback)
+ is
+ begin
+ Register (Action, Cur_Session);
+ end Register;
+
-----------------
-- Set_Current --
-----------------
procedure Set_Field_Separators
(Separators : String := Default_Separators;
- Session : Session_Type := Current_Session)
+ Session : Session_Type)
is
begin
Free (Session.Data.Separators);
end if;
end Set_Field_Separators;
+ procedure Set_Field_Separators
+ (Separators : String := Default_Separators)
+ is
+ begin
+ Set_Field_Separators (Separators, Cur_Session);
+ end Set_Field_Separators;
+
----------------------
-- Set_Field_Widths --
----------------------
procedure Set_Field_Widths
(Field_Widths : Widths_Set;
- Session : Session_Type := Current_Session) is
-
+ Session : Session_Type)
+ is
begin
Free (Session.Data.Separators);
end if;
end Set_Field_Widths;
+ procedure Set_Field_Widths
+ (Field_Widths : Widths_Set)
+ is
+ begin
+ Set_Field_Widths (Field_Widths, Cur_Session);
+ end Set_Field_Widths;
+
----------------
-- Split_Line --
----------------
procedure Split_Line (Session : Session_Type) is
Fields : Field_Table.Instance renames Session.Data.Fields;
-
begin
Field_Table.Init (Fields);
-
Split.Current_Line (Session.Data.Separators.all, Session);
end Split_Line;
+ -------------
+ -- Get_Def --
+ -------------
+
+ function Get_Def return Session_Data_Access is
+ begin
+ return Def_Session.Data;
+ end Get_Def;
+
+ -------------
+ -- Set_Cur --
+ -------------
+
+ procedure Set_Cur is
+ begin
+ Cur_Session.Data := Def_Session.Data;
+ end Set_Cur;
+
begin
-- We have declared two sessions but both should share the same data.
-- The current session must point to the default session as its initial
OSDN Git Service
