+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
-- 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);
-- --
-- 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- --
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
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,
-- 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)
-----------------------------
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.
-- 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
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;
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;
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;
projects / gcc.git / commitdiff