tests: compile with fpc 3.2.2

tests/base/TCFresnelBaseEvents.pas

@@ -13,8 +13,10 @@ unit TCFresnelBaseEvents;
 
 {$mode objfpc}
 {$H+}
+{$IF FPC_FULLVERSION>30300}
 {$modeswitch functionreferences}
 {$modeswitch nestedprocvars}
+{$ENDIF}
 
 interface
 
@@ -113,13 +115,17 @@ type
       aEvent: TAbstractEvent; aIndex, aCount: Integer);
   private
     FDispatcher: TEventDispatcher;
+    {$IFDEF HasFunctionReferences}
     FRHandler:TEventHandlerRef;
     FRHandler2:TEventHandlerRef;
+    {$ENDIF}
     FEvents : Array[1..3] of TAbstractEvent;
     FSecondEvent : TAbstractEvent;
 
     Procedure RegisterEvent2P;
+    {$IFDEF HasFunctionReferences}
     Procedure RegisterEvent2R;
+    {$ENDIF}
     Procedure RegisterEvent2O;
   protected
     Procedure SetUp; override;
@@ -131,41 +137,61 @@ type
     function RegisterHandlerO2(aEventName: String): TEventHandlerItem;
     function RegisterHandlerP(aEventName: String): TEventHandlerItem;
     function RegisterHandlerP2(aEventName: String): TEventHandlerItem;
+    {$IFDEF HasFunctionReferences}
     function RegisterHandlerR(aEventName: String): TEventHandlerItem;
     function RegisterHandlerR2(aEventName: String): TEventHandlerItem;
+    {$ENDIF}
     Property Dispatcher : TEventDispatcher Read FDispatcher;
   Published
     Procedure TestHookup;
     Procedure TestRegisterHandlerO;
+    {$IFDEF HasFunctionReferences}
     Procedure TestRegisterHandlerR;
+    {$ENDIF}
     Procedure TestRegisterHandlerP;
     Procedure TestRegisterHandlerOUnknown;
+    {$IFDEF HasFunctionReferences}
     Procedure TestRegisterHandlerRUnknown;
+    {$ENDIF}
     Procedure TestRegisterHandlerPUnknown;
     Procedure TestUnRegisterHandlerO;
+    {$IFDEF HasFunctionReferences}
     Procedure TestUnRegisterHandlerR;
+    {$ENDIF}
     Procedure TestUnRegisterHandlerP;
     Procedure TestUnRegisterHandlerOName;
+    {$IFDEF HasFunctionReferences}
     Procedure TestUnRegisterHandlerRName;
+    {$ENDIF}
     Procedure TestUnRegisterHandlerPName;
     Procedure TestUnRegisterHandlerOUnknownEvent;
+    {$IFDEF HasFunctionReferences}
     Procedure TestUnRegisterHandlerRUnknownEvent;
+    {$ENDIF}
     Procedure TestUnRegisterHandlerPUnknownEvent;
     Procedure TestUnRegisterHandlerOUnknownHandler;
+    {$IFDEF HasFunctionReferences}
     Procedure TestUnRegisterHandlerRUnknownHandler;
+    {$ENDIF}
     Procedure TestUnRegisterHandlerPUnknownHandler;
     Procedure TestUnRegisterHandlerOAllName;
+    {$IFDEF HasFunctionReferences}
     Procedure TestUnRegisterHandlerRAllName;
+    {$ENDIF}
     Procedure TestUnRegisterHandlerPAllName;
     Procedure TestUnRegisterHandlerMixedAllName;
     Procedure TestUnRegisterHandlerOAllHandler;
+    {$IFDEF HasFunctionReferences}
     Procedure TestUnRegisterHandlerRAllHandler;
+    {$ENDIF}
     Procedure TestUnRegisterHandlerPAllHandler;
     Procedure TestCreateEventByName;
     Procedure TestCreateEventByID;
     Procedure TestDispatchEvent;
     Procedure TestDispatchEventProc;
+    {$IFDEF HasFunctionReferences}
     Procedure TestDispatchEventRef;
+    {$ENDIF}
     Procedure TestDispatchEvent2Handlers;
     Procedure TestDispatchEvent2MixedHandlers;
     Procedure TestDispatchEventInEvent;
@@ -183,7 +209,9 @@ var
 
 begin
   inherited SetUp;
+  {$IFDEF HasFunctionReferences}
   FRHandler:=Nil;
