Browse Source

+ added register keyword to Interlocked* definitions as suggested by Jonas, resolves #12255

git-svn-id: trunk@12698 -
florian 16 years ago
parent
commit
0c65d53f45
3 changed files with 28 additions and 6 deletions
  1. 1 0
      .gitattributes
  2. 6 6
      rtl/win/wininc/redef.inc
  3. 21 0
      tests/webtbs/tw12255.pp

+ 1 - 0
.gitattributes

@@ -8719,6 +8719,7 @@ tests/webtbs/tw12233.pp svneol=native#text/plain
 tests/webtbs/tw12237.pp svneol=native#text/plain
 tests/webtbs/tw12242.pp svneol=native#text/plain
 tests/webtbs/tw12249.pp svneol=native#text/plain
+tests/webtbs/tw12255.pp svneol=native#text/plain
 tests/webtbs/tw1228.pp svneol=native#text/plain
 tests/webtbs/tw1229.pp svneol=native#text/plain
 tests/webtbs/tw12318.pp svneol=native#text/plain

+ 6 - 6
rtl/win/wininc/redef.inc

@@ -1004,18 +1004,18 @@ function SetKeyboardState(var KeyState:TKeyboardState):WINBOOL; external 'user32
 function GetWindowThreadProcessId(hWnd:HWND;var lpdwProcessId:DWORD):DWORD; external 'user32' name 'GetWindowThreadProcessId';
 function HwndMSWheel(var puiMsh_MsgMouseWheel, puiMsh_Msg3DSupport,puiMsh_MsgScrollLines: UINT;
   var pf3DSupport: BOOL; var piScrollLines: Integer): HWND;
-function CreateWaitableTimer(lpTimerAttributes :LPSECURITY_ATTRIBUTES; bManualReset:BOOl;lpTimerName:LPCTSTR):THandle;external 'kernel32' name 'CreateWaitableTimerA'; 
+function CreateWaitableTimer(lpTimerAttributes :LPSECURITY_ATTRIBUTES; bManualReset:BOOl;lpTimerName:LPCTSTR):THandle;external 'kernel32' name 'CreateWaitableTimerA';
 function OpenWaitableTimer(dwDesiredAccess:DWORD;bInheritHandle:BOOL;lpTimerName:LPCTSTR):THandle;external 'kernel32' name 'OpenWaitableTimerA';
 //function PropertySheetA(p:TPROPSHEETHEADER):longint; external 'comctl32' name 'PropertySheetA';
 
 // windows because of Delphi compat.
 
 {$calling default}
-function InterLockedIncrement (var Target: longint) : longint; external name 'FPC_INTERLOCKEDINCREMENT';
-function InterLockedDecrement (var Target: longint) : longint; external name 'FPC_INTERLOCKEDDECREMENT';
-function InterLockedExchange (var Target: longint;Source : longint) : longint; external name 'FPC_INTERLOCKEDEXCHANGE';
-function InterLockedExchangeAdd (var Target: longint;Source : longint) : longint; external name 'FPC_INTERLOCKEDEXCHANGEADD';
-function InterlockedCompareExchange(var Target: longint; NewValue: longint; Comperand: longint): longint; external name 'FPC_INTERLOCKEDCOMPAREEXCHANGE';
+function InterLockedIncrement (var Target: longint) : longint; register; external name 'FPC_INTERLOCKEDINCREMENT';
+function InterLockedDecrement (var Target: longint) : longint; register; external name 'FPC_INTERLOCKEDDECREMENT';
+function InterLockedExchange (var Target: longint;Source : longint) : longint; register; external name 'FPC_INTERLOCKEDEXCHANGE';
+function InterLockedExchangeAdd (var Target: longint;Source : longint) : longint; register; external name 'FPC_INTERLOCKEDEXCHANGEADD';
+function InterlockedCompareExchange(var Target: longint; NewValue: longint; Comperand: longint): longint; register; external name 'FPC_INTERLOCKEDCOMPAREEXCHANGE';
 {$calling stdcall}
 
 {$endif read_interface}

+ 21 - 0
tests/webtbs/tw12255.pp

@@ -0,0 +1,21 @@
+{ %target=win32 }
+{$mode objfpc}
+uses sysutils
+    , windows
+    ;
+var
+    SharedInt : PInteger;
+    target : integer;
+    savetarget : integer;
+
+begin
+    target := 0;
+    savetarget := system.InterlockedCompareExchange(Target, 1, 0);
+    Writeln(format('%d = InterlockedCompareExchange(Target= %d , 1, 0)',[savetarget, target]));
+    SharedInt := AllocMem(SizeOf(Integer));
+    SharedInt^ := 0;
+// here is runtime exception rised - access to invalid memory
+    savetarget := windows.InterlockedCompareExchange(SharedInt^, 1, 0);
+    Writeln(format('%d = InterlockedCompareExchange(SharedInt^= %d , 1, 0)',[savetarget, SharedInt^]));
+    FreeMem(SharedInt);
+end.