[fpc-pascal] Generics Compile Error, 2.4.2 vs 2.6.0

J.-c. Chu jcchu at acm.org
Mon Feb 13 17:59:03 CET 2012


If you are compiling the unit in Delphi mode, you’ll need to use the
syntax of Delphi.

*  Generics are defined without the GENERIC keyword.
*  Generics are specialized without the SPECIALIZE keyword.
*  To define class-local types and variables, visibility specifiers need
   to be placed before the TYPE and VAR keywords.
*  Implementations of the methods of a generic class must include the
   type parameters of the class.

Please check if the attached file works.


On February 14, 2012, David Copeland wrote:

> Under FPC 2.4.2 I have been using RBTree unit that uses generics. With
> 2.6.0 it fails to compile. I know that there have been changes for 2.6.0
> but I have checked the syntax in the 2.6.0 Language Reference and cannot
> see why the error is occurring. I have also looked in Mantis but don't
> know if anything there relates to my problem. I have excerpted the code
> below and attached the complete unit.
> 
> ==================
> 
> unit FOS_REDBLACKTREE_GEN;
> 
> // (c) Copyright FirmOS Business Solutions GmbH
> // Author Helmut Hartl, Franz Schober
> 
> }
> //{$MODE OBJFPC}
> {$MODE DELPHI}
> {$H+}
> 
> interface
> 
> type
>   TRB_NodeColor=(R,B);
> 
>   { TGFOS_RBTree }
>   {$B-}
>   generic TGFOS_RBTree<_TKey,_TStore> = class(TInterfacedObject)
> 
> *** The error occurs at the line above.
> 
> Free Pascal Compiler version 2.6.0 [2012/02/08] for x86_64
> Copyright (c) 1993-2011 by Florian Klaempfl and others
> Target OS: Linux for x86-64
> Compiling FOS_REDBLACKTREE_GEN.pas
> FOS_REDBLACKTREE_GEN.pas(48,11) Fatal: Syntax error, "=" expected but
> "identifier TGFOS_RBTREE" found
> Fatal: Compilation aborted
> 
> 
>     type public
>       PFOS_RB_NodeG=^TFOS_RB_NodeG;
>       _PStore       =^_TStore;
>       TFOS_RB_NodeG = packed record
>           k:  _TKey;
>           left, right, parent: PFOS_RB_NodeG;
>           col: TRB_NodeColor;
>           val:_TStore;
>        end;
>        TCompareKeys     = function  (const Item1, Item2: _TKey):
> Integer;
>        TGUndefined      = function  :_Tstore;
>        TGUndefinedKey   = function  :_TKey;
>        TGFOS_RB_OnItem  = procedure (const Item:_TStore) of object;
>        TGFOS_RB_OnItemN = procedure (const Item:_TStore);
> 
> 
> ==================
> 
> Thanks for any help.
> 
> 
> 
> 
> _______________________________________________
> fpc-pascal maillist  -  fpc-pascal at lists.freepascal.org
> http://lists.freepascal.org/mailman/listinfo/fpc-pascal

-- 
Best Regards,
J.-c. Chu
-------------- next part --------------
unit FOS_REDBLACKTREE_GEN;

// (c) Copyright FirmOS Business Solutions GmbH
// Author Helmut Hartl, Franz Schober

{ // New Style BSD Licence (OSI)

Copyright (c) 2001-2009, FirmOS Business Solutions GmbH
All rights reserved.

Redistribution and use in source and binary forms, with or without modification,
are permitted provided that the following conditions are met:

    * Redistributions of source code must retain the above copyright notice,
      this list of conditions and the following disclaimer.
    * Redistributions in binary form must reproduce the above copyright notice,
      this list of conditions and the following disclaimer in the documentation
      and/or other materials provided with the distribution.
    * Neither the name of the <FirmOS Business Solutions GmbH> nor the names
      of its contributors may be used to endorse or promote products derived
      from this software without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
PURPOSE ARE DISCLAIMED.
IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED
AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

}
//{$MODE OBJFPC}
{$MODE DELPHI}
{$H+}

interface

