diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 11 | ||||
| -rw-r--r-- | gcc/ada/gnat_rm.texi | 16 | ||||
| -rw-r--r-- | gcc/ada/prj-conf.adb | 20 | ||||
| -rw-r--r-- | gcc/ada/prj-tree.adb | 48 | ||||
| -rw-r--r-- | gcc/ada/prj-tree.ads | 17 |
5 files changed, 85 insertions, 27 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index b3eaabd..29b606b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,14 @@ +2009-11-30 Robert Dewar <dewar@adacore.com> + + * gnat_rm.texi: Document pragma Short_Circuit + +2009-11-30 Emmanuel Briot <briot@adacore.com> + + * prj-conf.adb, prj-tree.adb, prj-tree.ads (Create_Attribute): Now set + the index either on the attribute or on its value, depending on the + kind of the attribute. Done to match recent changes in Prj.PP that were + not synchronized with this function. + 2009-11-30 Arnaud Charlet <charlet@adacore.com> * gcc-interface/Make-lang.in: Fix typo. diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index b79b87a..7744f15 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -182,6 +182,7 @@ Implementation Defined Pragmas * Pragma Pure_Function:: * Pragma Restriction_Warnings:: * Pragma Shared:: +* Pragma Short_Circuit_And_Or:: * Pragma Source_File_Name:: * Pragma Source_File_Name_Project:: * Pragma Source_Reference:: @@ -794,6 +795,7 @@ consideration, the use of these pragmas should be minimized. * Pragma Pure_Function:: * Pragma Restriction_Warnings:: * Pragma Shared:: +* Pragma Short_Circuit_And_Or:: * Pragma Source_File_Name:: * Pragma Source_File_Name_Project:: * Pragma Source_Reference:: @@ -4254,6 +4256,20 @@ if the restriction is violated. This pragma is provided for compatibility with Ada 83. The syntax and semantics are identical to pragma Atomic. +@node Pragma Short_Circuit_And_Or +@unnumberedsec Pragma Short_Circuit_And_Or +@findex Short_Circuit_And_Or + +@noindent +This configuration pragma causes any occurrence of the AND operator applied to +operands of type Standard.Boolean to be short-circuited (i.e. the AND operator +is treated as if it were AND THEN). Or is similarly treated as OR ELSE. This +may be useful in the context of certification protocols requiring the use of +short-circuited logical operators. If this configuration pragma occurs locally +within the file being compiled, it applies only to the file being compiled. +There is no requirement that all units in a partition use this option. + +semantics are identical to pragma Atomic. @node Pragma Source_File_Name @unnumberedsec Pragma Source_File_Name @findex Source_File_Name diff --git a/gcc/ada/prj-conf.adb b/gcc/ada/prj-conf.adb index bcf434b..233f6db 100644 --- a/gcc/ada/prj-conf.adb +++ b/gcc/ada/prj-conf.adb @@ -1189,8 +1189,9 @@ package body Prj.Conf is Pkg : Project_Node_Id := Empty_Node) is Attr : Project_Node_Id; - Val : Name_Id := No_Name; + Val, Expr : Name_Id := No_Name; Parent : Project_Node_Id := Config_File; + pragma Unreferenced (Attr); begin if Index /= "" then Name_Len := Index'Length; @@ -1202,22 +1203,17 @@ package body Prj.Conf is Parent := Pkg; end if; + Name_Len := Value'Length; + Name_Buffer (1 .. Name_Len) := Value; + Expr := Name_Find; + Attr := Create_Attribute (Tree => Project_Tree, Prj_Or_Pkg => Parent, Name => Name, Index_Name => Val, - Kind => Prj.Single); - - Name_Len := Value'Length; - Name_Buffer (1 .. Name_Len) := Value; - Val := Name_Find; - - Set_Expression_Of - (Attr, Project_Tree, - Enclose_In_Expression - (Create_Literal_String (Val, Project_Tree), - Project_Tree)); + Kind => Prj.Single, + Value => Create_Literal_String (Expr, Project_Tree)); end Create_Attribute; Name : Name_Id; diff --git a/gcc/ada/prj-tree.adb b/gcc/ada/prj-tree.adb index df6e5ac..27e3520 100644 --- a/gcc/ada/prj-tree.adb +++ b/gcc/ada/prj-tree.adb @@ -2966,12 +2966,17 @@ package body Prj.Tree is (Node : Project_Node_Id; Tree : Project_Node_Tree_Ref) return Project_Node_Id is - Expr : constant Project_Node_Id := - Default_Project_Node (Tree, N_Expression, Single); - begin - Set_First_Term (Expr, Tree, Default_Project_Node (Tree, N_Term, Single)); - Set_Current_Term (First_Term (Expr, Tree), Tree, Node); - return Expr; + Expr : Project_Node_Id; + begin + if Kind_Of (Node, Tree) /= N_Expression then + Expr := Default_Project_Node (Tree, N_Expression, Single); + Set_First_Term + (Expr, Tree, Default_Project_Node (Tree, N_Term, Single)); + Set_Current_Term (First_Term (Expr, Tree), Tree, Node); + return Expr; + else + return Node; + end if; end Enclose_In_Expression; -------------------- @@ -3032,7 +3037,8 @@ package body Prj.Tree is Name : Name_Id; Index_Name : Name_Id := No_Name; Kind : Variable_Kind := List; - At_Index : Integer := 0) return Project_Node_Id + At_Index : Integer := 0; + Value : Project_Node_Id := Empty_Node) return Project_Node_Id is Node : constant Project_Node_Id := Default_Project_Node (Tree, N_Attribute_Declaration, Kind); @@ -3041,14 +3047,11 @@ package body Prj.Tree is Pkg : Package_Node_Id; Start_At : Attribute_Node_Id; + Expr : Project_Node_Id; begin Set_Name_Of (Node, Tree, Name); - if At_Index /= 0 then - Set_Source_Index_Of (Node, Tree, To => Int (At_Index)); - end if; - if Index_Name /= No_Name then Set_Associative_Array_Index_Of (Node, Tree, Index_Name); end if; @@ -3073,6 +3076,29 @@ package body Prj.Tree is Attribute_Kind_Of (Start_At) = Case_Insensitive_Associative_Array; Tree.Project_Nodes.Table (Node).Flag1 := Case_Insensitive; + if At_Index /= 0 then + if Attribute_Kind_Of (Start_At) = + Optional_Index_Associative_Array + then + -- Results in: for Name ("index" at index) use "value"; + -- This is currently only used for executables + Set_Source_Index_Of (Node, Tree, To => Int (At_Index)); + else + -- Results in: for Name ("index") use "value" at index; + + -- ??? This limitation makes no sense, we should be able to + -- set the source index on an expression + pragma Assert (Kind_Of (Value, Tree) = N_Literal_String); + + Set_Source_Index_Of (Value, Tree, To => Int (At_Index)); + end if; + end if; + + if Value /= Empty_Node then + Expr := Enclose_In_Expression (Value, Tree); + Set_Expression_Of (Node, Tree, Expr); + end if; + return Node; end Create_Attribute; diff --git a/gcc/ada/prj-tree.ads b/gcc/ada/prj-tree.ads index 2eb8949..f794c4a 100644 --- a/gcc/ada/prj-tree.ads +++ b/gcc/ada/prj-tree.ads @@ -615,14 +615,22 @@ package Prj.Tree is Name : Name_Id; Index_Name : Name_Id := No_Name; Kind : Variable_Kind := List; - At_Index : Integer := 0) return Project_Node_Id; + At_Index : Integer := 0; + Value : Project_Node_Id := Empty_Node) return Project_Node_Id; -- Create a new attribute. The new declaration is added at the end of the -- declarative item list for Prj_Or_Pkg (a project or a package), but -- before any package declaration). No addition is done if Prj_Or_Pkg is -- Empty_Node. If Index_Name is not "", then if creates an attribute value -- for a specific index. At_Index is used for the " at <idx>" in the naming - -- exceptions. Use Set_Expression_Of to set the value of the attribute (in - -- which case Enclose_In_Expression might be useful) + -- exceptions. + -- To set the value of the attribute, either provide a value for + -- Value, or use Set_Expression_Of to set the value of the attribute + -- (in which case Enclose_In_Expression might be useful). The former is + -- recommended since it will more correctly handle cases where the index + -- needs to be set on the expression rather than on the index of the + -- attribute ('for Specification ("unit") use "file" at 3', versus + -- 'for Executable ("file" at 3) use "name"'). Value must be a + -- N_String_Literal if an index will be added to it function Create_Literal_String (Str : Namet.Name_Id; @@ -647,7 +655,8 @@ package Prj.Tree is function Enclose_In_Expression (Node : Project_Node_Id; Tree : Project_Node_Tree_Ref) return Project_Node_Id; - -- Enclose the Node inside a N_Expression node, and return this expression + -- Enclose the Node inside a N_Expression node, and return this expression. + -- This does nothing if Node is already a N_Expression -------------------- -- Set Procedures -- |