Merge branch source:main into main

packages/vcl-compat/src/system.json.pp

@@ -1872,8 +1872,10 @@ end;
 
 destructor TJSONPair.Destroy;
 begin
-  JSonString:=nil;
-  JsonValue:=nil;
+  if Assigned(FJSonString) and (FJSONString.Owned) then
+    FreeAndNil(FJSonString);
+  if Assigned(FJSonValue) and (FJSONValue.Owned) then
+    FreeAndNil(FJSonValue);
   inherited Destroy;
 end;
 

packages/wasm-utils/src/wasm.timer.objects.pas

@@ -20,9 +20,9 @@ interface
 
 uses
 {$IFDEF FPC_DOTTEDUNITS}
-  System.Classes, System.SysUtils,
+  System.Classes, System.SysUtils, System.SyncObjs,
 {$ELSE}
-  Classes, SysUtils,
+  Classes, SysUtils, SyncObjs,
 {$ENDIF}
   wasm.timer.api, wasm.timer.shared;
 
@@ -76,6 +76,41 @@ uses wasm.logger.api;
 resourcestring
   SErrCouldNotCreateTimer = 'Could not create timer';
 
+var
+  ActiveTimers : TFPList;
+  Lock : TCriticalSection;
+
+procedure AddTimer(aTimer : TWasmTimer);
+begin
+  Lock.Enter;
+  try
+    ActiveTimers.Add(aTimer);
+  finally
+    Lock.Leave
+  end;
+end;
+
+function ValidTimer(aTimer : TWasmTimer): boolean;
+begin
+  Lock.Enter;
+  try
+    Result:=ActiveTimers.IndexOf(aTimer)<>-1;
+  finally
+    Lock.Leave;
+  end;
+end;
+
+procedure RemoveTimer(aTimer : TWasmTimer);
+
+begin
+  Lock.Enter;
+  try
+    ActiveTimers.Remove(aTimer);
+  finally
+    Lock.Leave;
+  end;
+end;
+
 constructor TWasmTimer.Create(aInterval: Integer; aEvent: TNotifyEvent; aSender: TObject);
 begin
   FOnTimer:=aEvent;
@@ -87,17 +122,21 @@ begin
     __wasmtimer_log(wllError,SErrCouldNotCreateTimer);
     Raise EWasmTimer.Create(SErrCouldNotCreateTimer);
     end;
+  AddTimer(Self);
 end;
 
 destructor TWasmTimer.Destroy;
 begin
+  FOnTimer:=Nil;
+  RemoveTimer(Self);
   __wasm_timer_deallocate(FID);
   inherited Destroy;
 end;
 
 procedure TWasmTimer.Execute;
 begin
-  FOnTimer(FSender);
+  if assigned(FOnTimer) then
+    FOnTimer(FSender);
 end;
 
 class procedure TWasmTimer.HandleWasmTimer(aTimerID: TWasmTimerID; userdata: pointer; var aContinue: Boolean);
@@ -107,7 +146,7 @@ var
 
 begin
   __wasmtimer_log(wllTrace, 'Timer(ID: %d) tick. Data [%p]',[aTimerID,UserData]);
-  aContinue:=(Obj.FID=aTimerID);
+  aContinue:=ValidTimer(Obj) and (Obj.FID=aTimerID);
   __wasmtimer_log(wllDebug, 'Timer(id: %d) tick. Data [%p] continue: %b',[aTimerID,UserData,aContinue]);
   if aContinue then
     Obj.Execute;
@@ -149,7 +188,7 @@ end;
 procedure TTimer.DoOnTimer(Sender : TObject);
 
 begin
-  If Assigned(FOnTimer) then
+  If FEnabled and Assigned(FOnTimer) then
     FOnTimer(Self);
 end;
 
@@ -175,11 +214,20 @@ end;
 
 destructor TTimer.Destroy;
 begin
+  OnTimer:=Nil;
   Enabled:=False;
+
   inherited Destroy;
 end;
 
 initialization
+  ActiveTimers:=TFPList.Create;
+  Lock:=TCriticalSection.Create;
   OnWasmTimerTick:[email protected]
+
+finalization
+  OnWasmTimerTick:=Nil;
+  FreeAndNil(ActiveTimers);
+  FreeAndNil(Lock);
 end.
 

rtl/objpas/classes/classes.inc

@@ -559,8 +559,12 @@ procedure TThread.Synchronize(AProcedure: TThreadProcedure);
 {$endif}
 
 Function PopThreadQueueHead : TThread.PThreadQueueEntry;
+var
+  lPrev : TThread.PThreadQueueEntry;
+  lNow : TDateTime;
 
 begin
+  lPrev:=Nil;
   Result:=ThreadQueueHead;
   if (Result<>Nil) then
     begin
@@ -569,10 +573,22 @@ begin
     try
 {$endif}
       Result:=ThreadQueueHead;
