[multiple changes]

2016-07-04  Olivier Hainque  <hainque@adacore.com>

	* g-sercom-mingw.adb (Set): Fix port configuration for the
	non-blocking + null-timeout case, request of immediate return.

2016-07-04  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Is_Non_Overriding_Operation): Add guard to test
	of generic parent type when operation is a parameterless function
	that may dispatch on result.

From-SVN: r237970
This commit is contained in:
Arnaud Charlet 2016-07-04 12:43:01 +02:00
parent c70cf4f8eb
commit ae4c4d53b4
3 changed files with 34 additions and 3 deletions

View File

@ -1,3 +1,14 @@
2016-07-04 Olivier Hainque <hainque@adacore.com>
* g-sercom-mingw.adb (Set): Fix port configuration for the
non-blocking + null-timeout case, request of immediate return.
2016-07-04 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb (Is_Non_Overriding_Operation): Add guard to test
of generic parent type when operation is a parameterless function
that may dispatch on result.
2016-07-04 Hristian Kirtchev <kirtchev@adacore.com>
* freeze.adb, ghost.adb, sem_ch13.adb: Minor reformatting.

View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2007-2013, 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- --
@ -248,11 +248,27 @@ package body GNAT.Serial_Communications is
Raise_Error ("cannot set comm state");
end if;
-- Set the timeout status
-- Set the timeout status, to honor our spec with respect to
-- read timeouts. Always disconnect write timeouts.
if Block then
-- Blocking reads - no timeout at all
Com_Time_Out := (others => 0);
elsif Timeout = 0.0 then
-- Non-blocking reads and null timeout - immediate return
-- with what we have - set ReadIntervalTimeout to MAXDWORD.
Com_Time_Out :=
(ReadIntervalTimeout => DWORD'Last,
others => 0);
else
-- Non-blocking reads with timeout - set total read timeout
-- accordingly
Com_Time_Out :=
(ReadTotalTimeoutConstant => DWORD (1000 * Timeout),
others => 0);

View File

@ -9077,6 +9077,8 @@ package body Sem_Ch6 is
-- tested.
Formal := First_Formal (Prev_E);
F_Typ := Empty;
while Present (Formal) loop
F_Typ := Base_Type (Etype (Formal));
@ -9090,6 +9092,8 @@ package body Sem_Ch6 is
Next_Formal (Formal);
end loop;
-- If the function dispatches on result check the result type.
if No (G_Typ) and then Ekind (Prev_E) = E_Function then
G_Typ := Get_Generic_Parent_Type (Base_Type (Etype (Prev_E)));
end if;
@ -9168,7 +9172,7 @@ package body Sem_Ch6 is
-- private part of the instance. Emit a warning now, which will
-- make the subsequent error message easier to understand.
if not Is_Abstract_Type (F_Typ)
if Present (F_Typ) and then not Is_Abstract_Type (F_Typ)
and then Is_Abstract_Subprogram (Prev_E)
and then In_Private_Part (Current_Scope)
then