Merge branch 'main' of https://gitlab.com/freepascal.org/fpc/pas2js into main

demo/chartjs/demoline.lpr

@@ -8,7 +8,7 @@ uses
 
 var
   config: TChartConfiguration;
-  dataset: TChartLineDataset;
+  dataset, d2: TChartLineDataset;
 begin
   config := TChartConfiguration.new;
   config.type_ := 'line';
@@ -21,6 +21,12 @@ begin
   dataset.fill := False;
   dataset.borderColor := 'rgb(75, 192, 192)';
   dataset.lineTension := 0.1;
-  config.data.datasets := [dataset];
+  d2 := TChartLineDataset.new;
+  d2.label_ := 'My other dataset';
+  d2.data := [35, 49, 90, 70, 55, 45, 20];
+  d2.fill := False;
+  d2.borderColor := 'rgb(255, 192, 192)';
+  d2.lineTension := 0.1;
+  config.data.datasets := [dataset,d2];
   TChart.new('myChart', config);
 end.

packages/fcl-db/extjsdataset.pas

@@ -228,7 +228,7 @@ Var
 
 begin
   Result:=True;
-  if anUpdate.OriginalStatus=usDeleted then
+  if anUpdate.Status=usDeleted then
     exit;
   D:=anUpdate.ServerData;
   If isNull(D) then

packages/fcl-db/jsondataset.pas

@@ -185,6 +185,8 @@ type
     Procedure AppendToIndex; virtual; abstract;
     // Delete aListIndex from list, not from row. Return Recordindex of deleted record.
     Function Delete(aListIndex : Integer) : Integer; virtual;
+    // Delete By rowIndex, Return list index of deleted record.
+    Function DeleteByRowIndex(aRowIndex : Integer) : Integer; virtual;
     // Append aRecordIndex to list. Return ListIndex of appended record.
     Function Append(aRecordIndex : Integer) : Integer; virtual; abstract;
     // Insert record into list. By default, this does an append. Return ListIndex of inserted record
@@ -193,6 +195,8 @@ type
     Function Update(aRecordIndex : Integer) : Integer; virtual; abstract;
     // Find list index for Record at index aCurrentIndex. Return -1 if not found.
     Function FindRecord(aRecordIndex : Integer) : Integer; virtual; abstract;
+    // index of record in index list, based on Row index.
+    Function IndexOfRow(aRowIndex : Integer): NativeInt;
     // index of record in FRows based on aListIndex in List.
     Property RecordIndex[aListIndex : Integer] : NativeInt Read GetRecordIndex;
     // Number of records in index. This can differ from FRows, e.g. when filtering.
@@ -296,8 +300,6 @@ type
     procedure SetRows(AValue: TJSArray);
     procedure SetRowType(AValue: TJSONRowType);
   protected
-    Function BlobDataToBytes(aValue : JSValue) : TBytes; override;
-    Function BytesToBlobData(aValue : TBytes) : JSValue ; override;
     // Remove calculated fields from buffer
     procedure RemoveCalcFields(Buf: JSValue);
     procedure ActivateIndex(Build : Boolean);
@@ -395,6 +397,8 @@ type
   public
     constructor Create (AOwner: TComponent); override;
     destructor Destroy; override;
+    Function BlobDataToBytes(aValue : JSValue) : TBytes; override;
+    Function BytesToBlobData(aValue : TBytes) : JSValue ; override;
     function ConvertDateTimeToNative(aField : TField; aValue : TDateTime) : JSValue; override;
     function Locate(const KeyFields: string; const KeyValues: JSValue; Options: TLocateOptions): boolean; override;
     function Lookup(const KeyFields: string; const KeyValues: JSValue; const ResultFields: string): JSValue; override;
@@ -445,7 +449,7 @@ type
   // Fieldmapper to be used when the data is in an object
   TJSONObjectFieldMapper = Class(TJSONFieldMapper)
   Public
-    Procedure RemoveField(Const FieldName : String; FieldIndex : Integer; Row : JSValue); override;
+    Procedure RemoveField(Const FieldName : String; FieldIndex{%H-} : Integer; Row : JSValue); override;
     procedure SetJSONDataForField(Const FieldName : String; FieldIndex{%H-} : Integer; Row,Data : JSValue); override;
     Function GetJSONDataForField(Const FieldName : String; FieldIndex{%H-} : Integer; Row : JSValue) : JSValue; override;
     Function CreateRow : JSValue; override;
@@ -455,7 +459,7 @@ type
   // Fieldmapper to be used when the data is in an array
   TJSONArrayFieldMapper = Class(TJSONFieldMapper)
   Public