+      lNow:=Now;
+      While Assigned(Result) and (Result^.ExecuteAfter<>0) and (Result^.ExecuteAfter>lNow) do
+        begin
+        lPrev:=Result;
+        Result:=Result^.Next;
+        end;
       if Result<>Nil then
-        ThreadQueueHead:=ThreadQueueHead^.Next;
-      if Not Assigned(ThreadQueueHead) then
-        ThreadQueueTail := Nil;
+        begin
+        if Assigned(lPrev) then
+          lPrev^.Next:=Result^.Next
+        else
+          ThreadQueueHead:=Result^.Next;
+        // if Result^.Next is Nil, it means we popped the last
+        if Not Assigned(Result^.Next) then
+           ThreadQueueTail := lPrev;
+        end;
 {$ifdef FPC_HAS_FEATURE_THREADING}
     finally
       System.LeaveCriticalSection(ThreadQueueLock);
@@ -666,17 +682,17 @@ end;
 
 class procedure TThread.Queue(aThread: TThread; aMethod: TThreadMethod); static;
 begin
-  InternalQueue(aThread, aMethod, False);
+  InternalQueue(aThread, aMethod, False, 0);
 end;
 
 {$ifdef FPC_HAS_REFERENCE_PROCEDURE}
 class procedure TThread.Queue(aThread: TThread; AProcedure: TThreadProcedure);
 begin
-  InternalQueue(aThread, aProcedure, False);
+  InternalQueue(aThread, aProcedure, False, 0);
 end;
 {$endif}
 
-class procedure TThread.InternalQueue(aThread: TThread; aMethod: TThreadMethod; aQueueIfMain: Boolean); static;
+class procedure TThread.InternalQueue(aThread: TThread; aMethod: TThreadMethod; aQueueIfMain: Boolean; aExecuteAfter: TDateTime); static;
 var
   queueentry: PThreadQueueEntry;
 begin
@@ -684,13 +700,14 @@ begin
   FillChar(queueentry^, SizeOf(TThreadQueueEntry), 0);
   queueentry^.Thread := aThread;
   queueentry^.Method := aMethod;
+  queueentry^.ExecuteAfter:=aExecuteAfter;
 
   { the queueentry is freed by CheckSynchronize (or by RemoveQueuedEvents) }
   ThreadQueueAppend(queueentry, aQueueIfMain);
 end;
 
 {$ifdef FPC_HAS_REFERENCE_PROCEDURE}
-class procedure TThread.InternalQueue(aThread: TThread; aProcedure: TThreadProcedure; aQueueIfMain: Boolean); static;
+class procedure TThread.InternalQueue(aThread: TThread; aProcedure: TThreadProcedure; aQueueIfMain: Boolean; aExecuteAfter: TDateTime); static;
 var
   queueentry: PThreadQueueEntry;
 begin
@@ -698,6 +715,7 @@ begin
   FillChar(queueentry^, SizeOf(TThreadQueueEntry), 0);
   queueentry^.Thread := aThread;
   queueentry^.ThreadProc := aProcedure;
+  queueentry^.ExecuteAfter:=aExecuteAfter;
 
   { the queueentry is freed by CheckSynchronize (or by RemoveQueuedEvents) }
   ThreadQueueAppend(queueentry, aQueueIfMain);
@@ -710,15 +728,28 @@ begin
 end;
 
 
-class procedure TThread.ForceQueue(aThread: TThread; aMethod: TThreadMethod); static;
+class procedure TThread.ForceQueue(aThread: TThread; aMethod: TThreadMethod; aDelay : Integer = 0); static;
+var
+  lEnd : TDateTime;
 begin
-  InternalQueue(aThread, aMethod, True);
+  if aDelay<>0 then
+    lEnd:=Now+aDelay*(1/MSecsPerDay)
+  else
+    lEnd:=0;
+  InternalQueue(aThread, aMethod, True, lEnd);
 end;
 
 {$ifdef FPC_HAS_REFERENCE_PROCEDURE}
-class procedure TThread.ForceQueue(aThread: TThread; aMethod: TThreadProcedure); static;
+class procedure TThread.ForceQueue(aThread: TThread; aMethod: TThreadProcedure; aDelay : Integer = 0); static;
+
+var
+  lEnd : TDateTime;
 begin
-  InternalQueue(aThread, aMethod, True);
+  if aDelay<>0 then
+    lEnd:=Now+aDelay*(1/MSecsPerDay)
+  else
+    lEnd:=0;
+  InternalQueue(aThread, aMethod, True, lEnd);
 end;
 {$endif}
 

rtl/objpas/classes/classesh.inc

@@ -2263,6 +2263,7 @@ type
       Exception: TObject;
       SyncEvent: PRtlEvent;
       Next: PThreadQueueEntry;
