[multiple changes]

2010-06-22  Gary Dismukes  <dismukes@adacore.com>

	* sem_ch3.adb (Build_Discriminal): Set default scopes for newly created
	discriminals to the current scope.
	* sem_util.adb (Find_Body_Discriminal): Remove setting of discriminal's
	scope, which could overwrite a different already set value.

2010-06-22  Ed Schonberg  <schonberg@adacore.com>

	* sem_res.adb (Valid_Conversion): If expression is a predefined
	operator, use sloc of type of interpretation to improve error message
	when operand is of some derived type.
	* sem_eval.adb (Is_Mixed_Mode_Operand): New function, use it.

2010-06-22  Emmanuel Briot  <briot@adacore.com>

	* g-expect-vms.adb (Expect_Internal): No longer raises an exception, so
	that it can set out parameters as well. When a process has died, reset
	its Input_Fd to Invalid_Fd, so that when using multiple processes we
	can find out which process has died.

From-SVN: r161135

6 files changed, 201 insertions, 70 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index e9b3374..fcc8c88 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,24 @@
+2010-06-22  Gary Dismukes  <dismukes@adacore.com>
+
+	* sem_ch3.adb (Build_Discriminal): Set default scopes for newly created
+	discriminals to the current scope.
+	* sem_util.adb (Find_Body_Discriminal): Remove setting of discriminal's
+	scope, which could overwrite a different already set value.
+
+2010-06-22  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_res.adb (Valid_Conversion): If expression is a predefined
+	operator, use sloc of type of interpretation to improve error message
+	when operand is of some derived type.
+	* sem_eval.adb (Is_Mixed_Mode_Operand): New function, use it.
+
+2010-06-22  Emmanuel Briot  <briot@adacore.com>
+
+	* g-expect-vms.adb (Expect_Internal): No longer raises an exception, so
+	that it can set out parameters as well. When a process has died, reset
+	its Input_Fd to Invalid_Fd, so that when using multiple processes we
+	can find out which process has died.
+
 2010-06-22  Thomas Quinot  <quinot@adacore.com>
 
 	* sem_eval.adb (Find_Universal_Operator_Type): New
diff --git a/gcc/ada/g-expect-vms.adb b/gcc/ada/g-expect-vms.adb
index d57093c..d92e1e7 100644
--- a/gcc/ada/g-expect-vms.adb
+++ b/gcc/ada/g-expect-vms.adb
@@ -50,6 +50,11 @@ package body GNAT.Expect is
    Save_Output : File_Descriptor;
    Save_Error  : File_Descriptor;
 
+   Expect_Process_Died   : constant Expect_Match := -100;
+   Expect_Internal_Error : constant Expect_Match := -101;
+   --  Additional possible outputs of Expect_Internal. These are not visible in
+   --  the spec because the user will never see them.
+
    procedure Expect_Internal
      (Descriptors : in out Array_Of_Pd;
       Result      : out Expect_Match;
@@ -57,11 +62,14 @@ package body GNAT.Expect is
       Full_Buffer : Boolean);
    --  Internal function used to read from the process Descriptor.
    --
-   --  Three outputs are possible:
+   --  Several outputs are possible:
    --     Result=Expect_Timeout, if no output was available before the timeout
    --        expired.
    --     Result=Expect_Full_Buffer, if Full_Buffer is True and some characters
    --        had to be discarded from the internal buffer of Descriptor.
+   --     Result=Express_Process_Died if one of the processes was terminated.
+   --        That process's Input_Fd is set to Invalid_FD
+   --     Result=Express_Internal_Error
    --     Result=<integer>, indicates how many characters were added to the
    --        internal buffer. These characters are from indexes
    --        Descriptor.Buffer_Index - Result + 1 .. Descriptor.Buffer_Index
@@ -209,7 +217,9 @@ package body GNAT.Expect is
       Status     : out Integer)
    is
    begin
-      Close (Descriptor.Input_Fd);
+      if Descriptor.Input_Fd /= Invalid_FD then
+         Close (Descriptor.Input_Fd);
+      end if;
 
       if Descriptor.Error_Fd /= Descriptor.Output_Fd then
          Close (Descriptor.Error_Fd);
@@ -331,10 +341,17 @@ package body GNAT.Expect is
 
          Expect_Internal (Descriptors, N, Timeout_Tmp, Full_Buffer);
 
-         if N = Expect_Timeout or else N = Expect_Full_Buffer then
-            Result := N;
-            return;
-         end if;
+         case N is
+            when Expect_Internal_Error | Expect_Process_Died =>
+               raise Process_Died;
+
+            when Expect_Timeout | Expect_Full_Buffer =>
+               Result := N;
+               return;
+
+            when others =>
+               null;  --  See below
+         end case;
 
          --  Calculate the timeout for the next turn
 
