2010-06-22 Robert Dewar <dewar@adacore.com>

	* g-expect-vms.adb, sem_res.adb: Minor reformatting.
	* exp_aggr.adb: Minor comment changes and reformatting.
	* sem_eval.adb (Find_Universal_Operator_Type): Put in proper alpha order
	* sem_util.ads: Add some missing pragma Inline's (efficiency issue only)

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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 76c3f15..bc310e3 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,10 @@
+2010-06-22  Robert Dewar  <dewar@adacore.com>
+
+       * g-expect-vms.adb, sem_res.adb: Minor reformatting.
+       * exp_aggr.adb: Minor comment changes and reformatting.
+       * sem_eval.adb (Find_Universal_Operator_Type): Put in proper alpha order
+       * sem_util.ads: Add some missing pragma Inline's (efficiency issue only)
+
 2010-06-22  Thomas Quinot  <quinot@adacore.com>
 
        * sem_util.adb (Build_Actual_Subtype): Record original expression in

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index c15b922..9345da2 100644 (file)
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -176,8 +176,9 @@ package body Exp_Aggr is
    --  Very large static aggregates present problems to the back-end, and are
    --  transformed into assignments and loops. This function verifies that the
    --  total number of components of an aggregate is acceptable for rewriting
-   --  into a purely positional static form. It is called prior to calling
-   --  Flatten.
+   --  into a purely positional static form. Aggr_Size_OK must be called before
+   --  calling Flatten.
+   --
    --  This function also detects and warns about one-component aggregates that
    --  appear in a non-static context. Even if the component value is static,
    --  such an aggregate must be expanded into an assignment.

diff --git a/gcc/ada/g-expect-vms.adb b/gcc/ada/g-expect-vms.adb
index d92e1e7..4d1a770 100644 (file)
--- a/gcc/ada/g-expect-vms.adb
+++ b/gcc/ada/g-expect-vms.adb
@@ -524,6 +524,7 @@ package body GNAT.Expect is
 
       for J in Descriptors'Range loop
          Descriptors (J) := Regexps (J).Descriptor;
+
          if Descriptors (J) /= null then
             Reinitialize_Buffer (Regexps (J).Descriptor.all);
          end if;
@@ -775,7 +776,8 @@ package body GNAT.Expect is
    ------------------------
 
    function First_Dead_Process
-     (Regexp : Multiprocess_Regexp_Array) return Natural is
+     (Regexp : Multiprocess_Regexp_Array) return Natural
+   is
    begin
       for R in Regexp'Range loop
          if Regexp (R).Descriptor /= null

diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index fb17144..11fba8e 100644 (file)
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -3763,6 +3763,141 @@ package body Sem_Eval is
       end if;
    end Expr_Value_S;
 
