Programa prueba para la unidad CacheCls
{ $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 }
Antes de comentar: Gran parte de los ejercicios propuestos no tienen librerías debido a que Wordpress las eliminó al verlas como etiquetas HTML. Si sabes/tienes/conoces las librerías que hacen falta, déjalo en los comentarios. Y lo mas importante: Todos los ejemplos fueron realizados por personas con únicamente conocimiento básico del lenguaje, no de programación.
Otro punto importante: Si vas a sugerir un segmento de código en algún lenguaje debes hacerlo así:
- Si es lenguaje C [c]Código en C[/c]
- Si es lenguaje Pascal [pascal]Aquí dentro el código de Pascal[/pascal].
De esta manera el código coloreas el código.
Otro punto importante para muchos que sienten que se les ignora: Todos los comentarios los reviso y en su debido momento los apruebo, pero ojo con el con lo siguiente:Me reservo el derecho de alterar, publicar o no los comentarios as´ como cambiar mis condiciones en el momento que así lo requiera.
¿estas de acuerdo? entonces adelante que ya te he quitado bastante tiempo leyendo esta basura de advertencias :)