From 3479844114fb9da80145e748af1ba33c93127f6d Mon Sep 17 00:00:00 2001 From: Emmanuel Briot Date: Wed, 3 Aug 2011 09:38:56 +0000 Subject: [PATCH] prj-proc.adb, [...] (Get_Attribute_Index): do not systematically lower case attribute indexes that contain no "." Fix... 2011-08-03 Emmanuel Briot * prj-proc.adb, prj-attr.adb, prj-attr.ads (Get_Attribute_Index): do not systematically lower case attribute indexes that contain no "." Fix definition of several Naming attributes, which take a unit name as index and therefore should be case insensitive. Minor refactoring (reduce length of variable names). 2011-08-03 Emmanuel Briot * makeutl.adb, makeutl.ads (Get_Switches): new subprogram. From-SVN: r177250 --- gcc/ada/ChangeLog | 12 ++++ gcc/ada/makeutl.adb | 86 ++++++++++++++++++++++++++++ gcc/ada/makeutl.ads | 22 +++++++ gcc/ada/prj-attr.adb | 10 ++-- gcc/ada/prj-attr.ads | 17 +++++- gcc/ada/prj-proc.adb | 158 ++++++++++++++++++++------------------------------- 6 files changed, 203 insertions(+), 102 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 4287e95..587e390 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,17 @@ 2011-08-03 Emmanuel Briot + * prj-proc.adb, prj-attr.adb, prj-attr.ads (Get_Attribute_Index): do + not systematically lower case attribute indexes that contain no "." + Fix definition of several Naming attributes, which take + a unit name as index and therefore should be case insensitive. + Minor refactoring (reduce length of variable names). + +2011-08-03 Emmanuel Briot + + * makeutl.adb, makeutl.ads (Get_Switches): new subprogram. + +2011-08-03 Emmanuel Briot + * gnatcmd.adb, prj-proc.adb, prj-proc.ads, make.adb, prj-part.adb, prj-part.ads, switch-m.adb, switch-m.ads, prj-makr.adb, clean.adb, prj-pars.adb, prj-pars.ads, prj-conf.adb, prj-conf.ads, prj-tree.adb, diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb index 5f677ea..6127833 100644 --- a/gcc/ada/makeutl.adb +++ b/gcc/ada/makeutl.adb @@ -652,6 +652,92 @@ package body Makeutl is return False; end File_Not_A_Source_Of; + ------------------ + -- Get_Switches -- + ------------------ + + procedure Get_Switches + (Source : Prj.Source_Id; + Pkg_Name : Name_Id; + Project_Tree : Project_Tree_Ref; + Value : out Variable_Value; + Is_Default : out Boolean) + is + begin + Get_Switches + (Source_File => Source.File, + Source_Lang => Source.Language.Name, + Source_Prj => Source.Project, + Pkg_Name => Pkg_Name, + Project_Tree => Project_Tree, + Value => Value, + Is_Default => Is_Default); + end Get_Switches; + + ------------------ + -- Get_Switches -- + ------------------ + + procedure Get_Switches + (Source_File : File_Name_Type; + Source_Lang : Name_Id; + Source_Prj : Project_Id; + Pkg_Name : Name_Id; + Project_Tree : Project_Tree_Ref; + Value : out Variable_Value; + Is_Default : out Boolean) + is + Project : constant Project_Id := + Ultimate_Extending_Project_Of (Source_Prj); + Pkg : constant Package_Id := + Prj.Util.Value_Of + (Name => Pkg_Name, + In_Packages => Project.Decl.Packages, + In_Tree => Project_Tree); + begin + Is_Default := False; + + if Source_File /= No_File then + Value := Prj.Util.Value_Of + (Name => Name_Id (Source_File), + Attribute_Or_Array_Name => Name_Switches, + In_Package => Pkg, + In_Tree => Project_Tree, + Allow_Wildcards => True); + end if; + + if Value = Nil_Variable_Value then + Is_Default := True; + Is_Default := True; + Value := + Prj.Util.Value_Of + (Name => Source_Lang, + Attribute_Or_Array_Name => Name_Switches, + In_Package => Pkg, + In_Tree => Project_Tree, + Force_Lower_Case_Index => True); + end if; + + if Value = Nil_Variable_Value then + Value := + Prj.Util.Value_Of + (Name => All_Other_Names, + Attribute_Or_Array_Name => Name_Switches, + In_Package => Pkg, + In_Tree => Project_Tree, + Force_Lower_Case_Index => True); + end if; + + if Value = Nil_Variable_Value then + Value := + Prj.Util.Value_Of + (Name => Source_Lang, + Attribute_Or_Array_Name => Name_Default_Switches, + In_Package => Pkg, + In_Tree => Project_Tree); + end if; + end Get_Switches; + ---------- -- Hash -- ---------- diff --git a/gcc/ada/makeutl.ads b/gcc/ada/makeutl.ads index b1e5765..8e9e151 100644 --- a/gcc/ada/makeutl.ads +++ b/gcc/ada/makeutl.ads @@ -148,6 +148,28 @@ package Makeutl is -- is printed last. Both N1 and N2 are printed in quotation marks. The two -- forms differ only in taking Name_Id or File_name_Type arguments. + procedure Get_Switches + (Source : Source_Id; + Pkg_Name : Name_Id; + Project_Tree : Project_Tree_Ref; + Value : out Variable_Value; + Is_Default : out Boolean); + procedure Get_Switches + (Source_File : File_Name_Type; + Source_Lang : Name_Id; + Source_Prj : Project_Id; + Pkg_Name : Name_Id; + Project_Tree : Project_Tree_Ref; + Value : out Variable_Value; + Is_Default : out Boolean); + -- Compute the switches (Compilation switches for instance) for the given + -- file. This checks various attributes to see whether there are file + -- specific switches, or else defaults on the switches for the + -- corresponding language. + -- Is_Default is set to False if there were file-specific switches + -- Source_File can be set to No_File to force retrieval of the default + -- switches. + function Linker_Options_Switches (Project : Project_Id; In_Tree : Project_Tree_Ref) return String_List; diff --git a/gcc/ada/prj-attr.adb b/gcc/ada/prj-attr.adb index 6fb2c0a..d584f6c 100644 --- a/gcc/ada/prj-attr.adb +++ b/gcc/ada/prj-attr.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2011, 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- -- @@ -165,10 +165,10 @@ package body Prj.Attr is "SVseparate_suffix#" & "SVcasing#" & "SVdot_replacement#" & - "sAspecification#" & -- Always renamed to "spec" in project tree - "sAspec#" & - "sAimplementation#" & -- Always renamed to "body" in project tree - "sAbody#" & + "saspecification#" & -- Always renamed to "spec" in project tree + "saspec#" & + "saimplementation#" & -- Always renamed to "body" in project tree + "sabody#" & "Laspecification_exceptions#" & "Laimplementation_exceptions#" & diff --git a/gcc/ada/prj-attr.ads b/gcc/ada/prj-attr.ads index a16e6f3..b171719 100644 --- a/gcc/ada/prj-attr.ads +++ b/gcc/ada/prj-attr.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2011, 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- -- @@ -152,6 +152,21 @@ package Prj.Attr is (Attribute : Attribute_Node_Id) return Attribute_Kind; -- Returns the attribute kind of a known attribute. Returns Unknown if -- Attribute is Empty_Attribute. + -- + -- To use this function, the following code should be used: + -- Pkg : constant Package_Node_Id := + -- Prj.Attr.Package_Node_Id_Of (Name => ); + -- Att : constant Attribute_Node_Id := + -- Prj.Attr.Attribute_Node_Id_Of + -- (Name => , + -- Starting_At => First_Attribute_Of (Pkg)); + -- Kind : constant Attribute_Kind := Attribute_Kind_Of (Att); + -- + -- However, you should not use this function once you have an already + -- parsed project tree. Instead, given a Project_Node_Id corresponding to + -- the attribute declaration ("for Attr (index) use ..."), it is simpler to + -- use + -- if Case_Insensitive (Attr, Tree) then ... procedure Set_Attribute_Kind_Of (Attribute : Attribute_Node_Id; diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb index 6dd3ca7..be3a0a7 100644 --- a/gcc/ada/prj-proc.adb +++ b/gcc/ada/prj-proc.adb @@ -458,41 +458,19 @@ package body Prj.Proc is ------------------------- function Get_Attribute_Index - (Tree : Project_Node_Tree_Ref; - Attr : Project_Node_Id; - Index : Name_Id) return Name_Id - is - Lower : Boolean; - + (Tree : Project_Node_Tree_Ref; + Attr : Project_Node_Id; + Index : Name_Id) return Name_Id is begin - if Index = All_Other_Names then + if Index = All_Other_Names + or else not Case_Insensitive (Attr, Tree) + then return Index; end if; Get_Name_String (Index); - Lower := Case_Insensitive (Attr, Tree); - - -- The index is always case insensitive if it does not include any dot. - -- ??? Why not use the properties from prj-attr, simply, maybe because - -- we don't know whether we have a file as an index? - - if not Lower then - Lower := True; - - for J in 1 .. Name_Len loop - if Name_Buffer (J) = '.' then - Lower := False; - exit; - end if; - end loop; - end if; - - if Lower then - To_Lower (Name_Buffer (1 .. Name_Len)); - return Name_Find; - else - return Index; - end if; + To_Lower (Name_Buffer (1 .. Name_Len)); + return Name_Find; end Get_Attribute_Index; ---------------- @@ -1440,7 +1418,7 @@ package body Prj.Proc is procedure Process_Expression (Current : Project_Node_Id); procedure Process_Expression_For_Associative_Array - (Current_Item : Project_Node_Id; + (Current : Project_Node_Id; New_Value : Variable_Value); procedure Process_Expression_Variable_Decl (Current_Item : Project_Node_Id; @@ -1869,29 +1847,25 @@ package body Prj.Proc is ---------------------------------------------- procedure Process_Expression_For_Associative_Array - (Current_Item : Project_Node_Id; - New_Value : Variable_Value) + (Current : Project_Node_Id; + New_Value : Variable_Value) is - Current_Item_Name : constant Name_Id := - Name_Of (Current_Item, Node_Tree); + Name : constant Name_Id := Name_Of (Current, Node_Tree); Current_Location : constant Source_Ptr := - Location_Of (Current_Item, Node_Tree); + Location_Of (Current, Node_Tree); Index_Name : Name_Id := - Associative_Array_Index_Of (Current_Item, Node_Tree); + Associative_Array_Index_Of (Current, Node_Tree); Source_Index : constant Int := - Source_Index_Of (Current_Item, Node_Tree); + Source_Index_Of (Current, Node_Tree); - The_Array : Array_Id; - The_Array_Element : Array_Element_Id := No_Array_Element; + The_Array : Array_Id; + Elem : Array_Element_Id := No_Array_Element; begin if Index_Name /= All_Other_Names then - Index_Name := Get_Attribute_Index - (Node_Tree, - Current_Item, - Associative_Array_Index_Of (Current_Item, Node_Tree)); + Index_Name := Get_Attribute_Index (Node_Tree, Current, Index_Name); end if; -- Look for the array in the appropriate list @@ -1903,7 +1877,7 @@ package body Prj.Proc is end if; while The_Array /= No_Array - and then In_Tree.Arrays.Table (The_Array).Name /= Current_Item_Name + and then In_Tree.Arrays.Table (The_Array).Name /= Name loop The_Array := In_Tree.Arrays.Table (The_Array).Next; end loop; @@ -1919,7 +1893,7 @@ package body Prj.Proc is if Pkg /= No_Package then In_Tree.Arrays.Table (The_Array) := - (Name => Current_Item_Name, + (Name => Name, Location => Current_Location, Value => No_Array_Element, Next => In_Tree.Packages.Table (Pkg).Decl.Arrays); @@ -1928,7 +1902,7 @@ package body Prj.Proc is else In_Tree.Arrays.Table (The_Array) := - (Name => Current_Item_Name, + (Name => Name, Location => Current_Location, Value => No_Array_Element, Next => Project.Decl.Arrays); @@ -1936,54 +1910,52 @@ package body Prj.Proc is Project.Decl.Arrays := The_Array; end if; - -- Otherwise initialize The_Array_Element as the - -- head of the element list. - else - The_Array_Element := In_Tree.Arrays.Table (The_Array).Value; + Elem := In_Tree.Arrays.Table (The_Array).Value; end if; -- Look in the list, if any, to find an element -- with the same index and same source index. - while The_Array_Element /= No_Array_Element + while Elem /= No_Array_Element and then - (In_Tree.Array_Elements.Table (The_Array_Element).Index /= - Index_Name + (In_Tree.Array_Elements.Table (Elem).Index /= Index_Name or else - In_Tree.Array_Elements.Table (The_Array_Element).Src_Index /= - Source_Index) + In_Tree.Array_Elements.Table (Elem).Src_Index /= Source_Index) loop - The_Array_Element := - In_Tree.Array_Elements.Table (The_Array_Element).Next; + Elem := In_Tree.Array_Elements.Table (Elem).Next; end loop; -- If no such element were found, create a new one -- and insert it in the element list, with the -- proper value. - if The_Array_Element = No_Array_Element then + if Elem = No_Array_Element then Array_Element_Table.Increment_Last (In_Tree.Array_Elements); - The_Array_Element := - Array_Element_Table.Last (In_Tree.Array_Elements); + Elem := Array_Element_Table.Last (In_Tree.Array_Elements); In_Tree.Array_Elements.Table - (The_Array_Element) := + (Elem) := (Index => Index_Name, Src_Index => Source_Index, Index_Case_Sensitive => - not Case_Insensitive (Current_Item, Node_Tree), + not Case_Insensitive (Current, Node_Tree), Value => New_Value, Next => In_Tree.Arrays.Table (The_Array).Value); - In_Tree.Arrays.Table (The_Array).Value := The_Array_Element; + In_Tree.Arrays.Table (The_Array).Value := Elem; + else -- An element with the same index already exists, -- just replace its value with the new one. - else - In_Tree.Array_Elements.Table (The_Array_Element).Value := - New_Value; + In_Tree.Array_Elements.Table (Elem).Value := New_Value; + end if; + + if Name = Snames.Name_External then + Debug_Output + ("Defined external value (" + & Get_Name_String (Index_Name) & ")", New_Value.Value); end if; end Process_Expression_For_Associative_Array; @@ -1995,80 +1967,74 @@ package body Prj.Proc is (Current_Item : Project_Node_Id; New_Value : Variable_Value) is - Current_Item_Name : constant Name_Id := - Name_Of (Current_Item, Node_Tree); - The_Variable : Variable_Id := No_Variable; + Name : constant Name_Id := Name_Of (Current_Item, Node_Tree); + Var : Variable_Id := No_Variable; + Is_Attribute : constant Boolean := + Kind_Of (Current_Item, Node_Tree) = N_Attribute_Declaration; begin -- First, find the list where to find the variable or attribute. - if Kind_Of (Current_Item, Node_Tree) = - N_Attribute_Declaration - then + if Is_Attribute then if Pkg /= No_Package then - The_Variable := In_Tree.Packages.Table (Pkg).Decl.Attributes; + Var := In_Tree.Packages.Table (Pkg).Decl.Attributes; else - The_Variable := Project.Decl.Attributes; + Var := Project.Decl.Attributes; end if; else if Pkg /= No_Package then - The_Variable := In_Tree.Packages.Table (Pkg).Decl.Variables; + Var := In_Tree.Packages.Table (Pkg).Decl.Variables; else - The_Variable := Project.Decl.Variables; + Var := Project.Decl.Variables; end if; end if; -- Loop through the list, to find if it has already been declared. - while The_Variable /= No_Variable - and then In_Tree.Variable_Elements.Table (The_Variable).Name /= - Current_Item_Name + while Var /= No_Variable + and then In_Tree.Variable_Elements.Table (Var).Name /= Name loop - The_Variable := - In_Tree.Variable_Elements.Table (The_Variable).Next; + Var := In_Tree.Variable_Elements.Table (Var).Next; end loop; -- If it has not been declared, create a new entry -- in the list. - if The_Variable = No_Variable then + if Var = No_Variable then -- All single string attribute should already have -- been declared with a default empty string value. pragma Assert - (Kind_Of (Current_Item, Node_Tree) /= - N_Attribute_Declaration, - "illegal attribute declaration for " - & Get_Name_String (Current_Item_Name)); + (not Is_Attribute, + "illegal attribute declaration for " & Get_Name_String (Name)); Variable_Element_Table.Increment_Last (In_Tree.Variable_Elements); - The_Variable := Variable_Element_Table.Last - (In_Tree.Variable_Elements); + Var := Variable_Element_Table.Last (In_Tree.Variable_Elements); -- Put the new variable in the appropriate list if Pkg /= No_Package then - In_Tree.Variable_Elements.Table (The_Variable) := + In_Tree.Variable_Elements.Table (Var) := (Next => In_Tree.Packages.Table (Pkg).Decl.Variables, - Name => Current_Item_Name, + Name => Name, Value => New_Value); - In_Tree.Packages.Table (Pkg).Decl.Variables := The_Variable; + In_Tree.Packages.Table (Pkg).Decl.Variables := Var; else - In_Tree.Variable_Elements.Table (The_Variable) := + In_Tree.Variable_Elements.Table (Var) := (Next => Project.Decl.Variables, - Name => Current_Item_Name, + Name => Name, Value => New_Value); - Project.Decl.Variables := The_Variable; + Project.Decl.Variables := Var; end if; -- If the variable/attribute has already been -- declared, just change the value. else - In_Tree.Variable_Elements.Table (The_Variable).Value := New_Value; + In_Tree.Variable_Elements.Table (Var).Value := New_Value; end if; end Process_Expression_Variable_Decl; -- 2.7.4