[1678] | 1 | { **************************************************************
|
---|
| 2 | Package: XWB - Kernel RPCBroker
|
---|
| 3 | Date Created: Sept 18, 1997 (Version 1.1)
|
---|
| 4 | Site Name: Oakland, OI Field Office, Dept of Veteran Affairs
|
---|
| 5 | Developers: Joel Ivey
|
---|
| 6 | Description: Unit tests for RPCBroker functionality - requires
|
---|
| 7 | dUnit to run unit tests.
|
---|
| 8 | Current Release: Version 1.1 Patch 47 (Jun. 17, 2008))
|
---|
| 9 | *************************************************************** }
|
---|
| 10 |
|
---|
| 11 | unit uUnitTestBroker;
|
---|
| 12 |
|
---|
| 13 | interface
|
---|
| 14 |
|
---|
| 15 | uses
|
---|
| 16 | TestFramework, Sgnoncnf, Classes, Graphics, SysUtils, Forms;
|
---|
| 17 |
|
---|
| 18 | type
|
---|
| 19 | TTestType = class(TTestCase)
|
---|
| 20 | private
|
---|
| 21 | // any private fields needed for processing
|
---|
| 22 | protected
|
---|
| 23 | // procedure SetUp; override;
|
---|
| 24 | // procedure TearDown; override;
|
---|
| 25 | published
|
---|
| 26 | // procedure TestName1;
|
---|
| 27 | // procedure TestName2;
|
---|
| 28 | end;
|
---|
| 29 |
|
---|
| 30 | TTestSgnoncnf = class(TTestCase)
|
---|
| 31 | private
|
---|
| 32 | FSignonConfiguration: TSignonConfiguration;
|
---|
| 33 | FRegValues: TStringList;
|
---|
| 34 | protected
|
---|
| 35 | procedure SetUp; override;
|
---|
| 36 | procedure TearDown; override;
|
---|
| 37 | published
|
---|
| 38 | procedure TestReadRegistry;
|
---|
| 39 | procedure TestShowModal1;
|
---|
| 40 | procedure TestShowModal2;
|
---|
| 41 | end;
|
---|
| 42 |
|
---|
| 43 | TTestMFunStr = class(TTestCase)
|
---|
| 44 | private
|
---|
| 45 | protected
|
---|
| 46 | procedure Setup; override;
|
---|
| 47 | public
|
---|
| 48 | published
|
---|
| 49 | procedure TestPiece1;
|
---|
| 50 | procedure TestPiece2;
|
---|
| 51 | procedure TestPiece3;
|
---|
| 52 | procedure TestPiece4;
|
---|
| 53 | procedure TestPiece5;
|
---|
| 54 | procedure TestPiece6;
|
---|
| 55 | procedure TestPiece7;
|
---|
| 56 | procedure TestPiece8;
|
---|
| 57 | procedure TestPiece9;
|
---|
| 58 | end;
|
---|
| 59 |
|
---|
| 60 | implementation
|
---|
| 61 |
|
---|
| 62 | uses
|
---|
| 63 | XWBut1, Dialogs, MFunStr, LoginFrm;
|
---|
| 64 |
|
---|
| 65 | var
|
---|
| 66 | Str: String;
|
---|
| 67 | Val: String;
|
---|
| 68 |
|
---|
| 69 |
|
---|
| 70 | procedure TTestSgnoncnf.SetUp;
|
---|
| 71 | begin
|
---|
| 72 | { setup as would be done in loginfrm.pas }
|
---|
| 73 |
|
---|
| 74 | FSignonConfiguration := TSignonConfiguration.Create;
|
---|
| 75 | {
|
---|
| 76 | // if any data currently in registry then save it
|
---|
| 77 | FRegValues := TStringList.Create;
|
---|
| 78 | ReadRegValues(HKCU,'Software\Vista\Signon',FRegValues);
|
---|
| 79 | // Now delete current data
|
---|
| 80 | DeleteRegData(HKCU,'Software\Vista\Signon');
|
---|
| 81 |
|
---|
| 82 | // Test for reading without registry data
|
---|
| 83 | FOriginalValues := TSignonValues.Create;
|
---|
| 84 | }
|
---|
| 85 | with SignonDefaults do
|
---|
| 86 | begin
|
---|
| 87 | Position := '0';
|
---|
| 88 | Size := '0';
|
---|
| 89 | IntroFont := 'Courier New^11';
|
---|
| 90 | IntroFontStyles := 'B';
|
---|
| 91 | TextColor := clWindowText;
|
---|
| 92 | BackColor := clWindow;
|
---|
| 93 | end; // with FSignonConfiguration.SignonDefaults
|
---|
| 94 | frmSignon := TfrmSignon.Create(Application);
|
---|
| 95 | end;
|
---|
| 96 |
|
---|
| 97 | procedure TTestSgnoncnf.TearDown;
|
---|
| 98 | begin
|
---|
| 99 | FSignonConfiguration.Free;
|
---|
| 100 | frmSignon.Free;
|
---|
| 101 | end;
|
---|
| 102 |
|
---|
| 103 | procedure TTestSgnoncnf.TestReadRegistry;
|
---|
| 104 | begin
|
---|
| 105 | FSignonConfiguration.ReadRegistrySettings;
|
---|
| 106 | with InitialValues do
|
---|
| 107 | begin
|
---|
| 108 | Check(Position = '0', 'ReadRegistry Error in Position value-'+Position);
|
---|
| 109 | Check(Size = '0', 'ReadRegistry Error in Size value-'+Size);
|
---|
| 110 | Check(IntroFont = 'Courier New^11', 'ReadRegistry Error in IntroFont-'+IntroFont);
|
---|
| 111 | Check(IntroFontStyles = 'B', 'ReadRegistry Error in IntroFontStyles value-'+IntroFontStyles);
|
---|
| 112 | Check(BackColor = clWindow, 'ReadRegistry Error in BackColor = '+IntToStr(BackColor));
|
---|
| 113 | Check(TextColor = clWindowText, 'ReadRegistry Error in TextColor = '+IntToStr(TextColor));
|
---|
| 114 | end; // with
|
---|
| 115 | end;
|
---|
| 116 |
|
---|
| 117 | procedure TTestSgnoncnf.TestShowModal1;
|
---|
| 118 | begin
|
---|
| 119 | ShowMessage('Click on Default Button');
|
---|
| 120 | InitialValues.TextColor := clWindow;
|
---|
| 121 | FSignonConfiguration.ShowModal;
|
---|
| 122 | with InitialValues do
|
---|
| 123 | begin
|
---|
| 124 | Check(TextColor = clWindowText, 'TestShowModal bad TextColor on restore');
|
---|
| 125 | end; // with
|
---|
| 126 | end;
|
---|
| 127 |
|
---|
| 128 | procedure TTestSgnoncnf.TestShowModal2;
|
---|
| 129 | begin
|
---|
| 130 | ShowMessage('Click on ''Select New'' Background Color then select OK (Standard) on next form Then click OK on Main Form');
|
---|
| 131 | InitialValues.TextColor := clWindowText;
|
---|
| 132 | FSignonConfiguration.ShowModal;
|
---|
| 133 | with InitialValues do
|
---|
| 134 | begin
|
---|
| 135 | Check(BackColor = clWindow, 'TestShowModal bad TextColor on restore');
|
---|
| 136 | end; // with
|
---|
| 137 | end;
|
---|
| 138 |
|
---|
| 139 | procedure TTestMFunStr.TestPiece1;
|
---|
| 140 | begin
|
---|
| 141 | Val := Piece(Str,'^');
|
---|
| 142 | Check(Val = 'Piece1','Failed Piece not specified');
|
---|
| 143 | end;
|
---|
| 144 |
|
---|
| 145 | procedure TTestMFunStr.Setup;
|
---|
| 146 | begin
|
---|
| 147 | Str := 'Piece1^Piece2^Piece3';
|
---|
| 148 | end;
|
---|
| 149 |
|
---|
| 150 | procedure TTestMFunStr.TestPiece2;
|
---|
| 151 | begin
|
---|
| 152 | Val := Piece(Str,'^',2);
|
---|
| 153 | Check(Val = 'Piece2', 'Failed Piece specified as 2');
|
---|
| 154 | end;
|
---|
| 155 |
|
---|
| 156 | procedure TTestMFunStr.TestPiece3;
|
---|
| 157 | begin
|
---|
| 158 | Val := Piece(Str,'^',3);
|
---|
| 159 | Check(Val = 'Piece3', 'Failed Piece specifed as 3');
|
---|
| 160 | end;
|
---|
| 161 |
|
---|
| 162 | procedure TTestMFunStr.TestPiece4;
|
---|
| 163 | begin
|
---|
| 164 | Val := Piece(Str,'^',4);
|
---|
| 165 | Check(Val = '','Failed piece specifed as 4');
|
---|
| 166 | end;
|
---|
| 167 |
|
---|
| 168 | procedure TTestMFunStr.TestPiece5;
|
---|
| 169 | begin
|
---|
| 170 | Val := Piece(Str,'^',1,2);
|
---|
| 171 | Check(Val = 'Piece1^Piece2','Failed Piece 1,2');
|
---|
| 172 | end;
|
---|
| 173 |
|
---|
| 174 | procedure TTestMFunStr.TestPiece6;
|
---|
| 175 | begin
|
---|
| 176 | Val := Piece(Str,'^',2,3);
|
---|
| 177 | Check(Val = 'Piece2^Piece3','Failed Piece 2,3');
|
---|
| 178 | end;
|
---|
| 179 |
|
---|
| 180 | procedure TTestMFunStr.TestPiece7;
|
---|
| 181 | begin
|
---|
| 182 | Val := Piece(Str,'^',2,4);
|
---|
| 183 | Check(Val = 'Piece2^Piece3', 'Failed on Piece 2,4');
|
---|
| 184 | end;
|
---|
| 185 |
|
---|
| 186 | procedure TTestMFunStr.TestPiece8;
|
---|
| 187 | begin
|
---|
| 188 | Val := Piece(Str,'^',3,5);
|
---|
| 189 | Check(Val = 'Piece3','Failed on Piece 3,5');
|
---|
| 190 | end;
|
---|
| 191 |
|
---|
| 192 | procedure TTestMFunStr.TestPiece9;
|
---|
| 193 | begin
|
---|
| 194 | Val := Piece(Str,'^',4,6);
|
---|
| 195 | Check(Val = '','Failed on Piece 4,6');
|
---|
| 196 | end;
|
---|
| 197 |
|
---|
| 198 | { // used with second method of registering tests
|
---|
| 199 | function UnitTests: ITestSuite;
|
---|
| 200 | var
|
---|
| 201 | ATestSuite: TTestSuite;
|
---|
| 202 | begin
|
---|
| 203 | ATestSuite := TTestSuite.create('Some trivial tests');
|
---|
| 204 | // add each test suite to be tested
|
---|
| 205 | ATestSuite.addSuite(TTestType.Suite);
|
---|
| 206 | // ATestSuite.addSuite(TTestStringlist.Suite);
|
---|
| 207 | Result := ATestSuite;
|
---|
| 208 | end;
|
---|
| 209 | }
|
---|
| 210 |
|
---|
| 211 |
|
---|
| 212 | {
|
---|
| 213 | procedure TTestType.TestName1;
|
---|
| 214 | begin
|
---|
| 215 | // Check( Boolean true for success, String comment for failed test)
|
---|
| 216 | Check(1+1=2,'Comment on Failure')
|
---|
| 217 | end;
|
---|
| 218 | }
|
---|
| 219 |
|
---|
| 220 | initialization
|
---|
| 221 | // one entry per testclass
|
---|
| 222 | TestFramework.RegisterTest('ReadRegistry',TTestSgnoncnf.Suite);
|
---|
| 223 | TestFramework.RegisterTest('Test Piece',TTestMFunStr.Suite);
|
---|
| 224 | // or
|
---|
| 225 | // TestFramework.RegisterTest('SimpleTest',UnitTests);
|
---|
| 226 | end.
|
---|