@@ -478,10 +495,17 @@ package body GNAT.Expect is
 
          Expect_Internal (Descriptors, N, Timeout, Full_Buffer);
 
-         if N = Expect_Timeout or else N = Expect_Full_Buffer then
-            Result := N;
-            return;
-         end if;
+         case N is
+            when Expect_Internal_Error | Expect_Process_Died =>
+               raise Process_Died;
+
+            when Expect_Timeout | Expect_Full_Buffer =>
+               Result := N;
+               return;
+
+            when others =>
+               null;  --  Continue
+         end case;
       end loop;
    end Expect;
 
@@ -500,7 +524,9 @@ package body GNAT.Expect is
 
       for J in Descriptors'Range loop
          Descriptors (J) := Regexps (J).Descriptor;
-         Reinitialize_Buffer (Regexps (J).Descriptor.all);
+         if Descriptors (J) /= null then
+            Reinitialize_Buffer (Regexps (J).Descriptor.all);
+         end if;
       end loop;
 
       loop
@@ -511,25 +537,36 @@ package body GNAT.Expect is
          --  checking the regexps).
 
          for J in Regexps'Range loop
-            Match (Regexps (J).Regexp.all,
-                   Regexps (J).Descriptor.Buffer
-                     (1 .. Regexps (J).Descriptor.Buffer_Index),
-                   Matched);
-
-            if Matched (0) /= No_Match then
-               Result := Expect_Match (J);
-               Regexps (J).Descriptor.Last_Match_Start := Matched (0).First;
-               Regexps (J).Descriptor.Last_Match_End := Matched (0).Last;
-               return;
+            if Regexps (J).Regexp /= null
+               and then Regexps (J).Descriptor /= null
+            then
+               Match (Regexps (J).Regexp.all,
+                      Regexps (J).Descriptor.Buffer
+                        (1 .. Regexps (J).Descriptor.Buffer_Index),
+                      Matched);
+
+               if Matched (0) /= No_Match then
+                  Result := Expect_Match (J);
+                  Regexps (J).Descriptor.Last_Match_Start := Matched (0).First;
+                  Regexps (J).Descriptor.Last_Match_End := Matched (0).Last;
+                  return;
+               end if;
             end if;
          end loop;
 
          Expect_Internal (Descriptors, N, Timeout, Full_Buffer);
 
-         if N = Expect_Timeout or else N = Expect_Full_Buffer then
-            Result := N;
-            return;
-         end if;
+         case N is
+            when Expect_Internal_Error | Expect_Process_Died =>
+               raise Process_Died;
+
+            when Expect_Timeout | Expect_Full_Buffer =>
+               Result := N;
+               return;
+
+            when others =>
+               null;  --  Continue
+         end case;
       end loop;
    end Expect;
 
@@ -549,21 +586,30 @@ package body GNAT.Expect is
       N : Integer;
 
       type File_Descriptor_Array is
