-- --
-- B o d y --
-- --
--- Copyright (C) 2000-2007, AdaCore --
+-- Copyright (C) 2000-2011, 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- --
--- ware Foundation; either version 2, or (at your option) any later ver- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
--- 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, 51 Franklin Street, Fifth Floor, --
--- Boston, MA 02110-1301, USA. --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
--- As a special exception, if other files instantiate generics from this --
--- unit, or you link this unit with other files to produce an executable, --
--- this unit does not by itself cause the resulting executable to be --
--- covered by the GNU General Public License. This exception does not --
--- however invalidate any other reasons why the executable file might be --
--- covered by the GNU Public License. --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-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.
-
-pragma Style_Checks (All_Checks);
--- Turn off alpha ordering check for subprograms, since we cannot
--- Put Finalize and Initialize in alpha order (see comments).
-
with Ada.Exceptions;
with Ada.Text_IO;
with Ada.Strings.Unbounded;
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 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
+ -- Release separators
+
+ Free (Session.Data.Separators);
+
+ 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 --
----------------------
procedure Current_Line (S : Separator; Session : Session_Type) is
Line : constant String := To_String (Session.Data.Current_Line);
Fields : Field_Table.Instance renames Session.Data.Fields;
+ Seps : constant Maps.Character_Set := Maps.To_Set (S.Separators);
- Start : Natural;
- Stop : Natural;
-
- Seps : constant Maps.Character_Set := Maps.To_Set (S.Separators);
+ Start : Natural;
+ Stop : Natural;
begin
-- First field start here
-- Look for next separator
Stop := Fixed.Index
- (Source => Line (Start .. Line'Last),
- Set => Seps);
+ (Source => Line (Start .. Line'Last),
+ Set => Seps);
exit when Stop = 0;
if Start = 0 then
Start := Stop + 1;
end if;
+
else
Start := Stop + 1;
end if;
when others =>
Raise_With_Info
(File_Error'Identity,
- "Error scaning directory " & Directory
+ "Error scanning directory " & Directory
& " for files " & Filenames & '.',
Session);
end Add_Files;
Text_IO.Close (Session.Data.Current_File);
end if;
- -- Release separators
-
- Free (Session.Data.Separators);
-
-- Release Filters table
for F in 1 .. Pattern_Action_Table.Last (Filters) loop
-- Current_Session --
---------------------
- function Current_Session return Session_Type is
+ function Current_Session return not null access 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);
+ return Cur_Session.Self;
end Current_Session;
---------------------
-- Default_Session --
---------------------
- function Default_Session return Session_Type is
+ function Default_Session return not null access 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);
+ return Def_Session.Self;
end Default_Session;
--------------------
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
