Merge remote-tracking branch 'origin/main' into wasm_js_promise_integration

packages/fcl-net/src/ssockets.pp

@@ -11,6 +11,7 @@
 
  **********************************************************************}
 {$MODE objfpc}{$H+}
+{$R-}
 
 unit ssockets;
 

packages/fcl-pdf/examples/pdfdump.lpi

@@ -4,7 +4,6 @@
     <Version Value="12"/>
     <General>
       <Flags>
-        <SaveOnlyProjectUnits Value="True"/>
         <MainUnitHasCreateFormStatements Value="False"/>
         <MainUnitHasTitleStatement Value="False"/>
         <MainUnitHasScaledStatement Value="False"/>

packages/fcl-pdf/examples/pdfdump.pp

@@ -25,7 +25,9 @@ uses
 type
 
   { TPDFDumpApplication }
-  TInfoSection = (isInfo,isCatalog,isTrailer,isObjects, isFonts, isPages,isPageContents,isPageText, isDictionaries);
+
+  TInfoSection = (isInfo, isCatalog, isTrailer, isObjects, isFonts,
+                  isPages, isPageContents, isPageText, isDictionaries);
   TInfoSections = Set of TInfoSection;
 
   TPDFDumpApplication = class(TCustomApplication)
@@ -36,21 +38,21 @@ type
     FVerbose : Boolean;
   Public
     constructor Create(aOwner: TComponent); override;
-    destructor destroy; override;
+    destructor Destroy; override;
   Protected
     procedure DisplayPageText(Doc: TPDFDocument; aIndex: Integer;  aPage: TPDFPageObject);
-    procedure DoLog(sender: TObject; aKind: TPDFLogkind; const aMessage: string);
-    Procedure DoProgress(Sender : TObject;aKind : TPDFProgressKind; aCurrent,aCount : Integer);
+    procedure DoLog(sender: TObject; aKind: TPDFLogkind; const aMessage: string); reintroduce;
+    Procedure DoProgress(Sender: TObject; aKind: TPDFProgressKind; aCurrent, aCount : Integer);
     procedure DisplayCatalog(Doc: TPDFDocument);
     procedure DisplayInfo(Doc: TPDFDocument);
     procedure DisplayObjects(Doc: TPDFDocument);
     procedure DisplayFonts(Doc: TPDFDocument);
-    procedure DisplayPageContents(Doc: TPDFDocument; aIndex: Integer;   aPage: TPDFPageObject);
+    procedure DisplayPageContents(Doc: TPDFDocument; aIndex: Integer; aPage: TPDFPageObject);
     procedure DisplayPages(Doc: TPDFDocument);
     procedure DisplayTrailer(Doc: TPDFDocument);
   Public
     function ProcessOptions : Boolean;
-    procedure Usage(Msg : String);
+    procedure Usage(Msg: String);
     procedure DumpFile(FN: String);
     procedure DoRun; override;
   end;
@@ -149,6 +151,7 @@ begin
   if (FSections=[]) then
     for S in TInfoSection do
       Include(FSections,S);
+  Result:=true;
 end;
 
 procedure TPDFDumpApplication.Usage(Msg: String);
@@ -315,13 +318,13 @@ begin
         UnicodeMap:=nil;
       end
     else If cmd is TPDFTextCommand then
-     begin
-     rawText:=TPDFTextCommand(Cmd).GetFullText(UnicodeMap);
-     // Writeln('GetCodePage : ',CodePageToCodePageName(StringCodePage(Rawtext)));
-     SetCodePage(RawText,CP_UTF8);
-     Writeln(RawText);
-     end;
-   end;
+      begin
+      rawText:=TPDFTextCommand(Cmd).GetFullText(UnicodeMap);
+      //Writeln('GetCodePage : ',CodePageToCodePageName(StringCodePage(Rawtext)));
+      SetCodePage(RawText,CP_UTF8);
+      Writeln(RawText);
+      end;
+    end;
 end;
 
 procedure TPDFDumpApplication.DisplayPages(Doc : TPDFDocument);

packages/fcl-pdf/src/fppdfobjects.pp

@@ -25,7 +25,11 @@ unit fppdfobjects;
 interface
 
 uses
