1(* $Id: RunTests.Mod,v 1.20 2003/05/20 20:10:31 mva Exp $ *) 2MODULE RunTests; 3(* Applies a test schedule to an OOC compiler and produces an XML report. 4 Copyright (C) 2001, 2002, 2003 Michael van Acken 5 6 This file is part of OOC. 7 8 OOC is free software; you can redistribute it and/or modify it 9 under the terms of the GNU General Public License as published by 10 the Free Software Foundation; either version 2 of the License, or 11 (at your option) any later version. 12 13 OOC is distributed in the hope that it will be useful, but WITHOUT 14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY 15 or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public 16 License for more details. 17 18 You should have received a copy of the GNU General Public License 19 along with OOC. If not, write to the Free Software Foundation, 59 20 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 21*) 22 23 24IMPORT 25 Err, Msg, Out, ProgramArgs, LongStrings, 26 Object, IO, IO:FileChannel, IO:Buffer, OS:Path, TextRider, URI, 27 StdChannels, XMLError := XML:Error, XML:UnicodeCodec:Latin1, 28 XML:Basic:Element, XMLWriter := XML:Writer, URI:Scheme:File, 29 OOC:TestFramework:TestSetup, OOC:TestFramework:Testcases, 30 OOC:TestFramework:Processor; 31 32CONST (* classifications of test results *) 33 passed = 0; 34 failed = 1; 35 tolerated = 2; 36 skipped = 3; 37 38TYPE 39 Results = ARRAY skipped+1 OF LONGINT; 40 41VAR 42 testSetup: TestSetup.TestSetup; 43 testSuite: Testcases.TestSuite; 44 proc: Processor.Processor; 45 reportWriter: XMLWriter.Writer; 46 results: Results; 47 str: ARRAY 256 OF CHAR; 48 exitError, stopOnError: BOOLEAN; 49 50PROCEDURE CheckErrorFile (msg: Msg.Msg; file: ARRAY OF CHAR); 51 VAR 52 str: ARRAY 4*1024 OF CHAR; 53 BEGIN 54 IF (msg # NIL) THEN 55 IF (file # "") THEN 56 Err.String ("Error in file "); 57 Err.String (file); 58 Err.String (": "); 59 ELSE 60 Err.String ("Error: "); 61 END; 62 msg. GetText (str); 63 Err.String (str); 64 Err.Ln; 65 HALT (1) 66 END 67 END CheckErrorFile; 68 69PROCEDURE CheckError (msg: Msg.Msg); 70 BEGIN 71 CheckErrorFile (msg, "") 72 END CheckError; 73 74PROCEDURE ReadConfig (VAR setup: TestSetup.TestSetup; 75 VAR suite: Testcases.TestSuite; 76 VAR stopOnError: BOOLEAN) 77RAISES IO.Error; 78 CONST 79 testSetup = 0; 80 testCases = 1; 81 VAR 82 r: TextRider.Reader; 83 arg: ARRAY 1024 OF CHAR; 84 elem: Element.Element; 85 reportFile: Buffer.Channel; 86 uri: URI.URI; 87 88 PROCEDURE ReadURI (uri: URI.URI; parser: SHORTINT): Element.Element 89 RAISES IO.Error; 90 VAR 91 ch: IO.ByteChannel; 92 errList: XMLError.List; 93 elem: Element.Element; 94 BEGIN 95 elem := NIL; 96 ch := uri. GetChannel (URI.channelOld); 97 CASE parser OF 98 | testSetup: 99 elem := TestSetup.Read (ch, uri, errList) 100 | testCases: 101 elem := Testcases.Read (ch, uri, errList) 102 END; 103 IF (elem = NIL) THEN 104 errList. Write (StdChannels.stderr); 105 HALT(1) 106 END; 107 RETURN elem 108 END ReadURI; 109 110 BEGIN 111 setup := NIL; 112 stopOnError := FALSE; 113 r := TextRider.ConnectReader (ProgramArgs.args); 114 IF (r = NIL) THEN 115 CheckError (ProgramArgs.args. res) 116 ELSE 117 r. ReadLine (arg); 118 r. ReadLine (arg); 119 LOOP 120 IF (arg = "--stop-on-error") THEN 121 stopOnError := TRUE; 122 r. ReadLine (arg); 123 ELSIF (arg = "--out-module") THEN 124 r. ReadLine (Processor.outModule); 125 r. ReadLine (arg); 126 ELSE 127 EXIT; 128 END; 129 END; 130 131 uri := File.ToURI (arg); 132 elem := ReadURI (uri, testSetup); 133 setup := elem(TestSetup.TestSetup); 134 elem := ReadURI (setup. testSuite. uri, testCases); 135 suite := elem(Testcases.TestSuite); 136 137 r. ReadLine (arg); 138 reportFile := FileChannel.Open(Object.NewLatin1(arg), 139 {FileChannel.write, FileChannel.create, 140 FileChannel.truncate}); 141 reportWriter := XMLWriter.New (reportFile, Latin1.factory, TRUE, 4) 142 END 143 END ReadConfig; 144 145 146PROCEDURE RunTests (testSetup: TestSetup.TestSetup; 147 testSuite: Testcases.TestSuite; 148 proc: Processor.Processor; 149 reportWriter: XMLWriter.Writer; 150 VAR results: Results) 151RAISES IO.Error; 152 VAR 153 testCases: Testcases.Testcases; 154 test: Testcases.Test; 155 result, class: SHORTINT; 156 timeStr, str: ARRAY 128 OF CHAR; 157 (*time: SysClock.DateTime;*) 158 elem: Element.Element; 159 processorInfo: Testcases.ProcessorInfo; 160 161 PROCEDURE In (pattern, string: ARRAY OF LONGCHAR): BOOLEAN; 162 VAR 163 pos, posOfPattern: INTEGER; 164 found: BOOLEAN; 165 BEGIN 166 pos := 0; 167 LOOP 168 LongStrings.FindNext (pattern, string, pos, found, posOfPattern); 169 IF found THEN 170 IF ((posOfPattern = 0) OR (string[posOfPattern-1] = " ")) & 171 (string[posOfPattern+LongStrings.Length (pattern)] <= " ") THEN 172 RETURN TRUE 173 ELSE 174 pos := posOfPattern+1 175 END 176 ELSE 177 EXIT 178 END 179 END; 180 RETURN FALSE 181 END In; 182 183 PROCEDURE ResultMatches (testType, result: SHORTINT): BOOLEAN; 184 BEGIN 185 RETURN 186 (testType = Testcases.testAccept) & 187 (result = Processor.processAccept) OR 188 (testType = Testcases.testReject) & 189 (result = Processor.processReject) OR 190 (testType = Testcases.testError) & 191 (result = Processor.processError) OR 192 (testType >= Testcases.testRun) & 193 (result = Processor.processSuccess) 194 END ResultMatches; 195 196 BEGIN 197 processorInfo := NIL; 198 elem := testSuite. processorInfoList. head; 199 WHILE (elem # NIL) DO 200 WITH elem: Testcases.ProcessorInfo DO 201 IF (elem. processorName = testSetup. processor. name) THEN 202 processorInfo := elem 203 END 204 END; 205 elem := elem. next 206 END; 207 208 reportWriter. StartTag ("test-report", FALSE); 209 (*SysClock.GetClock (time); 210 Calendar.TimeToStr (time, "%c", timeStr);*) 211 COPY("unknown", timeStr); 212 reportWriter. AttrStringLatin1 ("time", timeStr); 213 testSetup. Write (reportWriter); 214 215 reportWriter. StartTag ("test-results", FALSE); 216 testCases := testSuite. testcasesList. head(Testcases.Testcases); 217 WHILE (testCases # NIL) DO 218 IF (testCases. tests. head # NIL) THEN 219 test := testCases. tests. head(Testcases.Test); 220 WHILE (test # NIL) DO 221 reportWriter. StartTag ("test-result", FALSE); 222 test. Write (reportWriter); 223 224 IF ~testSuite. SelectedTest (test) THEN 225 result := Processor.processSkipped; 226 class := skipped 227 ELSE 228 proc. Process (test, processorInfo, reportWriter, result); 229 230 IF (result = Processor.processCrash) THEN 231 (* processor crashed *) 232 class := failed 233 ELSIF (result = Processor.processMainModuleError) OR 234 (result = Processor.processBuildError) OR 235 (result = Processor.processCompareFailed) THEN 236 (* some error while processing the test that cannot be 237 attributed to the processor *) 238 class := failed 239 ELSIF (result = Processor.processRejectMismatch) THEN 240 (* file was rejected fine, but for the wrong reasons *) 241 class := failed 242 ELSE 243 IF In (testSetup. lang^, test. lang^) THEN 244 IF ResultMatches (test. type, result) THEN 245 class := passed 246 ELSE 247 class := failed 248 END 249 ELSE 250 IF (result = Processor.processReject) THEN 251 class := passed 252 ELSIF ResultMatches (test. type, result) THEN 253 class := tolerated 254 ELSE 255 class := failed 256 END 257 END 258 END 259 END; 260 261 reportWriter. StartTag ("outcome", FALSE); 262 CASE result OF 263 | Processor.processSkipped: 264 str := "skipped" 265 | Processor.processCrash: 266 str := "compiler crashed" 267 | Processor.processReject: 268 str := "rejected by compiler" 269 | Processor.processRejectMismatch: 270 str := "rejected by compiler, but error messages do not match" 271 | Processor.processAccept: 272 str := "accepted by compiler" 273 | Processor.processMainModuleError: 274 str := "failed to write main module" 275 | Processor.processBuildError: 276 str := "failed to build executable (no `Test' procedure?)" 277 | Processor.processError: 278 str := "program exited with error" 279 | Processor.processSuccess: 280 str := "program completed successfully" 281 | Processor.processOutputDifference: 282 str := "program ran, but output does not match reference" 283 | Processor.processCompareFailed: 284 str := "program ran, but failed to compare output with reference" 285 | Processor.processWarningMismatch: 286 str := "accepted by compiler, but warnings do not match" 287 END; 288 reportWriter. AttrStringLatin1 ("result", str); 289 CASE class OF 290 | skipped: str := "skipped" 291 | passed: str := "passed" 292 | failed: str := "failed" 293 | tolerated: str := "tolerated" 294 END; 295 reportWriter. AttrStringLatin1 ("class", str); 296 reportWriter. EndTag; (* outcome *) 297 reportWriter. EndTag; (* test-result *) 298 299 IF (class = skipped) THEN 300 INC (results[class]); 301 ELSE 302 Out.String ("--> TEST RESULT: "); 303 CASE class OF 304 | skipped: Out.String ("SKIPPED ") 305 | failed: Out.String ("FAILED ") 306 | passed: Out.String ("PASSED ") 307 | tolerated: Out.String ("TOLERATED ") 308 END; 309 Out.String (test. id); 310 Out.String (" / "); 311 Out.Object (Path.BaseName(test.file.ToString())); 312 IF (test. relevance = Testcases.relevanceInformal) & 313 (result # Processor.processCrash) THEN 314 Out.String (" (informal test)") 315 ELSE 316 IF (class = failed) & stopOnError THEN 317 Out.Ln; Out.String ("Aborting..."); Out.Ln; HALT (2) 318 END; 319 320 INC (results[class]) 321 END; 322 Out.Ln; 323 END; 324 325 IF (test. next # NIL) THEN 326 test := test. next(Testcases.Test) 327 ELSE 328 test := NIL 329 END 330 END 331 END; 332 IF (testCases. next # NIL) THEN 333 testCases := testCases. next(Testcases.Testcases) 334 ELSE 335 testCases := NIL 336 END 337 END; 338 reportWriter. EndTag; (* test-results *) 339 reportWriter. EndTag; (* test-report *) 340 reportWriter. EndOfText 341 END RunTests; 342 343BEGIN 344 IF (ProgramArgs.args. ArgNumber() < 2) THEN 345 Err.String ("Usage: RunTests [--stop-on-error][--out-module <module-name>] <test-setup> <report-file>"); Err.Ln; HALT (1) 346 ELSE 347 (* make error message values "line" and "character position" Emacs 348 compatible be having them start at line 1, point 1 for the XML 349 parser *) 350 XMLError.errMsgLineBase := 1; 351 XMLError.errMsgCharPosBase := 1; 352 353 ReadConfig (testSetup, testSuite, stopOnError) 354 END; 355 356 proc := Processor.New (testSetup); 357 proc. Setup; 358 results[passed] := 0; results[failed] := 0; 359 results[tolerated] := 0; results[skipped] := 0; 360 RunTests (testSetup, testSuite, proc, reportWriter, results); 361 proc. Cleanup; 362 363 Out.Ln; Out.Ln; 364 Out.String ("OUTCOME"); Out.Ln; 365 Out.String ("passed: "); Out.LongInt (results[passed], 0); 366 Out.String (", failed: "); Out.LongInt (results[failed], 0); 367 Out.String (", tolerated: "); Out.LongInt (results[tolerated], 0); 368 Out.String (", skipped: "); Out.LongInt (results[skipped], 0); Out.Ln; 369 Out.String ("--> "); 370 exitError := FALSE; 371 IF (results[failed] # 0) THEN 372 Out.String ("Processor incompatible to "); 373 exitError := TRUE; 374 ELSIF (results[tolerated] # 0) THEN 375 Out.String ("Processor accepts ") 376 ELSE 377 Out.String ("Processor is compliant to ") 378 END; 379 LongStrings.Short (testSetup. lang^, "?", str); 380 Out.String (str); Out.Ln; 381 382 (* writer := Writer.New (StdChannels.stdout. NewWriter(), 383 Latin1.factory, TRUE, 4); 384 testSetup. Write (writer); 385 writer. EndOfText; 386 387 writer := Writer.New (StdChannels.stdout. NewWriter(), 388 Latin1.factory, TRUE, 4); 389 testSuite. Write (writer); 390 writer. EndOfText*) 391 392 IF exitError THEN 393 HALT (1) 394 ELSE 395 HALT (0) 396 END 397END RunTests. 398 399