2014-07-16 Vincent Celier <celier@adacore.com>
+ * make.adb: Do not read gnat.adc when gnatmake is invoked
+ with -gnatA.
+
+2014-07-16 Pascal Obry <obry@adacore.com>
+
+ * gnat_rm.texi, impunit.adb, g-rewdat.adb, g-rewdat.ads: Initial
+ implementation of GNAT.Rewrite_Data.
+
+2014-07-16 Vincent Celier <celier@adacore.com>
+
* gnatls.adb (Normalize): New function.
(Gnatls): Get the target parameters. On targets other than VMS,
normalize the path names in the source search path, the object search
--- /dev/null
+-----------------------------------------------------------------------------
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- G N A T . R E W R I T E _ D A T A --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 2014, Free Software Foundation, Inc. --
+-- --
+-- 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 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. --
+-- --
+-- 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. --
+-- --
+------------------------------------------------------------------------------
+
+with Ada.Unchecked_Conversion;
+
+package body GNAT.Rewrite_Data is
+
+ use Ada;
+
+ subtype SEO is Stream_Element_Offset;
+
+ procedure Do_Output
+ (B : in out Buffer;
+ Data : Stream_Element_Array;
+ Output : not null access procedure (Data : Stream_Element_Array));
+ -- Do the actual output, this ensures that we properly send the data
+ -- through linked rewrite buffers if any.
+
+ ------------
+ -- Create --
+ ------------
+
+ function Create
+ (Pattern, Value : String;
+ Size : Stream_Element_Offset := 1_024) return Buffer
+ is
+
+ subtype SP is String (1 .. Pattern'Length);
+ subtype SEAP is Stream_Element_Array (1 .. Pattern'Length);
+
+ subtype SV is String (1 .. Value'Length);
+ subtype SEAV is Stream_Element_Array (1 .. Value'Length);
+
+ function To_SEAP is new Unchecked_Conversion (SP, SEAP);
+ function To_SEAV is new Unchecked_Conversion (SV, SEAV);
+
+ begin
+ -- Return result (can't be smaller than pattern
+
+ return B : Buffer
+ (SEO'Max (Size, SEO (Pattern'Length)),
+ SEO (Pattern'Length),
+ SEO (Value'Length))
+ do
+ B.Pattern := To_SEAP (Pattern);
+ B.Value := To_SEAV (Value);
+ B.Pos_C := 0;
+ B.Pos_B := 0;
+ end return;
+ end Create;
+
+ ---------------
+ -- Do_Output --
+ ---------------
+
+ procedure Do_Output
+ (B : in out Buffer;
+ Data : Stream_Element_Array;
+ Output : not null access procedure (Data : Stream_Element_Array))
+ is
+ begin
+ if B.Next = null then
+ Output (Data);
+ else
+ Write (B.Next.all, Data, Output);
+ end if;
+ end Do_Output;
+
+ -----------
+ -- Flush --
+ -----------
+
+ procedure Flush
+ (B : in out Buffer;
+ Output : not null access procedure (Data : Stream_Element_Array))
+ is
+ begin
+ -- Flush output buffer
+
+ if B.Pos_B > 0 then
+ Do_Output (B, B.Buffer (1 .. B.Pos_B), Output);
+ end if;
+
+ -- Flush current buffer
+
+ if B.Pos_C > 0 then
+ Do_Output (B, B.Current (1 .. B.Pos_C), Output);
+ end if;
+
+ -- Flush linked buffer if any
+
+ if B.Next /= null then
+ Flush (B.Next.all, Output);
+ end if;
+
+ Reset (B);
+ end Flush;
+
+ ----------
+ -- Link --
+ ----------
+
+ procedure Link (From : in out Buffer; To : Buffer_Ref) is
+ begin
+ From.Next := To;
+ end Link;
+
+ -----------
+ -- Reset --
+ -----------
+
+ procedure Reset (B : in out Buffer) is
+ begin
+ B.Pos_B := 0;
+ B.Pos_C := 0;
+
+ if B.Next /= null then
+ Reset (B.Next.all);
+ end if;
+ end Reset;
+
+ -------------
+ -- Rewrite --
+ -------------
+
+ procedure Rewrite
+ (B : in out Buffer;
+ Input : not null access procedure
+ (Buffer : out Stream_Element_Array;
+ Last : out Stream_Element_Offset);
+ Output : not null access procedure (Data : Stream_Element_Array))
+ is
+ Buffer : Stream_Element_Array (1 .. B.Size);
+ Last : Stream_Element_Offset;
+
+ begin
+ Rewrite_All : loop
+ Input (Buffer, Last);
+ exit Rewrite_All when Last = 0;
+ Write (B, Buffer (1 .. Last), Output);
+ end loop Rewrite_All;
+
+ Flush (B, Output);
+ end Rewrite;
+
+ ----------
+ -- Size --
+ ----------
+
+ function Size (B : Buffer) return Natural is
+ begin
+ return Natural (B.Pos_B + B.Pos_C);
+ end Size;
+
+ -----------
+ -- Write --
+ -----------
+
+ procedure Write
+ (B : in out Buffer;
+ Data : Stream_Element_Array;
+ Output : not null access procedure (Data : Stream_Element_Array))
+ is
+ procedure Need_Space (Size : Stream_Element_Offset);
+ pragma Inline (Need_Space);
+
+ ----------------
+ -- Need_Space --
+ ----------------
+
+ procedure Need_Space (Size : Stream_Element_Offset) is
+ begin
+ if B.Pos_B + Size > B.Size then
+ Do_Output (B, B.Buffer (1 .. B.Pos_B), Output);
+ B.Pos_B := 0;
+ end if;
+ end Need_Space;
+
+ -- Start of processing for Write
+
+ begin
+ if B.Size_Pattern = 0 then
+ Do_Output (B, Data, Output);
+
+ else
+ for K in Data'Range loop
+ if Data (K) = B.Pattern (B.Pos_C + 1) then
+
+ -- Store possible start of a match
+
+ B.Pos_C := B.Pos_C + 1;
+ B.Current (B.Pos_C) := Data (K);
+
+ else
+ -- Not part of pattern, if a start of a match was found,
+ -- remove it.
+
+ if B.Pos_C /= 0 then
+ Need_Space (B.Pos_C);
+
+ B.Buffer (B.Pos_B + 1 .. B.Pos_B + B.Pos_C) :=
+ B.Current (1 .. B.Pos_C);
+ B.Pos_B := B.Pos_B + B.Pos_C;
+ B.Pos_C := 0;
+ end if;
+
+ Need_Space (1);
+ B.Pos_B := B.Pos_B + 1;
+ B.Buffer (B.Pos_B) := Data (K);
+ end if;
+
+ if B.Pos_C = B.Size_Pattern then
+
+ -- The pattern is found
+
+ Need_Space (B.Size_Value);
+
+ B.Buffer (B.Pos_B + 1 .. B.Pos_B + B.Size_Value) := B.Value;
+ B.Pos_C := 0;
+ B.Pos_B := B.Pos_B + B.Size_Value;
+ end if;
+ end loop;
+ end if;
+ end Write;
+
+end GNAT.Rewrite_Data;
--- /dev/null
+------------------------------------------------------------------------------
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- G N A T . R E W R I T E _ D A T A --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 2014, Free Software Foundation, Inc. --
+-- --
+-- 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 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. --
+-- --
+-- 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. --
+-- --
+------------------------------------------------------------------------------
+
+-- This package can be used to rewrite data on the fly. All occurences of a
+-- string (named pattern) will be replaced by another string.
+
+-- It is not necessary to load all data in memory and so this package can be
+-- used for large data chunks like disk files for example. The pattern is
+-- a standard string and not a regular expression.
+
+-- There is no dynamic allocation in the implementation.
+
+-- Example, to replace all occurences of "Gnat" with "GNAT":
+
+-- Rewriter : Buffer := Create (Pattern => "Gnat", Value => "GNAT");
+
+-- The output procedure that will receive the rewritten data:
+
+-- procedure Do (Data : Stream_Element_Array) is
+-- begin
+-- <implementation to handle Data>
+-- end Do;
+
+-- Then:
+
+-- Write (Rewriter, "Let's talk about Gnat compiler", Do'Access);
+-- Write (Rewriter, "Gnat is an Ada compiler", Do'Access);
+-- Flush (Rewriter, Do'Access);
+
+-- Another possible usage is to specify a method to get the input data:
+
+-- procedure Get
+-- (Buffer : out Stream_Element_Array;
+-- Last : out Stream_Element_Offset)
+-- is
+-- begin
+-- <get some data from a file, a socket, etc...>
+-- Last := ...
+-- Buffer := ...
+-- end Get;
+
+-- Then we can rewrite the whole file with:
+
+-- Rewrite (Rewriter, Input => Get'Access, Output => Do'Access);
+
+with Ada.Streams; use Ada.Streams;
+
+package GNAT.Rewrite_Data is
+
+ type Buffer (<>) is limited private;
+ type Buffer_Ref is access all Buffer;
+
+ function Create
+ (Pattern, Value : String;
+ Size : Stream_Element_Offset := 1_024) return Buffer;
+ -- Create a rewriter buffer. Pattern is the string to be rewriten as Value.
+ -- Size represent the size of the internal buffer used to store the data
+ -- reeady to be output. A larger buffer may improve the performance as the
+ -- Output routine (see Write, Rewrite below) will be called only when this
+ -- buffer is full. Note that Size cannot be lower than Pattern'Length, if
+ -- this is the case then Size value is set to Pattern'Length.
+
+ function Size (B : Buffer) return Natural;
+ -- Returns the current size of the buffer (count of Stream_Array_Element)
+
+ procedure Flush
+ (B : in out Buffer;
+ Output : not null access procedure (Data : Stream_Element_Array));
+ -- Call Output for all remaining data in the buffer. The buffer is
+ -- reset and ready for another use after this call.
+
+ procedure Reset (B : in out Buffer);
+ pragma Inline (Reset);
+ -- Clear all data in buffer, B is ready for another use. Note that this is
+ -- not needed after a Flush. Note: all data remaining in Buffer is lost.
+
+ procedure Write
+ (B : in out Buffer;
+ Data : Stream_Element_Array;
+ Output : not null access procedure (Data : Stream_Element_Array));
+ -- Write Data into the buffer, call Output for any prepared data. Flush
+ -- must be called when the last piece of Data as been sent in the Buffer.
+
+ procedure Rewrite
+ (B : in out Buffer;
+ Input : not null access procedure
+ (Buffer : out Stream_Element_Array;
+ Last : out Stream_Element_Offset);
+ Output : not null access procedure (Data : Stream_Element_Array));
+ -- Read data from Input, rewrite it and then call Output. When there is
+ -- no more data to be read from Input Last must be set to 0. Before leaving
+ -- this routine call Flush above to send all remaining data to Output.
+
+ procedure Link (From : in out Buffer; To : Buffer_Ref);
+ -- Link two rewrite buffers, that is all data sent to From buffer will be
+ -- rewritten and then passed to the To rewrite buffer.
+
+private
+
+ type Buffer
+ (Size, Size_Pattern, Size_Value : Stream_Element_Offset) is
+ limited record
+ Buffer : Stream_Element_Array (1 .. Size);
+ -- Fully prepared/rewritten data waiting to be output
+
+ Current : Stream_Element_Array (1 .. Size_Pattern);
+ -- Current data checked, this buffer contains every piece of data
+ -- starting with the pattern. It means that at any point:
+ -- Current (1 .. Pos_C) = Pattern (1 .. Pos_C).
+
+ Pattern : Stream_Element_Array (1 .. Size_Pattern);
+ -- The pattern to look for
+
+ Value : Stream_Element_Array (1 .. Size_Value);
+ -- The value the pattern is replaced by
+
+ Pos_C : Stream_Element_Offset; -- last valid element in Current
+ Pos_B : Stream_Element_Offset; -- last valid element in Buffer
+
+ Next : Buffer_Ref;
+ -- A link to another rewriter if any
+ end record;
+
+end GNAT.Rewrite_Data;
* GNAT.Regexp (g-regexp.ads)::
* GNAT.Registry (g-regist.ads)::
* GNAT.Regpat (g-regpat.ads)::
+* GNAT.Rewrite_Data (g-rewdat.ads)::
* GNAT.Secondary_Stack_Info (g-sestin.ads)::
* GNAT.Semaphores (g-semaph.ads)::
* GNAT.Serial_Communications (g-sercom.ads)::
* GNAT.Regexp (g-regexp.ads)::
* GNAT.Registry (g-regist.ads)::
* GNAT.Regpat (g-regpat.ads)::
+* GNAT.Rewrite_Data (g-rewdat.ads)::
* GNAT.Secondary_Stack_Info (g-sestin.ads)::
* GNAT.Semaphores (g-semaph.ads)::
* GNAT.Serial_Communications (g-sercom.ads)::
from the original V7 style regular expression library written in C by
Henry Spencer (and binary compatible with this C library).
+@node GNAT.Rewrite_Data (g-rewdat.ads)
+@section @code{GNAT.Rewrite_Data} (@file{g-rewdat.ads})
+@cindex @code{GNAT.Rewrite_Data} (@file{g-rewdat.ads})
+@cindex Rewrite data
+
+@noindent
+A unit to rewrite on-the-fly string occurrences in a stream of
+data. The implementation has a very minimum memory footprint as the
+full content to be processed is not loaded into memory. This makes
+this implementation usable for large files or socket streams.
+
@node GNAT.Secondary_Stack_Info (g-sestin.ads)
@section @code{GNAT.Secondary_Stack_Info} (@file{g-sestin.ads})
@cindex @code{GNAT.Secondary_Stack_Info} (@file{g-sestin.ads})
("g-regexp", F), -- GNAT.Regexp
("g-regist", F), -- GNAT.Registry
("g-regpat", F), -- GNAT.Regpat
+ ("g-rewdat", F), -- GNAT.Rewrite_Data
("g-semaph", F), -- GNAT.Semaphores
("g-sercom", F), -- GNAT.Serial_Communications
("g-sestin", F), -- GNAT.Secondary_Stack_Info
Fname.UF.Initialize;
- begin
- Fname.SF.Read_Source_File_Name_Pragmas;
+ if Config_File then
+ begin
+ Fname.SF.Read_Source_File_Name_Pragmas;
- exception
- when Err : SFN_Scan.Syntax_Error_In_GNAT_ADC =>
- Make_Failed (Exception_Message (Err));
- end;
+ exception
+ when Err : SFN_Scan.Syntax_Error_In_GNAT_ADC =>
+ Make_Failed (Exception_Message (Err));
+ end;
+ end if;
end if;
-- Make sure no project object directory is recorded
Do_Link_Step := False;
end if;
+ -- If -gnatA is specified, make sure that gnat.adc is never read
+
+ elsif Argv'Length >= 6 and then Argv (2 .. 6) = "gnatA" then
+ Add_Switch (Argv, Compiler, And_Save => And_Save);
+ Opt.Config_File := False;
+
elsif Argv (2 .. Argv'Last) = "nostdlib" then
-- Pass -nstdlib to gnatbind and gnatlink
projects / platform / upstream / gcc.git / commitdiff