-  TypInfo, Types, rtlConsts, SysUtils, Classes, Contnrs, fppdfconsts;
+  TypInfo,
+  {$IFDEF DEBUGPDFALLOCATION}
+  Types,
+  {$ENDIF}
+  rtlConsts, SysUtils, Classes, Contnrs, fppdfconsts;
 
 Const
   PDFTextArraySpaceTreshold = 200;
@@ -1426,19 +1430,16 @@ Var
 
 begin
   if aUnicodeMap=Nil then
-    Exit(GetFullText);
+    Exit('');
   Result:='';
   if Length(Tokens)>=2 then
     For I:=1 to Length(Tokens)-2 do
-      begin
-      if Tokens[I].TokenType=ptString then
-
-        Result:=Result+aUnicodeMap.InterPret(Tokens[I].TokenData)
-      else if Tokens[i].IsNumber then
-        begin
+      case Tokens[I].TokenType of
+      ptString,ptHexString:
+        Result:=Result+aUnicodeMap.InterPret(Tokens[I].TokenData);
+      ptNumber:
         if Abs(Tokens[i].AsDouble)>PDFTextArraySpaceTreshold then
-          Result:=Result+' '
-        end
+          Result:=Result+' ';
       else
         Raise EConvertError.Create('Unexpected char');
       end;
