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