1unit TestBasics;
2
3{$IFDEF FPC}
4  {$mode objfpc}{$H+}
5{$ENDIF}
6
7interface
8
9uses
10  fpcunit, testutils, testregistry, testdecorator, Classes, SysUtils;
11
12type
13
14  { TTestBasics }
15
16  TTestBasics = class(TTestCase)
17  private
18    procedure DeleteUserXmlFile;
19  protected
20  published
21    procedure TestSimpleWinRegistry;
22    procedure TestDoubleWrite;
23    procedure bug16395;
24    procedure TestAdv;
25  end;
26
27implementation
28
29uses
30  registry
31{$ifdef windows}
32  , tregistry2
33{$endif windows}
34  ;
35
36{ TTestBasics }
37
38procedure TTestBasics.DeleteUserXmlFile;
39{$ifndef windows}
40var
41  fn: string;
42{$endif}
43begin
44{$ifdef windows}
45  with TRegistry.Create do
46    try
47      DeleteKey('FirstNode');
48    finally
49      Free;
50    end;
51{$else}
52  FN:=includetrailingpathdelimiter(GetAppConfigDir(False))+'reg.xml';
53  if FileExists(FN) then
54    AssertTrue(DeleteFile(FN));
55{$endif}
56end;
57
58procedure TTestBasics.TestSimpleWinRegistry;
59var
60  Registry : TRegistry;
61begin
62  Registry := TRegistry.Create(KEY_READ);
63  Registry.RootKey:=HKEY_LOCAL_MACHINE;
64
65  // use a hopefully non existing key
66  AssertFalse(Registry.KeyExists('FPC1234'));
67{$ifdef windows}
68  AssertTrue(Registry.KeyExists('SOFTWARE'));
69{$endif}
70
71  Registry.Free;
72end;
73
74procedure TTestBasics.TestDoubleWrite;
75begin
76  DeleteUserXmlFile;
77  with TRegistry.Create do
78    try
79      OpenKey('FirstNode', true);
80      WriteString('LAYOUT', '');
81      CloseKey;
82    finally
83      Free;
84    end;
85  with TRegistry.Create do
86    try
87      OpenKey('FirstNode', true);
88      WriteString('LAYOUT', '');
89      CloseKey;
90    finally
91      Free;
92    end;
93  DeleteUserXmlFile;
94end;
95
96procedure TTestBasics.bug16395;
97var
98  r: TRegistry;
99  s,t: string;
100begin
101  DeleteUserXmlFile;
102
103  r := TRegistry.Create;
104  try
105    r.RootKey := HKEY_CURRENT_USER;
106    r.OpenKey('FirstNode', true);
107    r.WriteString('string1', '');
108    r.CloseKey;
109  finally
110    r.Free;
111  end;
112
113  // verify that empty value can be changed to non-empty one
114  r := TRegistry.Create;
115  try
116    r.RootKey := HKEY_CURRENT_USER;
117    r.OpenKey('FirstNode',false);
118    s := r.ReadString('string1');
119    AssertEquals('Failed to read back an empty string', '', s);
120    r.WriteString('string1', 'string_value_1');
121    r.CloseKey;
122  finally
123    r.Free;
124  end;
125
126  // verify that non-empty value can be changed to empty one
127  r := TRegistry.Create;
128  try
129    r.RootKey := HKEY_CURRENT_USER;
130    r.OpenKey('FirstNode',false);
131    s := r.ReadString('string1');
132    AssertEquals('Failed chaning empty string value to non-empty one', 'string_value_1',s);
133
134    r.WriteString('string1', '');
135    r.CloseKey;
136  finally
137    r.Free;
138  end;
139
140  r := TRegistry.Create;
141  try
142    r.RootKey := HKEY_CURRENT_USER;
143    r.OpenKey('FirstNode',false);
144    s := r.ReadString('string1');
145    AssertEquals('Failed changing non-empty string value to empty one', '', s);
146    r.CloseKey;
147  finally
148    r.Free;
149  end;
150
151  r := TRegistry.Create;
152  try
153    r.RootKey := HKEY_CURRENT_USER;
154    r.OpenKey('LongNode',true);
155    t:=StringOfChar('*',4000);
156    r.WriteString('LongString',T);
157    s := r.ReadString('LongString');
158    AssertEquals('Writing long string works OK', t, s);
159    r.CloseKey;
160  finally
161    r.Free;
162  end;
163
164  DeleteUserXmlFile;
165end;
166
167procedure TTestBasics.TestAdv;
168begin
169{$ifdef windows}
170  DoRegTest2;
171{$endif windows}
172end;
173
174initialization
175  RegisterTest(TTestBasics);
176end.
177
178