[multiple changes]

2017-04-25  Pascal Obry  <obry@adacore.com>

	* g-sercom.ads: Add simple usage of GNAT.Serial_Communication.

2017-04-25  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_res.adb (Resolve_Type_Conversion):
	When resolving against any fixed type, set the type of the
	operand as universal real when the operand is a multiplication
	or a division where both operands are of any fixed type.
	(Unique_Fixed_Point_Type): Add local variable ErrN. Improve the
	placement of an error message by pointing to the operand of a
	type conversion rather than the conversion itself.

2017-04-25  Thomas Quinot  <quinot@adacore.com>

	* sem_ch13.adb (Build_Predicate_Function_Declaration): Set
	Needs_Debug_Info when producing SCOs.

2017-04-25  Thomas Quinot  <quinot@adacore.com>

	* exp_ch6.adb (Add_Finalization_Master_Actual_To_Build_In_Place_Call):
	Always pass a null finalization master for a library level named access
	type to which a pragme No_Heap_Finalization applies.

From-SVN: r247216

5 files changed, 118 insertions, 15 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 3e6afcd..7f7a28a 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,28 @@
+2017-04-25  Pascal Obry  <obry@adacore.com>
+
+	* g-sercom.ads: Add simple usage of GNAT.Serial_Communication.
+
+2017-04-25  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_res.adb (Resolve_Type_Conversion):
+	When resolving against any fixed type, set the type of the
+	operand as universal real when the operand is a multiplication
+	or a division where both operands are of any fixed type.
+	(Unique_Fixed_Point_Type): Add local variable ErrN. Improve the
+	placement of an error message by pointing to the operand of a
+	type conversion rather than the conversion itself.
+
+2017-04-25  Thomas Quinot  <quinot@adacore.com>
+
+	* sem_ch13.adb (Build_Predicate_Function_Declaration): Set
+	Needs_Debug_Info when producing SCOs.
+
+2017-04-25  Thomas Quinot  <quinot@adacore.com>
+
+	* exp_ch6.adb (Add_Finalization_Master_Actual_To_Build_In_Place_Call):
+	Always pass a null finalization master for a library level named access
+	type to which a pragme No_Heap_Finalization applies.
+
 2017-04-25  Arnaud Charlet  <charlet@adacore.com trojanek>
 
 	PR ada/78845
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 2a42528..24de185 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -414,7 +414,8 @@ package body Exp_Ch6 is
             --  master.
 
             if Is_Library_Level_Entity (Ptr_Typ)
-              and then Finalize_Storage_Only (Desig_Typ)
+              and then (Finalize_Storage_Only (Desig_Typ)
+                          or else No_Heap_Finalization (Ptr_Typ))
             then
                Actual := Make_Null (Loc);
 
diff --git a/gcc/ada/g-sercom.ads b/gcc/ada/g-sercom.ads
index 9987011..f185a77 100644
--- a/gcc/ada/g-sercom.ads
+++ b/gcc/ada/g-sercom.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---                    Copyright (C) 2007-2015, AdaCore                      --
+--                    Copyright (C) 2007-2016, 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- --
@@ -36,6 +36,56 @@ with Interfaces.C;
 
 package GNAT.Serial_Communications is
 
+   --  Following is a simple example of using GNAT.Serial_Communications.
+   --
+   --  with Ada.Streams;
+   --  with GNAT.Serial_Communications;
+   --
+   --  procedure Serial is
+   --     use Ada.Streams;
+   --     use GNAT;
+   --
+   --     subtype Message is Stream_Element_Array (1 .. 20);
+   --
+   --     Data   : constant String (1 .. 20)  := "ABCDEFGHIJLKMNOPQRST";
+   --     Buffer : Message;
+   --
+   --     S_Port : constant Natural := 5;
+   --     --  Serial port number
+   --
+   --  begin
+   --     --  Convert message (String -> Stream_Element_Array)
+   --
+   --     for K in Data'Range loop
+   --        Buffer (Stream_Element_Offset (K)) := Character'Pos (Data (K));
+   --     end loop;
+   --
+   --     declare
+   --        Port_Name : constant Serial_Communications.Port_Name :=
+   --                      Serial_Communications.Name (Number => S_Port);
+   --        Port      : Serial_Communications.Serial_Port;
+   --
+   --     begin
+   --        Serial_Communications.Open
+   --          (Port => Port,
+   --           Name => Port_Name);
+   --
+   --        Serial_Communications.Set
+   --          (Port      => Port,
+   --           Rate      => Serial_Communications.B9600,
+   --           Bits      => Serial_Communications.CS8,
+   --           Stop_Bits => Serial_Communications.One,
+   --           Parity    => Serial_Communications.Even);
+   --
+   --        Serial_Communications.Write
+   --          (Port   => Port,
+   --           Buffer => Buffer);
+   --
+   --        Serial_Communications.Close
+   --          (Port => Port);
+   --     end;
+   --  end Serial;
+
    Serial_Error : exception;
    --  Raised when a communication problem occurs
 
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 14d71af..38e8279 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -8908,6 +8908,13 @@ package body Sem_Ch13 is
         Make_Defining_Identifier (Loc,
           Chars => New_External_Name (Chars (Typ), "Predicate"));
 
