OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes]

Browse Source 
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.

From-SVN: r212659
This commit is contained in:
Arnaud Charlet 2014-07-16 16:39:51 +02:00
parent c624a26b6a
commit 36f6df662c
6 changed files with 442 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
gcc/ada/ChangeLog
View File

@ -1,3 +1,13 @@
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.

253
gcc/ada/g-rewdat.adb Normal file
View File

@ -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;

151
gcc/ada/g-rewdat.ads Normal file
View File

@ -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;

13
gcc/ada/gnat_rm.texi
View File

@ -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})

1
gcc/ada/impunit.adb
View File

@ -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

20
gcc/ada/make.adb
View File

@ -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