Idea how to quickly fix all errors in Lazarus when compiling with the -CR option

[ALLIGATOR]

@JuhaManninen

https://gitlab.com/freepascal.org/lazarus/lazarus/-/issues/41567#note_2497274501

I decided to try to solve this problem, the first way - by disabling checks in the necessary places.
And realized that I could make the necessary edits quite quickly.

But, I have a few problems:

• I won't be able to check all the places, because I'm doing the checks at runtime, not searching through the code - so I can only fix those places where the runtime reaches when Lazarus starts and performs some limited set of actions in it. So even though Lazarus will start after that, it's likely that there may be some undiscovered dormant code somewhere waiting to be discovered. I don't know how best to solve this... leave this flag in the [main] branch and collect feedback?
• Also, I'm afraid of not noticing and disabling validation where I don't need to

But I've acquired a tool to quickly identify all such places, at least all those places that can be reached at runtime. So I will propose this utility here, and more experienced developers will probably figure out the best way to proceed

Here's the code for the utility:
vmt_err_logger.pas:

Code: Pascal  [Select][+][-]

1. unit vmt_err_logger;
2. {$mode ObjFPC}{$H+}
3.  
4. interface
5.  
6. uses
7.   ureplacefunction, Generics.Collections;
8.  
9. procedure fpc_check_object_ext(vmt, expvmt : pointer); external name 'FPC_CHECK_OBJECT_EXT';
10. function fpc_do_as(aclass : tclass;aobject : tobject): tobject; external name 'FPC_DO_AS';
11.  
12. implementation
13.  
14. type
15.   TSetData = record
16.     code: Pointer;
17.     error: Integer;
18.   end;
19.  
20. var
21.   FLog: TextFile;
22.   myset: specialize THashSet<TSetData>;
23.   i: integer = 1;
24.  
25. procedure log(const name: string; e: integer);
26. var
27.   i,count: Integer;
28.   frames: array [0..2] of codepointer;
29.   el: TSetData;
30. begin
31.   count:=CaptureBacktrace(2, 1, @frames[0]);
32.  
33.   for i:=0 to count-1 do
34.   begin
35.     el.code:=frames[i];
36.     el.error:=e;
37.     if myset.Add(el) then
38.       WriteLn(FLog, name, ', i: ', i, ', error ', el.error, BackTraceStrFunc(el.code));
39.     Flush(FLog);
40.   end;
41. end;
42.  
43. function my_fpc_do_as(aclass : tclass;aobject : tobject): tobject;
44.   begin
45.      if assigned(aobject) and not(aobject.inheritsfrom(aclass)) then log('fpc_do_as', 219);
46.      result := aobject;
47.   end;
48.  
49. procedure my_fpc_check_object_ext(vmt, expvmt : pointer);
50. type
51.   pobjectvmt=^tobjectvmt;
52.   tobjectvmt=record
53.     size,msize:sizeuint;
54.     parent:ppointer;
55.   end;
56. begin
57.   if (vmt=nil) or
58.      (pobjectvmt(vmt)^.size=0) or
59.      {$PUSH}{$R-}{$Q-}
60.      (pobjectvmt(vmt)^.size+pobjectvmt(vmt)^.msize<>0) then log('fpc_check_object_ext', 210);
61.      {$POP}
62.   while assigned(vmt) do
63.     if vmt=expvmt then
64.       exit
65.     else
66.       if assigned(pobjectvmt(vmt)^.parent) then
67.         vmt:=pobjectvmt(vmt)^.parent^
68.       else
69.         vmt:=nil;
70.   log('fpc_check_object_ext', 219);
71. end;
72.  
73. procedure init;
74. begin
75.   Assign(FLog, 'vmt_error_log.txt');
76.   Rewrite(FLog);
77.  
78.   myset:=specialize THashSet<TSetData>.Create;
79.  
80.   ReplaceFunction(@fpc_check_object_ext, @my_fpc_check_object_ext);
81.   ReplaceFunction(@fpc_do_as, @my_fpc_do_as);
82. end;
83.  
84. initialization
85.   init;
86.  
87. end.

ureplacefunction.pas:

Code: Pascal  [Select][+][-]