+  {$ENDIF}
   FDispatcher:=TEventDispatcher.Create(Self);
   FDispatcher.Registry:=Self.Registry;
   For H in THandlerType do
@@ -199,7 +227,9 @@ procedure TCEventsDispatcher.TearDown;
 var
   I : Integer;
 begin
+  {$IFDEF HasFunctionReferences}
   FRHandler:=Nil;
+  {$ENDIF}
   FreeAndNil(FDispatcher);
   for I:=1 to 3 do
     FreeAndNil(FEvents[i]);
@@ -238,10 +268,12 @@ begin
   RegisterHandlerP('event2');
 end;
 
+{$IFDEF HasFunctionReferences}
 procedure TCEventsDispatcher.RegisterEvent2R;
 begin
   RegisterHandlerR('event2');
 end;
+{$ENDIF}
 
 procedure TCEventsDispatcher.RegisterEvent2O;
 begin
@@ -297,6 +329,7 @@ begin
   Result:=Dispatcher.RegisterHandler(@EventHandlerP2,aEventName);
 end;
 
+{$IFDEF HasFunctionReferences}
 function TCEventsDispatcher.RegisterHandlerR(aEventName: String) : TEventHandlerItem;
 
   Procedure EventHandlerR(aEvent : TAbstractEVent);
@@ -323,6 +356,7 @@ begin
   FRHandler2:=@EventHandlerR2;
   Result:=Dispatcher.RegisterHandler(FRHandler,aEventName);
 end;
+{$ENDIF}
 
 procedure TCEventsDispatcher.TestHookup;
 begin
@@ -344,6 +378,7 @@ begin
   AssertEquals('Count',1,Dispatcher.Count);
 end;
 
+{$IFDEF HasFunctionReferences}
 procedure TCEventsDispatcher.TestRegisterHandlerR;
 Var
   Itm : TEventHandlerItem;
@@ -356,6 +391,7 @@ begin
   AssertEquals('Event name','event1',Itm.EventName);
   AssertEquals('Count',1,Dispatcher.Count);
 end;
+{$ENDIF}
 
 procedure TCEventsDispatcher.TestRegisterHandlerP;
 Var
@@ -376,11 +412,13 @@ begin
   AssertException('Not known',EEvents,@RegisterEvent2O,'Unknown event name: event2');
 end;
 
+{$IFDEF HasFunctionReferences}
 procedure TCEventsDispatcher.TestRegisterHandlerRUnknown;
 begin
   Register1;
   AssertException('Not known',EEvents,@RegisterEvent2R,'Unknown event name: event2');
 end;
+{$ENDIF}
 
 procedure TCEventsDispatcher.TestRegisterHandlerPUnknown;
 begin
@@ -402,6 +440,7 @@ begin
   AssertEquals('Dispatcher count',0,Dispatcher.Count);
 end;
 
+{$IFDEF HasFunctionReferences}
 procedure TCEventsDispatcher.TestUnRegisterHandlerR;
 Var
   Itm : TEventHandlerItem;
@@ -414,6 +453,7 @@ begin
   Dispatcher.UnregisterHandler(Itm);
   AssertEquals('Dispatcher count',0,Dispatcher.Count);
 end;
+{$ENDIF}
 
 procedure TCEventsDispatcher.TestUnRegisterHandlerP;
 
@@ -444,6 +484,7 @@ begin
   AssertEquals('Dispatcher count',0,Dispatcher.Count);
 end;
 
+{$IFDEF HasFunctionReferences}
 procedure TCEventsDispatcher.TestUnRegisterHandlerRName;
 Var
   Itm : TEventHandlerItem;
@@ -455,8 +496,8 @@ begin
   AssertEquals('Dispatcher count',1,Dispatcher.Count);
   Dispatcher.UnregisterHandler(FRHandler,'event1');
   AssertEquals('Dispatcher count',0,Dispatcher.Count);
-
 end;
+{$ENDIF}
 
 procedure TCEventsDispatcher.TestUnRegisterHandlerPName;
 
@@ -487,6 +528,7 @@ begin
   AssertEquals('Dispatcher count',1,Dispatcher.Count);
 end;
 
+{$IFDEF HasFunctionReferences}
 procedure TCEventsDispatcher.TestUnRegisterHandlerRUnknownEvent;
 Var
   Itm : TEventHandlerItem;
