diff --git a/Source/Simba.lpi b/Source/Simba.lpi index 90a219df9..3aa9aefef 100644 --- a/Source/Simba.lpi +++ b/Source/Simba.lpi @@ -763,10 +763,13 @@ + + + - + diff --git a/Source/script/imports/simba.import_base.pas b/Source/script/imports/simba.import_base.pas index cfadc2b86..393d45ca6 100644 --- a/Source/script/imports/simba.import_base.pas +++ b/Source/script/imports/simba.import_base.pas @@ -540,7 +540,12 @@ procedure _LapeBaseClass_Name_Write(const Params: PParamArray); LAPE_WRAPPER_CAL TSimbaBaseClass(Params^[0]^).Name := PString(Params^[1])^; end; -procedure _LapeBaseClass_FreeOnTerminate(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV +procedure _LapeBaseClass_FreeOnTerminate_Read(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +begin + PBoolean(Result)^ := TSimbaBaseClass(Params^[0]^).FreeOnTerminate; +end; + +procedure _LapeBaseClass_FreeOnTerminate_Write(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV begin TSimbaBaseClass(Params^[0]^).FreeOnTerminate := PBoolean(Params^[1])^; end; @@ -633,7 +638,7 @@ procedure ImportBase(Compiler: TSimbaScript_Compiler); addClass('TBaseClass', 'Pointer'); addProperty('TBaseClass', 'Name', 'String', @_LapeBaseClass_Name_Read, @_LapeBaseClass_Name_Write); - addGlobalFunc('procedure TBaseClass.FreeOnTerminate(Value: Boolean);', @_LapeBaseClass_FreeOnTerminate); + addProperty('TBaseClass', 'FreeOnTerminate', 'Boolean', @_LapeBaseClass_FreeOnTerminate_Read, @_LapeBaseClass_FreeOnTerminate_Write); end; end; diff --git a/Source/script/simba.script_threading.pas b/Source/script/simba.script_threading.pas index f98ff983e..3f16c1811 100644 --- a/Source/script/simba.script_threading.pas +++ b/Source/script/simba.script_threading.pas @@ -208,7 +208,7 @@ procedure TSimbaThread.Invoke(Method: TMethod; Params: array of Pointer); SetLength(VarStack, SizeOf(Pointer) + (Length(Params) * SizeOf(Pointer))); PPointer(@VarStack[0])^ := Method.Data; for I := 0 to High(Params) do - PPointer(@VarStack[SizeOf(Pointer) * (I+1)])^ := Params[I]; + PPointer(@VarStack[SizeOf(Pointer) * (I + 1)])^ := Params[I]; FCodeRunner.Run(TCodePos(Method.Code), VarStack); end; diff --git a/Source/simba.baseclass.pas b/Source/simba.baseclass.pas index dee93e72c..7bc8111a7 100644 --- a/Source/simba.baseclass.pas +++ b/Source/simba.baseclass.pas @@ -11,7 +11,7 @@ interface uses Classes, SysUtils, - simba.base, simba.containers; + simba.base, simba.containers, simba.threading; type TSimbaBaseClass = class @@ -41,6 +41,8 @@ TSimbaBaseThread = class(TThread) public constructor Create; reintroduce; virtual; destructor Destroy; override; + + property Terminated; end; procedure PrintUnfreedObjects; @@ -49,24 +51,33 @@ TSimbaBaseThread = class(TThread) implementation +type + TTrackedObjects = specialize TSimbaThreadsafeObjectList; + TTrackedThreads = specialize TSimbaThreadsafeObjectList; + var - TrackedObjects: specialize TSimbaObjectList; - TrackedThreads: specialize TSimbaObjectList; + TrackedObjects: TTrackedObjects; + TrackedThreads: TTrackedThreads; procedure PrintUnfreedObjects; var NeedHeader: Boolean = True; I: Integer; begin - for I := 0 to TrackedObjects.Count - 1 do - if not TrackedObjects[I].FreeOnTerminate then - begin - if NeedHeader then - DebugLn([EDebugLn.YELLOW], 'The following objects were not freed:'); - NeedHeader := False; - - TrackedObjects[I].NotifyUnfreed(); - end; + TrackedObjects.Lock(); + try + for I := 0 to TrackedObjects.Count - 1 do + if not TrackedObjects[I].FreeOnTerminate then + begin + if NeedHeader then + DebugLn([EDebugLn.YELLOW], 'The following objects were not freed:'); + NeedHeader := False; + + TrackedObjects[I].NotifyUnfreed(); + end; + finally + TrackedObjects.Unlock(); + end; end; procedure PrintUnfinishedThreads; @@ -74,15 +85,20 @@ procedure PrintUnfinishedThreads; NeedHeader: Boolean = True; I: Integer; begin - for I := 0 to TrackedThreads.Count - 1 do - if (not TrackedThreads[I].Finished) then - begin - if NeedHeader then - DebugLn([EDebugLn.YELLOW], 'The following threads were still running:'); - NeedHeader := False; - - TrackedThreads[I].NotifyUnfreed(); - end; + TrackedThreads.Lock(); + try + for I := 0 to TrackedThreads.Count - 1 do + if not TrackedThreads[I].Finished then + begin + if NeedHeader then + DebugLn([EDebugLn.YELLOW], 'The following threads were still running:'); + NeedHeader := False; + + TrackedThreads[I].NotifyUnfreed(); + end; + finally + TrackedThreads.Unlock(); + end; end; procedure PrintUnfreedThreads; @@ -90,15 +106,20 @@ procedure PrintUnfreedThreads; NeedHeader: Boolean = True; I: Integer; begin - for I := 0 to TrackedThreads.Count - 1 do - if TrackedThreads[I].Finished and (not TrackedThreads[I].FreeOnTerminate) then - begin - if NeedHeader then - DebugLn([EDebugLn.YELLOW], 'The following threads were not freed:'); - NeedHeader := False; - - TrackedThreads[I].NotifyUnfreed(); - end; + TrackedThreads.Lock(); + try + for I := 0 to TrackedThreads.Count - 1 do + if TrackedThreads[I].Finished and (not TrackedThreads[I].FreeOnTerminate) then + begin + if NeedHeader then + DebugLn([EDebugLn.YELLOW], 'The following threads were not freed:'); + NeedHeader := False; + + TrackedThreads[I].NotifyUnfreed(); + end; + finally + TrackedThreads.Unlock(); + end; end; procedure TSimbaBaseClass.NotifyUnfreed; @@ -160,26 +181,34 @@ destructor TSimbaBaseThread.Destroy; procedure FreeObjects; var - Obj: TSimbaBaseClass; + List: TTrackedObjects; + Thread: TSimbaBaseThread; + I: Integer; begin - for Obj in TrackedObjects.ToArray() do // use ToArray so not to worry about when Free removes from TrackedObjects list. - Obj.Free(); + List := TrackedObjects; + TrackedObjects := nil; + for I := 0 to List.Count - 1 do + List[I].Free(); end; procedure FreeThreads; var + List: TTrackedThreads; Thread: TSimbaBaseThread; + I: Integer; begin - for Thread in TrackedThreads.ToArray() do // .. - if Thread.FreeOnTerminate then - Thread.Terminate() + List := TrackedThreads; + TrackedThreads := nil; + for I := 0 to List.Count - 1 do + if List[I].FreeOnTerminate then + List[I].Terminate() else - Thread.Free(); + List[I].Free(); end; initialization - TrackedObjects := specialize TSimbaObjectList.Create(); - TrackedThreads := specialize TSimbaObjectList.Create(); + TrackedObjects := TTrackedObjects.Create(); + TrackedThreads := TTrackedThreads.Create(); finalization FreeObjects(); diff --git a/Source/simba.containers.pas b/Source/simba.containers.pas index e7ba107b3..74813d3a7 100644 --- a/Source/simba.containers.pas +++ b/Source/simba.containers.pas @@ -17,11 +17,14 @@ interface uses - Classes, SysUtils, + Classes, SysUtils, syncobjs, simba.base; type generic TSimbaList<_T> = class(TObject) + private + function GetFirst: _T; + function GetLast: _T; public type TArr = array of _T; protected @@ -38,6 +41,9 @@ generic TSimbaList<_T> = class(TObject) property Count: Integer read FCount; property Items[Index: Integer]: _T read GetItem write SetItem; default; + + property First: _T read GetFirst; + property Last: _T read GetLast; end; generic TSimbaObjectList<_T: class> = class(specialize TSimbaList<_T>) @@ -55,6 +61,33 @@ generic TSimbaObjectList<_T: class> = class(specialize TSimbaList<_T>) destructor Destroy; override; end; + generic TSimbaThreadsafeObjectList<_T: class> = class(TObject) + protected type + TList = specialize TSimbaObjectList<_T>; + protected + FList: TList; + FLock: TCriticalSection; + + function GetCount: Integer; + function GetFirst: _T; + function GetLast: _T; + function GetItem(Index: Integer): _T; + public + procedure Add(Item: _T); + procedure Delete(Item: _T); + + procedure Lock; + procedure UnLock; + + property Count: Integer read GetCount; + property Items[Index: Integer]: _T read GetItem; default; + property First: _T read GetFirst; + property Last: _T read GetLast; + + constructor Create; reintroduce; + destructor Destroy; override; + end; + TSimbaStringPair = record Name: String; Value: String; @@ -153,6 +186,20 @@ procedure TSimbaList.SetItem(Index: Integer; AValue: _T); FArr[Index] := AValue; end; +function TSimbaList.GetFirst: _T; +begin + if (FCount = 0) then + SimbaException('%s.GetItem: Index %d out of bounds', [ClassName, 0]); + Result := FArr[0]; +end; + +function TSimbaList.GetLast: _T; +begin + if (FCount = 0) then + SimbaException('%s.GetItem: Index %d out of bounds', [ClassName, 0]); + Result := FArr[FCount - 1]; +end; + function TSimbaList.GetItem(Index: Integer): _T; begin if (Index < 0) or (Index >= FCount) then @@ -247,6 +294,85 @@ destructor TSimbaObjectList.Destroy; inherited Destroy(); end; +function TSimbaThreadsafeObjectList.GetCount: Integer; +begin + Result := FList.Count; +end; + +function TSimbaThreadsafeObjectList.GetFirst: _T; +begin + FLock.Enter(); + try + Result := FList.First; + finally + FLock.Leave(); + end; +end; + +function TSimbaThreadsafeObjectList.GetLast: _T; +begin + FLock.Enter(); + try + Result := FList.Last; + finally + FLock.Leave(); + end; +end; + +function TSimbaThreadsafeObjectList.GetItem(Index: Integer): _T; +begin + FLock.Enter(); + try + Result := FList[Index]; + finally + FLock.Leave(); + end; +end; + +procedure TSimbaThreadsafeObjectList.Add(Item: _T); +begin + FLock.Enter(); + try + FList.Add(Item); + finally + FLock.Leave(); + end; +end; + +procedure TSimbaThreadsafeObjectList.Delete(Item: _T); +begin + FLock.Enter(); + try + FList.Delete(Item); + finally + FLock.Leave(); + end; +end; + +procedure TSimbaThreadsafeObjectList.Lock; +begin + FLock.Enter(); +end; + +procedure TSimbaThreadsafeObjectList.UnLock; +begin + FLock.Leave(); +end; + +constructor TSimbaThreadsafeObjectList.Create; +begin + FList := TList.Create(); + FLock := TCriticalSection.Create(); +end; + +destructor TSimbaThreadsafeObjectList.Destroy; +begin + FreeAndNil(FList); + FreeAndNil(FLock); + + inherited Destroy(); +end; + function TSimbaStack.GetTop: _T; begin if (FCount <= 0) then diff --git a/Tests/matchtemplatemask2.simba b/Tests/matchtemplatemask2.simba index c82c0cc23..82374f10b 100644 --- a/Tests/matchtemplatemask2.simba +++ b/Tests/matchtemplatemask2.simba @@ -4,9 +4,9 @@ var s: Single; begin img := TImage.CreateFromString('IMG:AQAAAIkAAACnAAAAAAAAABAAAAAAAAAAOHuIAAEAAABQ4z8BAAAAAKBoXAcAAAAAoGhcBwAAAACgaFwHAAAAALBWeAABAAAAAQAAAIkAAACnAAAAIAAAAAAAAAAAAAAAAAAAAAMAAAAgCBAICAgACBgBAAACAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAiVBORw0KGgoAAAANSUhEUgAAAIkAAACnCAIAAACq4OjYAAAbSUlEQVR4nO2dCTiUWx/A3e7Xclt0qW7L7bs3ddOiDaWSorRIpRJdUkmLZCkpSxFFocVSIpQlW9nKnn2XfWfs2zAYszHGGKL5zswgMTOGSF/z/p738cz857zvvHN+zv+cd+cIhfhR4eiG+FHhaIX4UeEICwvD4/GTvRrfj4iICCwWO9lrwRIcrq6u7e3tk70a3w9PT0/IzQ/KmN3gcDjwNz09/ZWzC/j7HQSz5AbeAs+ozqCt3Jjx8PB40M/Lly9pwUePHg0EwcjkW5bPImNzQ/vtcXFx0kpaYspWZ9Ru5+Xljf/KfQ1LbmLLYv+0+tM+3R6NRY/5m8zNzePj41Oo3L17lxa8desWLRIQEODi4sLKcnJzcxNYAIPB0J19DG5AeeAmPCJKXO7aPr3AQ/cTxZVMoqJjR7WQMcCSm5jSGG477jXuaxwzHFFY1Ni+CbhJTExMpTLYDS0SFBTEoptz587dvHlTW1v7+vXrV69eVVVVVVZWvnDhgqKi4unTp+Xk5GRkZPj5+REIBN3ZR+UGKKmvrwerFx4evl9Bc4+2n+T9RNErL67qGVdWVjKaKyY22tPLA0ylZaUjR0pLGS2HVTeLXy/mj+fnc+OzSbEZm55xdJOWlpaZmZmcnBwVFRUSEuLv7w9q3NnZ2c7OztLS0szMTExMbFzcoNFoTW190aNKAqJH9t0OkjRJEFFzOnP5OpMKBTwwuy9zUhpMj5889PByA5PGNbUhkavX1GmR2LgYRssZhRuhNCGBRIEV7itM4kya0E0s/rwBxtENSFlJSUlATHBwsJ+fH6huJycnW1tbIMbU1NTQ0HDnzp3f6Aa0GFDs3bt3Aid0gJI1EuqbThrtUrFVUr3R2NjIvOt1dnFSVrmod0snLT0NS8XJ+RV4OyRyQ1tLVV0lPSOd0XJG5wZM/An8yzyWmcabIlD0fzwjxtFNZGQkrcXQxIAWQxMDWgwQo6uru2PHjm93AwAtUkhMcvuFp/sMwnn3Xtp/VB70drTuh/nsbu6uI35FVXVVaFgwkwKjdkNrPas8V5nEmjSiG0dcgwHG0Q1oLnRTmZGRkZ6enqam5vbt27/FzcCoTF9fPzo65tQlTWFlOwnDCDBIy8/PZ0XtpLkBk2CyIM8bnmsfrjW0NIy4EjTG0Y2vry/dVAZazLVr11RUVISEhMbshiYmOjr6zp07+fmFNTVwL08vEXHJfQpaYMsG9EAjNprS0hLrZ5bZ2VmM1oFaphT0NC6uTkzKjNENmDbGbeR+zp1QnsB83gHG0Q3YVKKbykCLAWKUlJQ2b948Nje0VBYbG2toaJSVlYNANAUHhZiY3AfdG9gAAONyVjbyBsYCcXEMx9mm/WXGbSwwMG1O2bzs7TKVEBU4Ej7iutIYRzfOVIansitXrgAxp06dEhAQGIObgVR2+7Z+Xl4BEBMVFaOjo1NSUkLrwFnc+p5MN4JJgrxevAZRBqwntNZxdQOs0E1lQIy8vLy0tPSmTZvG1m7A0FxXV4+ayuqCgoLBa7AcWmNi/ZdisBhXN2fm2Q+UKS8vCwoJZFJmLOM0Hk8eoxijBtQoxLSOqxsrKyu6qQy0GCBGUlJy/fr1o3VDE2BjY+Pr69/Sgg4KCjE2NoHBYKMVQ2MSxgKgxSz3WK4frd+IGsUIjcY4ugGLopvKTpw4cejQIXFxcT4+vjG4yc7ONjK6m5GR9fTpMx0dXZDKxiam9fu7EUgQ4HPje5L0BIlBjm5NqYyjG3V1dVVV1UuXLikqKoIkJiMjIyUlJSEhAayIiIhs3bp11apVo3ID8k9qahpYPXV1DQMDg8DAQCQSOWYx5g/NTsrJyJ06GRD4vqysFEz3jI3A2yGRf+VlQbG4+DhGy2HVzbwX81Z7rLZJHeMOm9bxcwMGafdZoKWlhe7sw90AAUXFsIMyijdu3S0uLq6oqPjGPe4DYwGHl/YRkeFguqmj1RdxfDEkMg5jgYUWC61TrMcspnX83HwjdNuNg5PbtrPmQsc1snNyx9xcBigsLEj5mAwmeD18aATOMDIcltzUImuTK5IxOPp73VkEfNG9fsAoixYE/+C0CLAFMsm3LJ9F6Lp5bG27XdFc8KgGqK1vFDOOQMc9KZSVl1s8tX3l8hp0PJOyVnSB3Py4cIBEz1bn2YSFhf3fuJnsFYBgCOX8NIgfE46u/39IJFLnz8jPkNNQKBT2Z+RncINEIkHTmezWO/78DG6am5shNz8ojNzgkMjytMzqrDw8Fvv9a/bb+Wnd1Obmvz+n4Lh1o6OwQPDVGyg4YlLq91v4Od1kers7r+Wx5p5qwj3r0aJpLzbNfX3xWJarRQssqTb1Ayz5IwHfPrwuCM2VZY1ttJd1sLym1v4P8KjCkupW4ghpE1tflJVT1fp1EFGZW4fqYD4jqaOtqqq8CUdgCzdB8kefzZ1qOe836wXTbFfMCbryR5LaopCDvxfqr87XXpmksRuenzm8jtCRxrrv66gv6x4riHjm939QFi519m4uBk+nXlsqvAPiEe1E8LImyfnJ09B68Aqe7hycQ5Pkqr3tcdQITbYdAbutr+6dDmcLN4H/Hn82a7rtgtk2XFO9BKdlafxWqMWZozEfZyZItNnVYCeJri78qhpwCB8LS2fr61pObywNbUuRLLspBx8ZDf0ozWbbBScE5KaVnpsw2WNvRZa+4OF8PHOa7/aZBRozP6rOSNf8A2kmEqe0LueNFaG56utZSERMjrG81J7dGsmoDhKJrht05hsD5ZtGBmf2b920/fQDn7ra4odKG+YvXLb5oKxVZHm6nYyKax487a2K5ErOxau2K+rFwpoH3CDyo3TPHxTZtevAfiXPzEaQv8pTfFSO84PI4VPXj125xC5ukjTlHUQWPOb8xZRrmv+hOQmKMxLPTkk6P6f8niDMUAhnuQvldhHfMrguiPXxnmpWPoE2F2wCKwn0cxo63VNvl6h8XE1bc663zD6VZFTb4HaTZiN10SmHQbuB255TeBhaCnq50hDL8+qPSrBws+P7zKmRivCnG/cfZhc372WPWnJPd+T69d7iadrrOR8JzjXdMFtfiPO1yuaCx5KND/fVuGm1NtcNmqMTVVdRXteMaaqElTcTGbtRue+BI5C6WtK1xRXcYRhW3cDc1i/i2bJ7P2C3iMAeWbX0/LALO25lUEckbfVFN29eYBc3gaeOveCe6jB36pOFU+6umn1+3jSZWVMvbxcuLy5ubYZjG6oIeDAeYzLuarQ4t8ssvE8evuDdQUXDYizFzfXHvq0gH1HcSL/MZdlNtsO2rdopmDYa+HZCZ46j8Da9TOoIrq2hSEeHbXJa8LkT9vNBu5lqu2iq2YKp17n+c/a3KY81NImdrO4+SHilcsbArR4Hemp0qLWm5G0HbHsrfTeHbySi2oa42XLMqmKwG3T+jQN7zfzywTZwK7qhOL+SACKHD1hFgfzZVRVjL3SQbXJa8L9SdvOn2XL9+uT3afdmzTKdP92Ec8orraudnZ0susHVfHys/u9+sQMHxPfLKBqEFjV3kvB03LRW2lw4sl1a4XlM5Rc3qMxLwht2KBvGlyAHxgKFEa/OHtgIlidxXPZ5aBkYdOd+eHxi1xbxAwdkte7JXWSbnBZ2Uspq8QyTBdPvzp5+j3Pm04Vz7Rf+Zr9tfU1+LonEoh4SsaOdloLaCR20pXcSOwgdROqHnR3t7dSNUVoxPIFI6iS2E/q2T0nUWDtopsQOfAetsZI6CX3L64uANWnHU98TOjo6CMPb9M/ppvDN6wQzo5gHRjH3jeJNDD+a3Ut9aJhibFiZkgRqizU3k8/P6ebnAHLz4wK5+XHh+DR5jNd5cT+tG/LkQSAQIDdM+KncEInEjm+GhEruqTGlTZ3YAiYlQdPvmUh+KjfjkiQ7K0zJ8Ry0qaPOk0nJz58/T2j9QG6GArmhALlhDuRmKJAbCpPuBt1clx3zRufYdl7+M+HVfcEhbqysrF4N49mzZzk5OZCbCXQT43bj8nVTD/OzKzfKh1bRdwNMDJ8xLi4uOzsbuGmtzfKwf+iSWE37RV14ZITHw1cfcro62rLAKxq2tt6ZJd29FJGEygRbR+dMeFNugoeF9TOv5BJcN8P6YWs3JZmRBTWosjfXeMfqhlj8XlJgIe8+Czj1FzUVex/g4j5uFkLEwq0vC3PQmD59/hp+5ww8KNAYfGvJP6s0TO4f3sQ15T9TuVcee5FY+YlB/bC1GxojumlsbCwdRFVV1YAb8ue2SGOpxf9scs4hgl+UYnV0toBMUAGK/PlzJx4JK/oYHx/31tKIbxEn/50IMtXNwsXztoup2L/Og0U/lxKSvO+X09VLv34gNyO7gcFgIYOIo9LnhkzGw1wEFi4/Z5lAIDcbCi8UOfuwvB0kN2ygjfaOLVxTpvQ1ng36H8hUN3NnzhY587AcP3L9QG5GdjN8lsFuyORW8wMLhOTuwjK9Nixbe8e7hASSG8zvANfMpftV/QKCfWxu8S+b88UN19JTDyJaWagfyM23uyEXeqjP4xNTluHn3aaciqEEEQUuotM5hJR0oqMjbp/cyzXlly9u5v911iqewEL9sLWb3A8vjY2NtRVEFizZdF7P2NjGvxqFGeIGDJdjhuHm5jbYTRv846Wtc0HiOvoggVbphOZ8k5Mb587gmPrbbEHRPev/XLAJcjOqGSuyIn0GE5rSgMEOcZOfn59LJT4+3t3dPbcfMEAYcNPbRSjLig0NDS1r6R8R935C1xbGRoaGR0YXV9Xkf0xMKmsBYRKyNCIqJq8a08NC/fxAbtLS0uwHwfptGL7PfoGKioohdw5ho21P8I/5YBAoFKv3zoHcjD+QG+ZAbiA39IDcMAdyA7mhB+SGOWztBtNU+8HT2gRgZumXUIyaaDdtdQGejq5JfQcUiLjqAEe7D7nwTwwWw9Zuoh20z+s8dPP2tnuivnu74tvUMtyEuiGiI60Vl+2SDShoA+8+Oiht3S37LhfdC7kZDgaFRKIoN7pEVmRoHhRStA5vwU5sTvvc0/REdqOIrFFstMOuNSJ3w8oYiSGzuZsBGsvSVPfwqzhEo3AT3t8gc94eElzFu4z7yNX3zUxLQm4oZLnrLN2wxz6qaGJzGpVeQqOTpvgcjqVPM0Y4UMD2bjBNsLd3/vx7s4ZDNAJLucPtRLupy3CV5Fv418Lf18iYleEZHY+mwN5uME2Z75/sXbHlvJF3RX9sYt0QqoyOCWy78Dg62GTrkmWqzxO+nMtBqCI/syfHlAyUZWs3JdHP9i7fLKftVI7+cuvriXRDyHBQ5uOVdM9F95Bb32sd5N6hFFWG6/uw2JXMyUk+fJPc2EkLsLUbz1u7BfgFhbYJi9CQMy5oRk2cm6ZsPxXprbe8YT3U+dobi+8pbZU3e9dBO5mjt5kssYi8W4lcTaSVZ2s3dJm0/QIgp8lsIeu+Ivef5gG5+RHcdJOTPcjSQmQdVzKifSAKuRmFmzdv3pQNoreXwYllY+BTF5nQTu7+aoGQG1bdNDQ0BH9Ndzfj82XHA8gNq26GA+2HHhnIzfjzU7ghVSX6Oji5laLHv34gN0MZpRtcsN6+pSs3esO+uTqwGXr/KqiZBFT1b4yytZucNwa0jU6hHSIKuq7FiJbhbqytreleG5WbmzvOblBJF0XFT173HGiCbO1mgOocn+Mbd5u8z8CM+nxompt1NuG5r1/aPrV99bEU3Td6I7XlxYRbW1pa2LtGZFf39B+oqYd9ePnSYgC/5PJOAi4lsC/kGhCL7DsflwS5odBSmX3j8EEdryT0mNzM5Zz9z7r1nDOn/Tpt5ippvSSQlbrbklwMhHn+O+WXXzhmzPmLb6trJnVzvzJsvzDPzJkcA+wz8Mc2Vt6R5qG9XSelkdN3VKeVvd3g0LUlucnx8V6WKuLHNGOLKA+UpXttVPkgqqurh7iZM5NLXNkmpw4Z+urirCkrb3pltNSknhf4zxZJzfDI2JCXlpuXL+I76dBEJuc5yi5cxmseVo3HV+gKc66VVEmFf/r8uZdEJICInvBcyE0/aESSr622mprylSuXNG+/S4Zhhh33BG6Ki4uDBhEbGzssp/X1N/V5DsIcHPsN3hXHWWzk+AqeDfqgSMN7zQWLFh9VNbawMNq3nGvHafOyLxdJNRnu+h1yM8xRc5n9VclD6o6NKNyY+ps+N1UxD1ZzcJ+yjCpNeSrAwb1PxdQ/oM9odHwJsICNMv591lSarS3CCv4pCNKX+oDc0HWDLHHSkj2i5tCIGnqNBytuFv3Na+YHApFXtnLN/H3b4/CSlpqYM+vnTOWVsXufmk2lBkUE1R1mIPHX8r3WAZSrEpM+ppcgsKRe8idSW1UhKBJxiX/2ClE5z8jsomrUJzZ3kxfuRPsuwzvXLp+/7Z9agh3W39jY2MQOw93dvd8NMe7Zlb+W/EFrCn+v3HrV9n0DaCAkXKKHgTg/76/9F3yeciwEhYudVXlm/NqX5qbNXL5fM7AIiawM6x8K9LFK3qGFzd2UZ4S/oeLzPjivuu/500Pc5OXl5VAB/+lubm45/SAQCNo+m9bmmsTEBFriSs0sQXf1/7zu1prCzJDgYNpH2bXAGDJM9+SGv+Vs3SkRZyO51Rx/q75KxuORmdGDe7SgmOzaLnI3W7uhywQev2lIPLPrn6XLLvjFULKcreGRGb+tuOma9n9wDfvP74bYEGqhvW7JYlrimrF8pbzu88oGhlezQ26+oxsAqTUnKTGQyof0zAZ8F5OykJtvcpOZmVlWVjZB9QO5+SY3aWlpJSUlI//UMQG5gdzQA3LDHMgNpdr9njyydn0Hg6O+g5seIi4lyMmSgl1gXGkH45KQm9Zc36tgW33RDoWwXMTEu6mykDlxXEHD3hsszP+lvVdKYSOjM6nY3A2uqTj0soSwxn19ye/gpocYbyEtfMC0mNhFPdL2+VN396dPQE0PvgX2Sldh727RnVv3XDLzQRB62ivi2doNpqnK5da5w3r2mTFPjnwHN82pl3evVntTPSTcQ2x+rXP64A3X9q4eYkO67lHRq/6UZbK1m4qM1/Jisu5JFYWJlt/BDaEo4KDAQv0PGDIZ+cFM98TRo0fP3QorbMTUJioelXJOrqUmt+6PllJbrri1sbWbpiqjM9vUnkchsLji7+LmMzxOTmS5dmAz5c5RHe0NsJTzx3bZxlfUF70WmzefT1BYjMpOYaHjt/yx7Oymwvvan38JXjIwBehqHOPjEVS+edcvtXoCcxqxyub0Nsm7kbRrOPD1+SonKG7QNYmnjx1wS4MP2QXEvm7q8mO833jRsDE9L7RG1NDKOb6wYSLHad3NKU+3bzz4KKiwc5AbEr7eTvPwDjUHfOdXlxiyr5vBlGe+Vj+rmwBrap3oMfTn7oaSqJvSIqJiYqK7dh68qJ9eR6BEO6vctS7uFRWlpbWXaZQbEEBuhgLtF6AAuWEO5AZyQw/IDXMgN5AbekBumAO5gdzQA3LDHLZ2k/L8/JJla4T6bstx2jY8d/j1N5CbyXGTaHlORME8D/FVEHJDAXLDHLZ2k+l6Y5PAFuEdItu2iJy8+DilGjHae9tBbibKzQCIsrhr4hsO3/JsRg+9/gZyM8luWrF1vnflVx4yrG8e+vwbyM0ku0GWJevIiUjf80OioZxGZdLd5Ee6mFMxuCp78prNx5KGVqi/oTHpbsrSQz2o+LwLpnpphdz0Melu6AK5oQC5YQ7kBnJDD8gNcyA3kBt6QG6YA7mB3NDjx3BTn+Lt8vgh4GVUXtXw+3KMo5u2+jwfl/e1nQN3x+2qz4sNiMrv6qF/vTVbu0HDS1/e/feUirHLa3d398D0UviE7oduSXfbs1b6A2bgWdL4mKcqp294tXdBboaR5KJ+9KRWQikKNyg4cW7wBf4Sm2SDkF+5UTbwJ2ARDloKCvfczDUolxEIrJZ2L2r4xN5uGk1OrpXRtXa0o2Q0G7eAkom+3rMm5riwhGNBGyW5xaR2kjCh5lfUzUKJ2IZnKsJca8WMA4rIZGLGs9P8Ryzr2NtNmiLPgi3Sl+2c3d0drS/I7JEx9pnY4zct6ep7jjsVNKe5aK/h+TcNCfe5o3bTNr4TR3EjcsOTltw6m4pi4mB49naTosC75pJjEgYMAHDYLN97m/cpZSBaJtANvsBQQtDIJ8/2qba69E59/1yvW3oP/bK78RQ3+0By+/oe+uzspt7oBN8F2wTq12AyvQ03SaoUNo7u+TejHEPXvDgufM7Mw+qOWWb0s0Py5kaU7iYHckOH8KcKe2T0PpYj0XCYhbLkEX23pok9Jk1xs+3IGR3bVFInTF9McNtBJYvIkh7IzXAwjaWeD1T3Cu/YIXxAzcirGIlundhtz7Y4S2UxieOu6RgyuTf+6ZlNey+8zYT3Epo9Tc4o20QTv34yHlu7oQu0X4AC5IY5kBvIDT1+TDeEhuCuImXa1N6UwtxNTU0N+PYJqh/IDatM+HMKhwG5YRXIDRu5qU3zt/EMqWxheAc1yA2rjLubMMOdHOuk/HMYdlfs7CbLYL9439OKRYT51674a9f1vCaGXwq5mZx2g2kue6EhJaXl0oTGMSrDxE17Q6nv69c2NjbOIckNGMqdhIittaGvnWPSclPCfUDcIyCt61Nvf+FsWuErEisgNyNTkekuuWWvZVAulqEaxm6wWVoSIvNmzeLg4PhtMe8Z/RfVODKqIlSaZ8ayNRt5/8sN4nMWrnGjPTeqKuLkAX5aYdpjoiA3IyzAWU1c/IJVAQLLpBADN12p1jL/XfK3IfW5KeZn9/+6WNQuobKZ4oZjOtcS05CM/KBHW5f9uvluFLmnxlFedPYfa1TeZNWjUG9vbofcjEBjvvOeVbseRZQzL0bfDan04aHNU796QMo6g3e5jVQ3mzVc27s+43J99m/g3qD/gYxMVdm9+u+1KunU53lD/c2IVHpekdio+KyqZYRy9N10lz85vGXRnzvvOfv1E1mEwCGpbvYbvOvoJn9xQzkmvYxng34x9edDbpiDLY96IbZpt0MqfMSiDHJaW6yJ9Ozfl0pqeSRmFgJKqusJXb0oum564S8VRBb9tcoqJDnh3QPheTO/clP7nsyzlnzDg9x/pICt3VCHZ3vXyz1qQDLraWgwHAvAE6/I7VzEyUnLaItFFRMqCfTdgLJJ1iLrFoNiXP9dc0hCgHOwm/Rn5NmcZAVTcltfgK3dYJENqZG+H9JKMYyHZwMwGUMTW0pjw8J8qYTEZ6DaP5Hamz6G+SYWNfT0krtx9YmRgZFFTdSynUUZsaBYeGJmY0NBWGRKA66zrzo6G8kBoeRc+ED9sLWbUQHtT4PcfAFywyrAjbW1tecgwDdOaP1AblgFi8U2fU1vL6OnPIwP/wN1RhzA81qkGgAAAABJRU5ErkJggg=='); - img.FreeOnTerminate(True); + img.FreeOnTerminate := True; templ := img.copy([8,8,22,22]); - templ.FreeOnTerminate(True); + templ.FreeOnTerminate := True; mat := MatchTemplateMask(img.ToMatrix(), templ.ToMatrix(), TM_CCOEFF_NORMED); Assert(mat.ArgMax() = [8,8]); diff --git a/Tests/threading_locks.simba b/Tests/threading_locks.simba index d7856a728..377f4c695 100644 --- a/Tests/threading_locks.simba +++ b/Tests/threading_locks.simba @@ -7,8 +7,9 @@ var procedure TestWithLocks; var expected: Integer; + timeout: UInt64 := GetTickCount() + 1000; begin - while GetTimeRunning() < 1000 do + while Timeout > GetTickCount() do begin lock.Enter(); expected := counter; @@ -23,8 +24,9 @@ end; procedure TestWithoutLocks; var expected: Integer; + timeout: UInt64 := GetTickCount() + 1000; begin - while GetTimeRunning() < 1000 do + while Timeout > GetTickCount() do begin expected := counter; sleep(10); @@ -35,21 +37,21 @@ begin end; begin + lock.FreeOnTerminate := True; + counter := 0; errors := 0; RunInThread(@TestWithoutLocks); RunInThread(@TestWithoutLocks); RunInThread(@TestWithoutLocks); - Sleep(1500); + Sleep(2500); Assert(errors > 0); counter := 0; errors := 0; - RunInThread(@TestWithoutLocks); - RunInThread(@TestWithoutLocks); - RunInThread(@TestWithoutLocks); - Sleep(1500); + RunInThread(@TestWithLocks); + RunInThread(@TestWithLocks); + RunInThread(@TestWithLocks); + Sleep(2500); Assert(errors = 0); - - lock.Free(); end;