Skip to content

R
riscv-gcc-1
Commit ef83161c by Geert Bosch Committed by Geert Bosch
Options

* prj-makr.ads, prj-makr.adb : New files. 

From-SVN: r51406
parent 1f3f6dad
Showing with 1085 additions and 0 deletions
gcc/ada/ChangeLog
2002-03-27 Geert Bosch <bosch@gnat.com>
* prj-makr.ads, prj-makr.adb : New files.
2002-03-26 Neil Booth <neil@daikokuya.demon.co.uk> 2002-03-26 Neil Booth <neil@daikokuya.demon.co.uk>
* misc.c (LANG_HOOKS_MARK_TREE): Redefine. * misc.c (LANG_HOOKS_MARK_TREE): Redefine.
......
gcc/ada/prj-makr.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- P R J . M A K R --
-- --
-- B o d y --
-- --
-- $Revision$
-- --
-- Copyright (C) 2001-2002 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 2, 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, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
with Csets;
with Namet; use Namet;
with Opt;
with Output;
with Osint; use Osint;
with Prj; use Prj;
with Prj.Part;
with Prj.PP;
with Prj.Tree; use Prj.Tree;
with Snames; use Snames;
with Stringt; use Stringt;
with Table; use Table;
with Ada.Characters.Handling; use Ada.Characters.Handling;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with GNAT.Expect; use GNAT.Expect;
with GNAT.OS_Lib; use GNAT.OS_Lib;
with GNAT.Regexp; use GNAT.Regexp;
with GNAT.Regpat; use GNAT.Regpat;
package body Prj.Makr is
type Matched_Type is (True, False, Excluded);
Naming_File_Suffix : constant String := "_naming";
Source_List_File_Suffix : constant String := "_source_list.txt";
Output_FD : File_Descriptor;
-- To save the project file and its naming project file.
procedure Write_Eol;
-- Output an empty line.
procedure Write_A_Char (C : Character);
-- Write one character to Output_FD
procedure Write_A_String (S : String);
-- Write a String to Output_FD
----------
-- Make --
----------
procedure Make
(File_Path : String;
Project_File : Boolean;
Directories : Argument_List;
Name_Patterns : Argument_List;
Excluded_Patterns : Argument_List;
Very_Verbose : Boolean)
is
Path_Name : String (1 .. File_Path'Length +
Project_File_Extension'Length);
Path_Last : Natural := File_Path'Length;
Directory_Last : Natural := 0;
Output_Name : String (Path_Name'Range);
Output_Name_Last : Natural;
Output_Name_Id : Name_Id;
Project_Node : Project_Node_Id := Empty_Node;
Project_Declaration : Project_Node_Id := Empty_Node;
Source_Dirs_List : Project_Node_Id := Empty_Node;
Current_Source_Dir : Project_Node_Id := Empty_Node;
Project_Naming_Node : Project_Node_Id := Empty_Node;
Project_Naming_Decl : Project_Node_Id := Empty_Node;
Naming_Package : Project_Node_Id := Empty_Node;
Project_Naming_File_Name : String (1 .. Output_Name'Length +
Naming_File_Suffix'Length);
Project_Naming_Last : Natural;
Project_Naming_Id : Name_Id := No_Name;
Excluded_Expressions : array (Excluded_Patterns'Range) of Regexp;
Regular_Expressions : array (Name_Patterns'Range) of Regexp;
Source_List_Path : String (1 .. Output_Name'Length +
Source_List_File_Suffix'Length);
Source_List_Last : Natural;
Source_List_FD : File_Descriptor;
Str : String (1 .. 2_000);
Last : Natural;
Dir : Dir_Type;
PD : Process_Descriptor;
Result : Expect_Match;
Matcher : constant Pattern_Matcher :=
Compile (Expression => "expected|Unit.*\)|No such");
Args : Argument_List :=
(1 => new String'("-c"),
2 => new String'("-gnats"),
3 => new String'("-gnatu"),
4 => new String'("-x"),
5 => new String'("ada"),
6 => null);
type SFN_Pragma is record
Unit : String_Access;
File : String_Access;
Spec : Boolean;
end record;
package SFN_Pragmas is new Table.Table
(Table_Component_Type => SFN_Pragma,
Table_Index_Type => Natural,
Table_Low_Bound => 0,
Table_Initial => 50,
Table_Increment => 50,
Table_Name => "Prj.Makr.SFN_Pragmas");
begin
-- Do some needed initializations
Csets.Initialize;
Namet.Initialize;
Snames.Initialize;
Prj.Initialize;
SFN_Pragmas.Set_Last (0);
-- Get the path and file names
if File_Names_Case_Sensitive then
Path_Name (1 .. Path_Last) := File_Path;
else
Path_Name (1 .. Path_Last) := To_Lower (File_Path);
end if;
Path_Name (Path_Last + 1 .. Path_Name'Last) :=
Project_File_Extension;
-- Get the end of directory information, if any
for Index in reverse 1 .. Path_Last loop
if Path_Name (Index) = Directory_Separator then
Directory_Last := Index;
exit;
end if;
end loop;
if Project_File then
if Path_Last < Project_File_Extension'Length + 1
or else Path_Name
(Path_Last - Project_File_Extension'Length + 1 .. Path_Last)
/= Project_File_Extension
then
Path_Last := Path_Name'Last;
end if;
Output_Name (1 .. Path_Last) := To_Lower (Path_Name (1 .. Path_Last));
Output_Name_Last := Path_Last - Project_File_Extension'Length;
if Directory_Last /= 0 then
Output_Name (1 .. Output_Name_Last - Directory_Last) :=
Output_Name (Directory_Last + 1 .. Output_Name_Last);
Output_Name_Last := Output_Name_Last - Directory_Last;
end if;
-- Get the project name id
Name_Len := Output_Name_Last;
Name_Buffer (1 .. Name_Len) := Output_Name (1 .. Name_Len);
Output_Name_Id := Name_Find;
-- Create the project naming file name
Project_Naming_Last := Output_Name_Last;
Project_Naming_File_Name (1 .. Project_Naming_Last) :=
Output_Name (1 .. Project_Naming_Last);
Project_Naming_File_Name
(Project_Naming_Last + 1 ..
Project_Naming_Last + Naming_File_Suffix'Length) :=
Naming_File_Suffix;
Project_Naming_Last :=
Project_Naming_Last + Naming_File_Suffix'Length;
-- Get the project naming id
Name_Len := Project_Naming_Last;
Name_Buffer (1 .. Name_Len) :=
Project_Naming_File_Name (1 .. Name_Len);
Project_Naming_Id := Name_Find;
Project_Naming_File_Name
(Project_Naming_Last + 1 ..
Project_Naming_Last + Project_File_Extension'Length) :=
Project_File_Extension;
Project_Naming_Last :=
Project_Naming_Last + Project_File_Extension'Length;
-- Create the source list file name
Source_List_Last := Output_Name_Last;
Source_List_Path (1 .. Source_List_Last) :=
Output_Name (1 .. Source_List_Last);
Source_List_Path
(Source_List_Last + 1 ..
Source_List_Last + Source_List_File_Suffix'Length) :=
Source_List_File_Suffix;
Source_List_Last := Source_List_Last + Source_List_File_Suffix'Length;
-- Add the project file extension to the project name
Output_Name
(Output_Name_Last + 1 ..
Output_Name_Last + Project_File_Extension'Length) :=
Project_File_Extension;
Output_Name_Last := Output_Name_Last + Project_File_Extension'Length;
end if;
-- Change the current directory to the directory of the project file,
-- if any directory information is specified.
if Directory_Last /= 0 then
begin
Change_Dir (Path_Name (1 .. Directory_Last));
exception
when Directory_Error =>
Fail ("unknown directory """ &
Path_Name (1 .. Directory_Last) & '"');
end;
end if;
if Project_File then
-- Delete the source list file, if it already exists
declare
Discard : Boolean;
begin
Delete_File
(Source_List_Path (1 .. Source_List_Last),
Success => Discard);
end;
-- And create a new source list file.
-- Fail if file cannot be created.
Source_List_FD := Create_New_File
(Name => Source_List_Path (1 .. Source_List_Last),
Fmode => Text);
if Source_List_FD = Invalid_FD then
Fail ("cannot create file """ &
Source_List_Path (1 .. Source_List_Last) & '"');
end if;
end if;
-- Compile the regular expressions. Fails immediately if any of
-- the specified strings is in error.
for Index in Excluded_Expressions'Range loop
begin
Excluded_Expressions (Index) :=
Compile (Pattern => Excluded_Patterns (Index).all, Glob => True);
exception
when Error_In_Regexp =>
Fail ("invalid regular expression """ &
Excluded_Patterns (Index).all & '"');
end;
end loop;
for Index in Regular_Expressions'Range loop
begin
Regular_Expressions (Index) :=
Compile (Pattern => Name_Patterns (Index).all, Glob => True);
exception
when Error_In_Regexp =>
Fail ("invalid regular expression """ &
Name_Patterns (Index).all & '"');
end;
end loop;
if Project_File then
if Opt.Verbose_Mode then
Output.Write_Str ("Naming project file name is """);
Output.Write_Str
(Project_Naming_File_Name (1 .. Project_Naming_Last));
Output.Write_Line ("""");
end if;
-- If there is already a project file with the specified name,
-- parse it to get the components that are not automatically
-- generated.
if Is_Regular_File (Output_Name (1 .. Output_Name_Last)) then
if Opt.Verbose_Mode then
Output.Write_Str ("Parsing already existing project file """);
Output.Write_Str (Output_Name (1 .. Output_Name_Last));
Output.Write_Line ("""");
end if;
Part.Parse
(Project => Project_Node,
Project_File_Name => Output_Name (1 .. Output_Name_Last),
Always_Errout_Finalize => False);
-- If parsing was successful, remove the components that are
-- automatically generated, if any, so that they will be
-- unconditionally added later.
if Project_Node /= Empty_Node then
-- Remove the with clause for the naming project file
declare
With_Clause : Project_Node_Id :=
First_With_Clause_Of (Project_Node);
Previous : Project_Node_Id := Empty_Node;
begin
while With_Clause /= Empty_Node loop
if Tree.Name_Of (With_Clause) = Project_Naming_Id then
if Previous = Empty_Node then
Set_First_With_Clause_Of
(Project_Node,
To => Next_With_Clause_Of (With_Clause));
else
Set_Next_With_Clause_Of
(Previous,
To => Next_With_Clause_Of (With_Clause));
end if;
exit;
end if;
Previous := With_Clause;
With_Clause := Next_With_Clause_Of (With_Clause);
end loop;
end;
-- Remove attribute declarations of Source_Files,
-- Source_List_File, Source_Dirs, and the declaration of
-- package Naming, if they exist.
declare
Declaration : Project_Node_Id :=
First_Declarative_Item_Of
(Project_Declaration_Of (Project_Node));
Previous : Project_Node_Id := Empty_Node;
Current_Node : Project_Node_Id := Empty_Node;
begin
while Declaration /= Empty_Node loop
Current_Node := Current_Item_Node (Declaration);
if (Kind_Of (Current_Node) = N_Attribute_Declaration
and then
(Tree.Name_Of (Current_Node) = Name_Source_Files
or else Tree.Name_Of (Current_Node) =
Name_Source_List_File
or else Tree.Name_Of (Current_Node) =
Name_Source_Dirs))
or else
(Kind_Of (Current_Node) = N_Package_Declaration
and then Tree.Name_Of (Current_Node) = Name_Naming)
then
if Previous = Empty_Node then
Set_First_Declarative_Item_Of
(Project_Declaration_Of (Project_Node),
To => Next_Declarative_Item (Declaration));
else
Set_Next_Declarative_Item
(Previous,
To => Next_Declarative_Item (Declaration));
end if;
else
Previous := Declaration;
end if;
Declaration := Next_Declarative_Item (Declaration);
end loop;
end;
end if;
end if;
-- If there were no already existing project file, or if the parsing
-- was unsuccessful, create an empty project node with the correct
-- name and its project declaration node.
if Project_Node = Empty_Node then
Project_Node := Default_Project_Node (Of_Kind => N_Project);
Set_Name_Of (Project_Node, To => Output_Name_Id);
Set_Project_Declaration_Of
(Project_Node,
To => Default_Project_Node (Of_Kind => N_Project_Declaration));
end if;
-- Create the naming project node, and add an attribute declaration
-- for Source_Files as an empty list, to indicate there are no
-- sources in the naming project.
Project_Naming_Node := Default_Project_Node (Of_Kind => N_Project);
Set_Name_Of (Project_Naming_Node, To => Project_Naming_Id);
Project_Naming_Decl :=
Default_Project_Node (Of_Kind => N_Project_Declaration);
Set_Project_Declaration_Of (Project_Naming_Node, Project_Naming_Decl);
Naming_Package :=
Default_Project_Node (Of_Kind => N_Package_Declaration);
Set_Name_Of (Naming_Package, To => Name_Naming);
declare
Decl_Item : constant Project_Node_Id :=
Default_Project_Node (Of_Kind => N_Declarative_Item);
Attribute : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Attribute_Declaration,
And_Expr_Kind => List);
Expression : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Expression,
And_Expr_Kind => List);
Term : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Term,
And_Expr_Kind => List);
Empty_List : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Literal_String_List);
begin
Set_First_Declarative_Item_Of
(Project_Naming_Decl, To => Decl_Item);
Set_Next_Declarative_Item (Decl_Item, Naming_Package);
Set_Current_Item_Node (Decl_Item, To => Attribute);
Set_Name_Of (Attribute, To => Name_Source_Files);
Set_Expression_Of (Attribute, To => Expression);
Set_First_Term (Expression, To => Term);
Set_Current_Term (Term, To => Empty_List);
end;
-- Add a with clause on the naming project in the main project
declare
With_Clause : constant Project_Node_Id :=
Default_Project_Node (Of_Kind => N_With_Clause);
begin
Set_Next_With_Clause_Of
(With_Clause, To => First_With_Clause_Of (Project_Node));
Set_First_With_Clause_Of (Project_Node, To => With_Clause);
Set_Name_Of (With_Clause, To => Project_Naming_Id);
Start_String;
Store_String_Chars
(Project_Naming_File_Name (1 .. Project_Naming_Last));
Set_String_Value_Of (With_Clause, To => End_String);
end;
Project_Declaration := Project_Declaration_Of (Project_Node);
-- Add a renaming declaration for package Naming in the main project
declare
Decl_Item : constant Project_Node_Id :=
Default_Project_Node (Of_Kind => N_Declarative_Item);
Naming : constant Project_Node_Id :=
Default_Project_Node (Of_Kind => N_Package_Declaration);
begin
Set_Next_Declarative_Item
(Decl_Item,
To => First_Declarative_Item_Of (Project_Declaration));
Set_First_Declarative_Item_Of
(Project_Declaration, To => Decl_Item);
Set_Current_Item_Node (Decl_Item, To => Naming);
Set_Name_Of (Naming, To => Name_Naming);
Set_Project_Of_Renamed_Package_Of
(Naming, To => Project_Naming_Node);
end;
-- Add an attribute declaration for Source_Dirs, initialized as an
-- empty list. Directories will be added as they are read from the
-- directory list file.
declare
Decl_Item : constant Project_Node_Id :=
Default_Project_Node (Of_Kind => N_Declarative_Item);
Attribute : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Attribute_Declaration,
And_Expr_Kind => List);
Expression : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Expression,
And_Expr_Kind => List);
Term : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Term, And_Expr_Kind => List);
begin
Set_Next_Declarative_Item
(Decl_Item,
To => First_Declarative_Item_Of (Project_Declaration));
Set_First_Declarative_Item_Of
(Project_Declaration, To => Decl_Item);
Set_Current_Item_Node (Decl_Item, To => Attribute);
Set_Name_Of (Attribute, To => Name_Source_Dirs);
Set_Expression_Of (Attribute, To => Expression);
Set_First_Term (Expression, To => Term);
Source_Dirs_List :=
Default_Project_Node (Of_Kind => N_Literal_String_List,
And_Expr_Kind => List);
Set_Current_Term (Term, To => Source_Dirs_List);
end;
-- Add an attribute declaration for Source_List_File with the
-- source list file name that will be created.
declare
Decl_Item : constant Project_Node_Id :=
Default_Project_Node (Of_Kind => N_Declarative_Item);
Attribute : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Attribute_Declaration,
And_Expr_Kind => Single);
Expression : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Expression,
And_Expr_Kind => Single);
Term : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Term,
And_Expr_Kind => Single);
Value : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Literal_String,
And_Expr_Kind => Single);
begin
Set_Next_Declarative_Item
(Decl_Item,
To => First_Declarative_Item_Of (Project_Declaration));
Set_First_Declarative_Item_Of
(Project_Declaration, To => Decl_Item);
Set_Current_Item_Node (Decl_Item, To => Attribute);
Set_Name_Of (Attribute, To => Name_Source_List_File);
Set_Expression_Of (Attribute, To => Expression);
Set_First_Term (Expression, To => Term);
Set_Current_Term (Term, To => Value);
Start_String;
Store_String_Chars (Source_List_Path (1 .. Source_List_Last));
Set_String_Value_Of (Value, To => End_String);
end;
end if;
-- Process each directory
for Index in Directories'Range loop
declare
Dir_Name : constant String := Directories (Index).all;
Matched : Matched_Type := False;
begin
if Opt.Verbose_Mode then
Output.Write_Str ("Processing directory """);
Output.Write_Str (Dir_Name);
Output.Write_Line ("""");
end if;
if Project_File then
-- Add the directory in the list for attribute Source_Dirs
declare
Expression : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Expression,
And_Expr_Kind => Single);
Term : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Term,
And_Expr_Kind => Single);
Value : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Literal_String,
And_Expr_Kind => Single);
begin
if Current_Source_Dir = Empty_Node then
Set_First_Expression_In_List
(Source_Dirs_List, To => Expression);
else
Set_Next_Expression_In_List
(Current_Source_Dir, To => Expression);
end if;
Current_Source_Dir := Expression;
Set_First_Term (Expression, To => Term);
Set_Current_Term (Term, To => Value);
Start_String;
Store_String_Chars (S => Dir_Name);
Set_String_Value_Of (Value, To => End_String);
end;
end if;
-- Get the source file names from the directory.
-- Fails if the directory does not exist.
begin
Open (Dir, Dir_Name);
exception
when Directory_Error =>
Fail ("cannot open directory """ & Dir_Name & '"');
end;
-- Process each regular file in the directory
loop
Read (Dir, Str, Last);
exit when Last = 0;
if Is_Regular_File
(Dir_Name & Directory_Separator & Str (1 .. Last))
then
Matched := True;
-- First, check if the file name matches at least one of
-- the excluded expressions;
for Index in Excluded_Expressions'Range loop
if
Match (Str (1 .. Last), Excluded_Expressions (Index))
then
Matched := Excluded;
exit;
end if;
end loop;
-- If it does not match any of the excluded expressions,
-- check if the file name matches at least one of the
-- regular expressions.
if Matched = True then
Matched := False;
for Index in Regular_Expressions'Range loop
if
Match (Str (1 .. Last), Regular_Expressions (Index))
then
Matched := True;
exit;
end if;
end loop;
end if;
if Very_Verbose
or else (Matched = True and then Opt.Verbose_Mode)
then
Output.Write_Str (" Checking """);
Output.Write_Str (Str (1 .. Last));
Output.Write_Str (""": ");
end if;
-- If the file name matches one of the regular expressions,
-- parse it to get its unit name.
if Matched = True then
Args (6) := new String'
(Dir_Name &
Directory_Separator &
Str (1 .. Last));
begin
Non_Blocking_Spawn
(PD, "gcc", Args, Err_To_Out => True);
Expect (PD, Result, Matcher);
exception
when Process_Died =>
if Opt.Verbose_Mode then
Output.Write_Str ("(process died) ");
end if;
Result := Expect_Timeout;
end;
if Result /= Expect_Timeout then
-- If we got a unit name, this is a valid source file
declare
S : constant String := Expect_Out_Match (PD);
begin
if S'Length >= 13
and then S (S'First .. S'First + 3) = "Unit"
then
if Opt.Verbose_Mode then
Output.Write_Str
(S (S'Last - 4 .. S'Last - 1));
Output.Write_Str (" of ");
Output.Write_Line
(S (S'First + 5 .. S'Last - 7));
end if;
if Project_File then
-- Add the corresponding attribute in the
-- Naming package of the naming project.
declare
Decl_Item : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind =>
N_Declarative_Item);
Attribute : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind =>
N_Attribute_Declaration);
Expression : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Expression,
And_Expr_Kind => Single);
Term : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Term,
And_Expr_Kind => Single);
Value : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Literal_String,
And_Expr_Kind => Single);
begin
Set_Next_Declarative_Item
(Decl_Item,
To => First_Declarative_Item_Of
(Naming_Package));
Set_First_Declarative_Item_Of
(Naming_Package, To => Decl_Item);
Set_Current_Item_Node
(Decl_Item, To => Attribute);
if S (S'Last - 5 .. S'Last) = "(spec)" then
Set_Name_Of
(Attribute, To => Name_Specification);
else
Set_Name_Of
(Attribute,
To => Name_Implementation);
end if;
Start_String;
Store_String_Chars
(To_Lower
(S (S'First + 5 .. S'Last - 7)));
Set_Associative_Array_Index_Of
(Attribute, To => End_String);
Set_Expression_Of
(Attribute, To => Expression);
Set_First_Term (Expression, To => Term);
Set_Current_Term (Term, To => Value);
Start_String;
Store_String_Chars (Str (1 .. Last));
Set_String_Value_Of
(Value, To => End_String);
end;
-- Add source file name to source list file
Last := Last + 1;
Str (Last) := ASCII.LF;
if Write (Source_List_FD,
Str (1)'Address,
Last) /= Last
then
Fail ("disk full");
end if;
else
-- Add an entry in the SFN_Pragmas table
SFN_Pragmas.Increment_Last;
SFN_Pragmas.Table (SFN_Pragmas.Last) :=
(Unit => new String'
(S (S'First + 5 .. S'Last - 7)),
File => new String'(Str (1 .. Last)),
Spec => S (S'Last - 5 .. S'Last)
= "(spec)");
end if;
else
if Opt.Verbose_Mode then
Output.Write_Line ("not a unit");
end if;
end if;
end;
else
if Opt.Verbose_Mode then
Output.Write_Line ("not a unit");
end if;
end if;
Close (PD);
else
if Very_Verbose then
if Matched = False then
Output.Write_Line ("no match");
else
Output.Write_Line ("excluded");
end if;
end if;
end if;
end if;
end loop;
Close (Dir);
end;
end loop;
if Project_File then
Close (Source_List_FD);
end if;
declare
Discard : Boolean;
begin
-- Delete the file if it already exists
Delete_File
(Path_Name (Directory_Last + 1 .. Path_Last),
Success => Discard);
-- Create a new one
if Opt.Verbose_Mode then
Output.Write_Str ("Creating new file """);
Output.Write_Str (Path_Name (Directory_Last + 1 .. Path_Last));
Output.Write_Line ("""");
end if;
Output_FD := Create_New_File
(Path_Name (Directory_Last + 1 .. Path_Last),
Fmode => Text);
-- Fails if project file cannot be created
if Output_FD = Invalid_FD then
Fail ("cannot create new """ & Path_Name (1 .. Path_Last) & '"');
end if;
if Project_File then
-- Output the project file
Prj.PP.Pretty_Print
(Project_Node,
W_Char => Write_A_Char'Access,
W_Eol => Write_Eol'Access,
W_Str => Write_A_String'Access);
Close (Output_FD);
-- Delete the naming project file if it already exists
Delete_File
(Project_Naming_File_Name (1 .. Project_Naming_Last),
Success => Discard);
-- Create a new one
if Opt.Verbose_Mode then
Output.Write_Str ("Creating new naming project file """);
Output.Write_Str (Project_Naming_File_Name
(1 .. Project_Naming_Last));
Output.Write_Line ("""");
end if;
Output_FD := Create_New_File
(Project_Naming_File_Name (1 .. Project_Naming_Last),
Fmode => Text);
-- Fails if naming project file cannot be created
if Output_FD = Invalid_FD then
Fail ("cannot create new """ &
Project_Naming_File_Name (1 .. Project_Naming_Last) &
'"');
end if;
-- Output the naming project file
Prj.PP.Pretty_Print
(Project_Naming_Node,
W_Char => Write_A_Char'Access,
W_Eol => Write_Eol'Access,
W_Str => Write_A_String'Access);
Close (Output_FD);
else
-- Write to the output file each entry in the SFN_Pragmas table
-- as an pragma Source_File_Name.
for Index in 1 .. SFN_Pragmas.Last loop
Write_A_String ("pragma Source_File_Name");
Write_Eol;
Write_A_String (" (");
Write_A_String (SFN_Pragmas.Table (Index).Unit.all);
Write_A_String (",");
Write_Eol;
if SFN_Pragmas.Table (Index).Spec then
Write_A_String (" Spec_File_Name => """);
else
Write_A_String (" Body_File_Name => """);
end if;
Write_A_String (SFN_Pragmas.Table (Index).File.all);
Write_A_String (""");");
Write_Eol;
end loop;
Close (Output_FD);
end if;
end;
end Make;
----------------
-- Write_Char --
----------------
procedure Write_A_Char (C : Character) is
begin
Write_A_String ((1 => C));
end Write_A_Char;
---------------
-- Write_Eol --
---------------
procedure Write_Eol is
begin
Write_A_String ((1 => ASCII.LF));
end Write_Eol;
--------------------
-- Write_A_String --
--------------------
procedure Write_A_String (S : String) is
Str : String (1 .. S'Length);
begin
if S'Length > 0 then
Str := S;
if Write (Output_FD, Str (1)'Address, Str'Length) /= Str'Length then
Fail ("disk full");
end if;
end if;
end Write_A_String;
end Prj.Makr;
gcc/ada/prj-makr.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- P R J . M A K R --
-- --
-- S p e c --
-- --
-- $Revision$
-- --
-- Copyright (C) 2001-2002 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 2, 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, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- Support for procedure Gnatname.
-- For arbitrary naming schemes, create or update a project file,
-- or create a configuration pragmas file.
with GNAT.OS_Lib; use GNAT.OS_Lib;
package Prj.Makr is
procedure Make
(File_Path : String;
Project_File : Boolean;
Directories : Argument_List;
Name_Patterns : Argument_List;
Excluded_Patterns : Argument_List;
Very_Verbose : Boolean);
-- Create a project file or a configuration pragmas file
--
-- Project_File is the path name of the project file. If the project
-- file already exists parse it and keep all the elements that are not
-- automatically generated.
--
-- Directory_List_File is the path name of a text file that
-- contains on each non empty line the path names of the source
-- directories for the project file. The source directories
-- are relative to the directory of the project file.
--
-- File_Name_Patterns is a GNAT.Regexp string pattern such as
-- ".*\.ads|.*\.adb" or any other pattern.
--
-- A project file (without any sources) is automatically generated
-- with the name <project>_naming. It contains a package Naming with
-- all the specs and bodies for the project.
-- A file containing the source file names is automatically
-- generated and used as the Source_File_List for the project file.
end Prj.Makr;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment