Merge branch source:main into main

packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

@@ -77,7 +77,9 @@ Type
     fhandle: psqlite3;
     FOpenFlags: TSQLiteOpenFlags;
     FVFS: String;
+    function GetAlwaysUseMemo: Boolean;
     function GetSQLiteOpenFlags: Integer;
+    procedure SetAlwaysUseMemo(const aValue: Boolean);
     procedure SetOpenFlags(AValue: TSQLiteOpenFlags);
     procedure SetVFS(const AValue: String);
   protected
@@ -136,6 +138,7 @@ Type
     Property OpenFlags : TSQLiteOpenFlags Read FOpenFlags Write SetOpenFlags default DefaultOpenFlags;
     Property VFS : String Read FVFS Write SetVFS;
     Property AlwaysUseBigint : Boolean Read GetAlwaysUseBigint Write SetAlwaysUseBigint;
+    Property AlwaysUseMemo : Boolean Read GetAlwaysUseMemo Write SetAlwaysUseMemo stored true;
   end;
 
   { TSQLite3ConnectionDef }
@@ -329,6 +332,7 @@ end;
 
 Const
   SUseBigint = 'AlwaysUseBigint';
+  SUseMemo = 'AlwaysUseMemo';
 
 function TSQLite3Connection.GetAlwaysUseBigint : Boolean;
 
@@ -549,7 +553,12 @@ begin
         stInteger: FT:=ftLargeInt;
         stFloat:   FT:=ftFloat;
         stBlob:    FT:=ftBlob;
-        stText:    FT:=ftMemo;
+        stText:    begin
+        if AlwaysUseMemo then
+          FT:=ftMemo
+        else
+          FT:=ftString
+        end;
       else
         FT:=ftString;
       end;
@@ -874,6 +883,22 @@ begin
       Result:=Result or NativeFlags[F];
 end;
 
+function TSQLite3Connection.GetAlwaysUseMemo: Boolean;
+begin
+  {$IFDEF VER3_2}
+  // Must be set to 1 to take effect
+  Result:=Params.Values[SUseMemo]='1'
+  {$ELSE}
+  // Must be set to 0 to disable
+  Result:=Params.Values[SUseMemo]<>'0'
+  {$ENDIF}
+end;
+
+procedure TSQLite3Connection.SetAlwaysUseMemo(const aValue: Boolean);
+begin
+   Params.Values[SUseMemo]:=IntToStr(Ord(aValue));
+end;
+
 
 procedure TSQLite3Connection.SetOpenFlags(AValue: TSQLiteOpenFlags);
 begin

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

@@ -1516,7 +1516,7 @@ end;
 
 class function TPath.Exists(const aPath: string; aFollowLink: Boolean): Boolean;
 begin
