1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160

{
    $Id: cachetest.pp,v 1.4 2005/02/14 17:13:18 peter Exp $
 
    Test program for the CacheCls unit
    Copyright (C) 2000 by Sebastian Guenther (sg@freepascal.org) 
    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.
 
    This program is distributed in the hope that it will be useful,    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
}
 
 program CacheTest;
 
{$MODE objfpc}
 
uses Strings, CacheCls; 
type
  TCacheTester = class
  private
    TestCache: TCache;    function TestCacheIsDataEqual(ACache: TCache; AData1, AData2: Pointer): Boolean;
    procedure TestCacheFreeSlot(ACache: TCache; SlotIndex: Integer);
  protected
    procedure AddString(const s: PChar);
    procedure DumpCache;  public
    constructor Create;
    destructor Destroy; override;
    procedure Run;
  end; 
 
 
function TCacheTester.TestCacheIsDataEqual(ACache: TCache;
  AData1, AData2: Pointer): Boolean;begin
  if (not Assigned(AData1)) or (not Assigned(AData2)) then
    Result := (not Assigned(AData1)) and (not Assigned(AData2))
  else
    Result := StrComp(PChar(AData1), PChar(AData2)) = 0;end;
 
procedure TCacheTester.TestCacheFreeSlot(ACache: TCache; SlotIndex: Integer);
var
  p: PChar;begin
  Write('  Cache slot #', SlotIndex, ' has been freed (content: ');
  p := PChar(ACache.Slots[SlotIndex]^.Data);
  if Assigned(p) then
    WriteLn('"', p, '")')  else
    WriteLn('nil)');
end;
 
procedure TCacheTester.AddString(const s: PChar);var
  i: Integer;
begin
  WriteLn('Adding string "', s, '"...');
  i := TestCache.Add(Pointer(s));  WriteLn('string got cache index #', i);
  WriteLn('New cache state:');
  DumpCache;
  WriteLn;
end; 
procedure TCacheTester.DumpCache;
var
  Slot, PrevSlot: PCacheSlot;
begin  Slot := TestCache.MRUSlot;
  PrevSlot := nil;
  while Assigned(Slot) do
  begin
    Write('  Slot #', Slot^.Index, '  ');    if Assigned(Slot^.Data) then
      Write('"', PChar(Slot^.Data), '"')
    else
      Write('nil');
    if Slot^.Prev <> PrevSlot then    begin
      Write('  Slot^.Prev is invalid! (');
      if Assigned(Slot^.Prev) then
        Write('points to #', Slot^.Prev^.Index)
      else        Write('nil');
      Write(')');
    end;
    WriteLn;
    PrevSlot := Slot;    Slot := Slot^.Next;
  end;
end;
 
constructor TCacheTester.Create;begin
  inherited Create;
  TestCache := TCache.Create(4);
  TestCache.OnIsDataEqual := @TestCacheIsDataEqual;
  TestCache.OnFreeSlot := @TestCacheFreeSlot; 
  WriteLn('Initial cache state:');
  DumpCache;
  WriteLn;
end; 
destructor TCacheTester.Destroy;
begin
  TestCache.Free;
  inherited Destroy;end;
 
procedure TCacheTester.Run;
begin
  AddString('1st');  AddString('2nd');
  AddString('3rd');
  AddString('4th');
  AddString('5th');
  AddString('3rd');  AddString('2nd');
  WriteLn('Setting slot count to 2...');
  TestCache.SlotCount := 2;
  WriteLn('Cache state after resize:');
  DumpCache;  WriteLn;
  AddString('4th');
  WriteLn('Setting slot count to 6...');
  TestCache.SlotCount := 6;
  WriteLn('Cache state after resize:');  DumpCache;
  WriteLn;
  AddString('5th');
  AddString('6th');
  AddString('7th');  AddString('8th');
end;
 
 
var  CacheTester: TCacheTester;
 
begin
  CacheTester := TCacheTester.Create;
  CacheTester.Run;  CacheTester.Free;
end.
 
 
{  $Log: cachetest.pp,v $
  Revision 1.4  2005/02/14 17:13:18  peter
    * truncate log
 
}