+      --  The predicate function requires debug info when the predicates are
+      --  subject to Source Coverage Obligations.
+
+      if Opt.Generate_SCO then
+         Set_Debug_Info_Needed (Func_Id);
+      end if;
+
       Spec :=
         Make_Function_Specification (Loc,
           Defining_Unit_Name       => Func_Id,
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 683686f..2a8010d 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -10711,7 +10711,15 @@ package body Sem_Res is
          --  Mixed-mode operation involving a literal. Context must be a fixed
          --  type which is applied to the literal subsequently.
 
-         if Is_Fixed_Point_Type (Typ) then
+         --  Multiplication and division involving two fixed type operands must
+         --  yield a universal real because the result is computed in arbitrary
+         --  precision.
+
+         if Is_Fixed_Point_Type (Typ)
+           and then Nkind_In (Operand, N_Op_Divide, N_Op_Multiply)
+           and then Etype (Left_Opnd  (Operand)) = Any_Fixed
+           and then Etype (Right_Opnd (Operand)) = Any_Fixed
+         then
             Set_Etype (Operand, Universal_Real);
 
          elsif Is_Numeric_Type (Typ)
@@ -11722,12 +11730,7 @@ package body Sem_Res is
    -----------------------------
 
    function Unique_Fixed_Point_Type (N : Node_Id) return Entity_Id is
-      T1   : Entity_Id := Empty;
-      T2   : Entity_Id;
-      Item : Node_Id;
-      Scop : Entity_Id;
-
-      procedure Fixed_Point_Error;
+      procedure Fixed_Point_Error (T1 : Entity_Id; T2 : Entity_Id);
       --  Give error messages for true ambiguity. Messages are posted on node
       --  N, and entities T1, T2 are the possible interpretations.
 
@@ -11735,13 +11738,21 @@ package body Sem_Res is
       -- Fixed_Point_Error --
       -----------------------
 
-      procedure Fixed_Point_Error is
+      procedure Fixed_Point_Error (T1 : Entity_Id; T2 : Entity_Id) is
       begin
          Error_Msg_N ("ambiguous universal_fixed_expression", N);
          Error_Msg_NE ("\\possible interpretation as}", N, T1);
          Error_Msg_NE ("\\possible interpretation as}", N, T2);
       end Fixed_Point_Error;
 
+      --  Local variables
+
+      ErrN : Node_Id;
+      Item : Node_Id;
+      Scop : Entity_Id;
+      T1   : Entity_Id;
+      T2   : Entity_Id;
+
    --  Start of processing for Unique_Fixed_Point_Type
 
    begin
@@ -11761,7 +11772,7 @@ package body Sem_Res is
               and then Scope (Base_Type (T2)) = Scop
             then
                if Present (T1) then
-                  Fixed_Point_Error;
+                  Fixed_Point_Error (T1, T2);
                   return Any_Type;
                else
                   T1 := T2;
@@ -11787,7 +11798,7 @@ package body Sem_Res is
                  and then (Is_Potentially_Use_Visible (T2) or else In_Use (T2))
                then
                   if Present (T1) then
-                     Fixed_Point_Error;
+                     Fixed_Point_Error (T1, T2);
                      return Any_Type;
                   else
                      T1 := T2;
@@ -11802,11 +11813,20 @@ package body Sem_Res is
       end loop;
 
       if Nkind (N) = N_Real_Literal then
-         Error_Msg_NE
-           ("??real literal interpreted as }!", N, T1);
+         Error_Msg_NE ("??real literal interpreted as }!", N, T1);
+
       else
+         --  When the context is a type conversion, issue the warning on the
+         --  expression of the conversion because it is the actual operation.
+
+         if Nkind_In (N, N_Type_Conversion, N_Unchecked_Type_Conversion) then
+            ErrN := Expression (N);
+         else
+            ErrN := N;
+         end if;
+
          Error_Msg_NE
-           ("??universal_fixed expression interpreted as }!", N, T1);
+           ("??universal_fixed expression interpreted as }!", ErrN, T1);
       end if;
 
       return T1;