
{ ***** 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.











