mirror of
https://github.com/AdaCore/PolyORB.git
synced 2026-02-12 13:01:15 -08:00
223 lines
7.7 KiB
Ada
223 lines
7.7 KiB
Ada
------------------------------------------------------------------------------
|
|
-- --
|
|
-- POLYORB COMPONENTS --
|
|
-- --
|
|
-- S O U R C E _ I N P U T --
|
|
-- --
|
|
-- B o d y --
|
|
-- --
|
|
-- Copyright (C) 2011-2012, Free Software Foundation, Inc. --
|
|
-- --
|
|
-- This 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. This software is distributed in the hope that it will be useful, --
|
|
-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
|
|
-- TABILITY 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 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/>. --
|
|
-- --
|
|
-- PolyORB is maintained by AdaCore --
|
|
-- (email: sales@adacore.com) --
|
|
-- --
|
|
------------------------------------------------------------------------------
|
|
|
|
with Ada.Containers.Hashed_Maps; use Ada.Containers;
|
|
with Ada.Containers.Vectors;
|
|
|
|
with GNAT.OS_Lib; use GNAT.OS_Lib;
|
|
|
|
with Errors; use Errors;
|
|
with Namet; use Namet;
|
|
|
|
package body Source_Input is
|
|
|
|
-- Vector of source files in creation order
|
|
|
|
package Source_File_Vectors is new Vectors
|
|
(Index_Type => Positive,
|
|
Element_Type => Source_File_Ptr);
|
|
use Source_File_Vectors;
|
|
|
|
Source_Files : Source_File_Vectors.Vector;
|
|
-- Contains all source files in creation order. Open_Source appends to
|
|
-- this; elements are never removed. Used by Iterate_Source_Files.
|
|
|
|
-- Mapping from file names to source files
|
|
|
|
package Source_File_Maps is new Hashed_Maps
|
|
(Key_Type => Name_Id,
|
|
Element_Type => Source_File_Ptr,
|
|
Hash => Hash,
|
|
Equivalent_Keys => "=");
|
|
use Source_File_Maps;
|
|
|
|
Source_File_Map : Source_File_Maps.Map;
|
|
-- Contains all True_Source files. Open_Source inserts in this; elements
|
|
-- are never removed. Used by Named_File. It is important to avoid putting
|
|
-- Preprocessed_Source files in this mapping, because on Windows, all the
|
|
-- temp files get the same name (they are deleted immediately after being
|
|
-- read). We can't have duplicates.
|
|
|
|
-----------------------------
|
|
-- Copy_To_Standard_Output --
|
|
-----------------------------
|
|
|
|
procedure Copy_To_Standard_Output (Source : Source_File) is
|
|
Ignore : Integer;
|
|
pragma Unreferenced (Ignore);
|
|
Buf : Text_Buffer renames Source.Buffer.all;
|
|
begin
|
|
Ignore := Write (Standout, Buf'Address, Buf'Length - 1);
|
|
-- Deliberately ignore result on output; it's not clear what we could
|
|
-- do about any failure.
|
|
-- "- 1" is to leave out the EOF terminator
|
|
end Copy_To_Standard_Output;
|
|
|
|
-------------------
|
|
-- Iterate_Lines --
|
|
-------------------
|
|
|
|
procedure Iterate_Lines
|
|
(Source : Source_File;
|
|
Process : not null access procedure (Line : String)) is
|
|
|
|
Buf : Text_Buffer renames Source.Buffer.all;
|
|
First : Text_Ptr := 1;
|
|
Last : Text_Ptr := 0;
|
|
begin
|
|
while Last < Buf'Last loop
|
|
while Buf (Last + 1) /= EOF and then
|
|
Buf (Last + 1) /= ASCII.CR and then
|
|
Buf (Last + 1) /= ASCII.LF
|
|
loop
|
|
Last := Last + 1;
|
|
end loop;
|
|
|
|
Process (String (Buf (First .. Last)));
|
|
|
|
-- Skip end-of-line characters, which could be any of LF, CR, or
|
|
-- CRLF. Buf (Last + 1) always exists below, because there's an
|
|
-- extra EOF at the end.
|
|
|
|
Last := Last + 1;
|
|
|
|
if Buf (Last) = ASCII.CR and then Buf (Last + 1) = ASCII.LF then
|
|
Last := Last + 1;
|
|
end if;
|
|
|
|
-- Next line starts after end-of-line characters
|
|
|
|
First := Last + 1;
|
|
end loop;
|
|
end Iterate_Lines;
|
|
|
|
--------------------------
|
|
-- Iterate_Source_Files --
|
|
--------------------------
|
|
|
|
procedure Iterate_Source_Files
|
|
(Process : not null access procedure (Source : Source_File)) is
|
|
|
|
procedure Call_Process (Position : Source_File_Vectors.Cursor);
|
|
-- Wrapper just to get the Source_File from the cursor
|
|
|
|
------------------
|
|
-- Call_Process --
|
|
------------------
|
|
|
|
procedure Call_Process (Position : Source_File_Vectors.Cursor) is
|
|
begin
|
|
Process (Element (Position).all);
|
|
end Call_Process;
|
|
|
|
begin
|
|
Iterate (Source_Files, Call_Process'Access);
|
|
end Iterate_Source_Files;
|
|
|
|
----------------
|
|
-- Named_File --
|
|
----------------
|
|
|
|
function Named_File (Name : Name_Id) return Source_File_Ptr is
|
|
begin
|
|
return Element (Source_File_Map, Name);
|
|
end Named_File;
|
|
|
|
-----------------
|
|
-- Open_Source --
|
|
-----------------
|
|
|
|
function Open_Source
|
|
(Name : Name_Id; Kind : Source_Kind) return Source_File_Ptr
|
|
is
|
|
Name_String : aliased constant String :=
|
|
Get_Name_String (Name) & ASCII.NUL;
|
|
FD : constant File_Descriptor := Open_Read (Name_String'Address, Binary);
|
|
begin
|
|
if FD = Invalid_FD then
|
|
case Kind is
|
|
when True_Source =>
|
|
DE ("file not found: %", Get_Name_String (Name));
|
|
when Preprocessed_Source =>
|
|
DE ("preprocessor output file not found: %",
|
|
Get_Name_String (Name));
|
|
end case;
|
|
raise Fatal_Error;
|
|
end if;
|
|
|
|
declare
|
|
Length : Integer := Integer (File_Length (FD));
|
|
|
|
Result : constant Source_File_Ptr := new Source_File'
|
|
(Name => Name,
|
|
Buffer => new Text_Buffer (1 .. Text_Ptr (Length) + 1),
|
|
-- "+ 1" is room for the last character to be EOF
|
|
Kind => Kind);
|
|
|
|
Buf : Text_Buffer renames Result.Buffer.all;
|
|
Pos : Text_Ptr := 1; -- position in buffer to read into
|
|
Read_RC : Integer; -- return code from Read
|
|
|
|
begin
|
|
-- Put the Result in the two containers
|
|
|
|
Append (Source_Files, Result);
|
|
|
|
-- Put it in Source_File_Map only if it's a True_Source
|
|
|
|
case Kind is
|
|
when True_Source =>
|
|
Insert (Source_File_Map, Name, Result);
|
|
when Preprocessed_Source =>
|
|
null;
|
|
end case;
|
|
|
|
-- Read the entire contents of the file
|
|
|
|
loop
|
|
Read_RC := Read (FD, Buf (Pos)'Address, Length);
|
|
exit when Read_RC = Length;
|
|
if Read_RC <= 0 then
|
|
DE ("cannot read: %", Get_Name_String (Name));
|
|
raise Fatal_Error;
|
|
end if;
|
|
Pos := Pos + Text_Ptr (Read_RC);
|
|
Length := Length - Read_RC;
|
|
end loop;
|
|
Close (FD);
|
|
|
|
-- Terminate buffer with EOF
|
|
|
|
Buf (Buf'Length) := EOF;
|
|
|
|
return Result;
|
|
end;
|
|
end Open_Source;
|
|
|
|
end Source_Input;
|