@@ -501,10 +543,9 @@ begin
   Dispatcher.UnregisterHandler(FRHandler,'event2');
   AssertEquals('Dispatcher count',1,Dispatcher.Count);
 end;
+{$ENDIF}
 
 procedure TCEventsDispatcher.TestUnRegisterHandlerPUnknownEvent;
-
-
 begin
   Register1;
   Register2;
@@ -526,6 +567,7 @@ begin
   AssertEquals('Dispatcher count after',2,Dispatcher.Count);
 end;
 
+{$IFDEF HasFunctionReferences}
 procedure TCEventsDispatcher.TestUnRegisterHandlerRUnknownHandler;
 
 begin
@@ -537,6 +579,7 @@ begin
   Dispatcher.UnregisterHandler(FRHandler2,'event1');
   AssertEquals('Dispatcher count after',2,Dispatcher.Count);
 end;
+{$ENDIF}
 
 procedure TCEventsDispatcher.TestUnRegisterHandlerPUnknownHandler;
 Var
@@ -568,6 +611,7 @@ begin
   AssertEquals('Dispatcher count after',0,Dispatcher.Count);
 end;
 
+{$IFDEF HasFunctionReferences}
 procedure TCEventsDispatcher.TestUnRegisterHandlerRAllName;
 begin
   Register1;
@@ -577,8 +621,8 @@ begin
   AssertEquals('Dispatcher count before',2,Dispatcher.Count);
   Dispatcher.UnregisterHandler('event1');
   AssertEquals('Dispatcher count after',0,Dispatcher.Count);
-
 end;
+{$ENDIF}
 
 procedure TCEventsDispatcher.TestUnRegisterHandlerPAllName;
 begin
@@ -614,6 +658,7 @@ begin
 
 end;
 
+{$IFDEF HasFunctionReferences}
 procedure TCEventsDispatcher.TestUnRegisterHandlerRAllHandler;
 begin
   Register1;
@@ -624,6 +669,7 @@ begin
   Dispatcher.UnregisterHandler(FRHandler);
   AssertEquals('Dispatcher count after',0,Dispatcher.Count);
 end;
+{$ENDIF}
 
 procedure TCEventsDispatcher.TestUnRegisterHandlerPAllHandler;
 begin
@@ -695,6 +741,7 @@ begin
   AssertCalled('Event handler called',htProc,Evt,1,1);
 end;
 
+{$IFDEF HasFunctionReferences}
 procedure TCEventsDispatcher.TestDispatchEventRef;
 
 Var
@@ -714,6 +761,7 @@ begin
   AssertCalled('Event handler called',htRef,Evt,1,1);
 
 end;
+{$ENDIF}
 
 procedure TCEventsDispatcher.TestDispatchEvent2Handlers;
 Var

tests/base/tcfresnelimages.pas

@@ -1,6 +1,9 @@
 unit TCFresnelImages;
 
 {$mode ObjFPC}{$H+}
+{$IF FPC_FULLVERSION>30300}
+  {$DEFINE HasIOUtils}
+{$ENDIF}
 
 interface
 
@@ -84,7 +87,6 @@ Type
     FStore: TImageStore;
     FDir : string;
   Public
-    Procedure CopyFile(aFrom,aTo : String);
     Procedure CreateImages;
     Procedure Setup; override;
     Procedure TearDown; override;
@@ -112,9 +114,80 @@ Type
     Procedure TestHookup;
   end;
 
+procedure DeleteDir(Dir: string);
+procedure CopyFile(Src, Dest: string; Overwrite: boolean = false);
+
 implementation
 