+      ExecuteAfter : TDateTime;
     end;
   public type
     TSystemTimes = record
@@ -2286,9 +2287,9 @@ type
     FSynchronizeEntry: PThreadQueueEntry;
     class function GetCurrentThread: TThread; static;
     class function GetIsSingleProcessor: Boolean; static; inline;
-    class procedure InternalQueue(aThread: TThread; aMethod: TThreadMethod; aQueueIfMain: Boolean); static;
+    class procedure InternalQueue(aThread: TThread; aMethod: TThreadMethod; aQueueIfMain: Boolean; aExecuteAfter: TDateTime); static;
 {$ifdef FPC_HAS_REFERENCE_PROCEDURE}
-    class procedure InternalQueue(aThread: TThread; aProcedure: TThreadProcedure; aQueueIfMain: Boolean); static;
+    class procedure InternalQueue(aThread: TThread; aProcedure: TThreadProcedure; aQueueIfMain: Boolean; aExecuteAfter: TDateTime); static;
 {$endif}
     procedure CallOnTerminate;
     function GetPriority: TThreadPriority;
@@ -2366,9 +2367,9 @@ type
     {$ifdef FPC_HAS_REFERENCE_PROCEDURE}
     class procedure Queue(aThread: TThread; AProcedure : TThreadProcedure); static;
     {$endif}
-    class procedure ForceQueue(aThread: TThread; aMethod: TThreadMethod); inline; static;
+    class procedure ForceQueue(aThread: TThread; aMethod: TThreadMethod; aDelay : Integer = 0); inline; static;
     {$ifdef FPC_HAS_REFERENCE_PROCEDURE}
-    class procedure ForceQueue(aThread: TThread; aMethod: TThreadProcedure); inline; static;
+    class procedure ForceQueue(aThread: TThread; aMethod: TThreadProcedure; aDelay : Integer = 0); inline; static;
     {$endif}
     class procedure RemoveQueuedEvents(aThread: TThread; aMethod: TThreadMethod); static;
     class procedure RemoveQueuedEvents(aMethod: TThreadMethod); static;

utils/fpdoc/dw_basehtml.pp

@@ -96,46 +96,46 @@ type
     procedure DescrEndTableCell; override;
 
     // Basic HTML handling
-    Procedure SetHTMLDocument(aDoc : THTMLDocument);
-    procedure PushOutputNode(ANode: TDOMNode);
-    procedure PopOutputNode;
-    procedure AppendText(Parent: TDOMNode; const AText: AnsiString);
-    procedure AppendText(Parent: TDOMNode; const AText: DOMString);
-    procedure AppendNbSp(Parent: TDOMNode; ACount: Integer);
-    procedure AppendSym(Parent: TDOMNode; const AText: DOMString);
-    procedure AppendKw(Parent: TDOMNode; const AText: AnsiString);
-    procedure AppendKw(Parent: TDOMNode; const AText: DOMString);
-    function  AppendPasSHFragment(Parent: TDOMNode; const AText: String; AShFlags: Byte): Byte;
-    procedure AppendFragment(aParentNode: TDOMElement; aStream: TStream);
+    Procedure SetHTMLDocument(aDoc : THTMLDocument); virtual;
+    procedure PushOutputNode(ANode: TDOMNode); virtual;
+    procedure PopOutputNode; virtual;
+    procedure AppendText(Parent: TDOMNode; const AText: AnsiString); virtual;
+    procedure AppendText(Parent: TDOMNode; const AText: DOMString); virtual;
+    procedure AppendNbSp(Parent: TDOMNode; ACount: Integer); virtual;
+    procedure AppendSym(Parent: TDOMNode; const AText: DOMString); virtual;
+    procedure AppendKw(Parent: TDOMNode; const AText: AnsiString); virtual;
+    procedure AppendKw(Parent: TDOMNode; const AText: DOMString); virtual;
+    function  AppendPasSHFragment(Parent: TDOMNode; const AText: String; AShFlags: Byte): Byte; virtual;
+    procedure AppendFragment(aParentNode: TDOMElement; aStream: TStream); virtual;
     // FPDoc specifics
     procedure AppendSourceRef(aParent: TDOMElement; AElement: TPasElement);
     Procedure AppendSeeAlsoSection(AElement: TPasElement; DocNode: TDocNode); virtual;
     Procedure AppendExampleSection(AElement : TPasElement;DocNode : TDocNode); virtual;