1. unit uReplaceFunction;
2. {$mode objfpc}
3. {$asmmode intel}
4.  
5. interface
6.  
7. uses
8.   {$IF DEFINED(MSWINDOWS)}
9.   Windows
10.   {$ELSEIF DEFINED(LINUX)}
11.   BaseUnix
12.   {$ENDIF}
13.   ;
14.  
15. function ReplaceFunction(func_from, func_to: Pointer): Boolean;
16.  
17. implementation
18.  
19. function GetTemplate(Data: Boolean): Pointer; assembler; nostackframe;
20. asm
21. {$IF DEFINED(CPUX86_64)}
22.   test Data, Data
23.   jz @SIZE
24.  
25.   lea rax, [@datab+rip]
26.   ret
27.  
28.   @size:
29.   lea rax, [@datae-@datab]
30.   ret
31.  
32.   @datab:
33.   mov rax, $1122334455667788
34.   jmp rax
35.   @datae:
36. {$ELSEIF DEFINED(CPU386)}
37.   test Data, Data
38.   jz @SIZE
39.  
40.   lea eax, [@datab]
41.   ret
42.  
43.   @size:
44.   lea eax, [@datae-@datab]
45.   ret
46.  
47.   @datab:
48.   push DWORD $11223344
49.   ret
50.   @datae:
51. {$ENDIF}
52. end;
53.  
54. procedure MySimpleMove(const source; var dest; count: SizeInt);
55. begin
56.   for count:=0 to count-1 do PByte(@dest)[count]:=PByte(@source)[count];
57. end;
58.  
59. function MyCompareMem(P1, P2: PByte; Length: PtrUInt): Boolean;
60. begin
61.   for Length:=0 to Length-1 do
62.     if P1[Length]<>P2[Length] then Exit(False);
63.   Result:=True;
64. end;
65.  
66. function MemReplace(mem: PByte; mem_size: NativeInt; search_data: PByte; search_size: NativeInt; replace_data: PByte): Boolean;
67. begin
68.   for mem_size := 0 to mem_size - search_size do
69.   begin
70.     if (mem[mem_size] = search_data[0]) and MyCompareMem(@mem[mem_size], search_data, search_size) then
71.     begin
72.       MySimpleMove(replace_data^, mem[mem_size], search_size);
73.       Exit(True);
74.     end;
75.   end;
76.   Result := False;
77. end;
78.  
79. function DisableWriteProtection(addr: Pointer; size: PtrUInt; out oldprotect: UInt32): Boolean;
80. begin
81. {$IF DEFINED(MSWINDOWS)}
82.   Result := VirtualProtect(addr, size, PAGE_EXECUTE_READWRITE, oldprotect);
83. {$ELSEIF DEFINED(LINUX)}
84.   Result := Fpmprotect(addr, size, PROT_READ or PROT_WRITE or PROT_EXEC)=0;
85. {$ENDIF}
86. end;
87.  
88. function EnableWriteProtection(addr: Pointer; size: PtrUInt; oldprotect: UInt32): Boolean;
89. begin
90. {$IF DEFINED(MSWINDOWS)}
91.   Result := VirtualProtect(addr, size, oldprotect, @oldprotect);
92. {$ELSEIF DEFINED(LINUX)}
93.   Result := Fpmprotect(addr, size, PROT_READ or PROT_EXEC)=0;
94. {$ENDIF}
95. end;
96.  
97. function ReplaceFunction(func_from, func_to: Pointer): Boolean;
98. var
99.   OldProtect: UInt32;
100.   size: PtrUInt;
101. begin
102.   Result:=False;
103.   size:=UIntPtr(GetTemplate(False));
104.   if (DisableWriteProtection(func_from, size, OldProtect)) then
105.   begin
106.     MySimpleMove(GetTemplate(True)^, func_from^, size);
107.     {$IF DEFINED(CPUX86_64)}
108.     Result:=MemReplace(PByte(func_from), size, @[$1122334455667788], 8, @[func_to]);
109.     {$ELSEIF DEFINED(CPU386)}
110.     Result:=MemReplace(PByte(func_from), size, @[$11223344], 4, @[func_to]);
111.     {$ENDIF}
112.  
113.     EnableWriteProtection(func_from, size, OldProtect);
114.   end;
115. end;
116.  
117. end.

How to use it:

1. Save these files to the path lazarus\ide
2. In lazarus\ide\lazarus.pp you write:

Code: Diff  [Select][+][-]

1. uses
2. + vmt_err_logger,
3.   {$IFDEF EnableRedirectStdErr}
4.  

i.e. add it to the very beginning of the project.
3. Add the -CR compilation option to the Lazarus project
4. Compile, run, do something, see the result in vmt_error_log.txt, which will be next to lazarus.exe (for Linux, you may need to correct the path (specify the full path) to save the file)

An example of the resulting output:

Code: Pascal  [Select][+][-]