-uses inifiles, fpreadpng, fpwritepng, System.IOUtils;
+uses inifiles,
+  {$IFDEF HasIOUtils}
+  System.IOUtils,
+  {$ENDIF}
+  fpreadpng, fpwritepng;
+
+procedure DeleteDir(Dir: string);
+{$IFDEF HasIOUtils}
+{$ELSE}
+var
+  Info: TRawByteSearchRec;
+  List: TStringList;
+  i: Integer;
+  Filename: String;
+{$ENDIF}
+begin
+  {$IFDEF HasIOUtils}
+  TDirectory.Delete(Dir,True);
+  {$ELSE}
+  if not DirectoryExists(Dir) then exit;
+  Info:=Default(TRawByteSearchRec);
+  List:=TStringList.Create;
+  try
+    if FindFirst(Dir+PathDelim+AllFilesMask,faAnyFile,Info)=0 then
+      repeat
+        if (Info.Name='.') or (Info.Name='..') then continue;
+        List.Add(Info.Name);
+      until FindNext(Info)<>0;
+    for i:=0 to List.Count-1 do
+      begin
+      Filename:=Dir+PathDelim+List[i];
+      if not DeleteFile(Filename) then
+        raise Exception.Create('20240906122331 DeleteDir failed '+Filename);
+      end;
+  finally
+    FindClose(Info);
+  end;
+  {$ENDIF}
+end;
+
+procedure CopyFile(Src, Dest: string; Overwrite: boolean);
+{$IFDEF HasIOUtils}
+{$ELSE}
+var
+  SrcFS, DestFS: TFileStream;
+{$ENDIF}
+begin
+  {$IFDEF HasIOUtils}
+  TFile.Copy(Src,Dest,Overwrite);
+  {$ELSE}
+  if Overwrite and FileExists(Dest) then
+    begin
+    if not DeleteFile(Dest) then
+      raise Exception.Create('20240906122205 failed to delete file "'+Dest+'"');
+    end;
+
+  SrcFS:=TFileStream.Create(Src,fmOpenRead or fmShareDenyNone);
+  try
+    DestFS:=TFileStream.Create(Dest,fmCreate or fmShareDenyNone);
+    try
+      DestFS.CopyFrom(SrcFS,SrcFS.Size);
+    finally
+      DestFS.Free;
+    end;
+  finally
+    SrcFS.Free;
+  end;
+  {$ENDIF}
+end;
 
 { TImageTest }
 Procedure TImageTest.ReadConfig;
@@ -279,7 +352,9 @@ begin
   AssertNotNull('Have result',R);
   AssertEquals('Correct resolution',96,R.Resolution);
   AssertFalse('Default',R.Default);
+  {$IFDEF HasFunctionReferences}
   AssertException('No second resolution',EImageData,@AddData);
+  {$ENDIF}
 end;
 
 procedure TTestResolutionList.TestFindDefaultResolution;
@@ -392,16 +467,11 @@ end;
 
 { TTestImageStore }
 
-procedure TTestImageStore.CopyFile(aFrom, aTo: String);
-begin
-  TFile.Copy(aFrom,aTo);
-end;
-
 procedure TTestImageStore.CreateImages;
 begin
-  TFile.Copy(GetStdImage(10),ImagesConfig.GetSizedImageFileName('img'));
-  TFile.Copy(GetStdImage(20),ImagesConfig.GetSizedImageFileName('img',ImagesConfig.IconSize*2));
-  TFile.Copy(GetStdImage(30),ImagesConfig.GetSizedImageFileName('img',ImagesConfig.IconSize,192));
+  CopyFile(GetStdImage(10),ImagesConfig.GetSizedImageFileName('img'));
+  CopyFile(GetStdImage(20),ImagesConfig.GetSizedImageFileName('img',ImagesConfig.IconSize*2));
+  CopyFile(GetStdImage(30),ImagesConfig.GetSizedImageFileName('img',ImagesConfig.IconSize,192));
 end;
 
 procedure TTestImageStore.Setup;
@@ -416,7 +486,7 @@ end;
 procedure TTestImageStore.TearDown;
 begin
   FreeAndNil(FFreeImg);
-  TDirectory.Delete(FDir,True);
+  DeleteDir(FDir);
   FreeAndNil(FStore);
   inherited TearDown;
 end;
@@ -473,7 +543,7 @@ end;
 procedure TTestImageStore.TestNoSize;
 begin
   CreateImages;
-  TFile.Copy(GetStdImage(30),ImagesConfig.ImageDir+'img_96.png');
+  CopyFile(GetStdImage(30),ImagesConfig.ImageDir+'img_96.png');
   Store.Size:=0;
   Store.GetImageData('img',FFreeImg,True);
   AssertNotNull('Have image',FreeImg);
@@ -484,7 +554,7 @@ end;
 procedure TTestImageStore.TestNoResolution;
 begin
   CreateImages;
-  TFile.Copy(GetStdImage(30),ImagesConfig.ImageDir+'img_24x24.png',true);
+  CopyFile(GetStdImage(30),ImagesConfig.ImageDir+'img_24x24.png',true);
   Store.Size:=24;
   Store.Resolution:=0;
   Store.GetImageData('img',FFreeImg,True);