-    Procedure RemoveField(Const FieldName : String; FieldIndex : Integer; Row : JSValue); override;
+    Procedure RemoveField(Const FieldName{%H-} : String; FieldIndex : Integer; Row : JSValue); override;
     procedure SetJSONDataForField(Const FieldName{%H-} : String; FieldIndex : Integer; Row,Data : JSValue); override;
     Function GetJSONDataForField(Const FieldName{%H-} : String; FieldIndex : Integer; Row : JSValue) : JSValue; override;
     Function CreateRow : JSValue; override;
@@ -585,21 +589,26 @@ end;
 procedure TSortedJSONIndex.CreateIndex;
 
 Var
-  Lst : TJSArray;
-  Len : Integer;
+  Lst : Array of Integer;
+  I,SrcLen,Destlen : Integer;
 begin
   // CreateIndex is called during constructor. We cannot build index then, so we exit
   if FComparer=Nil then
     exit;
-  Len:=FRows.Length-1;
+  SrcLen:=FRows.Length;
   // Temp list, mergsort destroys list
-  Lst:=TJSArray.New(Len+1);
-  While Len>=0 do
+  SetLength(Lst,SrcLen);
+  DestLen:=0;
+  For I:=0 to SrcLen-1 do
     begin
-    Lst[Len]:=Len;
-    Dec(Len);
+    if not isUndefined(FRows[I]) then
+      begin
+      Lst[DestLen]:=I;
+      Inc(DestLen);
+      end;
     end;
-  FList:=MergeSort(Lst);
+  SetLength(Lst,DestLen);
+  FList:=MergeSort(TJSArray(Lst));
 end;
 
 procedure TSortedJSONIndex.AppendToIndex;
@@ -994,11 +1003,23 @@ begin
     Result:=-1;
 end;
 
+function TJSONIndex.DeleteByRowIndex(aRowIndex: Integer): Integer;
+begin
+  Result:=IndexOfRow(aRowIndex);
+  if Result<>-1 then
+    FList.Splice(Result,1);
+end;
+
 function TJSONIndex.Insert(aCurrentIndex, aRecordIndex: Integer): Integer;
 begin
   Result:=Append(aRecordIndex);
 end;
 
+function TJSONIndex.IndexOfRow(aRowIndex: Integer): NativeInt;
+begin
+  Result:=FList.indexOf(aRowIndex);
+end;
+
 function TJSONIndex.GetCount: Integer;
 begin
   Result:=FList.Length;
@@ -1164,11 +1185,6 @@ end;
 
 function TBaseJSONDataSet.BlobDataToBytes(aValue: JSValue): TBytes;
 
-Var
-  S : String;
-  Arr : TJSUint8Array;
-  I : Integer;
-
 begin
   Result:=[];
   Case BlobFormat of
@@ -1186,12 +1202,6 @@ end;
 
 function TBaseJSONDataSet.BytesToBlobData(aValue: TBytes): JSValue;
 
-Var
-  S : String;
-  Arr : TJSUint8Array;
-  I : Integer;
-  Buf : TJSArrayBuffer;
-
 begin
   Result:='';
   Case BlobFormat of
@@ -1476,20 +1486,26 @@ end;
 procedure TBaseJSONDataSet.InternalDelete;
 
 Var
-  Idx : Integer;
+  I,RowIdx : Integer;
+  aIndex : TJSONIndex;
 
 begin
-  Idx:=FCurrentIndex.Delete(FCurrent);
-  if (Idx<>-1) then
+  RowIdx:=FCurrentIndex.Delete(FCurrent);
+  if (RowIdx<>-1) then
     begin
-    // Add code here to Delete from other indexes as well.
+    For I:=0 to FIndexes.Count-1 do
+      begin
+      aIndex:=FIndexes[i].Index;
+      if aIndex<>FCurrentIndex then
+        aIndex.DeleteByRowIndex(RowIdx);
+      end;
     // ...
     // Add to array of deleted records.
     if Not Assigned(FDeletedRows) then
-      FDeletedRows:=TJSArray.New(FRows[idx])
+      FDeletedRows:=TJSArray.New(FRows[RowIdx])
     else
-      FDeletedRows.Push(FRows[Idx]);
-    FRows[Idx]:=Undefined;
+      FDeletedRows.Push(FRows[RowIdx]);
+    FRows[RowIdx]:=Undefined;
     end;
 end;
 

packages/fcl-db/sqldbrestdataset.pp