-    Procedure AppendShortDescr(Parent: TDOMNode; Element: TPasElement);
-    procedure AppendShortDescr(AContext: TPasElement; Parent: TDOMNode; DocNode: TDocNode);
-    procedure AppendShortDescrCell(Parent: TDOMNode; Element: TPasElement);
-    procedure AppendDescr(AContext: TPasElement; Parent: TDOMNode; DescrNode: TDOMElement; AutoInsertBlock: Boolean);
-    procedure AppendDescrSection(AContext: TPasElement; Parent: TDOMNode; DescrNode: TDOMElement; const ATitle: DOMString);
-    procedure AppendDescrSection(AContext: TPasElement; Parent: TDOMNode; DescrNode: TDOMElement; const ATitle: AnsiString);
+    Procedure AppendShortDescr(Parent: TDOMNode; Element: TPasElement); virtual;
+    procedure AppendShortDescr(AContext: TPasElement; Parent: TDOMNode; DocNode: TDocNode); virtual;
+    procedure AppendShortDescrCell(Parent: TDOMNode; Element: TPasElement); virtual;
+    procedure AppendDescr(AContext: TPasElement; Parent: TDOMNode; DescrNode: TDOMElement; AutoInsertBlock: Boolean); virtual;
+    procedure AppendDescrSection(AContext: TPasElement; Parent: TDOMNode; DescrNode: TDOMElement; const ATitle: DOMString); virtual;
+    procedure AppendDescrSection(AContext: TPasElement; Parent: TDOMNode; DescrNode: TDOMElement; const ATitle: AnsiString); virtual;
     function AppendHyperlink(Parent: TDOMNode; Element: TPasElement): TDOMElement;
 
     // Helper functions for creating DOM elements
 
-    function CreateEl(Parent: TDOMNode; const AName: DOMString): THTMLElement;
-    function CreatePara(Parent: TDOMNode): THTMLElement;
-    function CreateH1(Parent: TDOMNode): THTMLElement;
-    function CreateH2(Parent: TDOMNode): THTMLElement;
-    function CreateH3(Parent: TDOMNode): THTMLElement;
-    function CreateTable(Parent: TDOMNode; const AClass: DOMString = ''): THTMLElement;
-    function CreateContentTable(Parent: TDOMNode): THTMLElement;
-    function CreateTR(Parent: TDOMNode): THTMLElement;
-    function CreateTD(Parent: TDOMNode): THTMLElement;
-    function CreateTD_vtop(Parent: TDOMNode): THTMLElement;
-    function CreateLink(Parent: TDOMNode; const AHRef: AnsiString): THTMLElement;
-    function CreateLink(Parent: TDOMNode; const AHRef: DOMString): THTMLElement;
-    function CreateAnchor(Parent: TDOMNode; const AName: DOMString): THTMLElement;
-    function CreateCode(Parent: TDOMNode): THTMLElement;
-    function CreateWarning(Parent: TDOMNode): THTMLElement;
+    function CreateEl(Parent: TDOMNode; const AName: DOMString): THTMLElement; virtual;
+    function CreatePara(Parent: TDOMNode): THTMLElement; virtual;
+    function CreateH1(Parent: TDOMNode): THTMLElement; virtual;
+    function CreateH2(Parent: TDOMNode): THTMLElement; virtual;
+    function CreateH3(Parent: TDOMNode): THTMLElement; virtual;
+    function CreateTable(Parent: TDOMNode; const AClass: DOMString = ''): THTMLElement;virtual;
+    function CreateContentTable(Parent: TDOMNode): THTMLElement; virtual;
+    function CreateTR(Parent: TDOMNode): THTMLElement; virtual;
+    function CreateTD(Parent: TDOMNode): THTMLElement; virtual;
+    function CreateTD_vtop(Parent: TDOMNode): THTMLElement; virtual;
+    function CreateLink(Parent: TDOMNode; const AHRef: AnsiString): THTMLElement; virtual;
+    function CreateLink(Parent: TDOMNode; const AHRef: DOMString): THTMLElement; virtual;
+    function CreateAnchor(Parent: TDOMNode; const AName: DOMString): THTMLElement; virtual;
+    function CreateCode(Parent: TDOMNode): THTMLElement; virtual;
+    function CreateWarning(Parent: TDOMNode): THTMLElement; virtual;
 
 
     // Some info
@@ -465,10 +465,20 @@ begin
 end;
 
 procedure TBaseHTMLWriter.DescrBeginCode(HasBorder: Boolean; const AHighlighterName: String);
+var
+  lNode : THTMLElement;
+  lClass : string;
 begin
   FDoPasHighlighting := (AHighlighterName = '') or (AHighlighterName = 'Pascal');
   FHighlighterFlags := 0;
-  PushOutputNode(CreateEl(CurOutputNode, 'pre'));
+  lNode:=CreateEl(CurOutputNode, 'pre');
+  lClass:='code code-';
+  if AHighlighterName='' then
+    lClass:=lClass+'pascal'
+  else
+    lClass:=lClass+lowercase(AHighlighterName);
+  lNode['class']:=lClass;
+  PushOutputNode(lNode);
 end;
 
 procedure TBaseHTMLWriter.DescrWriteCodeLine(const ALine: String);