+   ----------------------------------
+   -- Find_Universal_Operator_Type --
+   ----------------------------------
+
+   function Find_Universal_Operator_Type (N : Node_Id) return Entity_Id is
+      PN     : constant Node_Id := Parent (N);
+      Call   : constant Node_Id := Original_Node (N);
+      Is_Int : constant Boolean := Is_Integer_Type (Etype (N));
+
+      Is_Fix : constant Boolean :=
+                 Nkind (N) in N_Binary_Op
+                   and then Nkind (Right_Opnd (N)) /= Nkind (Left_Opnd (N));
+      --  A mixed-mode operation in this context indicates the presence of
+      --  fixed-point type in the designated package.
+
+      Is_Relational : constant Boolean := Etype (N) = Standard_Boolean;
+      --  Case where N is a relational (or membership) operator (else it is an
+      --  arithmetic one).
+
+      In_Membership : constant Boolean :=
+                        Nkind (PN) in N_Membership_Test
+                          and then
+                        Nkind (Right_Opnd (PN)) = N_Range
+                          and then
+                        Is_Universal_Numeric_Type (Etype (Left_Opnd (PN)))
+                          and then
+                        Is_Universal_Numeric_Type
+                          (Etype (Low_Bound (Right_Opnd (PN))))
+                          and then
+                        Is_Universal_Numeric_Type
+                          (Etype (High_Bound (Right_Opnd (PN))));
+      --  Case where N is part of a membership test with a universal range
+
+      E      : Entity_Id;
+      Pack   : Entity_Id;
+      Typ1   : Entity_Id := Empty;
+      Priv_E : Entity_Id;
+
+      function Is_Mixed_Mode_Operand (Op : Node_Id) return Boolean;
+      --  Check whether one operand is a mixed-mode operation that requires
+      --  the presence of a fixed-point type. Given that all operands are
+      --  universal and have been constant-folded, retrieve the original
+      --  function call.
+
+      ---------------------------
+      -- Is_Mixed_Mode_Operand --
+      ---------------------------
+
+      function Is_Mixed_Mode_Operand (Op : Node_Id) return Boolean is
+      begin
+         return Nkind (Original_Node (Op)) = N_Function_Call
+           and then Present (Next_Actual (First_Actual (Original_Node (Op))))
+           and then Etype (First_Actual (Original_Node (Op))) /=
+                    Etype (Next_Actual (First_Actual (Original_Node (Op))));
+      end Is_Mixed_Mode_Operand;
+
+   begin
+      if Nkind (Call) /= N_Function_Call
+        or else Nkind (Name (Call)) /= N_Expanded_Name
+      then
+         return Empty;
+
+      --  There are two cases where the context does not imply the type of the
+      --  operands: either the universal expression appears in a type
+      --  type conversion, or we are in the case of a predefined relational
+      --  operator, where the context type is always Boolean.
+
+      elsif Nkind (Parent (N)) = N_Type_Conversion
+              or else
+            Is_Relational
+              or else
+            In_Membership
+      then
+         Pack := Entity (Prefix (Name (Call)));
+
+         --  If the prefix is a package declared elsewhere, iterate over
+         --  its visible entities, otherwise iterate over all declarations
+         --  in the designated scope.
+
+         if Ekind (Pack) = E_Package
+           and then not In_Open_Scopes (Pack)
+         then
+            Priv_E := First_Private_Entity (Pack);
+         else
+            Priv_E := Empty;
+         end if;
+
+         Typ1 := Empty;
+         E := First_Entity (Pack);
+         while Present (E) and then E /= Priv_E loop
+            if Is_Numeric_Type (E)
+              and then Nkind (Parent (E)) /= N_Subtype_Declaration
+              and then Comes_From_Source (E)
+              and then Is_Integer_Type (E) = Is_Int
+              and then
+                (Nkind (N) in N_Unary_Op
+                  or else Is_Relational
+                  or else Is_Fixed_Point_Type (E) = Is_Fix)
+            then
+               if No (Typ1) then
+                  Typ1 := E;
+
+                  --  Before emitting an error, check for the presence of a
+                  --  mixed-mode operation that specifies a fixed point type.
+
+               elsif Is_Relational
+                 and then
+                   (Is_Mixed_Mode_Operand (Left_Opnd (N))
+                    or else Is_Mixed_Mode_Operand (Right_Opnd (N)))
+                 and then Is_Fixed_Point_Type (E) /= Is_Fixed_Point_Type (Typ1)
+
+               then
+                  if Is_Fixed_Point_Type (E) then
+                     Typ1 := E;
+                  end if;
+
+               else
+                  --  More than one type of the proper class declared in P
+
+                  Error_Msg_N ("ambiguous operation", N);
+                  Error_Msg_Sloc := Sloc (Typ1);
+                  Error_Msg_N ("\possible interpretation (inherited)#", N);
+                  Error_Msg_Sloc := Sloc (E);
+                  Error_Msg_N ("\possible interpretation (inherited)#", N);
+                  return Empty;
+               end if;
+            end if;
+
+            Next_Entity (E);
+         end loop;
+      end if;
+
+      return Typ1;
+   end Find_Universal_Operator_Type;
+
    --------------------------
    -- Flag_Non_Static_Expr --
    --------------------------
@@ -4761,141 +4896,6 @@ package body Sem_Eval is
       end if;
    end Test;
 
