diff options
Diffstat (limited to 'gcc/ada')
| -rw-r--r-- | gcc/ada/ChangeLog | 7 | ||||
| -rw-r--r-- | gcc/ada/lib.adb | 12 | ||||
| -rw-r--r-- | gcc/ada/par-ch3.adb | 65 | ||||
| -rw-r--r-- | gcc/ada/prj-nmsc.adb | 69 | ||||
| -rw-r--r-- | gcc/ada/prj-proc.adb | 42 | ||||
| -rw-r--r-- | gcc/ada/prj-proc.ads | 12 | ||||
| -rw-r--r-- | gcc/ada/prj.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/prj.ads | 20 |
8 files changed, 140 insertions, 91 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 03680cca..c71282e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +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 diff --git a/gcc/ada/lib.adb b/gcc/ada/lib.adb index 802506b..63dd620 100644 --- a/gcc/ada/lib.adb +++ b/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; diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb index 820cb55..1b26833 100644 --- a/gcc/ada/par-ch3.adb +++ b/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; diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index 2609dff..3940e6c 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/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); diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb index dbf6441..7c553af 100644 --- a/gcc/ada/prj-proc.adb +++ b/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; diff --git a/gcc/ada/prj-proc.ads b/gcc/ada/prj-proc.ads index 4231b4e..40b5bf3 100644 --- a/gcc/ada/prj-proc.ads +++ b/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 diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb index 3f5feed..45effae 100644 --- a/gcc/ada/prj.adb +++ b/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, diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index 72193ca..47851fb 100644 --- a/gcc/ada/prj.ads +++ b/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, |