@@ -2108,7 +2109,7 @@ begin
     If (Length(TokenData)>2) and (TokenData[1]=#254) and (TokenData[2]=#255) then
       begin
       Len:=Length(TokenData)-2;
-      SetLength(UString,Len div 2);
+      SetLength(UString{%H-},Len div 2);
       Move(TokenData[3],UString[1],Len);
       P:=PWord(PUnicodeChar(UString));
       For I:=1 to Length(UString) do

packages/fcl-pdf/src/fppdfparser.pp

@@ -1410,7 +1410,7 @@ class procedure TPDFParser.RunlengthDecode(aSrc, aDest: TStream);
 Var
   I : Integer;
   RLE,B,Cnt,C : Byte;
-  Buf : Array[0..128] of byte;
+  {%H-}Buf : Array[0..128] of byte;
 
 begin
   RLE:=128;

packages/fcl-pdf/src/fppdfscanner.pp

@@ -586,9 +586,10 @@ Var
   lRes,lRawlen : Integer;
 
 begin
+  Result:='';
   aValue:=Char(aStartByte)+GetTillByte(Ord('>'));
   lRawlen:=Length(aValue) div 2;
-  SetLength(Result,lRawLen);
+  SetLength(Result{%H-},lRawLen);
   lRes:=HexToBin(PChar(aValue),PChar(Result),lRawLen);
   if lRes=-1 then
     DoError(senInvalidHexString,SErrInvalidHexString,[aValue]);
@@ -611,7 +612,6 @@ Var
   CharPos : Integer;
   lOpenCount : Integer;
   aByte,aByte2 : Byte;
-  aChar : Char absolute aByte;
   aChar2 : Char absolute aByte2;
   aChar3,aChar4 : Char;
   aOctal : integer;

packages/fcl-web/src/base/httproute.pp

@@ -891,6 +891,8 @@ end;
 procedure THTTPRoute.DoHandleRequest(ARequest: TRequest; AResponse: TResponse);
 begin
   // Do nothing
+  if ARequest=nil then ;
+  if AResponse=nil then ;
 end;
 
 destructor THTTPRoute.Destroy;

packages/fcl-web/src/websocket/fpwebsocket.pp

@@ -881,21 +881,33 @@ Const
 Var
   Buf : TBytes;
   aPos,toRead : QWord;
-  aCount : Longint;
+  aCount, FailCnt : Longint;
 
 begin
   Buf:=[];
   ToRead:=DataLength;
   aPos:=0;
+  FailCnt:=0;
   Repeat
     aCount:=ToRead;
     if aCount>MaxBufSize then
       aCount:=MaxBufSize;
     SetLength(Buf,aCount);
     aCount := aTransport.ReadBytes(Buf,aCount);
-    Move(Buf[0],Content[aPos],aCount);
-    Inc(aPos,aCount);
-    ToRead:=DataLength-aPos;
+    if aCount>0 then
+      begin
+      Move(Buf[0],Content[aPos],aCount);
+      Inc(aPos,aCount);
+      ToRead:=DataLength-aPos;
+      FailCnt:=0;
+      end
+    else
+      begin
+      sleep(1);
+      inc(FailCnt);
+      if FailCnt>100 then
+        raise Exception.Create('20230316102741 TWSFramePayload.ReadData');
+      end;
   Until (ToRead<=0);
 end;
 
@@ -912,7 +924,7 @@ begin
   LenFlag := buffer[1] and FlagLengthMask;
 
   Case LenFlag of
-   FlagTwoBytes:
+  FlagTwoBytes:
     begin
     aTransport.ReadBytes(Buffer,2);
     Paylen16:=Buffer.ToWord(0);

packages/fcl-web/src/websocket/wsupgrader.pp

@@ -11,6 +11,7 @@ Type
 
   { TCustomWebsocketUpgrader }
   TAllowUpgradeEvent = Procedure(Sender : TObject; aRequest : TRequest; var aAllow : Boolean) of object;
+  TWSConnectEvent = procedure(Sender: TObject; AConnection: TWSServerConnection) of object;
 
   TCustomWebsocketUpgrader = Class(TCustomWSServer)
   private
@@ -22,8 +23,8 @@ Type
     FHost: String;
     function GetHandshakeRequest(aRequest: TFPHTTPConnectionRequest): TWSHandShakeRequest;
     function GetUpgradeName: String;
-    procedure SetHost(const AValue: String);
-    procedure SetUpgradeName(const AValue: String);
+    procedure SetHost(AValue: String);
+    procedure SetUpgradeName(AValue: String);
     procedure SetWebServer(AValue: TFPCustomHttpServer);
   Protected
     // Override from custom server
@@ -64,6 +65,7 @@ Type
     Property MessageWaitTime;
     Property Options;
     Property OnAllow;
+    property OnConnect;
     property OnMessageReceived;
     property OnDisconnect;
     property OnControlReceived;
@@ -117,7 +119,7 @@ begin
   FreeConnectionHandler;
 end;
 
-procedure TCustomWebsocketUpgrader.SetHost(const AValue: String);
+procedure TCustomWebsocketUpgrader.SetHost(AValue: String);
 begin
   if Host=AValue then Exit;
   CheckInactive;
@@ -204,6 +206,8 @@ begin
     aConn.DoHandshake(aHandshake);
     Connections.Add(aConn);
     ConnectionHandler.HandleConnection(aConn,False);
+    if Assigned(OnConnect) then
+      OnConnect(Self,aConn);
   finally
     aHandshake.Free;
   end;
@@ -216,7 +220,7 @@ begin
 end;
 
 
-procedure TCustomWebsocketUpgrader.SetUpgradeName(const AValue: String);
+procedure TCustomWebsocketUpgrader.SetUpgradeName(AValue: String);
 begin
   if aValue=GetUpgradeName then
     exit;

utils/fpcm/fpcmmain.pp

@@ -213,7 +213,6 @@ interface
 
       TFPCMake = class
       private
-        FKnownArchitectures: TStrings;
         FStream         : TStream;
         FFileName       : string;
         FCommentChars   : TSysCharSet;
@@ -273,7 +272,6 @@ interface
         property CommentChars:TSysCharSet read FCommentChars write FCommentChars;
         property EmptyLines:Boolean read FEmptyLines write FEmptyLines;
         property IncludeTargets:TTargetSet read FIncludeTargets write FIncludeTargets;
-        Property KnownArchitectures : TStrings Read FKnownArchitectures;
       end;
 
     function posidx(const substr,s : string;idx:integer):integer;
@@ -653,7 +651,6 @@ implementation
         for c:=low(tcpu) to high(tcpu) do
          for t:=low(tos) to high(tos) do
           FRequireList[c,t]:=TStringList.Create;
-        FKnownArchitectures:=TStringList.Create;
         FVariables:=TKeyValue.Create;
         FCommentChars:=[';','#'];
         FEmptyLines:=false;
@@ -677,7 +674,6 @@ implementation
         for c:=low(tcpu) to high(tcpu) do
          for t:=low(tos) to high(tos) do
           FRequireList[c,t].Free;
-        FKnownArchitectures.Free;
         FVariables.Free;
       end;