1. fpc_do_as, error 219  $00000001011822B5  Create,  line 469 of lazchmhelp.pas
2. fpc_do_as, error 219  $00000001011822CF  Create,  line 470 of lazchmhelp.pas
3. fpc_check_object_ext, error 219  $0000000100213E5C  DefaultHandler,  line 3684 of include/wincontrol.inc
4. fpc_check_object_ext, error 219  $000000010027D157  GetMinimumTabHeight,  line 391 of include/customnotebook.inc
5. fpc_do_as, error 219  $000000010069D2C7  GetLookupRootForComponent,  line 110 of propeditutils.pp
6. fpc_check_object_ext, error 219  $000000010025E589  InitializeWnd,  line 31 of include/customcombobox.inc
7. fpc_check_object_ext, error 219  $0000000100267E83  InitializeWnd,  line 44 of include/customedit.inc
8. fpc_check_object_ext, error 219  $00000001003DBC09  AdjustSizeTabControlPages,  line 573 of win32/win32pagecontrol.inc
9. fpc_check_object_ext, error 219  $0000000100348574  SetBounds,  line 470 of win32/win32wscontrols.pp
10. fpc_check_object_ext, error 219  $0000000100383C32  DoOnResize,  line 7496 of grids.pas
11. fpc_do_as, error 219  $00000001003E0051  CreateHandle,  line 999 of win32/win32wscustomlistview.inc
12. fpc_check_object_ext, error 219  $0000000100292926  InitializeWnd,  line 584 of include/customlistview.inc
13. fpc_check_object_ext, error 219  $0000000100288CDC  WSDestroyColumn,  line 107 of include/listcolumn.inc
14. fpc_check_object_ext, error 219  $00000001002D8C60  WSCreateReference,  line 1093 of include/imglist.inc
15. fpc_check_object_ext, error 219  $00000001003E2E21  CreateHandle,  line 523 of win32/win32wscomctrls.pp
16. fpc_check_object_ext, error 219  $0000000100280D30  BoundsChanged,  line 116 of include/statusbar.inc
17. fpc_check_object_ext, error 219  $00000001002368EE  GetCanvasScaleFactor,  line 5654 of include/control.inc
18. fpc_do_as, error 219  $0000000100ACAC62  AssignAllImages,  line 780 of codeexplorer.pas
19. fpc_check_object_ext, error 219  $0000000100278BD2  SetVisible,  line 1631 of include/menuitem.inc
20. fpc_do_as, error 219  $000000010072685C  SetDesigningOfComponent,  line 359 of ../designer/jitforms.pp
21. fpc_do_as, error 219  $0000000100D01975  AddChildren,  line 733 of componenttreeview.pas
22. fpc_check_object_ext, error 219  $000000010026E80B  SetParams,  line 127 of include/scrollbar.inc
23. fpc_check_object_ext, error 219  $00000001001E6572  SendPaintMessage,  line 657 of win32/win32callback.inc
24. fpc_do_as, error 219  $00000001007472D7  PaintClientGrid,  line 3243 of ../designer/designer.pp
25. fpc_check_object_ext, error 219  $000000010004D0A3  SetBorderIcons,  line 1761 of include/customform.inc
26. fpc_check_object_ext, error 219  $00000001002419D4  InitializeWnd,  line 370 of include/bitbtn.inc
27. fpc_check_object_ext, error 219  $000000010026DA13  ApplyChanges,  line 221 of include/customcheckbox.inc
28. fpc_do_as, error 219  $0000000100359EA5  GetPreferredSize,  line 2068 of win32/win32wsstdctrls.pp
29. fpc_check_object_ext, error 219  $00000001002B1616  ApplyChanges,  line 336 of include/trackbar.inc
30. fpc_check_object_ext, error 219  $000000010026727E  InitializeWnd,  line 105 of include/custommemo.inc
31. fpc_check_object_ext, error 219  $0000000100270507  WSSetDefault,  line 345 of include/buttons.inc
32. fpc_do_as, error 219  $0000000100759BDB  GetOwner,  line 2855 of customformeditor.pp
33. fpc_check_object_ext, error 219  $0000000100279DFF  PopUp,  line 81 of include/popupmenu.inc
34. fpc_check_object_ext, error 219  $00000001002E654C  WSDestroyReference,  line 272 of lclclasses.pp

But none of this is as sad and fixable as this:

Code: Pascal  [Select][+][-]

1. fpc_check_object_ext, error 219  $0000000100050E91  $fin$000005AD,  line 3076 of include/customform.inc

$fin$ - 😢 I have no idea how to fix it at all, and whether it makes sense to start these edits if no solution can be found for this one in particular

[ALLIGATOR]

Wait a minute, though... finalization must always be successful, right? There's no type conversion, or there shouldn't be.... well, I can't think of how it happened right now... maybe it's a bug in DWARF data and just the wrong string is specified.

[ALLIGATOR]

Oh, no, that's it, I saw 😁... it's the finally section, so it's okay. (I just didn't double-check this code section in the source code for some reason 🫣🤭)