Bug 19526 - Windows errorcodes wrong in Ada when tasking
Summary: Windows errorcodes wrong in Ada when tasking
Status: RESOLVED WONTFIX
Alias: None
Product: gcc
Classification: Unclassified
Component: ada (show other bugs)
Version: 3.4.2
: P2 normal
Target Milestone: ---
Assignee: Not yet assigned to anyone
URL:
Keywords:
Depends on:
Blocks:
 
Reported: 2005-01-19 08:39 UTC by Björn Lundin
Modified: 2005-07-23 22:49 UTC (History)
2 users (show)

See Also:
Host:
Target: i686-pc-mingw32
Build:
Known to work:
Known to fail:
Last reconfirmed:


Attachments

Note You need to log in before you can comment on or make changes to this bug.
Description Björn Lundin 2005-01-19 08:39:22 UTC
BUG REPORTS HAVE TO CONTAIN AT LEAST THE FOLLOWING INFORMATION IN ORDER TO BE 
USEFUL:

the exact version of GCC, as shown by "gcc -v"; 

  gcc -v
  Reading specs from C:/languages/MinGW/bin/../lib/gcc/mingw32/3.4.2/specs
  Configured with: ../gcc/configure --with-gcc --with-gnu-ld --with-gnu-as --
host=mingw32 --target=mingw32 --prefix=/mingw --enable-threads --disable-nls --
enable-languages=c,c++,f77,ada,objc,java --disable-win32-registry --disable-
shared --enable-sjlj-exceptions --enable-libgcj --disable-java-awt --without-x -
-enable-java-gc=boehm --disable-libgcj-debug --enable-interpreter --enable-hash-
synchronization --enable-libstdcxx-debug
  Thread model: win32
  gcc version 3.4.2 (mingw-special)




THE SYSTEM TYPE; 
  Windows 2000 Professional, Windows 2000 Server, Windows 2003

THE OPTIONS WHEN GCC WAS CONFIGURED/BUILT; 
  Binaries used from minGW containing

  MinGW version 3.2.0 contains the following list of packages: 
   
  gcc-ada-3.4.2.tar.gz 
  gcc-core-3.4.2.tar.gz 
  gcc-g++-3.4.2.tar.gz 
  gcc-g77-3.4.2.tar.gz 
  gcc-java-3.4.2.tar.gz 
  gcc-objc-3.4.2.tar.gz 
  binutils-2.15.91-20040904-1 
  mingw-runtime-3.6 
  w32api-3.2 
  gdb-5.2.1-1 
  mingw32-make-3.80.0-3 
  mingw-utils-0.3.tar.gz 
  
  
  But this bug also applies to the 'official' gnat 3.15p from ACT


THE EXACT COMMAND LINE PASSED TO THE GCC PROGRAM TRIGGERING THE BUG
(not just the flags passed to gnatmake, but gnatmake prints the parameters it 
passed to gcc) 


  C:\Temp>gnatmake socket_connect.adb
  gcc -c socket_connect.adb
  socket_connect.adb:3:18: warning: "Gnat.Sockets.Thin" is an internal GNAT unit
  socket_connect.adb:3:18: warning: use of this unit is non-portable and 
version-d
  ependent
  gnatbind -x socket_connect.ali
  gnatlink socket_connect.ali

