[Ada] avoid incorrect lower casing of attribute names in some cases
Arnaud Charlet
charlet@adacore.com
Wed Aug 3 09:39:00 GMT 2011
The change to Get_Attribute_Index avoids an incorrect lower casing
of the external variable name when using the new "External" attribute in
aggregate projects.
Tested on x86_64-pc-linux-gnu, committed on trunk
2011-08-03 Emmanuel Briot <briot@adacore.com>
* 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).
-------------- next part --------------
Index: prj-proc.adb
===================================================================
--- prj-proc.adb (revision 177248)
+++ prj-proc.adb (working copy)
@@ -458,41 +458,19 @@
-------------------------
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 @@
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 @@
----------------------------------------------
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 @@
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 @@
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 @@
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,55 +1910,53 @@
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 @@
(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;
Index: prj-attr.adb
===================================================================
--- prj-attr.adb (revision 176998)
+++ prj-attr.adb (working copy)
@@ -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 @@
"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#" &
Index: prj-attr.ads
===================================================================
--- prj-attr.ads (revision 176998)
+++ prj-attr.ads (working copy)
@@ -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 @@
(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 => <package name>);
+ -- Att : constant Attribute_Node_Id :=
+ -- Prj.Attr.Attribute_Node_Id_Of
+ -- (Name => <attribute 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;
More information about the Gcc-patches
mailing list