..WARNING:: Dokładniejsze omówienie tego tematu pojawi się przed zajęciami z Deplhi/Lazarusa.
Klasa, jaka jest, każdy widzi. W przypadku Pascala klasy mają następujące cechy:
Obiekty istnieją tylko w pamięci alokowanej dynamicznie (tz. nie na stosie),
- Klasy zawierają
Pola (tak jak rekordy).
- Metody
- Zwykłe
- Wirtualne/abstrakcyjne
- Metody klasowe
Własności - mogą opakowywać bezpośrednio pole lub getter/setter.
Nie ma wielodziedziczenia (ale są interfejsy).
- Ręczne zarządzanie pamięcią
Obiekty tworzy się przez wywołanie konstruktora.
- Zwalnia przez wywołanie Free.
- Ciekawostka: Free można wywołać nawet dla referencji równej nil.
Można skorzystać z automatycznego zliczania referencji, ale tylko dla obiektów, których statycznym typem jest jakiś interfejs.
http://www.freepascal.org/docs-html/ref/refch6.html#x66-760006
Interfejsy zawierają sygnatury metod i własności. Wszystkie dziedziczą z IInterface, więc zawierają w szczególności metody służące do zliczania referencji i refleksji. Domyślna implementacja tych metod jest w klasie TInterfacedObject.
Zliczanie referencji działa tylko dla zmiennych, których statyczny typ jest interfejsem. Jeśli zrzutujemy obiekt np. na typ Pointer (żeby wstawić go do jakiejś ogólnej struktury danych), musimy ręcznie wywołać AddRef i Release.
http://www.freepascal.org/docs-html/ref/refch7.html#x84-940007
{ Stacks of integers. }
unit IntStack;
{$mode objfpc}{$H+}
interface
uses SysUtils;
type
{ Exception raised by some operations when invoked on an empty stack. }
EEmptyStack = class(Exception);
{ Interface of integer stacks. }
IIntStack = interface
{ Place new element on top of the stack.
@param(Value is the new element) }
procedure Push(Value : Integer);
{ Remove an element from top of the stack.
@return(Removed element)
@raises(EEmptyStack if the stack is empty) }
function Pop : Integer;
{ Get top element without removing it from the stack.
@return(Top element)
@raises(EEmptyStack if the stack is empty) }
function Peek : Integer;
{ Test emptiness of the stack.
@return(@true if the stack is empty, @false otherwise) }
function IsEmpty : Boolean;
end;
{ Create a new, empty stack.
@return(Stack instance.) }
function CreateIntStack : IIntStack;
implementation
const
{ Initial size of arrays used to store stack contents. }
INITIAL_SIZE = 16;
type
{ Stack implementation backed by a dynamic array. }
TIntStack = class(TInterfacedObject, IIntStack)
private
{ Array used to store actual stack elements. }
FElements : array of Integer;
{ Size of the stack. }
FSize : Integer;
public
constructor Create;
destructor Destroy; override;
{ IIntStack methods. }
procedure Push(Value : Integer);
function Pop : Integer;
function Peek : Integer;
function IsEmpty : Boolean;
end;
constructor TIntStack.Create;
begin
inherited Create;
SetLength(FElements, INITIAL_SIZE);
FSize := 0;
end;
destructor TIntStack.Destroy;
begin
FElements := nil;
inherited Destroy;
end;
procedure TIntStack.Push(Value : Integer);
begin
if FSize > High(FElements) then
begin
SetLength(FElements, 2 * FSize + 1);
end;
Assert(FSize <= High(FElements));
FElements[FSize] := Value;
Inc(FSize);
end;
function TIntStack.Pop : Integer;
begin
if FSize > 0 then
begin
Dec(FSize);
Result := FElements[FSize];
end else begin
raise EEmptyStack.Create('IIntStack.Pop');
end;
end;
function TIntStack.Peek : Integer;
begin
if FSize > 0 then
begin
Result := FElements[FSize - 1];
end else begin
raise EEmptyStack.Create('IIntStack.Peek');
end;
end;
function TIntStack.IsEmpty : Boolean;
begin
Result := FSize = 0;
end;
function CreateIntStack : IIntStack;
begin
Result := TIntStack.Create;
end;
end.
{ Unit tests for the IntStack unit. }
unit IntStackTest;
{$mode objfpc}{$H+}
interface
uses fpcunit, testregistry, IntStack;
type
TIntStackTest = class(TTestCase)
private
FStack : IIntStack;
protected
procedure SetUp; override;
procedure TearDown; override;
published
procedure TestNewStackNotNil;
procedure TestNewStackIsEmpty;
procedure TestEmptyPop;
procedure TestEmptyPeek;
procedure TestPushPop;
procedure TestPushPeek;
procedure TestBigStack;
end;
implementation
procedure TIntStackTest.SetUp;
begin
inherited SetUp;
FStack := CreateIntStack;
end;
procedure TIntStackTest.TearDown;
begin
FStack := nil;
inherited TearDown;
end;
{ Object returned by CreateIntStack is not nil. }
procedure TIntStackTest.TestNewStackNotNil;
begin
AssertNotNull('Unable to create a new stack.', FStack);
end;
{ Newly created stack is empty. }
procedure TIntStackTest.TestNewStackIsEmpty;
begin
AssertTrue('Wrong result of IsEmpty for new stack.', FStack.IsEmpty);
end;
{ Calling Pop on an empty stack raises proper exception. }
procedure TIntStackTest.TestEmptyPop;
begin
try
FStack.Pop;
except
on EEmptyStack do Exit
else Fail('Incorrect exception raised');
end;
Fail('No exception raised');
end;
{ Calling Peek on an empty stack raises proper exception. }
procedure TIntStackTest.TestEmptyPeek;
begin
try
FStack.Peek;
except
on EEmptyStack do Exit
else Fail('Incorrect exception raised');
end;
Fail('No exception raised');
end;
{ Pop returns the value that was pushed and removes it. }
procedure TIntStackTest.TestPushPop;
begin
FStack.Push(42);
AssertFalse('Empty stack after push.', FStack.IsEmpty);
AssertEquals('Wrong value returned by Pop', 42, FStack.Pop);
AssertTrue('Pop failed to remove element.', FStack.IsEmpty);
end;
procedure TIntStackTest.TestPushPeek;
begin
FStack.Push(42);
AssertFalse('Empty stack after push.', FStack.IsEmpty);
AssertEquals('Wrong value returned by Peek', 42, FStack.Peek);
AssertFalse('Peek removed an element.', FStack.IsEmpty);
end;
{ Pushing and then popping 1000 values does not cause problems. }
procedure TIntStackTest.TestBigStack;
var
i : Integer;
begin
for i := 1 to 1000 do
begin
FStack.Push(i);
end;
for i := 1000 downto 1 do
begin
AssertEquals('Wrong value pop''ed from the stack.', i, FStack.Pop);
end;
AssertTrue('Stack not empty.', FStack.IsEmpty);
end;
initialization
RegisterTest(TIntStackTest);
end.
{ FPCUnit test runner. }
program TestRunner;
{$mode objfpc}{$H+}
uses fpcunit, testreport, testregistry, IntStackTest;
var
Writer : TPlainResultsWriter;
TestResult : TTestResult;
Test : TTest;
begin
Writer := TPlainResultsWriter.Create;
TestResult := TTestResult.Create;
Test := GetTestRegistry;
TestResult.AddListener(Writer);
Test.Run(TestResult);
Writer.WriteResult(TestResult);
end.
$ ./testrunner
Test: TIntStackTest.TestNewStackNotNil
Test: TIntStackTest.TestNewStackIsEmpty
Test: TIntStackTest.TestEmptyPop
Test: TIntStackTest.TestEmptyPeek
Test: TIntStackTest.TestPushPop
Test: TIntStackTest.TestPushPeek
Test: TIntStackTest.TestBigStack
Number of run tests: 7
Number of errors: 0
Number of failures: 0
$ ppcx64 -gw hello.pas
$ gdb ./hello
GNU gdb (GDB) Red Hat Enterprise Linux (7.2-50.el6)
Copyright (C) 2010 Free Software Foundation, Inc.
License GPLv3+: GNU GPL version 3 or later <http://gnu.org/licenses/gpl.html>
This is free software: you are free to change and redistribute it.
There is NO WARRANTY, to the extent permitted by law. Type "show copying"
and "show warranty" for details.
This GDB was configured as "x86_64-redhat-linux-gnu".
For bug reporting instructions, please see:
<http://www.gnu.org/software/gdb/bugs/>...
Reading symbols from /home/user/hello...done.
(gdb) run world
Starting program: /home/user/hello
Hello, world!
Program exited normally.
Zatrzymują wykonanie programu, gdy sterowanie osiągnie dany punkt w kodzie.
Zatrzymują program przy każdym zapisie do podanej zmiennej.
Pozwala wprowadzić ciąg komend, które zostaną wykonane przy każdym aktywowaniu podanego punktu kontrolnego lub punktu przerwania. Listę komend należy zakończyć słowem ‘end’. Poniższy przykład pokazuje, jak wykorzystać polecenie commands do wydrukowania wartości argumentu funkcji przy każdym wywołaniu, bez zatrzymywania działania programu.
$ gdb ./naivefib
GNU gdb (GDB) Red Hat Enterprise Linux (7.2-50.el6)
Copyright (C) 2010 Free Software Foundation, Inc.
License GPLv3+: GNU GPL version 3 or later <http://gnu.org/licenses/gpl.html>
This is free software: you are free to change and redistribute it.
There is NO WARRANTY, to the extent permitted by law. Type "show copying"
and "show warranty" for details.
This GDB was configured as "x86_64-redhat-linux-gnu".
For bug reporting instructions, please see:
<http://www.gnu.org/software/gdb/bugs/>...
Reading symbols from /home/user/naivefib...done.
(gdb) break FIB
Breakpoint 1 at 0x80480ac: file naivefib.pas, line 9.
(gdb) commands 1
Type commands for breakpoint(s) 1, one per line.
End with a line saying just "end".
>silent
>print N
>continue
>end
(gdb) run 5
Starting program: /home/user/naivefib 5
$1 = 5
$2 = 4
$3 = 3
$4 = 2
$5 = 1
$6 = 0
$7 = 1
$8 = 2
$9 = 1
$10 = 0
$11 = 3
$12 = 2
$13 = 1
$14 = 0
$15 = 1
Fib(5) = 5
Program exited normally.
(gdb)
W instrukcjach print oraz x format podajemy jako pojedynczą literę z poniższego ziboru,
Instrukcja x obsługuje jeszcze dwa formaty
GDB rozumie wyrażenie wielu języków źródłowych, w tym Pascala. Język rozpoznawany jest na podstawie rozszerzenia pliku zawierającego źródła. Bieżący język można sprawdzić komendą show language:
(gdb) show language
The current source language is "auto; currently pascal".