summaryrefslogtreecommitdiff
path: root/fpcsrc/tests/test/units/fpcunit/tcpersistent.pp
blob: 26c88a5314a359ce7387e56c814ac2048ea7c712 (plain)
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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
unit tcpersistent;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, fpcunit, testregistry;

type

  { TTestTPersistent }

  TTestTPersistent= class(TTestCase)
  protected
    Instance : TPersistent;
    procedure SetUp; override; 
    procedure TearDown; override; 
  published
    procedure TestPropCount;
    procedure TestNamePath;
  end; 
  
  { TMyPersistent }

  TMyPersistent = Class(TPersistent)
  private
    FMyProp: Integer;
    FOwner : TPersistent;
  protected
    function GetOwner: TPersistent; override;
  public
    procedure Assign(Source: TPersistent); override;
  published
    Property MyProp : Integer Read FMyProp Write FMyProp;
  end;

  { TTestPersistentDescendent }

  TTestPersistentDescendent = class(TTestCase)
  private
    procedure WrongAssign;
  Protected
    Instance : TMyPersistent;
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure TestPropCount;
    procedure TestNamePath;
    procedure TestNamePathWithOwner;
    Procedure TestAssign;
    Procedure TestAssignFail;
  end;


implementation

uses typinfo;

procedure TTestTPersistent.TestPropCount;

Var
  ACOunt : Integer;
  P : Pointer;
  
begin
  P:=Nil;
  ACOunt:=GetPropList(Instance,P);
  AssertEquals('Property count of TPersistence is zero',0,ACount);
end;

procedure TTestTPersistent.TestNamePath;
begin
  AssertEquals('Namepath is class name if there is no owner','TPersistent',Instance.GetNamePath);
end;

procedure TTestTPersistent.SetUp; 
begin
  Instance:=TPersistent.Create;
end;

procedure TTestTPersistent.TearDown; 
begin
  FreeAndNil(Instance);
end; 

{ TTestPersistentDescendent }

procedure TTestPersistentDescendent.SetUp;
begin
  Instance:=TMyPersistent.Create;
end;

procedure TTestPersistentDescendent.TearDown;
begin
  FreeAndNil(Instance);
end;

procedure TTestPersistentDescendent.TestPropCount;

Var
  ACOunt : Integer;
  P : Pointer;

begin
  P:=Nil;
  ACount:=GetPropList(Instance,P);
  AssertEquals('Property count of TPersistence is zero',1,ACount);
  Freemem(p);
end;

procedure TTestPersistentDescendent.TestNamePath;
begin
  AssertEquals('Namepath is class name if there is no owner','TMyPersistent',Instance.GetNamePath);
end;

procedure TTestPersistentDescendent.TestNamePathWithOwner;

Var
  AOwner : TMyPersistent;
  
begin
  AOwner:=TMyPersistent.Create;
  try
    Instance.FOwner:=AOwner;
    AssertEquals('Namepath is owner namepath plus class name','TMyPersistent.TMyPersistent',Instance.GetNamePath);
  finally
    Aowner.Free;
  end;
end;

procedure TTestPersistentDescendent.TestAssign;

Var
  I2 : TMyPersistent;
  
begin
  I2:=TMyPersistent.Create;
  try
    I2.MyProp:=2;
    Instance.Assign(I2);
    AssertEquals('Property passed on during assign',2,Instance.MyProp);
  finally
    I2.Free;
  end;
end;


procedure TTestPersistentDescendent.TestAssignFail;

begin
  AssertException('Assigning the wrong class',EConvertError,@WrongAssign);
end;

procedure TTestPersistentDescendent.WrongAssign;
Var
  I2 : TPersistent;

begin
  I2:=TPersistent.Create;
  try
    Instance.Assign(I2);
  finally
    I2.Free;
  end;
end;

{ TMyPersistent }

function TMyPersistent.GetOwner: TPersistent;
begin
  Result:=FOwner;
end;

procedure TMyPersistent.Assign(Source: TPersistent);
begin
  If (Source is TMyPersistent) then
    FMyProp:=TMyPersistent(Source).FMyProp
  else
    Inherited;
end;

initialization

  RegisterTests([TTestTPersistent,TTestPersistentDescendent]);
end.