-  Result:=TDirectory.Exists(aPath, aFollowLink) and TFile.Exists(aPath, aFollowLink);
+  Result:=TDirectory.Exists(aPath, aFollowLink) or TFile.Exists(aPath, aFollowLink);
 end;
 
 class function TPath.GetAttributes(const aPath: string; aFollowLink: Boolean

utils/fpdoc/fpdoc.pp

@@ -205,11 +205,12 @@ Const
   SOptProject = '--project=';
   SOptPackage = '--package=';
   SOptMacro = '--macro=';
+  SOptDefine = '--define=';
 
   Function ProjectOpt(Const s : string) : boolean;
 
   begin
-    Result:=(Copy(s,1,3)='-p=') or (Copy(s,1,Length(SOptProject))=SOptProject) or (Copy(s,1,Length(SOptMacro))=SOptMacro);
+    Result:=(Copy(s,1,3)='-p=') or (Copy(s,1,Length(SOptProject))=SOptProject) or (Copy(s,1,Length(SOptMacro))=SOptMacro) or (Copy(s,1,Length(SOptDefine))=SOptDefine);
   end;
 
   Function PackageOpt(Const s : string) : boolean;
@@ -359,6 +360,11 @@ begin
       AddDirToFileList(SelectedPackage.Descriptions, Arg, '*.xml')
     else if (Cmd = '--base-descr-dir') then
       FCreator.BaseDescrDir:=Arg
+    else if (Cmd = '--define') then
+      begin
+      Writeln('Defining : ',Arg);
+      FCreator.Defines.Add(Arg)
+      end
     else if (Cmd = '--macro') then
       begin
       If Pos('=',Arg)=0 then

utils/fpdoc/fpdocxmlopts.pas

@@ -12,6 +12,7 @@ Type
 
   TXMLFPDocOptions = Class(TComponent)
   private
+    FDefines : TStrings;
   Protected
     Function PreProcessFile(const AFileName: String; Macros: TStrings): TStream; virtual;
     Procedure Error(Const Msg : String);
@@ -25,10 +26,12 @@ Type
     procedure SaveInputFile(const AInputFile: String; XML: TXMLDocument; AParent: TDOMElement);virtual;
     Procedure SavePackage(APackage : TFPDocPackage; XML : TXMLDocument; AParent : TDOMElement); virtual;
   Public
+    Destructor destroy; override;
     Procedure LoadOptionsFromFile(AProject : TFPDocProject; Const AFileName : String; Macros : TStrings = Nil);
     Procedure LoadFromXML(AProject : TFPDocProject; XML : TXMLDocument); virtual;
     Procedure SaveOptionsToFile(AProject : TFPDocProject; Const AFileName : String);
     procedure SaveToXML(AProject : TFPDocProject; ADoc: TXMLDocument); virtual;
+    Procedure SetDefines(aDefines : TStrings);
   end;
   EXMLFPdoc = Class(Exception);
 
@@ -79,6 +82,10 @@ procedure TXMLFPDocOptions.LoadPackage(APackage: TFPDocPackage; E: TDOMElement);
     S : UnicodeString;
 
   begin
+    S:=I['if'];
+    if S<>'' then
+      If Not (Assigned(FDefines) and (FDefines.IndexOf(S)<>-1)) then
+        exit('');
     Result:=I['file'];
     If (Result='') then
       Error(SErrNoInputFile);
@@ -88,8 +95,13 @@ procedure TXMLFPDocOptions.LoadPackage(APackage: TFPDocPackage; E: TDOMElement);
   end;
 
   Function LoadDescription(I : TDOMElement) : UnicodeString;
-
+  var
+    S : UnicodeString;
   begin
+    S:=I['if'];
+    if S<>'' then
+      If Not (Assigned(FDefines) and (FDefines.IndexOf(S)<>-1)) then
+        exit('');
     Result:=I['file'];
     If (Result='') then
       Error(SErrNoDescrFile);
@@ -101,6 +113,10 @@ procedure TXMLFPDocOptions.LoadPackage(APackage: TFPDocPackage; E: TDOMElement);
     S : UnicodeString;
 
   begin
+    S:=I['if'];
+    if S<>'' then
+      If Not (Assigned(FDefines) and (FDefines.IndexOf(S)<>-1)) then
+        exit('');
     Result:=I['file'];
     If (Result='') then
       Error(SErrNoImportFile);
@@ -113,7 +129,7 @@ procedure TXMLFPDocOptions.LoadPackage(APackage: TFPDocPackage; E: TDOMElement);
 Var
   N,S : TDOMNode;
   O : TDomElement;
-
+  lInput,lDescr : UnicodeString;
 begin
   APackage.Name:=UTF8Encode(E['name']);
   APackage.output:=UTF8Encode(E['output']);
@@ -130,7 +146,11 @@ begin
         While (S<>Nil) do
           begin
           If (S.NodeType=Element_Node) and (S.NodeName='unit') then
-            APackage.Inputs.add(UTF8Encode(LoadInput(S as TDomElement)));
+            begin
+            lInput:=LoadInput(S as TDomElement);
+            if lInput<>'' then
+              APackage.Inputs.add(UTF8Encode(lInput));
+            end;
           S:=S.NextSibling;
           end;
         end
@@ -140,7 +160,11 @@ begin
         While (S<>Nil) do
           begin
           If (S.NodeType=Element_Node) and (S.NodeName='description') then
-            APackage.Descriptions.add(UTF8Encode(LoadDescription(S as TDomElement)));
+            begin
+            lDescr:=LoadDescription(S as TDomElement);
+            if lDescr<>'' then
+              APackage.Descriptions.add(UTF8Encode(lDescr));
+            end;
           S:=S.NextSibling;
           end;
         end
@@ -243,6 +267,13 @@ begin
     end;
 end;
 
+procedure TXMLFPDocOptions.SetDefines(aDefines: TStrings);
+begin
+  if not assigned(FDefines) then
+    FDefines:=TStringList.Create;
+  FDefines.AddStrings(aDefines);
+end;
+
 procedure TXMLFPDocOptions.SaveEngineOptions(Options: TEngineOptions;
   XML: TXMLDocument; AParent: TDOMElement);
 
@@ -356,6 +387,12 @@ begin
     end;
 end;
 
+destructor TXMLFPDocOptions.destroy;
+begin
+  FreeAndNil(FDefines);
+  inherited destroy;
+end;
+
 
 Function TXMLFPDocOptions.PreprocessFile(const AFileName: String; Macros : TStrings) : TStream;
 
@@ -397,11 +434,12 @@ Var
 
 begin
   XML:=Nil;
-  if Macros=Nil then
-    S:=TFileStream.Create(AFileName,fmOpenRead or fmShareDenyWrite)
-  else
-    S:=PreProcessFile(AFileName,Macros);
+  S:=nil;
   try
+    if Macros=Nil then
+      S:=TFileStream.Create(AFileName,fmOpenRead or fmShareDenyWrite)
+    else
+      S:=PreProcessFile(AFileName,Macros);
     ReadXMLFile(XML,S);
     LoadFromXML(AProject,XML);
   finally

utils/fpdoc/mkfpdoc.pp

@@ -27,6 +27,7 @@ Type
     FBaseDescrDir: String;
     FBaseInputDir: String;
     FCurPackage : TFPDocPackage;
+    FDefines: TStrings;
     FExamplesPath: String;
     FProcessedUnits : TStrings;
     FOnLog: TPasParserLogHandler;
@@ -40,6 +41,7 @@ Type
     function GetPackages: TFPDocPackages;
     procedure SetBaseDescrDir(AValue: String);
     procedure SetBaseInputDir(AValue: String);
+    procedure SetDefines(const aValue: TStrings);
     procedure SetExamplesPath(AValue: String);
     procedure SetProjectMacros(AValue: TStrings);
   Protected
@@ -73,6 +75,7 @@ Type
     Property ExamplesPath : String Read FExamplesPath Write SetExamplesPath;
     // Macros used when loading the project file
     Property ProjectMacros : TStrings Read FProjectMacros Write SetProjectMacros;
+    Property Defines : TStrings Read FDefines Write SetDefines;
   end;
 
 implementation
@@ -191,6 +194,12 @@ begin
     FBaseInputDir:=IncludeTrailingPathDelimiter(FBaseInputDir);
 end;
 
+procedure TFPDocCreator.SetDefines(const aValue: TStrings);
+begin
+  if FDefines=aValue then Exit;
+  FDefines.Assign(aValue);
+end;
+
 procedure TFPDocCreator.SetExamplesPath(AValue: String);
 begin
   if FExamplesPath=AValue then Exit;
@@ -221,10 +230,12 @@ begin
   FProject.Options.EndianNess:=DefEndianNess;
   FProcessedUnits:=TStringList.Create;
   FProjectMacros:=TStringList.Create;
+  FDefines:=TStringList.Create;
 end;
 
 destructor TFPDocCreator.Destroy;
 begin
+  FreeAndNil(FDefines);
   FreeAndNil(FProcessedUnits);
   FreeAndNil(FProject);
   FreeAndNil(FProjectMacros);
@@ -398,6 +409,7 @@ procedure TFPDocCreator.LoadProjectFile(const AFileName: string);
 begin
   With TXMLFPDocOptions.Create(self) do
     try
+      SetDefines(Self.Defines);
       if (ProjectMacros.Count>0) then
         LoadOptionsFromFile(FProject,AFileName,ProjectMacros)
       else