@@ -87,6 +87,7 @@ Type
     function GetP(aIndex : Integer): TQueryParam;
     procedure SetP(aIndex : Integer; AValue: TQueryParam);
   Public
+    function AddParam(aName : string; aEnabled : Boolean = False) : TQueryParam;  overload;
     Property Params[aIndex : Integer] : TQueryParam Read GetP Write SetP; default;
   end;
 
@@ -193,7 +194,6 @@ end;
 function TQueryParam.AsQuery: String;
 
 var
-  S : String;
   B : TBytes;
   I : Integer;
 
@@ -221,7 +221,7 @@ begin
   else
     Result:=AsString
   end;
-  Result:=Name+'='+encodeURIComponent(AsString);
+  Result:=Name+'='+Result;
 end;
 
 { TQueryParams }
@@ -236,6 +236,13 @@ begin
   Items[aIndex]:=aValue;
 end;
 
+function TQueryParams.AddParam(aName: string; aEnabled: Boolean): TQueryParam;
+begin
+  Result:=add As TQueryParam;
+  Result.Name:=aName;
+  Result.Enabled:=aEnabled;
+end;
+
 { TServiceRequest }
 
 constructor TServiceRequest.Create(const aMethod,aURL, aUserName, aPassword: String; aOnDone1 : TNotifyEvent; aOnDone2 : TNotifyEvent = Nil);
@@ -582,8 +589,10 @@ begin
   if Not jsIsNan(toNumber(D)) then
     begin
     Result:=Trunc(toNumber(D));
-    if (Result<=0) then
+    if (Result<0) then
       Raise EJSONDataset.CreateFmt('Invalid maximum length specifier for field %s',[AName])
+    else if Result=0 then // memofield
+      Result:=1000000
     end
   else
     begin

packages/rtl/Rtl.BrowserLoadHelper.pas