-   ----------------------------------
-   -- Find_Universal_Operator_Type --
-   ----------------------------------
-
-   function Find_Universal_Operator_Type (N : Node_Id) return Entity_Id is
-      PN     : constant Node_Id := Parent (N);
-      Call   : constant Node_Id := Original_Node (N);
-      Is_Int : constant Boolean := Is_Integer_Type (Etype (N));
-
-      Is_Fix : constant Boolean :=
-                 Nkind (N) in N_Binary_Op
-                   and then Nkind (Right_Opnd (N)) /= Nkind (Left_Opnd (N));
-      --  A mixed-mode operation in this context indicates the presence of
-      --  fixed-point type in the designated package.
-
-      Is_Relational : constant Boolean := Etype (N) = Standard_Boolean;
-      --  Case where N is a relational (or membership) operator (else it is an
-      --  arithmetic one).
-
-      In_Membership : constant Boolean :=
-                        Nkind (PN) in N_Membership_Test
-                          and then
-                        Nkind (Right_Opnd (PN)) = N_Range
-                          and then
-                        Is_Universal_Numeric_Type (Etype (Left_Opnd (PN)))
-                          and then
-                        Is_Universal_Numeric_Type
-                          (Etype (Low_Bound (Right_Opnd (PN))))
-                          and then
-                        Is_Universal_Numeric_Type
-                          (Etype (High_Bound (Right_Opnd (PN))));
-      --  Case where N is part of a membership test with a universal range
-
-      E      : Entity_Id;
-      Pack   : Entity_Id;
-      Typ1   : Entity_Id := Empty;
-      Priv_E : Entity_Id;
-
-      function Is_Mixed_Mode_Operand (Op : Node_Id) return Boolean;
-      --  Check whether one operand is a mixed-mode operation that requires
-      --  the presence of a fixed-point type. Given that all operands are
-      --  universal and have been constant-folded, retrieve the original
-      --  function call.
-
-      ---------------------------
-      -- Is_Mixed_Mode_Operand --
-      ---------------------------
-
-      function Is_Mixed_Mode_Operand (Op : Node_Id) return Boolean is
-      begin
-         return Nkind (Original_Node (Op)) = N_Function_Call
-           and then Present (Next_Actual (First_Actual (Original_Node (Op))))
-           and then Etype (First_Actual (Original_Node (Op))) /=
-                    Etype (Next_Actual (First_Actual (Original_Node (Op))));
-      end Is_Mixed_Mode_Operand;
-
-   begin
-      if Nkind (Call) /= N_Function_Call
-        or else Nkind (Name (Call)) /= N_Expanded_Name
-      then
-         return Empty;
-
-      --  There are two cases where the context does not imply the type of the
-      --  operands: either the universal expression appears in a type
-      --  type conversion, or we are in the case of a predefined relational
-      --  operator, where the context type is always Boolean.
-
-      elsif Nkind (Parent (N)) = N_Type_Conversion
-              or else
-            Is_Relational
-              or else
-            In_Membership
-      then
-         Pack := Entity (Prefix (Name (Call)));
-
-         --  If the prefix is a package declared elsewhere, iterate over
-         --  its visible entities, otherwise iterate over all declarations
-         --  in the designated scope.
-
-         if Ekind (Pack) = E_Package
-           and then not In_Open_Scopes (Pack)
-         then
-            Priv_E := First_Private_Entity (Pack);
-         else
-            Priv_E := Empty;
-         end if;
-
-         Typ1 := Empty;
-         E := First_Entity (Pack);
-         while Present (E) and then E /= Priv_E loop
-            if Is_Numeric_Type (E)
-              and then Nkind (Parent (E)) /= N_Subtype_Declaration
-              and then Comes_From_Source (E)
-              and then Is_Integer_Type (E) = Is_Int
-              and then
-                (Nkind (N) in N_Unary_Op
-                  or else Is_Relational
-                  or else Is_Fixed_Point_Type (E) = Is_Fix)
-            then
-               if No (Typ1) then
-                  Typ1 := E;
-
-                  --  Before emitting an error, check for the presence of a
-                  --  mixed-mode operation that specifies a fixed point type.
-
-               elsif Is_Relational
-                 and then
-                   (Is_Mixed_Mode_Operand (Left_Opnd (N))
-                    or else Is_Mixed_Mode_Operand (Right_Opnd (N)))
-                 and then Is_Fixed_Point_Type (E) /= Is_Fixed_Point_Type (Typ1)
-
-               then
-                  if Is_Fixed_Point_Type (E) then
-                     Typ1 := E;
-                  end if;
-
-               else
-                  --  More than one type of the proper class declared in P
-
-                  Error_Msg_N ("ambiguous operation", N);
-                  Error_Msg_Sloc := Sloc (Typ1);
-                  Error_Msg_N ("\possible interpretation (inherited)#", N);
-                  Error_Msg_Sloc := Sloc (E);
-                  Error_Msg_N ("\possible interpretation (inherited)#", N);
-                  return Empty;
-               end if;
-            end if;
-
-            Next_Entity (E);
-         end loop;
-      end if;
-
-      return Typ1;
-   end Find_Universal_Operator_Type;
-
    ---------------------------------
    -- Test_Expression_Is_Foldable --
    ---------------------------------

diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index a6b9d3a..c3be8b5 100644 (file)
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -5083,13 +5083,15 @@ package body Sem_Res is
                            Expressions => Parameter_Associations (N));
                   end if;
 
+                  --  Preserve the parenthesis count of the node
+
+                  Set_Paren_Count (Index_Node, Paren_Count (N));
+
                   --  Since we are correcting a node classification error made
                   --  by the parser, we call Replace rather than Rewrite.
-                  --  Preserve the parenthesis count of the node, for use by
-                  --  tools.
 
-                  Set_Paren_Count (Index_Node, Paren_Count (N));
                   Replace (N, Index_Node);
+
                   Set_Etype (Prefix (N), Ret_Type);
                   Set_Etype (N, Typ);
                   Resolve_Indexed_Component (N, Typ);

diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 1df648d..2720b4e 100644 (file)
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -801,6 +801,7 @@ package Sem_Util is
    --  function simply tests if it is True (i.e. non-zero)
 
    function Is_Universal_Numeric_Type (T : Entity_Id) return Boolean;
+   pragma Inline (Is_Universal_Numeric_Type);
    --  True if T is Universal_Integer or Universal_Real
 
    function Is_Value_Type (T : Entity_Id) return Boolean;