{ ***** Modified pre-release version for PVS4.2, Dec. 85 ***** } program program4( AnalysisReportFile, StdCompFile, StdSuiteFile, StdOutFile, output); label 999; const space= ' '; ThreeSpaces= ' '; TwentyFiveSpaces= ' '; MaxNumberSize= 15; { maximum number of characters in a test number } TotalErrorConditions= 59; { This is the total number of error conditions in the ISO Standard. A summary of these error conditions appears in Appendix C-1 of the User Guide. } TotalDefinedConditions= 17; { This is the total number of implementation defined features in the ISO Standard. } TotalDependentConditions= 11; { This is the total number of implementation dependent features in the ISO Standard. } type ErrorType= 1..TotalErrorConditions; DefType= 1..TotalDefinedConditions; DepType= 1..TotalDependentConditions; NumberSize= 1..MaxNumberSize; charvectype= packed array[NumberSize] of char; { used to hold test numbers } natural= 0..maxint; LevelType= (zero,one); { holds the level number of a particular test } ClassType= (conformance,deviance,impldefined, impldependent,errorhandling, quality,extension); PossibleMessages= (pass,fail,deviates,qualty,impdependent, impdefined,error,OutputFromTest, pretest); SetOfPossibleMessages= set of PossibleMessages; TestFromStdSuite= record number : charvectype; level : LevelType; case class : ClassType of errorhandling : (ErrorNumber:ErrorType); impldefined : (DefNumber:DefType); impldependent : (DepNumber:DepType); conformance, deviance, quality, extension : () end; { Contains details which have been read in from StdSuiteFile. } var AnalysisReportFile, StdCompFile, StdSuiteFile, StdOutFile, FailConFile, FailDevFile, FailDefFile, FailDepFile, PassDepFile, PassDefFile, FailQualFile, PassQualFile, Level1FailFile, XtensionFailFile, ShouldDetectFile, ShouldNotDetectFile: text; { AnalysisReportFile : the validation report StdCompFile : standardized compiler description StdSuiteFile : standardized description of the suite StdOutFile : standardized output file All of the Fail files contain details of failed tests i.e. test number plus explanatory text. ShouldDetectFile : contains failed errorhandling tests which, according to the manufacturers, should have detected the errors, but failed to do so. ShouldNotDetectFile : contains all the other error- handling tests in which the errors were not detected. } WillBeDetected: array[ErrorType] of boolean; { holds manufacturers claims regarding error detection i.e.if the value of an array element is true, then the manufacturer has claimed that the error will always be detected. } SetOfMessages: SetOfPossibleMessages; TestLevel, LevelOfCompiler: LevelType; { TestLevel: level of current test } OutputTestNumber: charvectype; { Test number which has been read in from StdOutFile. } CurrentTest: TestFromStdSuite; { The current test which has been read in from StdSuiteFile } SpecialText: boolean; { Set to true if a test has produced output which is to be included in the report. } PretestHasFailed: boolean; ExplainLines, { number of lines of explanatory text for the current test } TotalSpecialLines, { If SpecialText = true, this variable holds the number of lines of text which are to be included in the report. } TotalLevel1Tests, Level1Rejected, EkstensionsRejected, PretestFailures, PretestPasses, OverallTestCount, SuiteLineCount, { Current line number of StdSuiteFile } OutLineCount: { Current line number of StdOutFile } natural; PassCount, FailCount, TestCount: array[LevelType,ClassType] of natural; AdjustdTestCount, AdjustdPassCount, AdjustdFailCount: array[ClassType] of natural; { For a level one implementation, no distinction is made between a level zero test and a level one test. However, a level zero implementation does make a distinction. When the analysis of all the validation output has finished, the values of these variables are assigned values (based on the values of the counts which make a distinction betwee level zero and level one. } TestClass: ClassType; { the class of the current test from the standardized suite file } procedure InitializeGlobalVariables; { This procedure just initializes all the pass/fail counts to zero and prepares all the files for reading/writing. } var klass : ClassType; lev : LevelType; begin for klass := conformance to extension do for lev := zero to one do begin TestCount[lev,klass] := 0; PassCount[lev,klass] := 0; FailCount[lev,klass] := 0 end; OverallTestCount := 0; TotalLevel1Tests := 0; Level1Rejected := 0; EkstensionsRejected := 0; PretestHasFailed := false; PretestPasses := 0; PretestFailures := 0; rewrite(AnalysisReportFile); reset(StdSuiteFile); reset(StdOutFile); rewrite(FailConFile); rewrite(FailDevFile); rewrite(FailDefFile); rewrite(PassDefFile); rewrite(FailDepFile); rewrite(PassDepFile); rewrite(FailQualFile); rewrite(PassQualFile); rewrite(Level1FailFile); rewrite(XtensionFailFile); rewrite(ShouldDetectFile); rewrite(ShouldNotDetectFile); OutLineCount := 0; SuiteLineCount := 0; end; { of procedure InitializeGlobalVariables} {=================================================================} procedure BlankLines(var AnyFile:text; Lines:integer); { This procedure writes Lines of blank lines to AnyFile. } var bl : natural; begin for bl := 1 to lines do writeln(AnyFile) end; { of procedure BlankLines} {=================================================================} procedure ExtractDetailsFromStandardCompilerDescription; { Input for this procedure is obtained from the standardized compiler description. This routine extracts certain information about the compiler and about test details e.g. the name of the machine, date of testing etc. Also, information regarding manufacturers claims on error detection is extracted. } const {EB} str1p1 = 'PASCAL VALIDATION REPORT'; str1p2 = 'PASCAL PROCESSOR IDENTIFICATION'; str1p3 = 'MACHINE '; str1p4 = 'COMPILER '; str1p5 = 'OPERATING SYSTEM '; str1p6 = 'TEST CONDITIONS'; str1p7 = 'DATE '; str1p8 = 'TESTER '; str1p9 = 'TEST SUITE VERSION '; str1p10 = 'EVALUATOR '; str1p11 = 'COMPILER OPTIONS USED DURING VALIDATION'; {EE} {FB str1p1 = 'RAPPORT DE VALIDATION PASCAL'; str1p2 = 'IDENTIFICATION DU PROCESSEUR PASCAL'; str1p3 = 'MACHINE '; str1p4 = 'COMPILATEUR '; str1p5 = 'SYSTEME D''EXPLOITATION'; str1p6 = 'CONDITION DU TEST'; str1p7 = 'DATE '; str1p8 = 'VALIDATEUR '; str1p9 = 'VERSION DU JEU DU TEST'; str1p10 = 'RAPPORTEUR '; str1p11 = 'OPTIONS DE COMPILATION UTILISEES LORS DE LA VALIDATION'; FE} MaxDetailSize = 22; type DetailSize = 1..MaxDetailSize; string = packed array[DetailSize] of char; procedure DetermineErrorDetection; { This procedure reads in the information on error detection into the boolean array WillBeDetected. The array is indexed using the error numbers appearing in Appendix C-1 of the User Guide. Each of the elements of the array is set to true/false depending on whether or not the manufacturer claims an error condition will be detected. } var ii : ErrorType; begin { The procedure expects a sequence of integers seperated by spaces or end of lines. Reading is terminated by an asterisk. } reset(StdCompFile); for ii := 1 to TotalErrorConditions do WillBeDetected[ii] := false; while StdCompFile^ <> '*' do begin read(StdCompFile,ii); WillBeDetected[ii] := true; while StdCompFile^ = space do get(StdCompFile) end end; { of procedure DetermineErrorDetection } procedure GetLevelOfCompiler; { Reads in the level of ISO 7185 to which the compiler is being tested. } var ch : char; begin { read past the asterisk and eoln symbol } readln(StdCompFile); read(StdCompFile,ch); LevelOfCompiler := zero; if ch = '1' then LevelOfCompiler := one else if ch <> '0' then { Level zero has been assumed. } end; { of procedure GetLevelOfCompiler } procedure GetDetailsOf(Detail:string); { Copies characters from StdCompFile (upto asterisk) into the AnalysisReportFile. } var ii, CharsInDetail : DetailSize; begin write(AnalysisReportFile,' '); CharsInDetail := MaxDetailSize; while Detail[CharsInDetail] = ' ' do CharsInDetail := CharsInDetail - 1; for ii := 1 to CharsInDetail do write(AnalysisReportFile,Detail[ii]); write(AnalysisReportFile,' : '); readln(StdCompFile); while StdCompFile^ <> '*' do begin if eoln(StdCompFile) then begin writeln(AnalysisReportFile); write(AnalysisReportFile,' '); get(StdCompFile) end else begin write(AnalysisReportFile,StdCompFile^); get(StdCompFile) end end; writeln(AnalysisReportFile) end; { of procedure GetDetailsOf } procedure GetCompilerOptions; { Copies text (upto an asterisk) into the report. } begin write(AnalysisReportFile,' '); readln(StdCompFile); while StdCompFile^ <> '*' do begin if eoln(StdCompFile) then begin writeln(AnalysisReportFile); write(AnalysisReportFile,' '); get(StdCompFile) end else begin write(AnalysisReportFile,StdCompFile^); get(StdCompFile) end end; readln(StdCompFile); writeln(AnalysisReportFile) end; { of procedure GetCompilerOptions } begin BlankLines(AnalysisReportFile,2); writeln(AnalysisReportFile,TwentyFiveSpaces,str1p1); BlankLines(AnalysisReportFile,2); writeln(AnalysisReportFile,str1p2); DetermineErrorDetection; GetLevelOfCompiler; GetDetailsOf(str1p3); GetDetailsOf(str1p4); GetDetailsOf(str1p5); BlankLines(AnalysisReportFile,2); writeln(AnalysisReportFile,str1p6); GetDetailsOf(str1p7); GetDetailsOf(str1p8); GetDetailsOf(str1p9); GetDetailsOf(str1p10); BlankLines(AnalysisReportFile,2); writeln(AnalysisReportFile,str1p11); GetCompilerOptions; BlankLines(AnalysisReportFile,2); end; { of proc ExtractDetailsFromStandardCompilerDescription} {=================================================================} procedure ReadTestFromStdOutFile; { This procedure reads in details of a test from StdOutFile. } const {EB} str2p1 = 'TOTAL SPECIAL LINES HAS JUST BEEN READ BUT NEXT'; str2p2 = ' CHARACTER IS NOT AN ASTERISK'; str2p3 = 'OUT LINE COUNT = '; str2p4 = 'PROGRAM ABORTED - PLEASE INVESTIGATE'; {EE} {FB str2p1 = '"TOTAL SPECIAL LINES" A ETE LU MAIS LE PROCHAIN'; str2p2 = ' CARACTERE N''EST PAS UN ASTERISQUE'; str2p3 = '"OUT LINE COUNT" = '; str2p4 = 'PROGRAMME ABORTE - FAITES DES RECHERCHES'; FE} var i : NumberSize; helpint : natural; function converted(j : natural) : PossibleMessages; begin case j of 0 : converted := pass; 1 : converted := fail; 2 : converted := deviates; 3 : converted := qualty; 4 : converted := impdependent; 5 : converted := impdefined; 6 : converted := error; 7 : converted := OutputFromTest; 8 : converted := pretest; end end; begin SetOfMessages := []; OutLineCount := OutLineCount + 1; { Read a test number. } for i := 1 to MaxNumberSize do read(StdOutFile,OutputTestNumber[i]); get(StdOutFile); while StdOutFile^ <> '*' do begin { Read all the messages produced by a test. } read(StdOutFile,helpint); SetOfMessages := SetOfMessages + [converted(helpint)] end; get(StdOutFile); if not eoln(StdOutFile) then begin { The test has produced some useful output which is to be included in the report. } SpecialText := true; read(StdOutFile,TotalSpecialLines); if StdOutFile^ <> '*' then begin writeln(output,str2p1); writeln(output,str2p2); writeln(output,str2p3, OutLineCount:1); writeln(output,str2p4); goto 999 end end else SpecialText := false; readln(StdOutFile); end; { of procedure ReadTestFromStdOutFile} {=================================================================} procedure ReadAtestFromStdSuiteFile; { This procedure reads in details of a test from StdSuiteFile. } const {EB} str3p1 = 'ERROR IN STD SUITE FILE'; str3p2 = 'CHARACTER AFTER THE NUMBER '; str3p3 = 'IS NOT AN ASTERISK'; str3p4 = 'CURRENT TEST NUMBER = '; str3p5 = 'SUITE LINE COUNT = '; str3p6 = 'PROGRAM ABORTED - PLEASE INVESTIGATE '; {EE} {FB str3p1 = 'ERREUR DANS "STD SUITE FILE"'; str3p2 = 'LE CARACTERE APRES LE NOMBRE '; str3p3 = 'N''EST PAS UN ASTERISQUE'; str3p4 = '"CURRENT TEST NUMBER" = '; str3p5 = '"SUITE LINE COUNT" = '; str3p6 = 'PROGRAMME ABORTE - FAITES DES RECHERCHES '; FE} var i : NumberSize; helpint : integer; begin SuiteLineCount := SuiteLineCount + 1; with CurrentTest do begin { read in the test number } for i := 1 to MaxNumberSize do read(StdSuiteFile,number[i]); get(StdSuiteFile); { determine the level of the test } read(StdSuiteFile,helpint); case helpint of 0 : level := zero; 1 : begin level := one; TotalLevel1Tests := TotalLevel1Tests + 1 end end; get(StdSuiteFile); { determine the class of the test } read(StdSuiteFile,helpint); case helpint of 0: class := conformance; 1: class := deviance; 2: class := impldefined; 3: class := impldependent; 4: class := errorhandling; 5: class := quality; 6: class := extension end; { case} TestCount[level,class] := TestCount[level,class] + 1; TestClass := class; TestLevel := level; get(StdSuiteFile); if class in [errorhandling,impldefined,impldependent] then begin case class of errorhandling : read(StdSuiteFile,ErrorNumber); impldefined : read(StdSuiteFile,DefNumber); impldependent : read(StdSuiteFile,DepNumber) end; get(StdSuiteFile) end; { Now determine the number of explanatory lines of text for this particular test. } read(StdSuiteFile,ExplainLines); if StdSuiteFile^ <> '*' then begin writeln(output,str3p1); writeln(output,str3p2,ExplainLines:3, str3p3); writeln(output,str3p4, CurrentTest.Number); writeln(output,str3p5,SuiteLineCount:3); writeln(output,str3p6); goto 999 end; OverallTestCount := OverallTestCount + 1; if OverallTestCount mod 20 = 0 then begin write(output,OverallTestCount); write(output,' '); writeln(output,CurrentTest.Number) end; readln(StdSuiteFile); end { with } end; { of procedure ReadAtestFromStdSuiteFile} {=================================================================} procedure CopyLine(var ReadFile,PrintFile:text); { This procedure copies a line of text from the Read File to the Print File. } var ch : char; begin while not eoln(ReadFile) do begin read(ReadFile,ch); write(PrintFile,ch) end; readln(ReadFile); writeln(PrintFile) end; { of procedure CopyLine} {=================================================================} procedure AdvanceStdSuiteFile; { If a test has passed, the lines of explanatory text for that test (which are in the StdSuiteFile) are not needed. This procedure just advances the Std Suite File to the next test. } var i : natural; begin for i := 1 to ExplainLines do readln(StdSuiteFile); SuiteLineCount := SuiteLineCount + ExplainLines end; { of procedure AdvanceStdSuiteFile } {=================================================================} procedure ListExplanation(var ReadFile, PrintFile:text; TextLines:natural); { When a test fails, the explanatory text in the Std Suite File must be copied to one of the fail files. This procedure reads 'Text Lines' of text from Read File and outputs them to Print File in a certain format. NOTE: this procedure is also used when printing out any special text which has been produced by a test. } const {EB} str4p1 = 'Error Number = D.'; str4p2 = 'Reference Number = E.'; str4p3 = 'Reference Number = F.'; str4p4 = ' PRETEST HAS FAILED'; {EE} {FB str4p1 = 'Numero d''erreur = D.'; str4p2 = 'Numero de reference = E.'; str4p3 = 'Numero de reference = F.'; str4p4 = ' LE PRETEST A ECHOUE'; FE} SixSpaces = ' '; var i : natural; begin writeln(PrintFile); write(PrintFile,ThreeSpaces); write(PrintFile,CurrentTest.number); if TestClass = errorhandling then begin write(PrintFile, str4p1, CurrentTest.ErrorNumber:1); if PretestHasFailed then write(PrintFile,str4p4) end else if TestClass = impldefined then write(PrintFile, str4p2, CurrentTest.DefNumber:1) else if TestClass = impldependent then write(PrintFile, str4p3, CurrentTest.DepNumber:1); writeln(PrintFile); for i := 1 to TextLines do begin write(PrintFile,SixSpaces); CopyLine(ReadFile,PrintFile) end end; { of procedure ListExplanation} {=================================================================} procedure PrintExplanation; { This procedure calls List Explanation having firstly determined which files are to be used. } begin case TestClass of conformance: ListExplanation(StdSuiteFile, FailConFile,ExplainLines); deviance: ListExplanation(StdSuiteFile, FailDevFile,ExplainLines); impldefined: ListExplanation(StdSuiteFile, FailDefFile,ExplainLines); impldependent: ListExplanation(StdSuiteFile, FailDepFile,ExplainLines); quality: ListExplanation(StdSuiteFile, FailQualFile,ExplainLines); errorhandling: if WillBeDetected[CurrentTest.ErrorNumber] then ListExplanation(StdSuiteFile, ShouldDetectFile,ExplainLines) else ListExplanation(StdSuiteFile, ShouldNotDetectFile,ExplainLines) end { case} end; { of procedure PrintExplanation} {=================================================================} procedure CopyFile(var FromFile, ToFile:text); begin while not eof(FromFile) do CopyLine(FromFile,ToFile) end; { of procedure CopyFile} {=================================================================} procedure IgnoreSpecialText; { If a test has produced special text and its class is not in [impldefined,impldependent,quality] then the text is ignored. } var i : natural; begin for i := 1 to TotalSpecialLines do readln(StdOutFile); OutLineCount := OutLineCount + TotalSpecialLines end; {=================================================================} procedure ProcessSuccessfulTest; { Increments the pass count and prints any special text. } begin PassCount[TestLevel,TestClass] := PassCount[TestLevel,TestClass] + 1; if SpecialText then begin if not (TestClass in [impldefined,impldependent,quality]) then IgnoreSpecialText else begin if TestClass = impldefined then ListExplanation(StdOutFile,PassDefFile, TotalSpecialLines) else if TestClass = impldependent then ListExplanation(StdOutFile,PassDepFile, TotalSpecialLines) else if TestClass = quality then ListExplanation(StdOutFile,PassQualFile, TotalSpecialLines); OutLineCount := OutLineCount + TotalSpecialLines end end; AdvanceStdSuiteFile end; { of procedure ProcessSuccessfulTest} {=================================================================} procedure ProcessFailedTest; { This procedure increments the fail count and prints out the explanatory text contained in StdSuiteFile. } begin FailCount[TestLevel,TestClass] := FailCount[TestLevel,TestClass] + 1; PrintExplanation end; { of procedure ProcessFailedTest} {=================================================================} procedure ProcessNoOutputTest; { Called whenever a test does not produce any output. } begin if (LevelOfCompiler = zero) and (CurrentTest.Level = one) then begin { A level zero processor has rejected a level one test as required. } PassCount[TestLevel,TestClass] := PassCount[TestLevel,TestClass] + 1; AdvanceStdSuiteFile; Level1Rejected := Level1Rejected + 1 end else if TestClass = extension then begin { An extension test has been rejected as required. } PassCount[TestLevel,TestClass] := PassCount[TestLevel,TestClass] + 1; AdvanceStdSuiteFile; EkstensionsRejected := EkstensionsRejected + 1 end else begin case TestClass of conformance, impldefined, impldependent, quality : ProcessFailedTest; deviance : {ProcessSuccessfulTest;} begin PassCount[TestLevel,TestClass] := PassCount[TestLevel,TestClass] + 1; AdvanceStdSuiteFile end; errorhandling : begin PretestHasFailed := true; ProcessFailedTest; PretestFailures := PretestFailures + 1; PretestHasFailed := false; end end { case} end end; { of procedure ProcessNoOutputTest} {=================================================================} function ValidMessage : boolean; { Returns true if the messages produced by a particular test are appropriate for the class of test. } var ValiddMessage : boolean; begin ValiddMessage := true; case TestClass of conformance: if (SetOfMessages - [pass,fail,OutputFromTest]) <> [] then ValiddMessage := false; deviance: if (SetOfMessages - [deviates,OutputFromTest]) <> [] then ValiddMessage := false; impldefined: if (SetOfMessages - [fail,impdefined,OutputFromTest]) <> [] then ValiddMessage := false; impldependent: if (SetOfMessages - [fail,impdependent,OutputFromTest]) <> [] then ValiddMessage := false; errorhandling: if (SetOfMessages - [error,pretest,OutputFromTest]) <> [] then ValiddMessage := false; quality: if (SetOfMessages - [qualty,fail,OutputFromTest]) <> [] then ValiddMessage := false; extension: end; ValidMessage := ValiddMessage end; { of function ValidMessage} {=================================================================} procedure CheckAndPrintResult; { Called if a test has produced some messages e.g. pass, deviates, quality etc. It determines if a test has passed or failed. If a test has failed, the test number and the explanatory text for the test (contained in StdSuiteFile) is copied to the AnalysisReportFile. } const {EB} str6p1 = 'PRETEST HAS FAILED BUT ERRORHANDLING TEST RAN TO COMPLETION'; str6p2 = 'OUTPUT TEST NUMBER = '; str6p3 = 'OUT LINE COUNT = '; {EE} {FB str6p1 = 'LE PRETEST A ECHOUE MAIS LE TEST "DETECTION D''ERREUR" A ETE EXECUTE'; str6p2 = '"OUTPUT TEST NUMBER" = '; str6p3 = '"OUT LINE COUNT" = '; FE} begin if (LevelOfCompiler = zero) and (CurrentTest.Level = one) then begin { A Level1 test has been executed (either partially or completely) on a Level0 processor. The test has failed. } FailCount[TestLevel,TestClass] := FailCount[TestLevel,TestClass] + 1; ListExplanation(StdSuiteFile, Level1FailFile,ExplainLines); if SpecialText then IgnoreSpecialText end else if TestClass = extension then begin { An extension test has executed successfully. The test has failed. } FailCount[TestLevel,TestClass] := FailCount[TestLevel,TestClass] + 1; ListExplanation(StdSuiteFile, XtensionFailFile,ExplainLines); if SpecialText then IgnoreSpecialText end else begin if [pass,qualty,impdefined,impdependent] * SetOfMessages <> [] then ProcessSuccessfulTest else if [error,pretest] * SetOfMessages <> [] then begin SetOfMessages := SetOfMessages - [OutputFromTest]; if SetOfMessages = [error,pretest] then begin { pretest passed but error not detected } ProcessFailedTest; PretestPasses := PretestPasses + 1; if SpecialText then IgnoreSpecialText end else if SetOfMessages = [pretest] then begin { pretest has passed and error has been detected } PretestPasses := PretestPasses + 1; ProcessSuccessfulTest end else begin {pretest has failed but error test ran to completion} PretestHasFailed := true; ProcessFailedTest; PretestHasFailed := false; PretestFailures := PretestFailures +1; writeln(output,str6p1); writeln(output,str6p2,OutputTestNumber); writeln(output,str6p3,OutLineCount:1); if SpecialText then IgnoreSpecialText end end else begin if SetOfMessages = [OutputFromTest] then ProcessNoOutputTest else begin { message is either fail or deviates } ProcessFailedTest; if SpecialText then IgnoreSpecialText end end end end; { of procedure CheckAndPrintResult} {=================================================================} procedure PrintInvalidMessage; { Called if a test has output a message which could not have originated from the current test e.g. a conformance test cannot output a DEVIATES message. } const {EB} str7p1 = 'MESSAGE(S) PRODUCED ARE INVALID FOR THIS CLASS'; str7p2 = 'OF TEST. THE MESSAGES ARE:'; str7p3 = 'CURRENT TEST NUMBER = '; str7p4 = 'OUT LINE COUNT = '; {EE} {FB str7p1 = 'LE(S) MESSAGE(S) PRODUIT(S) EST(SONT) INVALIDE(S) POUR CETTE CLASSE'; str7p2 = 'DE TEST. LES MESSAGES SONT:'; str7p3 = '"CURRENT TEST NUMBER" = '; str7p4 = '"OUT LINE COUNT" = '; FE} var Message : PossibleMessages; procedure PrintMessage; begin case Message of pass : write(output,'''PASS'' '); fail : write(output,'''FAIL'' '); impdependent : write(output,'''IMPLEMENTATION DEPENDENT'' '); impdefined : write(output,'''IMPLEMENTATION DEFINED'' '); deviates : write(output,'''DEVIATES'' '); OutputFromTest : write(output,'''OUTPUT FROM TEST'' '); error : write(output,'''ERROR'' '); pretest : write(output,'''PRETEST'' '); qualty : write(output,'''QUALITY'' '); end end; begin writeln(output,str7p1); writeln(output,str7p2); for Message := pass to pretest do if Message in SetOfMessages then PrintMessage; writeln(output); writeln(output,str7p3, CurrentTest.number); writeln(output,str7p4,OutLineCount:1) end; { of procedure PrintInvalidMessage} {=================================================================} procedure ErrorInStdOutFile; { Called when eof(StdSuiteFile) = true and eof(StdOutFile = false. } const {EB} str8p1 = 'ERROR - ALL VALIDATION OUTPUT SHOULD HAVE BEEN PROCESSED'; str8p2 = 'BUT EOF(STD OUT FILE) = FALSE. NONEXISTENT TEST NUMBER?'; str8p3 = 'OUT LINE COUNT = '; str8p4 = 'OUTPUT TEST NUMBER = '; {EE} {FB str8p1 = 'ERREUR - TOUTES LES SORTIES DE VALIDATION AUARIENT DU ETRE TRAITEES'; str8p2 = 'MAIS EOF(STD OUT FILE) = FALSE. NUMERO DE TEST INEXISTANT?'; str8p3 = '"OUT LINE COUNT" = '; str8p4 = '"OUTPUT TEST NUMBER" = '; FE} begin writeln(output,str8p1); writeln(output,str8p2); writeln(output,str8p3, OutLineCount:1); writeln(output,str8p4,OutputTestNumber) end; {=================================================================} procedure AdjustTestCount; { This procedure determines the pass/fail statistics depending on the level of the implementation. This avoids having many conditional statements in the print procedures. } var klass : ClassType; begin if LevelOfCompiler = one then begin for klass := conformance to extension do begin AdjustdTestCount[klass] := TestCount[zero,klass] + TestCount[one,klass]; AdjustdPassCount[klass] := PassCount[zero,klass] + PassCount[one,klass]; AdjustdFailCount[klass] := FailCount[zero,klass] + FailCount[one,klass]; end end else begin for klass := conformance to extension do begin AdjustdTestCount[klass] := TestCount[zero,klass]; AdjustdPassCount[klass] := PassCount[zero,klass]; AdjustdFailCount[klass] := FailCount[zero,klass]; end end end; { of procedure AdjustTestCount} {=================================================================} procedure PrintManufacturersComplianceStatement; { This procedure copies the remaining text in StdCompFile to AnalysisReportFile. } begin CopyFile(StdCompFile,AnalysisReportFile) end; {=================================================================} { The remaining procedures print out the Automatic Analysis Report. } {=================================================================} procedure PrintConformanceSection; const {EB} str9p1 = 'CONFORMANCE TESTS'; str9p2 = 'Total number of Conformance tests = '; str9p3 = 'Number of tests passed = '; str9p4 = 'Number of tests failed = '; str9p5 = 'Details of failed tests:'; {EE} {FB str9p1 = 'TESTS "CONFORMITE"'; str9p2 = 'Nombre total de tests "Conformite" = '; str9p3 = 'Nombre de tests ayant reussi = '; str9p4 = 'Nombre de tests ayant echoue = '; str9p5 = 'Details des tests ayant echoue:'; FE} begin BlankLines(AnalysisReportFile,2); writeln(AnalysisReportFile,str9p1); writeln(AnalysisReportFile); writeln(AnalysisReportFile,str9p2, AdjustdTestCount[conformance]:3); writeln(AnalysisReportFile,str9p3, AdjustdPassCount[conformance]:3); writeln(AnalysisReportFile,str9p4, AdjustdFailCount[conformance]:3); if AdjustdFailCount[conformance] <> 0 then begin writeln(AnalysisReportFile); writeln(AnalysisReportFile,str9p5); reset(FailConFile); CopyFile(FailConFile,AnalysisReportFile) end end; { of procedure PrintConformanceSection} {=================================================================} procedure PrintDevianceSection; const {EB} str10p1 = 'DEVIANCE TESTS'; str10p2 = 'Total number of Deviance tests = '; str10p3 = 'Number of tests which detected deviations = '; str10p4 = 'Number of tests which did not detect deviations = '; str10p5 = 'Details of deviating tests:'; {EE} {FB str10p1 = 'TESTS "DEVIANCE"'; str10p2 = 'Nombre total de tests "Deviance" = '; str10p3 = 'Nombres de tests qui detectent une deviance = '; str10p4 = 'Nombre de tests qui ne detectent pas de deviance = '; str10p5 = 'Details des tests deviants:'; FE} begin BlankLines(AnalysisReportFile,2); writeln(AnalysisReportFile,str10p1); writeln(AnalysisReportFile); writeln(AnalysisReportFile,str10p2, AdjustdTestCount[deviance]:3); writeln(AnalysisReportFile,str10p3, AdjustdPassCount[deviance]:3); writeln(AnalysisReportFile,str10p4, AdjustdFailCount[deviance]:3); if AdjustdFailCount[deviance] <> 0 then begin writeln(AnalysisReportFile); writeln(AnalysisReportFile,str10p5); reset(FailDevFile); CopyFile(FailDevFile,AnalysisReportFile) end end; { of procedure PrintDevianceSection} {=================================================================} procedure PrintErrorhandlingSection; const {EB} str11p1 = 'ERRORHANDLING TESTS'; str11p2 = 'The manufacturer claimed detection of the following error numbers'; str11p3 = 'Total number of Errorhandling tests = '; str11p4 = 'Number of pretests which passed = '; str11p5 = 'Number of pretests which failed = '; str11p6 = 'Number of tests which detected errors = '; str11p7 = 'Number of tests which did not detect errors = '; str11p8 = 'DETAILS OF TESTS IN WHICH ERRORS SHOULD HAVE BEEN DETECTED:'; str11p9 = 'Details of tests in which an error condition was not detected:'; {EE} {FB str11p1 = 'TESTS "DETECTION D''ERREUR"'; str11p2 = 'Le realisateur pretend detecter les erreurs suivantes'; str11p3 = 'Nombre total de tests "Detection d''erreur = '; str11p4 = 'Nombre de pretests ayant reussi = '; str11p5 = 'Nombre de pretests ayant echoue = '; str11p6 = 'Nombre de tests detectant une erreur = '; str11p7 = 'Nombre de tests ne detectant pas d''erreur = '; str11p8 = 'DETAILS DES TESTS QUI AURAIENT DU DETECTER DES ERREURS:'; str11p9 = 'Details des tests n''ayant detecte aucune erreur:'; FE} var i : ErrorType; j : natural; begin reset(ShouldDetectFile); j := 0; BlankLines(AnalysisReportFile,2); writeln(AnalysisReportFile,str11p1); writeln(AnalysisReportFile); writeln(AnalysisReportFile,str11p2); write(AnalysisReportFile,' '); for i := 1 to TotalErrorConditions do if WillBeDetected[i] then begin j := j + 1; write(AnalysisReportFile,'D.',i:1,', '); if ((j mod 8) = 0) and (i <> TotalErrorConditions) then begin writeln(AnalysisReportFile); write(AnalysisReportFile,' ') end; end; writeln(AnalysisReportFile); writeln(AnalysisReportFile,str11p3, AdjustdTestCount[errorhandling]:3); writeln(AnalysisReportFile,str11p4,PretestPasses:3); writeln(AnalysisReportFile,str11p5, PretestFailures:3); writeln(AnalysisReportFile,str11p6, AdjustdPassCount[errorhandling]:3); writeln(AnalysisReportFile,str11p7, AdjustdFailCount[errorhandling]:3); if not eof(ShouldDetectFile) then begin writeln(AnalysisReportFile); writeln(AnalysisReportFile,str11p8); CopyFile(ShouldDetectFile,AnalysisReportFile); end; reset(ShouldNotDetectFile); if not eof(ShouldNotDetectFile) then begin writeln(AnalysisReportFile); writeln(AnalysisReportFile,str11p9); CopyFile(ShouldNotDetectFile,AnalysisReportFile) end end; { of procedure PrintErrorhandlingSection} {=================================================================} procedure PrintDefinedSection; const {EB} str12p1 = 'IMPLEMENTATION DEFINED TESTS'; str12p2 = 'Total number of Implementation Defined tests = '; str12p3 = 'Number of tests passed = '; str12p4 = 'Number of tests failed = '; str12p5 = 'Details of successful tests:'; str12p6 = 'Details of failed tests:'; {EE} {FB str12p1 = 'TESTS "DEFINI PAR L''IMPLEMENTATION"'; str12p2 = 'Nombre total de tests "defini par l''implementation" = '; str12p3 = 'Nombre de tests ayant reussi = '; str12p4 = 'Nombre de tests ayant echoue = '; str12p5 = 'Details des tests ayant reussi:'; str12p6 = 'Details des tests ayant echoue:'; FE} begin reset(FailDefFile); BlankLines(AnalysisReportFile,2); writeln(AnalysisReportFile,str12p1); writeln(AnalysisReportFile); writeln(AnalysisReportFile,str12p2, AdjustdTestCount[impldefined]:3); writeln(AnalysisReportFile,str12p3, AdjustdPassCount[impldefined]:3); writeln(AnalysisReportFile,str12p4, AdjustdFailCount[impldefined]:3); writeln(AnalysisReportFile); writeln(AnalysisReportFile,str12p5); reset(PassDefFile); CopyFile(PassDefFile,AnalysisReportFile); if AdjustdFailCount[impldefined] <> 0 then begin writeln(AnalysisReportFile); writeln(AnalysisReportFile,str12p6); CopyFile(FailDefFile,AnalysisReportFile) end end; { of procedure PrintDefinedSection} {=================================================================} procedure PrintDependentSection; const {EB} str13p1 = 'IMPLEMENTATION DEPENDENT TESTS'; str13p2 = 'Total number of Implementation Dependent tests = '; str13p3 = 'Number of tests which produced informative output = '; str13p4 = 'Number of tests which did not produce informative output = '; str13p5 = 'Details of tests which produced informative output:'; str13p6 = 'Details of tests which did not produce informative output:'; {EE} {FB str13p1 = 'TESTS "DEPENDANT DE L''IMPLEMENTATION"'; str13p2 = 'Nombre total de tests "dependant de l''implementation" = '; str13p3 = 'Nombre de tests ayant produit de l''information = '; str13p4 = 'Nombre de tests n''ayant pas produit d''information = '; str13p5 = 'Details des tests ayant produit de l''information:'; str13p6 = 'Details des tests n''ayant pas produit d''information:'; FE} begin BlankLines(AnalysisReportFile,2); writeln(AnalysisReportFile,str13p1); writeln(AnalysisReportFile); writeln(AnalysisReportFile,str13p2, AdjustdTestCount[impldependent]:3); writeln(AnalysisReportFile,str13p3, AdjustdPassCount[impldependent]:3); writeln(AnalysisReportFile,str13p4, AdjustdFailCount[impldependent]:3); reset(PassDepFile); if not eof(PassDepFile) then begin writeln(AnalysisReportFile); writeln(AnalysisReportFile,str13p5); CopyFile(PassDepFile,AnalysisReportFile); end; reset(FailDepFile); if not eof(FailDepFile) then begin writeln(AnalysisReportFile); writeln(AnalysisReportFile,str13p6); CopyFile(FailDepFile,AnalysisReportFile) end end; { of procedure PrintDependentSection} {=================================================================} procedure PrintQualitySection; const {EB} str14p1 = 'QUALITY TESTS'; str14p2 = 'Total number of Quality tests = '; str14p3 = 'Number of tests passed = '; str14p4 = 'Number of tests failed = '; str14p5 = 'Details of failed tests:'; str14p6 = 'Details of successful tests:'; {EE} {FB str14p1 = 'TESTS "QUALITE"'; str14p2 = 'Nombre total de tests "Qualite" = '; str14p3 = 'Nombre de tests ayant reussi = '; str14p4 = 'Nombre de tests ayant echoue = '; str14p5 = 'Details des tests ayant echoue:'; str14p6 = 'Details des tests ayant reussi:'; FE} begin BlankLines(AnalysisReportFile,2); writeln(AnalysisReportFile,str14p1); writeln(AnalysisReportFile); writeln(AnalysisReportFile,str14p2, AdjustdTestCount[quality]:3); writeln(AnalysisReportFile,str14p3, AdjustdPassCount[quality]:3); writeln(AnalysisReportFile,str14p4, AdjustdFailCount[quality]:3); if AdjustdFailCount[quality] <> 0 then begin writeln(AnalysisReportFile); writeln(AnalysisReportFile,str14p5); reset(FailQualFile); CopyFile(FailQualFile,AnalysisReportFile); end; reset(PassQualFile); if not eof(PassQualFile) then begin writeln(AnalysisReportFile); writeln(AnalysisReportFile,str14p6); CopyFile(PassQualFile,AnalysisReportFile) end end; { of procedure PrintQualitySection} {=================================================================} procedure PrintLevel1Section; const {EB} str15p1 = 'LEVEL ONE TESTS - ADDITIONAL DEVIANCE TESTS FOR A LEVEL ZERO COMPILER'; str15p2 = 'All Level 1 tests have been rejected'; str15p3 = ' out of '; str15p4 = ' Level 1 tests have been rejected'; str15p5 = 'Details of Level 1 tests which were not rejected:'; {EE} {FB str15p1 = 'TESTS "NIVEAU 1" - TESTS DEVIANTS POUR UN COMPILATEUR NIVEAU 0'; str15p2 = 'Tous les tests "Niveau 1" ont ete rejetes'; str15p3 = ' d''entre '; str15p4 = ' tests "Niveau 1" ont ete rejetes'; str15p5 = 'Details des tests "Niveau 1" n''ayant pas ete rejetes:'; FE} begin if LevelOfCompiler = zero then begin BlankLines(AnalysisReportFile,2); writeln(AnalysisReportFile,str15p1); writeln(AnalysisReportFile); if TotalLevel1Tests = Level1Rejected then writeln(AnalysisReportFile,str15p2) else begin { At least one Level 1 test has executed on a level zero processor. } writeln(AnalysisReportFile, Level1Rejected:1, str15p3, TotalLevel1Tests:1,str15p4); writeln(AnalysisReportFile); writeln(AnalysisReportFile,str15p5); reset(Level1FailFile); CopyFile(Level1FailFile,AnalysisReportFile) end end end; { of procedure PrintLevel1Section} {=================================================================} procedure PrintExtensionSection; const {EB} str16p1 = 'EXTENSION TESTS'; str16p2 = 'Total number of Extension tests = '; str16p3 = 'All Extension tests have been rejected'; str16p4 = ' out of '; str16p5 = ' Extension tests have been rejected'; str16p6 = 'Details of Extension tests which were not rejected:'; {EE} {FB str16p1 = 'TESTS "EXTENSIONS"'; str16p2 = 'Nombre total de tests "Extensions" = '; str16p3 = 'Tous les tests "Extensions" ont ete rejetes'; str16p4 = ' d''entre '; str16p5 = ' tests "Extensions" ont ete rejetees'; str16p6 = 'Details des tests "Extensions" n''ayant pas ete rejetes:'; FE} begin BlankLines(AnalysisReportFile,2); writeln(AnalysisReportFile,str16p1); writeln(AnalysisReportFile); writeln(AnalysisReportFile, str16p2, AdjustdTestCount[extension]:1); if AdjustdTestCount[extension] = EkstensionsRejected then writeln(AnalysisReportFile,str16p3) else begin { At least one extension test has been executed. } writeln(AnalysisReportFile, EkstensionsRejected:1,str16p4, AdjustdTestCount[extension]:1,str16p5); writeln(AnalysisReportFile); writeln(AnalysisReportFile,str16p6); reset(XtensionFailFile); CopyFile(XtensionFailFile,AnalysisReportFile) end end; { of procedure PrintExtensionSection} {=================================================================} procedure PrintAutomaticAnalysisReport; const {EB} str17p1 = 'DETAILS OF TESTS'; str17p2 = 'PRINTING COMPLIANCE STATEMENT'; str17p3 = 'PRINTING CONFORMANCE SECTION'; str17p4 = 'PRINTING DEVIANCE SECTION'; str17p5 = 'PRINTING LEVEL1SECTION'; str17p6 = 'PRINTING ERROR HANDLING SECTION'; str17p7 = 'PRINTING IMPLEMENTATION DEFINED SECTION'; str17p8 = 'PRINTING IMPLEMENTATION DEPENDENT SECTION'; str17p9 = 'PRINTING QUALITY SECTION'; str17p10= 'PRINTING EXTENSION SECTION'; {EE} {FB str17p1 = 'DETAILS DES TESTS'; str17p2 = 'PRINTING COMPLIANCE STATEMENT'; str17p3 = 'PRINTING CONFORMANCE SECTION'; str17p4 = 'PRINTING DEVIANCE SECTION'; str17p5 = 'PRINTING LEVEL1SECTION'; str17p6 = 'PRINTING ERROR HANDLING SECTION'; str17p7 = 'PRINTING IMPLEMENTATION DEFINED SECTION'; str17p8 = 'PRINTING IMPLEMENTATION DEPENDENT SECTION'; str17p9 = 'PRINTING QUALITY SECTION'; str17p10= 'PRINTING EXTENSION SECTION'; FE} begin writeln(output,str17p2); PrintManufacturersComplianceStatement; BlankLines(AnalysisReportFile,2); writeln(AnalysisReportFile,TwentyFiveSpaces,str17p1); writeln(output,str17p3); PrintConformanceSection; writeln(output,str17p4); PrintDevianceSection; writeln(output,str17p5); PrintLevel1Section; writeln(output,str17p6); PrintErrorhandlingSection; writeln(output,str17p7); PrintDefinedSection; writeln(output,str17p8); PrintDependentSection; writeln(output,str17p9); PrintQualitySection; writeln(output,str17p10); PrintExtensionSection; end; { of procedure PrintAutomaticAnalysisReport} {=================================================================} procedure PrintStatistics; { This procedure prints out the pass/ fail rates for all the tests in the form of a table. Note that pretests are counted separately. } const {EB} str18p1 ='PASS/FAIL RATE IS > THAN 100. ALTER PROC. PRINTSTATISTICS'; str18p2 = 'PASS/FAIL |'; str18p3 = 'DETECTED/NOT DETECTED |'; str18p4 = 'QUALITY/FAIL |'; str18p5 = 'PRINTING STATISTICS TABLE'; str18p6 = 'STATISTICAL SUMMARY OF THE VALIDATION'; str18p7 = 'Conformance |'; str18p8 = 'Deviance |'; str18p9 = 'Pretests |'; str18p10 = 'Error Handling |'; str18p11 = 'Implementation Defined |'; str18p12 = 'Implementation Dependent |'; str18p13 = 'Quality |'; str18p14 = 'Extension |'; str18p15 = 'Level 1 |'; str18p16 = ' Total'; str18p17 = ' Grand Total |'; {EE} {FB str18p1 ='PASS/FAIL RATE IS > THAN 100. ALTER PROC. PRINTSTATISTICS'; str18p2 = 'REUSSI/ECHOUE |'; str18p3 = 'DETECTE/PAS DETECTE |'; str18p4 = 'QUALITE/ECHOUE |'; str18p5 = 'PRINTING STATISTICS TABLE'; str18p6 = 'STATISTICAL SUMMARY OF THE VALIDATION'; str18p7 = 'Conformite |'; str18p8 = 'Deviance |'; str18p9 = 'Pretests |'; str18p10 = 'Detection d''erreur |'; str18p11 = 'Defini par l''implementation |'; str18p12 = 'Dependant de l''implementation |'; str18p13 = 'Qualite |'; str18p14 = 'Extension |'; str18p15 = 'Niveau 1 |'; str18p16 = ' Total'; str18p17 = ' Grand Total |'; FE} type string26 = packed array[1..26] of char; string31 = packed array[1..31] of char; var PassLevel1,FailLevel1,GrandTotal: natural; procedure PrintOneLine(ClassString:string31; PassRate,FailRate:natural; PassFailString:string26; Total:natural); begin if (PassRate > 1000) or (FailRate > 1000) then writeln(output,str18p1); write(AnalysisReportFile,'|',ClassString, PassRate:3,'/',FailRate:1); if FailRate < 10 then write(AnalysisReportFile,' ') else if FailRate < 100 then write(AnalysisReportFile,' '); writeln(AnalysisReportFile,PassFailString,Total:3,'|'); GrandTotal := GrandTotal + Total end; begin writeln(output,str18p5); BlankLines(AnalysisReportFile,4); writeln(AnalysisReportFile,str18p6); BlankLines(AnalysisReportFile,2); GrandTotal := 0; writeln(AnalysisReportFile,str18p16); writeln(AnalysisReportFile, '====================================================================='); PrintOneLine(str18p7, AdjustdPassCount[conformance],AdjustdFailCount[conformance], str18p2, AdjustdPassCount[conformance]+AdjustdFailCount[conformance]); PrintOneLine(str18p8, AdjustdPassCount[deviance],AdjustdFailCount[deviance], str18p2, AdjustdPassCount[deviance]+AdjustdFailCount[deviance]); PrintOneLine(str18p9, PretestPasses,PretestFailures, str18p2, PretestPasses+PretestFailures); PrintOneLine(str18p10, AdjustdPassCount[errorhandling],AdjustdFailCount[errorhandling], str18p3, AdjustdPassCount[errorhandling]+AdjustdFailCount[errorhandling]); PrintOneLine(str18p11, AdjustdPassCount[impldefined],AdjustdFailCount[impldefined], str18p2, AdjustdPassCount[impldefined]+AdjustdFailCount[impldefined]); { Note that the current version of program4 judges an implementation dependent test to have passed if it executes to completion. But dependent tests must be regarded as error handling tests. Thus the pass and fail rates should be switched. In the next call of 'PrintOneLine', the pass/fail rates have been switched. } PrintOneLine(str18p12, AdjustdFailCount[impldependent],AdjustdPassCount[impldependent], str18p3, AdjustdFailCount[impldependent]+AdjustdPassCount[impldependent]); PrintOneLine(str18p13, AdjustdPassCount[quality],AdjustdFailCount[quality], str18p4, AdjustdPassCount[quality]+AdjustdFailCount[quality]); PrintOneLine(str18p14, AdjustdPassCount[extension],AdjustdFailCount[extension], str18p3, AdjustdPassCount[extension]+AdjustdFailCount[extension]); if (LevelOfCompiler = zero) and (TotalLevel1Tests <> Level1Rejected) then begin PassLevel1 := TotalLevel1Tests - Level1Rejected + PassCount[one,errorhandling]; FailLevel1 := Level1Rejected + FailCount[one,errorhandling]; { Note that PassLevel1 and FailLevel1 count Pretests and Errorhandling tests separately. } PrintOneLine(str18p15, PassLevel1,FailLevel1, str18p3, PassLevel1 + FailLevel1); end; writeln(AnalysisReportFile, '====================================================================='); writeln(AnalysisReportFile,str18p17,GrandTotal:3,'|'); end; { of procedure PrintStatistics} {=================================================================} begin { BODY OF MAIN PROGRAM } InitializeGlobalVariables; ExtractDetailsFromStandardCompilerDescription; ReadTestFromStdOutFile; while not eof(StdSuiteFile) do begin ReadATestFromStdSuiteFile; { check if the two test numbers match } if CurrentTest.number = OutputTestNumber then begin { A test has produced a pass/fail message. Check that the message is appropriate for the class of test. } if ValidMessage then CheckAndPrintResult else begin { Message produced is invalid for the class of test. } PrintInvalidMessage; ProcessFailedTest; if SpecialText then IgnoreSpecialText end; if not eof(StdOutFile) then { there is still some validation output to be processed } ReadTestFromStdOutFile else while not eof(StdSuiteFile) do begin { all validation output has been processed so we only need to process the standardized suite file. The remaining tests have not produced any output. } ReadATestFromStdSuiteFile; ProcessNoOutputTest end end else begin { CurrentTest.Number <> OutputTestNumber CurrentTest has not produced any output. } ProcessNoOutputTest end; end; { All validation output must have been processed by now but the check must be made. } if not eof(StdOutFile) then { Either the standardized output file contains a test number which does not exist in the suite, or textfiles do not adhere to the Standard. } ErrorInStdOutFile; AdjustTestCount; PrintAutomaticAnalysisReport; PrintStatistics; 999: end.