@@ -47,7 +47,7 @@ class procedure TBrowserLoadHelper.LoadText(aURL: String; aSync: Boolean; OnLoad
 
   begin
     Result:=False;
-    OnError('Error 999: unknown error');
+    OnError('Error 999: unknown error: '+TJSJSON.Stringify(response));
   end;
 
 begin

packages/rtl/classes.pas

@@ -10463,10 +10463,9 @@ begin
   if not IsAlpha then
     ErrorFmt(SParserExpected,[GetTokenName(toSymbol)]);
   Result:='';
-  while IsAlphaNum do
+  while (not fEofReached) and IsAlphaNum do
   begin
     Result:=Result+fBuf[fPos];
-
     GotoToNextChar;
   end;
 end;
@@ -10476,7 +10475,7 @@ begin
   if fBuf[fPos]=#13 then //CR
     GotoToNextChar;
 
-  if fBuf[fPos]=#10 then //LF
+  if (not fEOFReached) and (fBuf[fPos]=#10) then //LF
     GotoToNextChar;
 
   inc(fSourceLine);

packages/rtl/dateutils.pas

@@ -507,7 +507,7 @@ Function ScanDateTime(APattern,AValue: String; APos : integer = 1) : TDateTime;
 
 implementation
 
-uses js, rtlconsts;
+uses  rtlconsts;
 
 const
   TDateTimeEpsilon = 2.2204460493e-16;
@@ -2482,7 +2482,7 @@ end;
 
 Const
   FmtUTC = 'yyyy"-"mm"-"dd"T"hh":"nn":"ss"."zzz';
-  FmtUTCTZ = 'hh":"mm';
+//  FmtUTCTZ = 'hh":"mm';
 
 function DateToISO8601(const ADate: TDateTime; AInputIsUTC: Boolean = True): string;
 
@@ -2708,12 +2708,14 @@ begin
     end;
 end;
 
+(*
 Function ISOTZStrToTZOffset(TZ : String) : Integer;
 
 begin
   if not TryISOTZStrToTZOffSet(TZ,Result) then
     Raise EConvertError.CreateFmt('Invalid ISO timezone string',[TZ]);
 end;
+*)
 
 
 Function TryISO8601ToDate(const DateString: string; out ADateTime: TDateTime;ReturnUTC : Boolean = True) : Boolean;

packages/rtl/web.pas

@@ -48,6 +48,8 @@ Type
 
   TJSServiceWorker = weborworker.TJSServiceWorker;
   TJSServiceWorkerRegistration = weborworker.TJSServiceWorkerRegistration;
+  TJSMessageEvent = weborworker.TJSMessageEvent;
+  TJSMessagePortArray = TJSMessagePortDynArray;
 
   { TEventListenerEvent }
 
@@ -2944,22 +2946,7 @@ TEventListenerEvent = class external name 'EventListener_Event' (TJSObject)
     TJSWebSocket
     --------------------------------------------------------------------}
 
-  TJSMessagePortArray = Array of TJSMessagePort;
 
-  { TJSMessageEvent }
-
-  TJSMessageEvent = class external name 'MessageEvent' (TEventListenerEvent)
-  private
-    FData: JSValue; external name 'data';
-    FLastEventID: String; external name 'lastEventID';
-    FOrigin: String;  external name 'origin';
-    FPorts: TJSMessagePortArray; external name 'ports';
-  Public
-    Property Data : JSValue Read FData;
-    Property LastEventID : String Read FLastEventID;
-    Property Origin : String Read FOrigin;
-    Property Ports : TJSMessagePortArray Read FPorts;
-  end;
 
   TJSWebSocket = class external name 'WebSocket'  (TJSEventTarget)
   Private

packages/rtl/webassembly.pas

@@ -14,6 +14,7 @@ Type
   TJSWebAssemblyMemoryDescriptor = record
     initial,
     maximum : integer;
+    shared : Boolean;
   end;
 
   TJSWebAssemblyMemory = class external name 'WebAssembly.Memory' (TJSObject)
@@ -23,6 +24,7 @@ Type
   Public
     constructor new (memorydescriptor : TJSWebAssemblyMemoryDescriptor);
     constructor new (memorydescriptor : TJSObject);
+    Function grow(number : NativeInt) : NativeInt; external name 'grow';
     Property buffer : TJSArrayBuffer Read FBuffer;
     Property length: NativeInt Read FLength;
   end;

packages/rtl/weborworker.pas

@@ -131,6 +131,21 @@ type
   end;
   TJSMessagePortDynArray = Array of TJSMessagePort;
 
+  { TJSMessageEvent }
+
+  TJSMessageEvent = class external name 'MessageEvent' (TJSEvent)
+  private
+    FData: JSValue; external name 'data';
+    FLastEventID: String; external name 'lastEventID';
+    FOrigin: String;  external name 'origin';
+    FPorts: TJSMessagePortDynArray; external name 'ports';
+  Public
+    Property Data : JSValue Read FData;
+    Property LastEventID : String Read FLastEventID;
+    Property Origin : String Read FOrigin;
+    Property Ports : TJSMessagePortDynArray Read FPorts;
+  end;
+
   { TJSExtendableMessageEvent }
 
   TJSExtendableMessageEvent = class external name 'ExtendableMessageEvent' (TJSExtendableEvent)

packages/rtl/webworker.pas

@@ -70,6 +70,18 @@ Type
     Property Self_ : TJSWorkerGlobalScope Read FSelf;
   end;
 
+  { TJSDedicatedWorkerGlobalScope }
+
+  TJSDedicatedWorkerGlobalScope = class external name 'DedicatedWorkerGlobalScope' (TJSWorkerGlobalScope)
+  private
+    FName: String; external name 'name';
+  Public
+    Procedure close;
+    Procedure PostMessage(aMessage : JSValue); overload;
+    Procedure PostMessage(aMessage : JSValue; TransferableObjects : Array of JSValue); overload;
+    Property name : String Read FName;
+  end;
+
   TJSClientsMatchAllOptions = class external name 'Object'
     includeUncontrolled : Boolean;
     type_ : string; external name 'type';

packages/wasi/wasienv.pas

@@ -336,6 +336,7 @@ type
     Class Var UTF8TextDecoder: TJSTextDecoder;
   Protected
     class procedure setBigUint64(View: TJSDataView; byteOffset, value: NativeInt; littleEndian: Boolean);
+    class procedure setBigInt64(View: TJSDataView; byteOffset, value: NativeInt; littleEndian: Boolean);
     procedure DoConsoleWrite(IsStdErr: Boolean; aBytes: TJSArray); virtual;
     procedure GetImports(aImports: TJSObject); virtual;
     Function GetTime(aClockID : NativeInt): NativeInt; virtual;
@@ -396,6 +397,14 @@ type
     Constructor Create;
     Destructor Destroy; override;
     Function GetUTF8StringFromMem(aLoc, aLen : Longint) : String;
+    Procedure SetMemInfoInt8(aLoc : Integer; aValue : ShortInt);
+    Procedure SetMemInfoInt16(aLoc : Integer; aValue : SmallInt);
+    Procedure SetMemInfoInt32(aLoc : Integer; aValue : Longint);
+    Procedure SetMemInfoInt64(aLoc : Integer; aValue : NativeInt);
+    Procedure SetMemInfoUInt8(aLoc : Integer; aValue : Byte);
+    Procedure SetMemInfoUInt16(aLoc : Integer; aValue : Word);
+    Procedure SetMemInfoUInt32(aLoc : Integer; aValue : Cardinal);
+    Procedure SetMemInfoUInt64(aLoc : Integer; aValue : NativeUint);
     // Add imports
     Procedure AddImports(aObject: TJSObject); 
     Property ImportObject : TJSObject Read GetImportObject;
@@ -582,6 +591,7 @@ begin
   Fenv.OnGetConsoleInputString:=@DoStdRead;
   FMemoryDescriptor.initial:=256;
   FMemoryDescriptor.maximum:=256;
+  FMemoryDescriptor.shared:=False;
   FTableDescriptor.initial:=0;
   FTableDescriptor.maximum:=0;
   FTableDescriptor.element:='anyfunc';
@@ -782,6 +792,28 @@ begin
     end;
 end;
 
+class procedure TPas2JSWASIEnvironment.setBigInt64(View: TJSDataView;
+  byteOffset, value: NativeInt; littleEndian: Boolean);
+
+Var
+  LowWord,HighWord : Integer;
+
+begin
+  lowWord:=value;
+  highWord:=value shr 32;
+  if LittleEndian then
+    begin
+    view.setint32(ByteOffset+0, lowWord, littleEndian);
+    view.setint32(ByteOffset+4, highWord, littleEndian);
+    end
+  else
+    begin
+    view.setint32(ByteOffset+4, lowWord, littleEndian);
+    view.setint32(ByteOffset+0, highWord, littleEndian);
+    end;
+end;
+
+
 procedure TPas2JSWASIEnvironment.SetInstance(AValue: TJSWebAssemblyInstance);
 begin
   if Finstance=AValue then Exit;
@@ -1371,6 +1403,85 @@ begin
   Result:=UTF8TextDecoder.Decode(getModuleMemoryDataView.buffer.slice(aLoc,aLoc+alen));
 end;
 
+procedure TPas2JSWASIEnvironment.SetMemInfoInt8(aLoc: Integer; aValue: ShortInt
+  );
+
+Var
+  View : TJSDataView;
+
+begin
+  view:=getModuleMemoryDataView();
+  view.setint8(aLoc,aValue);
+end;
+
+procedure TPas2JSWASIEnvironment.SetMemInfoInt16(aLoc: Integer; aValue: SmallInt);
+
+Var
+  View : TJSDataView;
+
+begin
+  view:=getModuleMemoryDataView();
+  view.setint16(aLoc,aValue, IsLittleEndian);
+end;
+
+procedure TPas2JSWASIEnvironment.SetMemInfoInt32(aLoc: Integer; aValue: Longint);
+
+Var
+  View : TJSDataView;
+
+begin
+  view:=getModuleMemoryDataView();
+  view.setInt32(aLoc,aValue,IsLittleEndian);
+end;
+
+procedure TPas2JSWASIEnvironment.SetMemInfoInt64(aLoc: Integer; aValue: NativeInt);
+
+Var
+  View : TJSDataView;
+
+begin
+  view:=getModuleMemoryDataView();
+  setBigInt64(View,aLoc,aValue,IsLittleEndian);
+end;
+
+procedure TPas2JSWASIEnvironment.SetMemInfoUInt8(aLoc: Integer; aValue: Byte);
+Var
+  View : TJSDataView;
+
+begin
+  view:=getModuleMemoryDataView();
+  view.setUInt8(aLoc,aValue);
+end;
+
+procedure TPas2JSWASIEnvironment.SetMemInfoUInt16(aLoc: Integer; aValue: Word);
+Var
+  View : TJSDataView;
+
+begin
+  view:=getModuleMemoryDataView();
+  view.setUint16(aLoc,aValue,IsLittleEndian);
+end;
+
+procedure TPas2JSWASIEnvironment.SetMemInfoUInt32(aLoc: Integer;
+  aValue: Cardinal);
+Var
+  View : TJSDataView;
+
+begin
+  view:=getModuleMemoryDataView();
+  view.setUint32(aLoc,aValue,IsLittleEndian);
+end;
+
+procedure TPas2JSWASIEnvironment.SetMemInfoUInt64(aLoc: Integer;
+  aValue: NativeUint);
+Var
+  View : TJSDataView;
+
+begin
+  view:=getModuleMemoryDataView();
+  setBigUint64(View,aLoc,aValue,IsLittleEndian);
+end;
+
 initialization
 
 end.