[multiple changes]

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

	* sem_eval.adb: Minor reformatting.

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

	* exp_ch4.adb (Expand_N_Conditional_Expression): Use
	Expression_With_Actions to clean up the code generated when folding
	constant expressions.

2010-06-22  Vincent Celier  <celier@adacore.com>

	* g-expect-vms.adb: Add new subprograms Free, First_Dead_Process and
	Has_Process.

From-SVN: r161132

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index a58cf0d..cf19f2e 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,18 @@
+2010-06-22  Robert Dewar  <dewar@adacore.com>
+
+       * sem_eval.adb: Minor reformatting.
+
+2010-06-22  Robert Dewar  <dewar@adacore.com>
+
+       * exp_ch4.adb (Expand_N_Conditional_Expression): Use
+       Expression_With_Actions to clean up the code generated when folding
+       constant expressions.
+
+2010-06-22  Vincent Celier  <celier@adacore.com>
+
+       * g-expect-vms.adb: Add new subprograms Free, First_Dead_Process and
+       Has_Process.
+
 2010-06-22  Vincent Celier  <celier@adacore.com>
 
        * prj-nmsc.adb (Find_Sources): When a source from a multi-unit file is

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 10d9dbc..a74ba46 100644 (file)
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -4053,8 +4053,25 @@ package body Exp_Ch4 is
          end if;
 
          Remove (Expr);
-         Insert_Actions (N, Actions);
-         Rewrite (N, Relocate_Node (Expr));
+
+         if Present (Actions) then
+
+            --  If we are not allowed to use Expression_With_Actions, just
+            --  skip the optimization, it is not critical for correctness.
+
+            if not Use_Expression_With_Actions then
+               goto Skip_Optimization;
+            end if;
+
+            Rewrite (N,
+              Make_Expression_With_Actions (Loc,
+                Expression => Relocate_Node (Expr),
+                Actions    => Actions));
+            Analyze_And_Resolve (N, Typ);
+
+         else
+            Rewrite (N, Relocate_Node (Expr));
+         end if;
 
          --  Note that the result is never static (legitimate cases of static
          --  conditional expressions were folded in Sem_Eval).
@@ -4063,6 +4080,8 @@ package body Exp_Ch4 is
          return;
       end if;
 
+      <<Skip_Optimization>>
+
       --  If the type is limited or unconstrained, we expand as follows to
       --  avoid any possibility of improper copies.
 

diff --git a/gcc/ada/g-expect-vms.adb b/gcc/ada/g-expect-vms.adb
index cc413f7..d57093c 100644 (file)
--- a/gcc/ada/g-expect-vms.adb
+++ b/gcc/ada/g-expect-vms.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                     Copyright (C) 2002-2009, AdaCore                     --
+--                     Copyright (C) 2002-2010, AdaCore                     --
 --                                                                          --
 -- 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- --
@@ -715,6 +715,24 @@ package body GNAT.Expect is
         (Descriptor.Last_Match_Start .. Descriptor.Last_Match_End);
    end Expect_Out_Match;
 
+   ------------------------
+   -- First_Dead_Process --
+   ------------------------
+
+   function First_Dead_Process
+     (Regexp : Multiprocess_Regexp_Array) return Natural is
+   begin
+      for R in Regexp'Range loop
+         if Regexp (R).Descriptor /= null
+           and then Regexp (R).Descriptor.Input_Fd = GNAT.OS_Lib.Invalid_FD
+         then
+            return R;
+         end if;
+      end loop;
+
+      return 0;
+   end First_Dead_Process;
+
    -----------
    -- Flush --
    -----------
@@ -770,6 +788,18 @@ package body GNAT.Expect is
       end loop;
    end Flush;
 
+   ----------
+   -- Free --
+   ----------
+
+   procedure Free (Regexp : in out Multiprocess_Regexp) is
+      procedure Unchecked_Free is new Ada.Unchecked_Deallocation
+        (Process_Descriptor'Class, Process_Descriptor_Access);
+   begin
+      Unchecked_Free (Regexp.Descriptor);
+      Free (Regexp.Regexp);
+   end Free;
+
    ------------------------
    -- Get_Command_Output --
    ------------------------
@@ -897,6 +927,15 @@ package body GNAT.Expect is
       return Descriptor.Pid;
    end Get_Pid;
 
+   -----------------
+   -- Has_Process --
+   -----------------
+
+   function Has_Process (Regexp : Multiprocess_Regexp_Array) return Boolean is
+   begin
+      return Regexp /= (Regexp'Range => (null, null));
+   end Has_Process;
+
    ---------------
    -- Interrupt --
    ---------------

diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index b2a29a5..6c8eb66 100644 (file)
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -183,7 +183,7 @@ package body Sem_Eval is
    procedure Test_Ambiguous_Operator (N : Node_Id);
    --  Check whether an arithmetic operation with universal operands which
    --  is a rewritten function call with an explicit scope indication is
-   --  ambiguous:  P."+" (1, 2) will be ambiguous if there is more than one
+   --  ambiguous: P."+" (1, 2) will be ambiguous if there is more than one
    --  visible numeric type declared in P and the context does not impose a
    --  type on the result (e.g. in the expression of a type conversion).
 
@@ -1466,10 +1466,12 @@ package body Sem_Eval is
       end if;
 
       if (Etype (Right) = Universal_Integer
-           or else Etype (Right) = Universal_Real)
+            or else
+          Etype (Right) = Universal_Real)
         and then
           (Etype (Left) = Universal_Integer
-            or else Etype (Left) = Universal_Real)
+            or else
+           Etype (Left) = Universal_Real)
       then
          Test_Ambiguous_Operator (N);
       end if;
@@ -3412,7 +3414,8 @@ package body Sem_Eval is
       end if;
 
       if Etype (Right) = Universal_Integer
-           or else Etype (Right) = Universal_Real
+           or else
+         Etype (Right) = Universal_Real
       then
          Test_Ambiguous_Operator (N);
       end if;
@@ -4730,9 +4733,9 @@ package body Sem_Eval is
       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
+                 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.
 
       E      : Entity_Id;
@@ -4763,9 +4766,7 @@ package body Sem_Eval is
 
          Typ1 := Empty;
          E := First_Entity (Pack);
-         while Present (E)
-           and then E /= Priv_E
-         loop
+         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)