type
  TRB_NodeColor=(R,B);

  { TGFOS_RBTree }
  {$B-}
  TGFOS_RBTree<_TKey,_TStore> = class(TInterfacedObject)
  public
    type
      PFOS_RB_NodeG=^TFOS_RB_NodeG;
      _PStore       =^_TStore;
      TFOS_RB_NodeG = packed record
          k:  _TKey;
          left, right, parent: PFOS_RB_NodeG;
          col: TRB_NodeColor;
          val:_TStore;
       end;
       TCompareKeys     = function  (const Item1, Item2: _TKey): Integer;
       TGUndefined      = function  :_Tstore;
       TGUndefinedKey   = function  :_TKey;
       TGFOS_RB_OnItem  = procedure (const Item:_TStore) of object;
       TGFOS_RB_OnItemN = procedure (const Item:_TStore);
  private
    var
      _Count:    QWord;
      _Compare:  TCompareKeys;
      _Undef:    TGUndefined;
      _UndefKey: TGUndefinedKey;
      root:      PFOS_RB_NodeG;
      leftmost:  PFOS_RB_NodeG;
      rightmost: PFOS_RB_NodeG;
      procedure  RotLeft        (var x: PFOS_RB_NodeG);
      procedure  RotRight       (var x: PFOS_RB_NodeG);
      function   Min            (var x: PFOS_RB_NodeG): PFOS_RB_NodeG;
      function   Max            (var x: PFOS_RB_NodeG): PFOS_RB_NodeG;
      procedure  _Delete        (z: PFOS_RB_NodeG);
      function   _Find          (key:_TKey):PFOS_RB_NodeG;
      function   _FindNextPrev  (key:_TKey;const next:boolean):PFOS_RB_NodeG;
      procedure  _fast_erase    (x: PFOS_RB_NodeG;const DoFreeItem:TGFOS_RB_OnItem);
      procedure  _fast_eraseN   (x: PFOS_RB_NodeG;const DoFreeItem:TGFOS_RB_OnItemN);
    protected
      procedure  RBInc          (var x: PFOS_RB_NodeG);
      procedure  RBDec          (var x: PFOS_RB_NodeG);
    public
      constructor Create        (const Compare:TCompareKeys;const Undef:TGUndefined;const UndefKey:TGUndefinedKey);
      destructor  Destroy;      override;
      procedure   Clear         (const DoFreeItem: TGFOS_RB_OnItem);
      procedure   ClearN        (const DoFreeItem: TGFOS_RB_OnItemN);
      function    Find          (const key:_TKey;out   store:_TStore):Boolean;       // Delivers True on Find
      function    Delete        (const key:_TKey;out   Store:_TStore):Boolean;       // Deletes the Item from the Directory, returns true on found
      function    AddCheck      (const key:_TKey;var   Store:_TStore):Boolean;       // Delivers Old Value on FIND
      function    Add           (const key:_TKey;const Store:_TStore):Boolean;       // Ignores  new value if old value exists
      function    FindNext      (var   key:_TKey;out   Store:_TStore):Boolean;       // Delivers false if no next element
      function    FindPrev      (var   key:_TKey;out   Store:_TStore):Boolean;       // Delivers true  if no prev element
      function    FirstNode     (out   key:_TKey;out   Store:_TStore):boolean;
      function    LastNode      (out   key:_TKey;out   Store:_TStore):boolean;
      function    Count         :QWord;
   end;

   TFOS_RB_Tree_SS      = TGFOS_RBTree<string,string>;
   TFOS_RB_Tree_II      = TGFOS_RBTree<integer,integer>;

//Default Sorting & Value functions
function Default_RB_String_Compare(const S1, S2: string): Integer;
function Default_RB_String_Undef:string;
function Default_RB_Integer_Compare(const d1, d2: integer): Integer;
function Default_RB_Integer_Undef:integer;


implementation

function Default_RB_String_Compare(const S1, S2: string): Integer;
var count1, count2,i: integer;
    p1,p2:pointer;
begin
  Count1 := Length(S1);Count2 := Length(S2);
  if count1=count2 then begin
    i := 0;
    result := 0;
    p1:=pointer(s1);
    p2:=pointer(s2);
    while (result=0) and (I<count1) do begin
      result:=byte(P1^)-byte(P2^);
      P1:=pchar(P1)+1;P2:=pchar(P2)+1;
      inc(i);
    end;
  end else
  if Count1>Count2 then begin
   result:=1;
   exit;
  end else begin
   result:=-1;
   exit;
  end;
