[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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index c0f7ff767f624eb48e63fbb6be8e033ed6c2ee83..55e56f78bbc5e10c08bf65837d2cc2c78afa6e0b 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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.

diff --git a/gcc/ada/g-sercom-mingw.adb b/gcc/ada/g-sercom-mingw.adb
index 292ca8f563efa4544cbb96376b37d572d638108d..ec3beaa2b0325c240472740689d3d81318846055 100644 (file)
--- 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 5865b874f38d1c66e2e2654d49f6433a29f25310..0b5f7a3ba29728618eabb63d12f4ec0027b4f299 100644 (file)
--- 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