Skip to content

R
riscv-gcc-1
Commit 2c011ce1 by Robert Dewar Committed by Arnaud Charlet
Options

lib.adb, [...]: Minor reformatting and code reorganization. 

2009-07-13  Robert Dewar  <dewar@adacore.com>

	* lib.adb, prj-nmsc.adb, prj-proc.adb, prj-proc.ads, prj.adb,
	prj.ads: Minor reformatting and code reorganization.

	* par-ch3.adb (Check_Restricted_Expression): New procedure

From-SVN: r149566
parent db55a299
Showing with 140 additions and 91 deletions
gcc/ada/ChangeLog
2009-07-13 Robert Dewar <dewar@adacore.com>
* lib.adb, prj-nmsc.adb, prj-proc.adb, prj-proc.ads, prj.adb,
prj.ads: Minor reformatting and code reorganization.
* par-ch3.adb (Check_Restricted_Expression): New procedure
2009-07-13 Ed Schonberg <schonberg@adacore.com> 2009-07-13 Ed Schonberg <schonberg@adacore.com>
* exp_attr.adb (Rewrite_Stream_Proc_Call): When rewriting a stream * exp_attr.adb (Rewrite_Stream_Proc_Call): When rewriting a stream
......
gcc/ada/lib.adb
...@@ -605,13 +605,15 @@ package body Lib is ...@@ -605,13 +605,15 @@ package body Lib is
-- If not in the table, must be a spec created for a main unit that is a -- If not in the table, must be a spec created for a main unit that is a
-- child subprogram body which we have not inserted into the table yet. -- child subprogram body which we have not inserted into the table yet.
if N /= Library_Unit (Cunit (Main_Unit)) then if N = Library_Unit (Cunit (Main_Unit)) then
-- We do not use a pragma Assert here, since this would not be return Main_Unit;
-- enabled in case assertions are not active.
-- If it is anything else, something is seriously wrong, and we really
-- don't want to proceed, even if assertions are off, so we explicitly
-- raise an exception in this case to terminate compilation.
raise Program_Error;
else else
return Main_Unit; raise Program_Error;
end if; end if;
end Get_Cunit_Unit_Number; end Get_Cunit_Unit_Number;
......
gcc/ada/par-ch3.adb
...@@ -31,6 +31,10 @@ with Sinfo.CN; use Sinfo.CN; ...@@ -31,6 +31,10 @@ with Sinfo.CN; use Sinfo.CN;
separate (Par) separate (Par)
---------
-- Ch3 --
---------
package body Ch3 is package body Ch3 is
----------------------- -----------------------
...@@ -55,6 +59,24 @@ package body Ch3 is ...@@ -55,6 +59,24 @@ package body Ch3 is
function P_Variant return Node_Id; function P_Variant return Node_Id;
function P_Variant_Part return Node_Id; function P_Variant_Part return Node_Id;
procedure Check_Restricted_Expression (N : Node_Id);
-- Check that the expression N meets the Restricted_Expression syntax.
-- The syntax is as follows:
--
-- RESTRICTED_EXPRESSION ::=
-- RESTRICTED_RELATION {and RESTRICTED_RELATION}
-- | RESTRICTED_RELATION {and then RESTRICTED_RELATION}
-- | RESTRICTED_RELATION {or RESTRICTED_RELATION}
-- | RESTRICTED_RELATION {or else RESTRICTED_RELATION}
-- | RESTRICTED_RELATION {xor RESTRICTED_RELATION}
--
-- RESTRICTED_RELATION ::=
-- SIMPLE_EXPRESSION [RELATIONAL_OPERATOR SIMPLE_EXPRESSION]
--
-- This syntax is used for choices when extensions (and set notations)
-- are enabled, to remove the ambiguity of "when X in A | B". We consider
-- it very unlikely that this will ever arise in practice.
procedure P_Declarative_Items procedure P_Declarative_Items
(Decls : List_Id; (Decls : List_Id;
Done : out Boolean; Done : out Boolean;
...@@ -89,6 +111,27 @@ package body Ch3 is ...@@ -89,6 +111,27 @@ package body Ch3 is
-- current token, and if this is the first such message issued, saves -- current token, and if this is the first such message issued, saves
-- the message id in Missing_Begin_Msg, for possible later replacement. -- the message id in Missing_Begin_Msg, for possible later replacement.
---------------------------------
-- Check_Restricted_Expression --
---------------------------------
procedure Check_Restricted_Expression (N : Node_Id) is
begin
if Nkind_In (N, N_Op_And, N_Op_Or, N_Op_Xor, N_And_Then, N_Or_Else) then
Check_Restricted_Expression (Left_Opnd (N));
Check_Restricted_Expression (Right_Opnd (N));
elsif Nkind_In (N, N_In, N_Not_In)
and then Paren_Count (N) = 0
then
Error_Msg_N
("|this expression must be parenthesized!", N);
Error_Msg_N
("\|since extensions (and set notation) are allowed", N);
end if;
end Check_Restricted_Expression;
------------------- -------------------
-- Init_Expr_Opt -- -- Init_Expr_Opt --
------------------- -------------------
...@@ -3630,22 +3673,16 @@ package body Ch3 is ...@@ -3630,22 +3673,16 @@ package body Ch3 is
-- when (A in 1 .. 10 | 12) => -- when (A in 1 .. 10 | 12) =>
-- when (A in 1 .. 10) | 12 => -- when (A in 1 .. 10) | 12 =>
-- We consider it unlikely that reintroducing the Ada 83 -- To solve this, if extensins are enabled, we disallow
-- restriction will cause an upwards incompatibility issue. -- the use of membership operations in expressions in
-- Historically the only reason for the change in Ada 95 was -- choices. Technically in the grammar, the expression
-- for consistency (all cases of Simple_Expression in Ada 83 -- must match the grammar for restricted expression.
-- which could be changed to Expression without causing any
-- ambiguities were changed). if Extensions_Allowed then
Check_Restricted_Expression (Expr_Node);
if Extensions_Allowed and then Expr_Form = EF_Non_Simple then
Error_Msg_N
("|this expression must be parenthesized!",
Expr_Node);
Error_Msg_N
("\|since extensions (and set notation) are allowed",
Expr_Node);
-- In Ada 83 mode, the syntax required a simple expression -- In Ada 83 mode, the syntax required a simple expression
else else
Check_Simple_Expression_In_Ada_83 (Expr_Node); Check_Simple_Expression_In_Ada_83 (Expr_Node);
end if; end if;
......
gcc/ada/prj-nmsc.adb
...@@ -143,7 +143,7 @@ package body Prj.Nmsc is ...@@ -143,7 +143,7 @@ package body Prj.Nmsc is
Hash => Hash, Hash => Hash,
Equal => "="); Equal => "=");
-- Mapping from base file names to Source_Id (containing full info about -- Mapping from base file names to Source_Id (containing full info about
-- the source) -- the source).
type Tree_Processing_Data is record type Tree_Processing_Data is record
Tree : Project_Tree_Ref; Tree : Project_Tree_Ref;
...@@ -937,9 +937,8 @@ package body Prj.Nmsc is ...@@ -937,9 +937,8 @@ package body Prj.Nmsc is
-- are sources for which this is an alternate language. -- are sources for which this is an alternate language.
if Language.First_Source = No_Source if Language.First_Source = No_Source
and then and then (Data.Flags.Require_Sources_Other_Lang
(Data.Flags.Require_Sources_Other_Lang or else Language.Name = Name_Ada)
or else Language.Name = Name_Ada)
then then
Iter := For_Each_Source (In_Tree => Data.Tree, Iter := For_Each_Source (In_Tree => Data.Tree,
Project => Project); Project => Project);
...@@ -4315,12 +4314,11 @@ package body Prj.Nmsc is ...@@ -4315,12 +4314,11 @@ package body Prj.Nmsc is
and then not UData.File_Names (Impl).Locally_Removed and then not UData.File_Names (Impl).Locally_Removed
then then
if Check_Project if Check_Project
(UData.File_Names (Impl).Project, (UData.File_Names (Impl).Project,
Project, Extending) Project, Extending)
then then
-- There is a body for this unit. If there is -- There is a body for this unit. If there is no
-- no spec, we need to check that it is not a -- spec, we need to check that it is not a subunit.
-- subunit.
if UData.File_Names (Spec) = null then if UData.File_Names (Spec) = null then
declare declare
...@@ -4333,7 +4331,7 @@ package body Prj.Nmsc is ...@@ -4333,7 +4331,7 @@ package body Prj.Nmsc is
(Impl).Path.Name)); (Impl).Path.Name));
if Sinput.P.Source_File_Is_Subunit if Sinput.P.Source_File_Is_Subunit
(Src_Ind) (Src_Ind)
then then
Error_Msg Error_Msg
(Project, (Project,
...@@ -4347,11 +4345,10 @@ package body Prj.Nmsc is ...@@ -4347,11 +4345,10 @@ package body Prj.Nmsc is
end; end;
end if; end if;
-- The unit is not a subunit, so we add the -- The unit is not a subunit, so we add the ALI
-- ALI file for its body to the Interface ALIs. -- file for its body to the Interface ALIs.
Add_ALI_For Add_ALI_For (UData.File_Names (Impl).File);
(UData.File_Names (Impl).File);
else else
Error_Msg Error_Msg
...@@ -4365,16 +4362,15 @@ package body Prj.Nmsc is ...@@ -4365,16 +4362,15 @@ package body Prj.Nmsc is
and then UData.File_Names (Spec) /= null and then UData.File_Names (Spec) /= null
and then not UData.File_Names (Spec).Locally_Removed and then not UData.File_Names (Spec).Locally_Removed
and then Check_Project and then Check_Project
(UData.File_Names (Spec).Project, (UData.File_Names (Spec).Project,
Project, Extending) Project, Extending)
then then
-- The unit is part of the project, it has a spec, -- The unit is part of the project, it has a spec,
-- but no body. We add the ALI for its spec to the -- but no body. We add the ALI for its spec to the
-- Interface ALIs. -- Interface ALIs.
Add_ALI_For Add_ALI_For (UData.File_Names (Spec).File);
(UData.File_Names (Spec).File);
else else
Error_Msg Error_Msg
...@@ -4391,7 +4387,7 @@ package body Prj.Nmsc is ...@@ -4391,7 +4387,7 @@ package body Prj.Nmsc is
while Prj.Element (Iter) /= No_Source while Prj.Element (Iter) /= No_Source
and then and then
(Prj.Element (Iter).Unit = null (Prj.Element (Iter).Unit = null
or else Prj.Element (Iter).Unit.Name /= Unit) or else Prj.Element (Iter).Unit.Name /= Unit)
loop loop
Next (Iter); Next (Iter);
end loop; end loop;
...@@ -4407,7 +4403,6 @@ package body Prj.Nmsc is ...@@ -4407,7 +4403,6 @@ package body Prj.Nmsc is
if Source /= No_Source then if Source /= No_Source then
if Source.Kind = Sep then if Source.Kind = Sep then
Source := No_Source; Source := No_Source;
elsif Source.Kind = Spec elsif Source.Kind = Spec
and then Other_Part (Source) /= No_Source and then Other_Part (Source) /= No_Source
then then
...@@ -4437,6 +4432,8 @@ package body Prj.Nmsc is ...@@ -4437,6 +4432,8 @@ package body Prj.Nmsc is
Source := Other_Part (Source); Source := Other_Part (Source);
end if; end if;
-- Can't we use Append here???
String_Element_Table.Increment_Last String_Element_Table.Increment_Last
(Data.Tree.String_Elements); (Data.Tree.String_Elements);
...@@ -4456,13 +4453,10 @@ package body Prj.Nmsc is ...@@ -4456,13 +4453,10 @@ package body Prj.Nmsc is
String_Element_Table.Last String_Element_Table.Last
(Data.Tree.String_Elements); (Data.Tree.String_Elements);
end if; end if;
end if; end if;
end if; end if;
Interfaces := Interfaces := Data.Tree.String_Elements.Table (Interfaces).Next;
Data.Tree.String_Elements.Table (Interfaces).Next;
end loop; end loop;
-- Put the list of Interface ALIs in the project data -- Put the list of Interface ALIs in the project data
...@@ -4575,7 +4569,7 @@ package body Prj.Nmsc is ...@@ -4575,7 +4569,7 @@ package body Prj.Nmsc is
-- Report error if it is one of the source directories -- Report error if it is one of the source directories
if Project.Library_Src_Dir.Name = if Project.Library_Src_Dir.Name =
Path_Name_Type (Src_Dir.Value) Path_Name_Type (Src_Dir.Value)
then then
Error_Msg Error_Msg
(Project, (Project,
...@@ -4604,7 +4598,7 @@ package body Prj.Nmsc is ...@@ -4604,7 +4598,7 @@ package body Prj.Nmsc is
Data.Tree.String_Elements.Table (Src_Dirs); Data.Tree.String_Elements.Table (Src_Dirs);
-- Report error if it is one of the source -- Report error if it is one of the source
-- directories -- directories.
if Project.Library_Src_Dir.Name = if Project.Library_Src_Dir.Name =
Path_Name_Type (Src_Dir.Value) Path_Name_Type (Src_Dir.Value)
...@@ -4852,7 +4846,8 @@ package body Prj.Nmsc is ...@@ -4852,7 +4846,8 @@ package body Prj.Nmsc is
begin begin
if Dir'Length > 1 if Dir'Length > 1
and then (Dir (Dir'Last - 1) = Directory_Separator and then (Dir (Dir'Last - 1) = Directory_Separator
or else Dir (Dir'Last - 1) = '/') or else
Dir (Dir'Last - 1) = '/')
then then
return Dir'Last - 1; return Dir'Last - 1;
else else
...@@ -5120,8 +5115,8 @@ package body Prj.Nmsc is ...@@ -5120,8 +5115,8 @@ package body Prj.Nmsc is
The_Path : constant String := The_Path : constant String :=
Normalize_Pathname Normalize_Pathname
(Get_Name_String (Path), (Get_Name_String (Path),
Directory => Get_Name_String Directory =>
(Project.Directory.Display_Name), Get_Name_String (Project.Directory.Display_Name),
Resolve_Links => Opt.Follow_Links_For_Dirs) & Resolve_Links => Opt.Follow_Links_For_Dirs) &
Directory_Separator; Directory_Separator;
...@@ -6746,7 +6741,8 @@ package body Prj.Nmsc is ...@@ -6746,7 +6741,8 @@ package body Prj.Nmsc is
procedure Initialize procedure Initialize
(Data : out Tree_Processing_Data; (Data : out Tree_Processing_Data;
Tree : Project_Tree_Ref; Tree : Project_Tree_Ref;
Flags : Prj.Processing_Flags) is Flags : Prj.Processing_Flags)
is
begin begin
Files_Htable.Reset (Data.File_To_Source); Files_Htable.Reset (Data.File_To_Source);
Data.Tree := Tree; Data.Tree := Tree;
...@@ -6768,7 +6764,8 @@ package body Prj.Nmsc is ...@@ -6768,7 +6764,8 @@ package body Prj.Nmsc is
procedure Initialize procedure Initialize
(Data : in out Project_Processing_Data; (Data : in out Project_Processing_Data;
Project : Project_Id) is Project : Project_Id)
is
begin begin
Data.Project := Project; Data.Project := Project;
end Initialize; end Initialize;
...@@ -7473,8 +7470,9 @@ package body Prj.Nmsc is ...@@ -7473,8 +7470,9 @@ package body Prj.Nmsc is
else else
-- Check if it is a subunit -- Check if it is a subunit
Src_Ind := Sinput.P.Load_Project_File Src_Ind :=
(Get_Name_String (Src_Id.Path.Name)); Sinput.P.Load_Project_File
(Get_Name_String (Src_Id.Path.Name));
if Sinput.P.Source_File_Is_Subunit (Src_Ind) then if Sinput.P.Source_File_Is_Subunit (Src_Ind) then
Override_Kind (Src_Id, Sep); Override_Kind (Src_Id, Sep);
...@@ -7661,7 +7659,8 @@ package body Prj.Nmsc is ...@@ -7661,7 +7659,8 @@ package body Prj.Nmsc is
procedure Recursive_Check procedure Recursive_Check
(Project : Project_Id; (Project : Project_Id;
Data : in out Tree_Processing_Data) is Data : in out Tree_Processing_Data)
is
begin begin
if Verbose_Mode then if Verbose_Mode then
Write_Str ("Processing_Naming_Scheme for project """); Write_Str ("Processing_Naming_Scheme for project """);
...@@ -7676,6 +7675,8 @@ package body Prj.Nmsc is ...@@ -7676,6 +7675,8 @@ package body Prj.Nmsc is
For_Every_Project_Imported (Tree_Processing_Data, Recursive_Check); For_Every_Project_Imported (Tree_Processing_Data, Recursive_Check);
Data : Tree_Processing_Data; Data : Tree_Processing_Data;
-- Start of processing for Process_Naming_Scheme
begin begin
Initialize (Data, Tree => Tree, Flags => Flags); Initialize (Data, Tree => Tree, Flags => Flags);
Check_All_Projects (Root_Project, Data, Imported_First => True); Check_All_Projects (Root_Project, Data, Imported_First => True);
......
gcc/ada/prj-proc.adb
...@@ -77,9 +77,9 @@ package body Prj.Proc is ...@@ -77,9 +77,9 @@ package body Prj.Proc is
-- the package or project with declarations Decl. -- the package or project with declarations Decl.
procedure Check procedure Check
(In_Tree : Project_Tree_Ref; (In_Tree : Project_Tree_Ref;
Project : Project_Id; Project : Project_Id;
Flags : Processing_Flags); Flags : Processing_Flags);
-- Set all projects to not checked, then call Recursive_Check for the -- Set all projects to not checked, then call Recursive_Check for the
-- main project Project. Project is set to No_Project if errors occurred. -- main project Project. Project is set to No_Project if errors occurred.
-- Current_Dir is for optimization purposes, avoiding extra system calls. -- Current_Dir is for optimization purposes, avoiding extra system calls.
...@@ -264,9 +264,9 @@ package body Prj.Proc is ...@@ -264,9 +264,9 @@ package body Prj.Proc is
----------- -----------
procedure Check procedure Check
(In_Tree : Project_Tree_Ref; (In_Tree : Project_Tree_Ref;
Project : Project_Id; Project : Project_Id;
Flags : Processing_Flags) Flags : Processing_Flags)
is is
begin begin
Process_Naming_Scheme (In_Tree, Project, Flags); Process_Naming_Scheme (In_Tree, Project, Flags);
...@@ -293,7 +293,6 @@ package body Prj.Proc is ...@@ -293,7 +293,6 @@ package body Prj.Proc is
if Source2 = No_Source then if Source2 = No_Source then
Unit_Htable.Set (K => Name, E => Source1); Unit_Htable.Set (K => Name, E => Source1);
else else
Unit_Htable.Remove (Name); Unit_Htable.Remove (Name);
end if; end if;
...@@ -355,7 +354,6 @@ package body Prj.Proc is ...@@ -355,7 +354,6 @@ package body Prj.Proc is
if To.Attributes = No_Variable then if To.Attributes = No_Variable then
To.Attributes := To.Attributes :=
Variable_Element_Table.Last (In_Tree.Variable_Elements); Variable_Element_Table.Last (In_Tree.Variable_Elements);
else else
In_Tree.Variable_Elements.Table (V2).Next := In_Tree.Variable_Elements.Table (V2).Next :=
Variable_Element_Table.Last (In_Tree.Variable_Elements); Variable_Element_Table.Last (In_Tree.Variable_Elements);
...@@ -388,7 +386,6 @@ package body Prj.Proc is ...@@ -388,7 +386,6 @@ package body Prj.Proc is
if To.Arrays = No_Array then if To.Arrays = No_Array then
To.Arrays := Array_Table.Last (In_Tree.Arrays); To.Arrays := Array_Table.Last (In_Tree.Arrays);
else else
In_Tree.Arrays.Table (A2).Next := In_Tree.Arrays.Table (A2).Next :=
Array_Table.Last (In_Tree.Arrays); Array_Table.Last (In_Tree.Arrays);
...@@ -453,7 +450,7 @@ package body Prj.Proc is ...@@ -453,7 +450,7 @@ package body Prj.Proc is
First_Term : Project_Node_Id; First_Term : Project_Node_Id;
Kind : Variable_Kind) return Variable_Value Kind : Variable_Kind) return Variable_Value
is is
The_Term : Project_Node_Id := First_Term; The_Term : Project_Node_Id;
-- The term in the expression list -- The term in the expression list
The_Current_Term : Project_Node_Id := Empty_Node; The_Current_Term : Project_Node_Id := Empty_Node;
...@@ -471,6 +468,7 @@ package body Prj.Proc is ...@@ -471,6 +468,7 @@ package body Prj.Proc is
-- Process each term of the expression, starting with First_Term -- Process each term of the expression, starting with First_Term
The_Term := First_Term;
while Present (The_Term) loop while Present (The_Term) loop
The_Current_Term := Current_Term (The_Term, From_Project_Node_Tree); The_Current_Term := Current_Term (The_Term, From_Project_Node_Tree);
...@@ -1219,12 +1217,12 @@ package body Prj.Proc is ...@@ -1219,12 +1217,12 @@ package body Prj.Proc is
Configuration Configuration
then then
Process_Project_Tree_Phase_2 Process_Project_Tree_Phase_2
(In_Tree => In_Tree, (In_Tree => In_Tree,
Project => Project, Project => Project,
Success => Success, Success => Success,
From_Project_Node => From_Project_Node, From_Project_Node => From_Project_Node,
From_Project_Node_Tree => From_Project_Node_Tree, From_Project_Node_Tree => From_Project_Node_Tree,
Flags => Flags); Flags => Flags);
end if; end if;
end Process; end Process;
...@@ -2273,12 +2271,12 @@ package body Prj.Proc is ...@@ -2273,12 +2271,12 @@ package body Prj.Proc is
---------------------------------- ----------------------------------
procedure Process_Project_Tree_Phase_2 procedure Process_Project_Tree_Phase_2
(In_Tree : Project_Tree_Ref; (In_Tree : Project_Tree_Ref;
Project : Project_Id; Project : Project_Id;
Success : out Boolean; Success : out Boolean;
From_Project_Node : Project_Node_Id; From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref; From_Project_Node_Tree : Project_Node_Tree_Ref;
Flags : Processing_Flags) Flags : Processing_Flags)
is is
Obj_Dir : Path_Name_Type; Obj_Dir : Path_Name_Type;
Extending : Project_Id; Extending : Project_Id;
......
gcc/ada/prj-proc.ads
...@@ -52,12 +52,12 @@ package Prj.Proc is ...@@ -52,12 +52,12 @@ package Prj.Proc is
-- project table before processing. -- project table before processing.
procedure Process_Project_Tree_Phase_2 procedure Process_Project_Tree_Phase_2
(In_Tree : Project_Tree_Ref; (In_Tree : Project_Tree_Ref;
Project : Project_Id; Project : Project_Id;
Success : out Boolean; Success : out Boolean;
From_Project_Node : Project_Node_Id; From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref; From_Project_Node_Tree : Project_Node_Tree_Ref;
Flags : Processing_Flags); Flags : Processing_Flags);
-- Perform the second phase of the processing, filling the rest of the -- Perform the second phase of the processing, filling the rest of the
-- project with the information extracted from the project tree. This phase -- project with the information extracted from the project tree. This phase
-- requires that the configuration file has already been parsed (in fact -- requires that the configuration file has already been parsed (in fact
......
gcc/ada/prj.adb
...@@ -1229,8 +1229,8 @@ package body Prj is ...@@ -1229,8 +1229,8 @@ package body Prj is
Require_Sources_Other_Lang : Boolean := True; Require_Sources_Other_Lang : Boolean := True;
Allow_Duplicate_Basenames : Boolean := True; Allow_Duplicate_Basenames : Boolean := True;
Compiler_Driver_Mandatory : Boolean := False; Compiler_Driver_Mandatory : Boolean := False;
Error_On_Unknown_Language : Boolean := True) Error_On_Unknown_Language : Boolean := True) return Processing_Flags
return Processing_Flags is is
begin begin
return Processing_Flags' return Processing_Flags'
(Report_Error => Report_Error, (Report_Error => Report_Error,
......
gcc/ada/prj.ads
...@@ -1343,10 +1343,9 @@ package Prj is ...@@ -1343,10 +1343,9 @@ package Prj is
-- project file tree. Initialize must be called before the call to Reset. -- project file tree. Initialize must be called before the call to Reset.
type Processing_Flags is private; type Processing_Flags is private;
-- Flags used while parsing and processing a project tree. -- Flags used while parsing and processing a project tree to configure the
-- These configure various behavior in the parser, as well as indicate how -- behavior of the parser, and indicate how to report error messages. This
-- to report error messages. -- structure does not allocate memory and never needs to be freed
-- This structure does not allocate memory and never needs to be freed
function Create_Flags function Create_Flags
(Report_Error : Put_Line_Access; (Report_Error : Put_Line_Access;
...@@ -1354,29 +1353,34 @@ package Prj is ...@@ -1354,29 +1353,34 @@ package Prj is
Require_Sources_Other_Lang : Boolean := True; Require_Sources_Other_Lang : Boolean := True;
Allow_Duplicate_Basenames : Boolean := True; Allow_Duplicate_Basenames : Boolean := True;
Compiler_Driver_Mandatory : Boolean := False; Compiler_Driver_Mandatory : Boolean := False;
Error_On_Unknown_Language : Boolean := True) Error_On_Unknown_Language : Boolean := True) return Processing_Flags;
return Processing_Flags; -- Function used to create Processing_Flags structure
--
-- If Allow_Duplicate_Basenames, then files with the same base names are -- If Allow_Duplicate_Basenames, then files with the same base names are
-- authorized within a project for source-based languages (never for unit -- authorized within a project for source-based languages (never for unit
-- based languages) -- based languages).
--
-- If Compiler_Driver_Mandatory is true, then a Compiler.Driver attribute -- If Compiler_Driver_Mandatory is true, then a Compiler.Driver attribute
-- for each language must be defined, or we will not look for its source -- for each language must be defined, or we will not look for its source
-- files. -- files.
--
-- When_No_Sources indicates what should be done when no sources of a -- When_No_Sources indicates what should be done when no sources of a
-- language are found in a project where this language is declared. -- language are found in a project where this language is declared.
-- If Require_Sources_Other_Lang is true, then all languages must have at -- If Require_Sources_Other_Lang is true, then all languages must have at
-- least one source file, or an error is reported via When_No_Sources. If -- least one source file, or an error is reported via When_No_Sources. If
-- it is false, this is only required for Ada (and only if it is a language -- it is false, this is only required for Ada (and only if it is a language
-- of the project). -- of the project).
--
-- If Report_Error is null, use the standard error reporting mechanism -- If Report_Error is null, use the standard error reporting mechanism
-- (Errout). Otherwise, report errors using Report_Error. -- (Errout). Otherwise, report errors using Report_Error.
--
-- If Error_On_Unknown_Language is true, an error is displayed if some of -- If Error_On_Unknown_Language is true, an error is displayed if some of
-- the source files listed in the project do not match any naming scheme -- the source files listed in the project do not match any naming scheme
Gprbuild_Flags : constant Processing_Flags; Gprbuild_Flags : constant Processing_Flags;
Gnatmake_Flags : constant Processing_Flags; Gnatmake_Flags : constant Processing_Flags;
-- Flags used by the various tools. They all display the error messages -- Flags used by the various tools. They all display the error messages
-- through Prj.Err -- through Prj.Err.
package Project_Boolean_Htable is new Simple_HTable package Project_Boolean_Htable is new Simple_HTable
(Header_Num => Header_Num, (Header_Num => Header_Num,
......
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