end;


function Default_RB_String_Undef:string;
begin
 result:='';
end;

function Default_RB_Integer_Compare(const d1, d2: integer): Integer;
begin
  if d1=d2 then begin
   result := 0;
  end else
  if d1>d2 then begin
   result:=1;
  end else begin
   result:=-1;
  end;
end;

function  Default_RB_Integer_Undef:integer;
begin
 result:=0;
end;


constructor TGFOS_RBTree<_TKey, _TStore>.Create(const Compare:TCompareKeys;const Undef:TGUndefined;const UndefKey:TGUndefinedKey);
begin
  inherited Create;
  _Count:=0;
  _Compare:=Compare;
  _Undef:=Undef;
  _UndefKey:=UndefKey;
  root := nil;
  leftmost := nil;
  rightmost := nil;
end;


function TGFOS_RBTree<_TKey, _TStore>.Delete(const key: _TKey;out store:_TStore): Boolean;
var n:PFOS_RB_NodeG;
begin
 n:=_Find(key);
 if not assigned(n) then begin
  store:=_Undef;
  result:=false;
 end else begin
  store:=n.val;
  _Delete(n);
  dec(_count);
  result:=true;
 end;
end;

destructor TGFOS_RBTree<_TKey, _TStore>.Destroy;
begin
  inherited Destroy;
end;


function TGFOS_RBTree<_TKey, _TStore>.FirstNode(out key: _TKey; out Store: _TStore): boolean;
begin
 if Assigned(leftmost) then begin
  result := true;
  key    := leftmost.k;
  Store  := leftmost.val;
 end else begin
  result := false;
  key    := _UndefKey;
  Store  := _Undef;
 end;
end;

function TGFOS_RBTree<_TKey, _TStore>.LastNode(out key: _TKey; out Store: _TStore): boolean;
begin
 if Assigned(rightmost) then begin
  result := true;
  key    := rightmost.k;
  Store  := rightmost.val;
 end else begin
  result := false;
  key    := _UndefKey;
  Store  := _Undef;
 end;
end;

function TGFOS_RBTree<_TKey, _TStore>.Count: QWord;
begin
 result:=_Count;
end;

function TGFOS_RBTree<_TKey, _TStore>.FindNext(var key: _TKey;out Store:_TStore):Boolean;
var n:PFOS_RB_NodeG;
begin
 n:=_FindNextPrev(key,true);
 if assigned(n)then begin
   result  :=true;
   Store   :=n.val;
   key     :=n.k;
 end else begin
   result  :=false;
   Store   :=_Undef;
   key     :=_UndefKey;
 end;
end;

function TGFOS_RBTree<_TKey, _TStore>.FindPrev(var key: _TKey;out Store:_TStore):Boolean;
var n:PFOS_RB_NodeG;
begin
 n:=_FindNextPrev(key,false);
 if assigned(n)then begin
   result :=true;
   Store  :=n.val;
   key    :=n.k;
 end else begin
   result :=false;
   Store  :=_Undef;
   key    :=_UndefKey;
 end;
end;

procedure TGFOS_RBTree<_TKey, _TStore>.Clear(const DoFreeItem:TGFOS_RB_OnItem);
begin
  if (root <> nil) then _fast_erase(root,DoFreeItem);
  root := nil;
  leftmost := nil;
  rightmost := nil;
  _count:=0;
end;

procedure TGFOS_RBTree<_TKey, _TStore>.ClearN(const DoFreeItem: TGFOS_RB_OnItemN);
begin
  if (root <> nil) then _fast_eraseN(root,DoFreeItem);
  root := nil;
  leftmost := nil;
  rightmost := nil;
  _count:=0;
end;

function TGFOS_RBTree<_TKey, _TStore>.Find(const key: _TKey;out store:_TStore): Boolean;
var nd:PFOS_RB_NodeG;
begin
 nd:=_Find(key);
 if assigned(nd) then begin
  store:=nd.val;
  result:=true;
 end else begin
  store:=_Undef;
  result:=false;
 end;
end;

procedure TGFOS_RBTree<_TKey, _TStore>.RotLeft(var x: PFOS_RB_NodeG);
var
  y: PFOS_RB_NodeG;
