Commit cccb761b by Arnaud Charlet

[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
parent 6a3936d4
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> 2017-04-25 Arnaud Charlet <charlet@adacore.com trojanek>
PR ada/78845 PR ada/78845
......
...@@ -414,7 +414,8 @@ package body Exp_Ch6 is ...@@ -414,7 +414,8 @@ package body Exp_Ch6 is
-- master. -- master.
if Is_Library_Level_Entity (Ptr_Typ) 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 then
Actual := Make_Null (Loc); Actual := Make_Null (Loc);
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -36,6 +36,56 @@ with Interfaces.C; ...@@ -36,6 +36,56 @@ with Interfaces.C;
package GNAT.Serial_Communications is 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; Serial_Error : exception;
-- Raised when a communication problem occurs -- Raised when a communication problem occurs
......
...@@ -8908,6 +8908,13 @@ package body Sem_Ch13 is ...@@ -8908,6 +8908,13 @@ package body Sem_Ch13 is
Make_Defining_Identifier (Loc, Make_Defining_Identifier (Loc,
Chars => New_External_Name (Chars (Typ), "Predicate")); 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 := Spec :=
Make_Function_Specification (Loc, Make_Function_Specification (Loc,
Defining_Unit_Name => Func_Id, Defining_Unit_Name => Func_Id,
......
...@@ -10711,7 +10711,15 @@ package body Sem_Res is ...@@ -10711,7 +10711,15 @@ package body Sem_Res is
-- Mixed-mode operation involving a literal. Context must be a fixed -- Mixed-mode operation involving a literal. Context must be a fixed
-- type which is applied to the literal subsequently. -- 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); Set_Etype (Operand, Universal_Real);
elsif Is_Numeric_Type (Typ) elsif Is_Numeric_Type (Typ)
...@@ -11722,12 +11730,7 @@ package body Sem_Res is ...@@ -11722,12 +11730,7 @@ package body Sem_Res is
----------------------------- -----------------------------
function Unique_Fixed_Point_Type (N : Node_Id) return Entity_Id is function Unique_Fixed_Point_Type (N : Node_Id) return Entity_Id is
T1 : Entity_Id := Empty; procedure Fixed_Point_Error (T1 : Entity_Id; T2 : Entity_Id);
T2 : Entity_Id;
Item : Node_Id;
Scop : Entity_Id;
procedure Fixed_Point_Error;
-- Give error messages for true ambiguity. Messages are posted on node -- Give error messages for true ambiguity. Messages are posted on node
-- N, and entities T1, T2 are the possible interpretations. -- N, and entities T1, T2 are the possible interpretations.
...@@ -11735,13 +11738,21 @@ package body Sem_Res is ...@@ -11735,13 +11738,21 @@ package body Sem_Res is
-- Fixed_Point_Error -- -- Fixed_Point_Error --
----------------------- -----------------------
procedure Fixed_Point_Error is procedure Fixed_Point_Error (T1 : Entity_Id; T2 : Entity_Id) is
begin begin
Error_Msg_N ("ambiguous universal_fixed_expression", N); Error_Msg_N ("ambiguous universal_fixed_expression", N);
Error_Msg_NE ("\\possible interpretation as}", N, T1); Error_Msg_NE ("\\possible interpretation as}", N, T1);
Error_Msg_NE ("\\possible interpretation as}", N, T2); Error_Msg_NE ("\\possible interpretation as}", N, T2);
end Fixed_Point_Error; 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 -- Start of processing for Unique_Fixed_Point_Type
begin begin
...@@ -11761,7 +11772,7 @@ package body Sem_Res is ...@@ -11761,7 +11772,7 @@ package body Sem_Res is
and then Scope (Base_Type (T2)) = Scop and then Scope (Base_Type (T2)) = Scop
then then
if Present (T1) then if Present (T1) then
Fixed_Point_Error; Fixed_Point_Error (T1, T2);
return Any_Type; return Any_Type;
else else
T1 := T2; T1 := T2;
...@@ -11787,7 +11798,7 @@ package body Sem_Res is ...@@ -11787,7 +11798,7 @@ package body Sem_Res is
and then (Is_Potentially_Use_Visible (T2) or else In_Use (T2)) and then (Is_Potentially_Use_Visible (T2) or else In_Use (T2))
then then
if Present (T1) then if Present (T1) then
Fixed_Point_Error; Fixed_Point_Error (T1, T2);
return Any_Type; return Any_Type;
else else
T1 := T2; T1 := T2;
...@@ -11802,11 +11813,20 @@ package body Sem_Res is ...@@ -11802,11 +11813,20 @@ package body Sem_Res is
end loop; end loop;
if Nkind (N) = N_Real_Literal then if Nkind (N) = N_Real_Literal then
Error_Msg_NE Error_Msg_NE ("??real literal interpreted as }!", N, T1);
("??real literal interpreted as }!", N, T1);
else 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 Error_Msg_NE
("??universal_fixed expression interpreted as }!", N, T1); ("??universal_fixed expression interpreted as }!", ErrN, T1);
end if; end if;
return T1; return T1;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment