From ae4c4d53b46fb246534cc9de41d230610b50d99a Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 4 Jul 2016 12:43:01 +0200 Subject: [PATCH] [multiple changes] 2016-07-04 Olivier Hainque * g-sercom-mingw.adb (Set): Fix port configuration for the non-blocking + null-timeout case, request of immediate return. 2016-07-04 Ed Schonberg * 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 --- gcc/ada/ChangeLog | 11 +++++++++++ gcc/ada/g-sercom-mingw.adb | 20 ++++++++++++++++++-- gcc/ada/sem_ch6.adb | 6 +++++- 3 files changed, 34 insertions(+), 3 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c0f7ff767f6..55e56f78bbc 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,14 @@ +2016-07-04 Olivier Hainque + + * g-sercom-mingw.adb (Set): Fix port configuration for the + non-blocking + null-timeout case, request of immediate return. + +2016-07-04 Ed Schonberg + + * 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 * freeze.adb, ghost.adb, sem_ch13.adb: Minor reformatting. diff --git a/gcc/ada/g-sercom-mingw.adb b/gcc/ada/g-sercom-mingw.adb index 292ca8f563e..ec3beaa2b03 100644 --- a/gcc/ada/g-sercom-mingw.adb +++ b/gcc/ada/g-sercom-mingw.adb @@ -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); diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 5865b874f38..0b5f7a3ba29 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -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 -- 2.30.2