-        array (Descriptors'Range) of File_Descriptor;
+        array (0 .. Descriptors'Length - 1) of File_Descriptor;
       Fds : aliased File_Descriptor_Array;
+      Fds_Count : Natural := 0;
+
+      Fds_To_Descriptor : array (Fds'Range) of Integer;
+      --  Maps file descriptor entries from Fds to entries in Descriptors.
+      --  They do not have the same index when entries in Descriptors are null.
 
-      type Integer_Array is array (Descriptors'Range) of Integer;
+      type Integer_Array is array (Fds'Range) of Integer;
       Is_Set : aliased Integer_Array;
 
    begin
       for J in Descriptors'Range loop
-         Fds (J) := Descriptors (J).Output_Fd;
+         if Descriptors (J) /= null then
+            Fds (Fds'First + Fds_Count) := Descriptors (J).Output_Fd;
+            Fds_To_Descriptor (Fds'First + Fds_Count) := J;
+            Fds_Count := Fds_Count + 1;
 
-         if Descriptors (J).Buffer_Size = 0 then
-            Buffer_Size := Integer'Max (Buffer_Size, 4096);
-         else
-            Buffer_Size :=
-              Integer'Max (Buffer_Size, Descriptors (J).Buffer_Size);
+            if Descriptors (J).Buffer_Size = 0 then
+               Buffer_Size := Integer'Max (Buffer_Size, 4096);
+            else
+               Buffer_Size :=
+                 Integer'Max (Buffer_Size, Descriptors (J).Buffer_Size);
+            end if;
          end if;
       end loop;
 
@@ -572,19 +618,23 @@ package body GNAT.Expect is
          --  Buffer used for input. This is allocated only once, not for
          --  every iteration of the loop
 
+         D : Integer;
+         --  Index in Descriptors
+
       begin
          --  Loop until we match or we have a timeout
 
          loop
             Num_Descriptors :=
-              Poll (Fds'Address, Fds'Length, Timeout, Is_Set'Address);
+              Poll (Fds'Address, Fds_Count, Timeout, Is_Set'Address);
 
             case Num_Descriptors is
 
                --  Error?
 
                when -1 =>
-                  raise Process_Died;
+                  Result := Expect_Internal_Error;
+                  return;
 
                --  Timeout?
 
@@ -595,15 +645,17 @@ package body GNAT.Expect is
                --  Some input
 
                when others =>
-                  for J in Descriptors'Range loop
-                     if Is_Set (J) = 1 then
-                        Buffer_Size := Descriptors (J).Buffer_Size;
+                  for F in Fds'Range loop
+                     if Is_Set (F) = 1 then
+                        D := Fds_To_Descriptor (F);
+
+                        Buffer_Size := Descriptors (D).Buffer_Size;
 
                         if Buffer_Size = 0 then
                            Buffer_Size := 4096;
                         end if;
 
-                        N := Read (Descriptors (J).Output_Fd, Buffer'Address,
+                        N := Read (Descriptors (D).Output_Fd, Buffer'Address,
                                    Buffer_Size);
 
                         --  Error or End of file
@@ -611,43 +663,46 @@ package body GNAT.Expect is
                         if N <= 0 then
                            --  ??? Note that ddd tries again up to three times
                            --  in that case. See LiterateA.C:174
-                           raise Process_Died;
+
+                           Descriptors (D).Input_Fd := Invalid_FD;
+                           Result := Expect_Process_Died;
+                           return;
 
                         else
                            --  If there is no limit to the buffer size
 
-                           if Descriptors (J).Buffer_Size = 0 then
+                           if Descriptors (D).Buffer_Size = 0 then
 
                               declare
-                                 Tmp : String_Access := Descriptors (J).Buffer;
+                                 Tmp : String_Access := Descriptors (D).Buffer;
 
                               begin
                                  if Tmp /= null then
-                                    Descriptors (J).Buffer :=
+                                    Descriptors (D).Buffer :=
                                       new String (1 .. Tmp'Length + N);
-                                    Descriptors (J).Buffer (1 .. Tmp'Length) :=
+                                    Descriptors (D).Buffer (1 .. Tmp'Length) :=
                                       Tmp.all;
-                                    Descriptors (J).Buffer
+                                    Descriptors (D).Buffer
                                       (Tmp'Length + 1 .. Tmp'Length + N) :=
                                       Buffer (1 .. N);
                                     Free (Tmp);
-                                    Descriptors (J).Buffer_Index :=
-                                      Descriptors (J).Buffer'Last;
+                                    Descriptors (D).Buffer_Index :=
+                                      Descriptors (D).Buffer'Last;
 
                                  else
-                                    Descriptors (J).Buffer :=
+                                    Descriptors (D).Buffer :=
                                       new String (1 .. N);
-                                    Descriptors (J).Buffer.all :=
+                                    Descriptors (D).Buffer.all :=
                                       Buffer (1 .. N);
-                                    Descriptors (J).Buffer_Index := N;
+                                    Descriptors (D).Buffer_Index := N;
                                  end if;
                               end;
 
                            else
                               --  Add what we read to the buffer
 
-                              if Descriptors (J).Buffer_Index + N >
-                                Descriptors (J).Buffer_Size
+                              if Descriptors (D).Buffer_Index + N >
+                                Descriptors (D).Buffer_Size
                               then
                                  --  If the user wants to know when we have
                                  --  read more than the buffer can contain.
@@ -660,33 +715,33 @@ package body GNAT.Expect is
                                  --  Keep as much as possible from the buffer,
                                  --  and forget old characters.
 
-                                 Descriptors (J).Buffer
-                                   (1 .. Descriptors (J).Buffer_Size - N) :=
-                                  Descriptors (J).Buffer
-                                   (N - Descriptors (J).Buffer_Size +
-                                    Descriptors (J).Buffer_Index + 1 ..
-                                    Descriptors (J).Buffer_Index);
-                                 Descriptors (J).Buffer_Index :=
-                                   Descriptors (J).Buffer_Size - N;
+                                 Descriptors (D).Buffer
+                                   (1 .. Descriptors (D).Buffer_Size - N) :=
+                                  Descriptors (D).Buffer
+                                   (N - Descriptors (D).Buffer_Size +
+                                    Descriptors (D).Buffer_Index + 1 ..
+                                    Descriptors (D).Buffer_Index);
+                                 Descriptors (D).Buffer_Index :=
+                                   Descriptors (D).Buffer_Size - N;
                               end if;
 
                               --  Keep what we read in the buffer
 
-                              Descriptors (J).Buffer
-                                (Descriptors (J).Buffer_Index + 1 ..
-                                 Descriptors (J).Buffer_Index + N) :=
+                              Descriptors (D).Buffer
+                                (Descriptors (D).Buffer_Index + 1 ..
+                                 Descriptors (D).Buffer_Index + N) :=
                                 Buffer (1 .. N);
-                              Descriptors (J).Buffer_Index :=
-                                Descriptors (J).Buffer_Index + N;
+                              Descriptors (D).Buffer_Index :=
+                                Descriptors (D).Buffer_Index + N;
                            end if;
 
                            --  Call each of the output filter with what we
                            --  read.
 
                            Call_Filters
-                             (Descriptors (J).all, Buffer (1 .. N), Output);
+                             (Descriptors (D).all, Buffer (1 .. N), Output);
 
-                           Result := Expect_Match (N);
+                           Result := Expect_Match (D);
                            return;
                         end if;
                      end if;
@@ -1062,6 +1117,13 @@ package body GNAT.Expect is
 
          Expect_Internal (Descriptors, Result,
                           Timeout => 0, Full_Buffer => False);
+
+         if Result = Expect_Internal_Error
+           or else Result = Expect_Process_Died
+         then
+            raise Process_Died;
+         end if;
+
          Descriptor.Last_Match_End := Descriptor.Buffer_Index;
 
          --  Empty the buffer
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 27cb478..f98b3b1 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -7710,6 +7710,7 @@ package body Sem_Ch3 is
       Set_Ekind     (D_Minal, E_In_Parameter);
       Set_Mechanism (D_Minal, Default_Mechanism);
       Set_Etype     (D_Minal, Etype (Discrim));
+      Set_Scope     (D_Minal, Current_Scope);
 
       Set_Discriminal (Discrim, D_Minal);
       Set_Discriminal_Link (D_Minal, Discrim);
@@ -7726,6 +7727,7 @@ package body Sem_Ch3 is
          Set_Ekind            (CR_Disc, E_In_Parameter);
          Set_Mechanism        (CR_Disc, Default_Mechanism);
          Set_Etype            (CR_Disc, Etype (Discrim));
+         Set_Scope            (CR_Disc, Current_Scope);
          Set_Discriminal_Link (CR_Disc, Discrim);
          Set_CR_Discriminant  (Discrim, CR_Disc);
       end if;
diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index 1d9e0f6..fb17144 100644
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -4799,6 +4799,24 @@ package body Sem_Eval is
       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
@@ -4845,6 +4863,20 @@ package body Sem_Eval is
                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
 
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index bf00a97..fcf5a2c9 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -9567,6 +9567,7 @@ package body Sem_Res is
             It  : Interp;
             It1 : Interp;
             N1  : Entity_Id;
+            T1  : Entity_Id;
 
          begin
             --  Remove procedure calls, which syntactically cannot appear in
@@ -9623,16 +9624,30 @@ package body Sem_Res is
 
             if Present (It.Typ) then
                N1  := It1.Nam;
+               T1  := It1.Typ;
                It1 :=  Disambiguate (Operand, I1, I, Any_Type);
 
                if It1 = No_Interp then
                   Error_Msg_N ("ambiguous operand in conversion", Operand);
 
-                  Error_Msg_Sloc := Sloc (It.Nam);
+                  --  If the interpretation involves a standard operator, use
+                  --  the location of the type, which may be user-defined.
+
+                  if Sloc (It.Nam) = Standard_Location then
+                     Error_Msg_Sloc := Sloc (It.Typ);
+                  else
+                     Error_Msg_Sloc := Sloc (It.Nam);
+                  end if;
+
                   Error_Msg_N -- CODEFIX
                     ("\\possible interpretation#!", Operand);
 
-                  Error_Msg_Sloc := Sloc (N1);
+                  if Sloc (N1) = Standard_Location then
+                     Error_Msg_Sloc := Sloc (T1);
+                  else
+                     Error_Msg_Sloc := Sloc (N1);
+                  end if;
+
                   Error_Msg_N -- CODEFIX
                     ("\\possible interpretation#!", Operand);
 
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 340e8fe..04f8341 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -3082,7 +3082,6 @@ package body Sem_Util is
       Disc := First_Discriminant (Tsk);
       while Present (Disc) loop
          if Chars (Disc) = Chars (Spec_Discriminant) then
-            Set_Scope (Discriminal (Disc), Tsk);
             return Discriminal (Disc);
          end if;