diff --git a/components/synedit/synedithighlighter.pp b/components/synedit/synedithighlighter.pp
index 8e5f507ae8..4469b8cd90 100644
--- a/components/synedit/synedithighlighter.pp
+++ b/components/synedit/synedithighlighter.pp
@@ -158,9 +158,10 @@ type
     property Children: TSynCustomCodeFoldBlock read FChildren;
   public
     destructor Destroy; override;
-    function Compare(Block: TSynCustomCodeFoldBlock): integer; virtual;
+    procedure WriteDebugReport;
   public
-    property BlockType: Pointer read FBlockType write FBlockType;
+    procedure InitRootBlockType(AType: Pointer);
+    property BlockType: Pointer read FBlockType;
     property Parent: TSynCustomCodeFoldBlock read FParent;
     property Child[ABlockType: Pointer]: TSynCustomCodeFoldBlock read GetChild;
   end;
@@ -1524,15 +1525,26 @@ begin
   inherited Destroy;
 end;
 
-function TSynCustomCodeFoldBlock.Compare(Block: TSynCustomCodeFoldBlock
-  ): integer;
+procedure TSynCustomCodeFoldBlock.WriteDebugReport;
+  procedure debugout(n: TSynCustomCodeFoldBlock; s1, s: String; p: TSynCustomCodeFoldBlock);
+  begin
+    if n = nil then exit;
+    if n.FParent <> p then
+      DebugLn([s1, 'Wrong Parent for', ' (', PtrInt(n), ')']);
+    DebugLn([s1, PtrUInt(n.BlockType), ' (', PtrInt(n), ')']);
+    debugout(n.FLeft, s+'L: ', s+'   ', p);
+    debugout(n.FRight, s+'R: ', s+'   ', p);
+    debugout(n.FChildren, s+'C: ', s+'   ', n);
+  end;
 begin
-  if BlockType>Block.BlockType then
-    Result:=1
-  else if BlockType<Block.BlockType then
-    Result:=-1
-  else
-    Result:=0;
+  debugout(self, '', '', nil);
+end;
+
+procedure TSynCustomCodeFoldBlock.InitRootBlockType(AType: Pointer);
+begin
+  if assigned(FParent) then
+    raise Exception.Create('Attempt to modify a FoldBlock');
+  FBlockType := AType;
 end;
 
 { TSynCustomHighlighterRange }
@@ -1559,8 +1571,12 @@ begin
     Result:=1
   else if RangeType>Range.RangeType then
     Result:=-1
+  else if Pointer(FTop) < Pointer(Range.FTop) then
+    Result:= -1
+  else if Pointer(FTop) > Pointer(Range.FTop) then
+    Result:= 1
   else