begin
  y := x^.right;
  x^.right := y^.left;
  if (y^.left <> nil) then begin
    y^.left^.parent := x;
  end;
  y^.parent := x^.parent;
  if (x = root) then begin
    root := y;
  end else if (x = x^.parent^.left) then begin
    x^.parent^.left := y;
  end else begin
    x^.parent^.right := y;
  end;
  y^.left := x;
  x^.parent := y;
end;

procedure TGFOS_RBTree<_TKey, _TStore>.RotRight(var x: PFOS_RB_NodeG);
var
  y: PFOS_RB_NodeG;
begin
  y := x^.left;
  x^.left := y^.right;
  if (y^.right <> nil) then begin
    y^.right^.parent := x;
  end;
  y^.parent := x^.parent;
  if (x = root) then begin
    root := y;
  end else if (x = x^.parent^.right) then begin
    x^.parent^.right := y;
  end else begin
    x^.parent^.left := y;
  end;
  y^.right := x;
  x^.parent := y;
end;

function TGFOS_RBTree<_TKey, _TStore>.Min(var x: PFOS_RB_NodeG): PFOS_RB_NodeG;
begin
  Result := x;
  while (Result^.left <> nil) do Result := Result^.left;
end;

function TGFOS_RBTree<_TKey, _TStore>.Max(var x: PFOS_RB_NodeG): PFOS_RB_NodeG;
begin
  Result := x;
  while (Result^.right <> nil) do Result := Result^.right;
end;

function TGFOS_RBTree<_TKey, _TStore>.AddCheck(const key: _TKey;var Store:_TStore):Boolean;
var x, y, z, zpp: PFOS_RB_NodeG;
    cmp: Integer;
begin
  z := New(PFOS_RB_NodeG);
  { Initialize fields in new node z }
  z^.k := key;
  z^.left := nil;
  z^.right := nil;
  z^.col := R;
  z^.val:=Store;

  { Maintain leftmost and rightmost nodes }
  if (leftmost = nil) then begin
    leftmost := z;
  end else
  if (_Compare(key, leftmost^.k) < 0) then begin
    leftmost := z;
  end;
  if (rightmost = nil) then begin
    rightmost := z;
  end else
  if (_Compare(key, rightmost^.k) > 0) then begin
    rightmost := z;
  end;
  { Insert node z }
  y := nil;
  x := root;
  while (x <> nil) do begin
    y := x;
    cmp := _Compare(key, x^.k);
    if (cmp < 0) then begin
      x := x^.left;
    end else if (cmp > 0) then begin
      x := x^.right;
    end else begin
      { val already exists in tree. }
      Dispose(z);
      Store:=x.val; // Return old Store
      result:=false; //Return old Value
      exit;
    end;
  end;
  inc(_Count);
  z^.parent := y;
  if (y = nil) then begin
    root := z;
  end else if (_Compare(key, y^.k) < 0) then begin
    y^.left := z;
  end else begin
    y^.right := z;
  end;
  store:=z.val;
  result:=true;
  { Rebalance tree }
  repeat
    if (z=root) then break;
    if not (z^.parent^.col = R) then break;
    zpp := z^.parent^.parent;
    if (z^.parent = zpp^.left) then begin
      y := zpp^.right;
      if ((y <> nil) and (y^.col = R)) then begin
        z^.parent^.col := B;
        y^.col := B;
        zpp^.col := R;
        z := zpp;
      end else begin
        if (z = z^.parent^.right) then begin
          z := z^.parent;
          RotLeft(z);
        end;
        z^.parent^.col := B;
        zpp^.col := R;
        RotRight(zpp);
      end;
    end else begin
      y := zpp^.left;
      if ((y <> nil) and (y^.col = R)) then begin
        z^.parent^.col := B;
        y^.col := B;
        zpp.col := R;
        z := zpp;
      end else begin
        if (z = z^.parent^.left) then begin
          z := z^.parent;
          RotRight(z);
        end;
        z^.parent^.col := B;
        zpp.col := R;
        RotLeft(zpp);
      end;
    end;
  until false;
  root^.col := B;
end;

function TGFOS_RBTree<_TKey, _TStore>.Add(const key: _TKey; const Store: _TStore): Boolean;
var temp:_TStore;
begin
 temp:=Store;
 result:=AddCheck(key,temp);
