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.

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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index b3eaabd..29b606b 100644 (file)
--- 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.
 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 (file)
--- 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 Pure_Function::
 * Pragma Restriction_Warnings::
 * Pragma Shared::

+* Pragma Short_Circuit_And_Or::

 * Pragma Source_File_Name::
 * Pragma Source_File_Name_Project::
 * Pragma Source_Reference::
 * 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 Pure_Function::
 * Pragma Restriction_Warnings::
 * Pragma Shared::

+* Pragma Short_Circuit_And_Or::

 * Pragma Source_File_Name::
 * Pragma Source_File_Name_Project::
 * Pragma Source_Reference::
 * 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.
 
 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
 @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 (file)
--- 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;
          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;
          Parent : Project_Node_Id := Config_File;

+         pragma Unreferenced (Attr);

       begin
          if Index /= "" then
             Name_Len := Index'Length;
       begin
          if Index /= "" then
             Name_Len := Index'Length;


@@ -1202,22 +1203,17 @@ package body Prj.Conf is
             Parent := Pkg;
          end if;
 
             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,
          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;
       end Create_Attribute;
 
       Name   : Name_Id;

diff --git a/gcc/ada/prj-tree.adb b/gcc/ada/prj-tree.adb
index df6e5ac..27e3520 100644 (file)
--- 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
      (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;
 
    --------------------
    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;
       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);
    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;
 
       Pkg      : Package_Node_Id;
       Start_At : Attribute_Node_Id;

+      Expr     : Project_Node_Id;

 
    begin
       Set_Name_Of (Node, Tree, Name);
 
 
    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;
       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;
 
         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;
 
       return Node;
    end Create_Attribute;
 

diff --git a/gcc/ada/prj-tree.ads b/gcc/ada/prj-tree.ads
index 2eb8949..f794c4a 100644 (file)
--- 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;
       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
    --  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;
 
    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;
    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 --
 
    --------------------
    -- Set Procedures --