OSDN Git Service

2009-11-30 Robert Dewar <dewar@adacore.com>
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Mon, 30 Nov 2009 11:29:28 +0000 (11:29 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Mon, 30 Nov 2009 11:29:28 +0000 (11:29 +0000)
* 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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@154789 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/ada/ChangeLog
gcc/ada/gnat_rm.texi
gcc/ada/prj-conf.adb
gcc/ada/prj-tree.adb
gcc/ada/prj-tree.ads

index b3eaabd..29b606b 100644 (file)
@@ -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.
index b79b87a..7744f15 100644 (file)
@@ -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
index bcf434b..233f6db 100644 (file)
@@ -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;
index df6e5ac..27e3520 100644 (file)
@@ -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;
 
index 2eb8949..f794c4a 100644 (file)
@@ -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 --