A COLLECTION OF SOURCE FILES FOR REPRODUCING THE BUG, PREFERABLY A MINIMAL SET 
(SEE BELOW); 

  with Text_Io;
  with Gnat.Sockets;
  with Gnat.Sockets.Thin;
  with Ada.Exceptions;
  
  procedure Socket_Connect is
    Socket   : Gnat.Sockets.Socket_Type;
    Address  : Gnat.Sockets.Sock_Addr_Type;
    Error    : Integer := 0;
    --------------------------------------------------
    task type Run_Once is
      entry Execute;
    end Run_Once;
    --------------------------------------------------
    task body Run_Once is
    begin
      select
        accept Execute do
          text_io.put_line("Task running, Execute!");
        end Execute;
      or
        terminate;
      end select;
    end Run_Once;
    --------------------------------------------------  
  begin
    declare
      TmpTask : Run_Once;
    begin
      TmpTask.Execute;
    end;
  
    text_io.put_line("Startup sockets");
    Gnat.Sockets.Initialize;
  
    text_io.put_line("Get a socket");
    Gnat.Sockets.Create_Socket (Socket);
  
    text_io.put_line("Try to connect!");
    Address.Addr := Gnat.Sockets.Inet_Addr("127.0.0.1"); 
    Address.Port := 8000;
    Gnat.Sockets.Connect_Socket (Socket, Address);
    text_io.put_line("Connected!");
  
    text_io.put_line("Close socket!");
    Gnat.Sockets.Close_Socket (Socket);
  
    text_io.put_line("Shutdown sockets!");
    Gnat.Sockets.Finalize;
  
    text_io.put_line("Done!");
  exception
    when E: others =>
     Text_IO.Put_Line(Ada.Exceptions.Exception_Name (E) & ": " & 
                      Ada.Exceptions.Exception_Message (E));
     
     Error := Gnat.Sockets.Thin.Socket_Errno;
     Text_IO.Put_Line(Integer'Image(Error) & " - " ) ; --& 
  --            Gnat.Sockets.Thin.Socket_Error_Message (Error));
   
     Text_IO.Put_Line("Resolve_Exception" & " - " & 
       Gnat.Sockets.Error_Type'Image(Gnat.Sockets.Resolve_Exception(E)));
  
     Gnat.Sockets.Finalize;
  
  end Socket_Connect;



A DESCRIPTION OF THE EXPECTED BEHAVIOR; 
  I'd like an output like this:
  
  C:\Temp>socket_connect
  Task running, Execute!
  Startup sockets
  Get a socket
  Try to connect!
  GNAT.SOCKETS.SOCKET_ERROR: [10061] Connection refused
   10061 -
  Resolve_Exception - CONNECTION_REFUSED
  
  
  Note the second last line, printed by a call to
  Gnat.Sockets.Thin.Socket_Errno.
  
  I get the behavior when I comment out the task type.
  (well not the 'Task running, Execute' of course)


A DESCRIPTION OF ACTUAL BEHAVIOR. 
  C:\Temp>socket_connect
  Task running, Execute!
  Startup sockets
  Get a socket
  Try to connect!
  GNAT.SOCKETS.SOCKET_ERROR: [10061] Connection refused
   0 -
  Resolve_Exception - CONNECTION_REFUSED
  
  Note the second last line, printed by a call to
  Gnat.Sockets.Thin.Socket_Errno.
  This time there's no error! 
  This behavior occurs when any task at all is involved. If I write my
  own socket biding, and call WSAGetLastError 
  (as Gnat.Sockets.Thin.Socket_Errno does)
  I still have this behavior. So I can recognize a socketerror,
  via the fact that c-socket function return -1 on error but
  NOT find the reason, unless I use Gnat.sockets, and mask the error out from
  the exception, which breaks socket code not written unsing Gnat.Sockets



/Björn
Comment 1 Arnaud Charlet 2005-03-17 10:27:16 UTC
I do not see any GNAT bug here. Potentially a problem in your code,
or in the Win32 API you used, but that's all.

Note that GNAT.Sockets.Thin as shown in your build output is an internal
unit that should not be used directly.

Arno
Comment 2 Björn Lundin 2005-03-18 22:45:16 UTC
How come not many people see this as a bug? 
When a program behaves differently, just because 
a totally non-related task was introduced, I  
consider it a bug. I think Danny is on the right track. 
 
As for the remark of using internal gnat-units, I do state 
that I get the same result if I import WSAGetLastError myself, 
in the same way gnat.sockets.this does, and that way is  
the only way to go. 
function Last_Error return Interfaces.c.int (or long) 
pragma Import(stdcall,Last_Error,WSAGetLastError)  
 
/Björn 
Comment 3 Danny Smith 2005-03-19 11:14:58 UTC
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;
Comment 4 Björn Lundin 2005-03-19 13:02:19 UTC
Danny, to me it seems you've got the solution.  
What will happen next? Will your patch make it into 
the next version, or does it have to be approved by 
someone else, who might not think it's a bug at all? 
Or is this not the correct place to ask this question? 
(I'm a bit confused about how the work on mingw/gcc is organized 
with respect to ACT, the 'gnat-company') 
 
/Björn 
 
Comment 5 charlet@adacore.com 2005-03-19 13:54:58 UTC
Subject: Re:  Windows errorcodes wrong in Ada when tasking

> IMO, resetting the error code set by the kernel whenever the internal Ada
> tasking functions are called successfully is a bug.

So you are saying that there is a bug in the Windows kernel ?
Since the Ada run time does not do any reset of the error code.

> It can be easily fixed:

I don't see how this fixes things, since TlsGetValue is also called
in the Self function.

Is_Valid_Task is not called in the test case at hand, and Set is called
during task elaboration, so that's also not problematic.

Did you get a "successful"run of the application with this patch ?
If so, it probably means that the problem is elsewhere and that this
patch is just hiding it.

The function which is called when you use tasking constructs is
Self, and this function is time critical, so it is simply out of the
question to call GetLastError/SetLastError there.

If you want to know the error code associated with your socket call,
you should save the result right away, and not delay this operation.

Arno
Comment 6 Danny Smith 2005-03-20 01:26:58 UTC
Oops, I had split up the patch into a non-critical (as far as
this bug report is concerned) part and a critical part, but messed up when
I pasted into bug report.

Following is the part for Self

In reply to other query in comment #5

The behaviour of TlsGetValue (and the reason for it) is documented, so when
users call it directly, they should know to save and restore the error code
if they want to.

The calls in s-taprop.adb are indirect calls by an internal Ada function, so
users wouldn't know that they should do anything special.

It affects not just windows socket errors, but any error code set by a win32api
function 

But if, as you say, its out of the question to fix this, I won't waste
any more time caring about it.  Perhaps I need to investigate the efects of
these Get/SetLastError calls on c++ code (they are used in gthr-win32.c)

Danny


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	20 Mar 2005 00:49:58 -0000
*************** package body System.Task_Primitives.Oper
*** 367,381 ****
     -- Self --
     ----------
  
!    function Self return Task_Id is
!       Self_Id : constant Task_Id := To_Task_Id (TlsGetValue (TlsIndex));
!    begin
!       if Self_Id = null then
!          return Register_Foreign_Thread (GetCurrentThread);
!       else
!          return Self_Id;
!       end if;
!    end Self;
  
     ---------------------
     -- Initialize_Lock --
--- 381,400 ----
     -- Self --
     ----------
  
!      function Self return Task_ID is
!         Saved_Err_Code : DWORD;
!         Self_Id        : Task_ID;
!   
!      begin
!         Saved_Err_Code := GetLastError;
!         Self_Id := To_Task_Id (TlsGetValue (TlsIndex));
!         if Self_Id = null then
!            return Register_Foreign_Thread (GetCurrentThread);
!         else
!            SetLastError (Saved_Err_Code);
!            return Self_Id;
!         end if;
!      end Self;
  
     ---------------------
     -- Initialize_Lock --
Comment 7 Arnaud Charlet 2005-06-20 08:12:44 UTC
Closing, as discussed, it would be an undesirable performance hit to make changes
in this area.

Arno