[Bug ada/19526] Windows errorcodes wrong in Ada when tasking

[dannysmith at users dot sourceforge dot net]

------- Additional Comments From dannysmith at users dot sourceforge dot net  2005-03-19 11:14 -------
IMO, resetting the error code set by the kernel whenever the internal Ada
tasking functions are called successfully is a bug.  It can be easily fixed:

	* s-osinte-mingw.ads (SetLastError): Import win32api function.
	* s-taprop-mingw.adb (Specific.Is_Valid_Task): Save last OS
	error code and restore if TlsGetValue succeeds.
	(Specific.Set): Likewise.

Index: s-osinte-mingw.ads
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/s-osinte-mingw.ads,v
retrieving revision 1.1
diff -c -3 -p -r1.1 s-osinte-mingw.ads
*** s-osinte-mingw.ads	14 May 2004 10:02:00 -0000	1.1
--- s-osinte-mingw.ads	19 Mar 2005 10:57:53 -0000
*************** pragma Preelaborate;
*** 433,438 ****
--- 433,441 ----
     function GetLastError return DWORD;
     pragma Import (Stdcall, GetLastError, "GetLastError");
  
+    procedure SetLastError (dwErrCode : DWORD);
+    pragma Import (Stdcall, SetLastError, "SetLastError");
+ 
  private
  
     type sigset_t is new Interfaces.C.unsigned_long;
Index: s-taprop-mingw.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/s-taprop-mingw.adb,v
retrieving revision 1.7
diff -c -3 -p -r1.7 s-taprop-mingw.adb
*** s-taprop-mingw.adb	10 Feb 2005 13:57:21 -0000	1.7
--- s-taprop-mingw.adb	19 Mar 2005 10:57:55 -0000
*************** package body System.Task_Primitives.Oper
*** 143,160 ****
  
     end Specific;
  
     package body Specific is
  
        function Is_Valid_Task return Boolean is
        begin
!          return TlsGetValue (TlsIndex) /= System.Null_Address;
        end Is_Valid_Task;
  
        procedure Set (Self_Id : Task_Id) is
           Succeeded : BOOL;
        begin
           Succeeded := TlsSetValue (TlsIndex, To_Address (Self_Id));
           pragma Assert (Succeeded = True);
        end Set;
  
     end Specific;
--- 143,174 ----
  
     end Specific;
  
+    --  Unlike other win32api functions, TlsGetValue resets the OS error
+    --  status to O on success.  Save and restore the error code so it
+    --  doesn't get clobbered behind the user's back when multi-tasking.
+ 
     package body Specific is
  
        function Is_Valid_Task return Boolean is
+          Succeeded : Boolean;
+          Saved_Err_Code : DWORD;
        begin
!          Saved_Err_Code := GetLastError;
!          Succeeded := TlsGetValue (TlsIndex) /= System.Null_Address;
!          if Succeeded then
!             SetLastError (Saved_Err_Code);
!          end if;
!          return Succeeded;
        end Is_Valid_Task;
  
        procedure Set (Self_Id : Task_Id) is
           Succeeded : BOOL;
+          Saved_Err_Code : DWORD;
        begin
+          Saved_Err_Code := GetLastError;
           Succeeded := TlsSetValue (TlsIndex, To_Address (Self_Id));
           pragma Assert (Succeeded = True);
+          SetLastError (Saved_Err_Code);
        end Set;
  
     end Specific;

-- 


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=19526