-    Result := FTop.Compare(Range.FTop);
+    Result := 0;
 end;
 
 function TSynCustomHighlighterRange.Add(ABlockType: Pointer;
@@ -1609,7 +1625,8 @@ procedure TSynCustomHighlighterRange.WriteDebugReport;
 begin
   debugln('TSynCustomHighlighterRange.WriteDebugReport ',DbgSName(Self),
     ' RangeType=',dbgs(RangeType),' StackSize=',dbgs(CodeFoldStackSize));
-  debugln(' BlockType=',dbgs(FTop.BlockType));
+  debugln(' Block=',dbgs(PtrInt(FTop)));
+  FTop.WriteDebugReport;
 end;
 
 { TSynCustomHighlighterRanges }
diff --git a/components/synedit/synhighlighterpas.pp b/components/synedit/synhighlighterpas.pp
index 6f26d29d14..e493bb3d86 100644
--- a/components/synedit/synhighlighterpas.pp
+++ b/components/synedit/synhighlighterpas.pp
@@ -329,6 +329,7 @@ type
     function StartPascalCodeFoldBlock(ABlockType: TPascalCodeFoldBlockType;
                             SubBlock: boolean = false): TSynCustomCodeFoldBlock;
     procedure EndCodeFoldBlock(DecreaseLevel: Boolean = True); override;
+    procedure CloseBeginEndBlocks;
     function GetRangeClass: TSynCustomHighlighterRangeClass; override;
     {$ENDIF}
     procedure EndCodeFoldBlockLastLine;
@@ -1149,6 +1150,7 @@ begin
       if not(rsAfterEqual in fRange) and
          (fRange * [rsInterface, rsImplementation] = []) then
       begin
+        CloseBeginEndBlocks;
         if TopPascalCodeFoldBlockType=cfbtVarType then EndCodeFoldBlockLastLine;
         if TopPascalCodeFoldBlockType=cfbtUnitSection then EndCodeFoldBlockLastLine;
         StartPascalCodeFoldBlock(cfbtUnitSection);
@@ -1286,6 +1288,7 @@ begin
   if KeyComp('Function') then begin
     if not(rsAfterEqual in fRange) then begin
       TSynPasSynRange(CodeFoldRange).BracketNestLevel := 0; // Reset in case of partial code
+      CloseBeginEndBlocks;
       if TopPascalCodeFoldBlockType=cfbtVarType then EndCodeFoldBlockLastLine;
       if ((rsImplementation in fRange) and
           not(TopPascalCodeFoldBlockType in [cfbtClass, cfbtClassSection]))
@@ -1307,6 +1310,7 @@ begin
   if KeyComp('Procedure') then begin
     if not(rsAfterEqual in fRange) then begin
       TSynPasSynRange(CodeFoldRange).BracketNestLevel := 0; // Reset in case of partial code
+      CloseBeginEndBlocks;
       if TopPascalCodeFoldBlockType=cfbtVarType then EndCodeFoldBlockLastLine;
       if ((rsImplementation in fRange) and
           not(TopPascalCodeFoldBlockType in [cfbtClass, cfbtClassSection]))
@@ -1405,6 +1409,7 @@ function TSynPasSyn.Func136: TtkTokenKind;
 begin
   if KeyComp('Finalization') then begin
     TSynPasSynRange(CodeFoldRange).BracketNestLevel := 0; // Reset in case of partial code
+    CloseBeginEndBlocks;
     if TopPascalCodeFoldBlockType=cfbtVarType then EndCodeFoldBlockLastLine;
     if TopPascalCodeFoldBlockType=cfbtUnitSection then EndCodeFoldBlockLastLine;
     StartPascalCodeFoldBlock(cfbtUnitSection);
@@ -1429,6 +1434,7 @@ begin
     if not(rsAfterEqual in fRange) then
     begin
       TSynPasSynRange(CodeFoldRange).BracketNestLevel := 0; // Reset in case of partial code
+      CloseBeginEndBlocks;
       if TopPascalCodeFoldBlockType = cfbtVarType then EndCodeFoldBlockLastLine;
       if ((rsImplementation in fRange) and
           not(TopPascalCodeFoldBlockType in [cfbtClass, cfbtClassSection]))
@@ -1448,6 +1454,7 @@ begin
   if KeyComp('Constructor') then begin
     if not(rsAfterEqual in fRange) then begin
       TSynPasSynRange(CodeFoldRange).BracketNestLevel := 0; // Reset in case of partial code
+      CloseBeginEndBlocks;
       if TopPascalCodeFoldBlockType=cfbtVarType then EndCodeFoldBlockLastLine;
       if ((rsImplementation in fRange) and
           not(TopPascalCodeFoldBlockType in [cfbtClass, cfbtClassSection]))
@@ -1458,6 +1465,7 @@ begin
   end else
     if KeyComp('Implementation') then begin
       TSynPasSynRange(CodeFoldRange).BracketNestLevel := 0; // Reset in case of partial code
+      CloseBeginEndBlocks;
       if TopPascalCodeFoldBlockType=cfbtVarType then EndCodeFoldBlockLastLine;
       if TopPascalCodeFoldBlockType=cfbtUnitSection then EndCodeFoldBlockLastLine;
       StartPascalCodeFoldBlock(cfbtUnitSection);
@@ -1477,6 +1485,7 @@ function TSynPasSyn.Func168: TtkTokenKind;
 begin
   if KeyComp('Initialization') then begin
     TSynPasSynRange(CodeFoldRange).BracketNestLevel := 0; // Reset in case of partial code
+    CloseBeginEndBlocks;
     if TopPascalCodeFoldBlockType=cfbtVarType then EndCodeFoldBlockLastLine;
     if TopPascalCodeFoldBlockType=cfbtUnitSection then EndCodeFoldBlockLastLine;
     StartPascalCodeFoldBlock(cfbtUnitSection);
@@ -1631,7 +1640,7 @@ begin
   {$ENDIF}
   SetAttributesOnChange({$IFDEF FPC}@{$ENDIF}DefHighlightChange);
   if hcCodeFolding in Capabilities then
-    RootCodeFoldBlock.BlockType := Pointer(PtrInt(cfbtNone));
+    RootCodeFoldBlock.InitRootBlockType(Pointer(PtrInt(cfbtNone)));
 
   InitIdent;
   MakeMethodTables;
@@ -2247,7 +2256,7 @@ var
 begin
   p := inherited TopCodeFoldBlockType;
   if p >= CountPascalCodeFoldBlockOffset then
-    p := p - PtrInt(CountPascalCodeFoldBlockOffset);
+    p := p - PtrUInt(CountPascalCodeFoldBlockOffset);
   Result := TPascalCodeFoldBlockType(PtrUInt(p));
 end;
 
@@ -2455,6 +2464,16 @@ begin
   inherited EndCodeFoldBlock(DecreaseLevel);
 end;
 
+procedure TSynPasSyn.CloseBeginEndBlocks;
+begin
+  if TopPascalCodeFoldBlockType <> cfbtBeginEnd then
+    exit;
+  while TopPascalCodeFoldBlockType = cfbtBeginEnd do
+    EndCodeFoldBlock;
+  if TopPascalCodeFoldBlockType = cfbtProcedure then
+    EndCodeFoldBlock; // This procedure did have a begin/end block, so it must end too
+end;
+
 procedure TSynPasSyn.EndCodeFoldBlockLastLine;
 begin
   EndCodeFoldBlock;