-CR switch to build  lazarus - Re bugtracker 37360
lazarus / 31-LCL

----------------------------------------------------------------------
BrunoK · 2020-07-24 15:26

To Juha Manninen

As per our discussion here is my status about the -CR flag.

I have added in WSLCLClasses a list ordered by the synthetic
classImplemented a pendant to laz_check_object_ext that handles
specifically the registered WSLCLComponent's descendantsThis requires
modification to FPC where I added a callback holder and modified
laz_check_object_ext so in case of inheritance error it executes the
laz_check_object_ext.
Added  at the end of systemh.inc
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i {**********
*******************************************************************  
     Lazarus callback for Verify Method Call (switch -CR)*************
****************************************************************} type
 TLazarusCRCallback = function(vmt, expvmt : pointer): Boolean;const 
LazarusCRCallback : TLazarusCRCallback = nil; Patched
fpc_check_object_ext in generic.inc with
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i procedure
fpc_check_object_ext(vmt, expvmt : pointer);
[public,alias:'FPC_CHECK_OBJECT_EXT']; compilerproc;var  lvmt :
pointer;begin   if (vmt=nil) or      (pobjectvmt(vmt)^.size=0) or    
(pobjectvmt(vmt)^.size+pobjectvmt(vmt)^.msize<>0) then       
RunError(210);   lvmt := vmt;   while assigned(vmt) do     if
vmt=expvmt then       exit     else     
 vmt:=pobjectvmt(vmt)^.parent;   if Assigned(LazarusCRCallback) and
LazarusCRCallback(lvmt, expvmt) then     Exit;   RunError(219);end;
Implemented a callback function in laz_check_object_extCode: Pascal
 [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i { Extend
class type verification to handle the double inheritance of the 
TWSLCLComponents. If the component TWS<Widget><WSLCLClass> is found, 
check that its 'lateral' component in the TWS<Class> tree matches 
inheritence constraints. }function laz_check_object_ext(vmt, expvmt:
pointer) : Boolean;var  idx : integer;  lComponentClass :
TComponentClass;begin  Result :=
WSLCLClassesList.Search(TComponentClass(vmt), idx);  if Result then
begin    lComponentClass :=
TComponentClass(PClassNode(WSLCLClassesList[idx])^.LCLParentClass);  
Result := lComponentClass.InheritsFrom(TClass(expvmt));  end;end;
All that stuff goes quite well. One wrong transtype occurs quickly in
TWinControl.DoAllAutoSize function CheckHandleAllocated , very easy to
fix. See wincontrol.inc.patch.
The next one is in  the designer
TSetDesigningComponent.SetDesigningOfComponent class procedure.

Do you want to proceed further. If yes indicate in what form you want
me to return my current code.

I attach a LCLComponent_VCR.patch for LCLClasses and WSLCLClasses so
you can have a look.

----------------------------------------------------------------------
PascalDragon · 2020-07-30 07:57

FPC will not be extended for such shenigans. Disable the object checks
for code that needs it using {$Push}{$ObjectChecks Off} … {$Pop}. This
has the advantage that it will work with released versions of FPC as
well.