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.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@212659 138bc75d-0d04-0410-961f-82ee72b054a4

6 files changed, 442 insertions, 6 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index e63452a5e93..b1be626e1a5 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,15 @@
 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
diff --git a/gcc/ada/g-rewdat.adb b/gcc/ada/g-rewdat.adb
new file mode 100644
index 00000000000..846ff9dcee8
--- /dev/null
+++ b/gcc/ada/g-rewdat.adb
@@ -0,0 +1,253 @@
+-----------------------------------------------------------------------------
+--                         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;
diff --git a/gcc/ada/g-rewdat.ads b/gcc/ada/g-rewdat.ads
new file mode 100644
index 00000000000..4fc8afd6461
--- /dev/null
+++ b/gcc/ada/g-rewdat.ads
@@ -0,0 +1,151 @@
+------------------------------------------------------------------------------
+--                         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;
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index ee3abf6b73f..70b4c25c04a 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -594,6 +594,7 @@ The GNAT Library
 * 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)::
@@ -18464,6 +18465,7 @@ of GNAT, and will generate a warning message.
 * 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)::
@@ -19563,6 +19565,17 @@ A complete implementation of Unix-style regular expression matching, copied
 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})
diff --git a/gcc/ada/impunit.adb b/gcc/ada/impunit.adb
index de0cb0b2d15..ae7a5e29d97 100644
--- a/gcc/ada/impunit.adb
+++ b/gcc/ada/impunit.adb
@@ -291,6 +291,7 @@ package body Impunit is
     ("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
diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb
index 74be6988cfa..ebd2bfd9a52 100644
--- a/gcc/ada/make.adb
+++ b/gcc/ada/make.adb
@@ -6671,13 +6671,15 @@ package body Make is
 
          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
@@ -7907,6 +7909,12 @@ package body Make is
                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