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