end;


procedure TGFOS_RBTree<_TKey, _TStore>._Delete(z: PFOS_RB_NodeG);
var  w, x, y, x_parent: PFOS_RB_NodeG;
     tmpcol: TRB_NodeColor;

begin
  y := z;
  x := nil;
  x_parent := nil;

  if (y^.left = nil) then begin    { z has at most one non-null child. y = z. }
    x := y^.right;     { x might be null. }
  end else begin
    if (y^.right = nil) then begin { z has exactly one non-null child. y = z. }
      x := y^.left;    { x is not null. }
    end else begin
      { z has two non-null children.  Set y to }
      y := y^.right;   {   z's successor.  x might be null. }
      while (y^.left <> nil) do begin
        y := y^.left;
      end;
      x := y^.right;
    end;
  end;

  if (y <> z) then begin
    { "copy y's sattelite data into z" }
    { relink y in place of z.  y is z's successor }
    z^.left^.parent := y;
    y^.left := z^.left;
    if (y <> z^.right) then begin
      x_parent := y^.parent;
      if (x <> nil) then begin
        x^.parent := y^.parent;
      end;
      y^.parent^.left := x;   { y must be a child of left }
      y^.right := z^.right;
      z^.right^.parent := y;
    end else begin
      x_parent := y;
    end;
    if (root = z) then begin
      root := y;
    end else if (z^.parent^.left = z) then begin
      z^.parent^.left := y;
    end else begin
      z^.parent^.right := y;
    end;
    y^.parent := z^.parent;
    tmpcol := y^.col;
    y^.col := z^.col;
    z^.col := tmpcol;
    y := z;  { y now points to node to be actually deleted }
  end else begin                        { y = z }
    x_parent := y^.parent;
    if (x <> nil)  then begin
      x^.parent := y^.parent;
    end;
    if (root = z) then begin
      root := x;
    end else begin
      if (z^.parent^.left = z) then begin
        z^.parent^.left := x;
      end else begin
        z^.parent^.right := x;
      end;
    end;
	  if (leftmost = z) then begin
	    if (z^.right = nil) then begin      { z^.left must be null also }
	      leftmost := z^.parent;
	    end else begin
	      leftmost := Min(x);
      end;
    end;
	  if (rightmost = z) then begin
	    if (z^.left = nil) then begin       { z^.right must be null also }
	      rightmost := z^.parent;
	    end else begin                     { x == z^.left }
	      rightmost := Max(x);
      end;
    end;
  end;

  { Rebalance tree }
  if (y^.col = B)  then begin
    repeat
      if (x=root) then break;
      if  x<>nil  then begin
       if (x^.col<>B) then break;
      end;
      if (x = x_parent^.left)  then begin
          w := x_parent^.right;
          if (w^.col = R)  then begin
            w^.col := B;
            x_parent^.col := R;
            RotLeft(x_parent);
            w := x_parent^.right;
          end;
          if (((w^.left = nil) or
               (w^.left^.col = B)) and
              ((w^.right = nil) or
               (w^.right^.col = B)))  then begin
            w^.col := R;
            x := x_parent;
            x_parent := x_parent^.parent;
          end else begin
            if ((w^.right = nil) or (w^.right^.col = B)) then begin
              w^.left^.col := B;
              w^.col := R;
              RotRight(w);
              w := x_parent^.right;
            end;
            w^.col := x_parent^.col;
            x_parent^.col := B;
            if (w^.right <> nil)  then begin
              w^.right^.col := B;
            end;
            RotLeft(x_parent);
            x := root;
         end
      end else begin
        w := x_parent^.left;
        if (w^.col = R)  then begin
          w^.col := B;
          x_parent^.col := R;
          RotRight(x_parent);
          w := x_parent^.left;
        end;
        if (((w^.right = nil) or
             (w^.right^.col = B)) and
            ((w^.left = nil) or
             (w^.left^.col = B)))  then begin
          w^.col := R;
          x := x_parent;
          x_parent := x_parent^.parent;
        end else begin
          if (w^.left = nil) or (w^.left^.col = B) then begin
            w^.right^.col := B;
            w^.col := R;
            RotLeft(w);
            w := x_parent^.left;
          end;
          w^.col := x_parent^.col;
          x_parent^.col := B;
          if (w^.left <> nil) then begin
            w^.left^.col := B;
          end;
          RotRight(x_parent);
          x := root;
        end;
      end;
    until  false;
    if (x <> nil) then begin
      x^.col := B;
    end;
  end;
  dispose(y);
end;

function TGFOS_RBTree<_TKey, _TStore>._Find(key: _TKey): PFOS_RB_NodeG;
var cmp: integer;
    node: PFOS_RB_NodeG;
begin
  result:=nil;
  node := root;
  while (node <> nil) do begin
    cmp := _Compare(node^.k, key);
    if cmp < 0 then begin
      node := node^.right;
    end else if cmp > 0 then begin
      node := node^.left;
    end else begin
      result:=node;
      break;
    end;
  end;
end;

function TGFOS_RBTree<_TKey, _TStore>._FindNextPrev(key: _TKey;const next:boolean): PFOS_RB_NodeG;
var cmp: integer;
    node: PFOS_RB_NodeG;
begin
  result:=nil;
  node := root;
  while true do begin
    if node=nil then exit;
    cmp := _Compare(node^.k, key);
    if cmp < 0 then begin
      if node^.right<>nil then begin
       node := node^.right;
      end else begin
       result:=node;
       if not next then exit;
       break;
      end;
    end else if cmp > 0 then begin
      if node^.left<>nil then begin
       node := node^.left;
      end else begin
       result:=node;
       if next then exit;
       break;
      end;
    end else begin
      if (node.left=nil) and (node.right=nil) and (node.parent=nil) then begin
       result:=nil;
       exit;
      end else begin
       result:=node;
       break;
      end;
    end;
  end;
  if next then begin
   if result=rightmost then begin
    result:=nil;
   end else begin
    RBInc(result);
   end;
  end else begin
   if result=leftmost then begin
    result:=nil;
   end else begin
    RBDec(result);
   end;
  end;
end;

procedure TGFOS_RBTree<_TKey, _TStore>._fast_erase(x: PFOS_RB_NodeG;const DoFreeItem:TGFOS_RB_OnItem);
begin
   if (x^.left <> nil) then  _fast_erase(x^.left,DoFreeItem);
   if (x^.right <> nil) then _fast_erase(x^.right,DoFreeItem);
   if assigned(DoFreeItem) then DoFreeItem(x.val);
   dispose(x);
end;

procedure TGFOS_RBTree<_TKey, _TStore>._fast_eraseN(x: PFOS_RB_NodeG; const DoFreeItem: TGFOS_RB_OnItemN);
begin
   if (x^.left <> nil) then  _fast_eraseN(x^.left,DoFreeItem);
   if (x^.right <> nil) then _fast_eraseN(x^.right,DoFreeItem);
   if assigned(DoFreeItem) then DoFreeItem(x.val);
   dispose(x);
end;



procedure TGFOS_RBTree<_TKey, _TStore>.RBInc(var x: PFOS_RB_NodeG);
var y: PFOS_RB_NodeG;
begin
  if (x^.right <> nil) then begin
    x := x^.right;
    while (x^.left <> nil) do begin
      x := x^.left;
    end;
  end else begin
    y := x^.parent;
    while (x = y^.right) do begin
      x := y;
      y := y^.parent;
    end;
    if (x^.right <> y) then
      x := y;
  end
end;


procedure TGFOS_RBTree<_TKey, _TStore>.RBDec(var x: PFOS_RB_NodeG);
var  y: PFOS_RB_NodeG;
begin
  if (x^.left <> nil)  then begin
    y := x^.left;
    while (y^.right <> nil) do begin
      y := y^.right;
    end;
    x := y;
  end else begin
    y := x^.parent;
    while (x = y^.left) do begin
      x := y;
      y := y^.parent;
    end;
    x := y;
  end
end;

end.
-------------- next part --------------
A non-text attachment was scrubbed...
Name: smime.p7s
Type: application/pkcs7-signature
Size: 4438 bytes
Desc: S/MIME Cryptographic Signature
URL: <http://lists.freepascal.org/pipermail/fpc-pascal/attachments/20120214/12dde447/attachment.bin>


More information about the fpc-pascal mailing list