program program3(TotalOutput,output,StdOutFile); label 999; { used for disaster exits } const space= ' '; maxnumbersize= 15; { max number of characters in test number} numberoverflow= 16; { maxnumbersize + 1 } maxlinesize= 120; { size of line array } lineoverflow= 121; { maxlinesize + 1 } MaxStdFormSize= 21; { = MaxSections * MaxSubSize - see the function NumberOK } type numbersize= 1..maxnumbersize; linesize= 1..maxlinesize; index= 1..lineoverflow; charvectype= packed array[numbersize] of char; { used to hold test numbers } PtrToStoredLine= ^StoredLine; StoredLine= record TextLine : packed array[linesize] of char; length : 0..maxlinesize; next : PtrToStoredLine end; { used to store lines of text which are to be included in the analysis report. } TestNumber= record number: charvectype end; { holds the test number } messages= (pass, fail, deviates, quality, impldependent, impldefined, error, OutputFromTest, pretest, undefined); StandardForm= packed array[1..MaxStdFormSize] of char; { used to check that test numbers appear in ascending order } natural= 0..maxint; { very common type } linetype= array[linesize] of char; { used for line buffers } loopcontrol= (scanning,found,notfound); { for controlling scan loops } var TotalOutput, StdOutFile: text; { StdOutFile holds the standardized output TotalOutput produced by a validation } CurrentTest, PreviousTest: Testnumber; { PreviousTest holds the number of the last test to be processed correctly. } ThisTest, LastTest : StandardForm; { These variables hold test numbers in a standard form to allow the ordering of the tests to be checked. e.g. If PreviousTest.Number had the value '6.8.10.4-14 ' then LastTest would have the value '006008010004000000014' } FirstLinePtr, LastLinePtr: PtrToStoredLine; { Used to build up a linked list containing special text to be included in a report. } linecount, TotalSpecialLines: natural; { linecount - The current line number TotalSpecialLines - number of lines of special text produced by a test. } line: linetype; { the line buffer } linelength: 0..maxlinesize; { holds actual number of chars in line } DotSearching, LineTruncated, InputNextLine: boolean; { DotSearching - this is set to false after a line containing three dots, a valid message and a correct test number has been located. LineTruncated - set to false by procedure readaline if a line exceeds 120 characters. InputNextLine - set to false if the current line has to be re-processed. } state: loopcontrol; { Used in the scan procedure. } LastMessage, message: messages; ii, LastDigitPosition, FirstDigitPosition: index; { FirstDigitPosition ( LastDigitPosition) points to the first (last) character of the test number. ii - used for scanning the line buffer. } CharsInMessage: 0..maxlinesize; { Once three dots have been located, CharsInMessage is set to the number of of characters appearing before the first dot. } {================================================================} procedure readaline; { Reads a line into the line buffer and sets the linelength. A line containing 120 characters is truncated after the 120th character. } var pp : 0..lineoverflow; ch: char; begin LineTruncated := false; pp := 0; linecount := linecount + 1; while (not eoln(TotalOutput)) do begin pp := pp + 1; if (pp = lineoverflow) then begin { the line contains more than 120 characters } LineTruncated := true; { ignore the rest of the line } repeat read(TotalOutput, ch) until eoln(TotalOutput) end else read(TotalOutput, line[pp]) end; { get rid of the line-marker } readln(TotalOutput); { and set the line length } if (pp < lineoverflow) then linelength := pp else linelength := maxlinesize end; { of procedure readaline } {================================================================} procedure warning; { Standard warning message indicating that the current line has been ignored. } begin writeln(output, '=========='); write(output, ' WARNING: LINENUMBER ', linecount : 4); writeln(output, ' HAS BEEN IGNORED') end; { of procedure warning } {================================================================} function IsDigit(ch : char) : boolean; { This function checks if a character is a digit. } begin if ((ch >= '0') and (ch <= '9')) then IsDigit := true else IsDigit := false end; { of function Isdigit } {================================================================} function IsDot(ch : char) : boolean; { This function checks if a character is a dot. } begin if ch = '.' then IsDot := true else IsDot := false end; { of function IsDot } {================================================================} procedure scan(lowch,highch:char); { Scan moves the index ii along the line until it finds a character lying between lowch and highch inclusive. The value of the global variable 'state' is set accordingly. } begin { Set loop to scan forwards } state := scanning; { Loop invariant R1 = "characters from line[initial ii] to line[ii-1] are not in the desired subrange." } while (state = scanning) do begin if (ii > linelength) then { No more to go, so get out } state := notfound else if (line[ii] >= lowch) and (line[ii] <= highch) then state := found else { Char is not in range } ii := ii + 1 end { Return, leaving ii at found character } end; { of procedure scan } {================================================================} function ThreeDotsOnLine : boolean; { This function tries to find three consecutive dots in the line buffer. Note that if 4 (or more) consecutive dots are located then the function is set to false. } var NumberOfDots : 0..maxlinesize; exit : boolean; begin { start scanning at the beginning of the line } ii := 1; { look for a dot } scan('.','.'); if state = found then begin { determine the number of consecutive dots } NumberOfDots := 1; exit := false; repeat ii := ii + 1; if ii > linelength then exit := true else if IsDot(line[ii]) then NumberOfDots := NumberOfDots + 1 else exit := true until exit; { number of consecutive dots is known so } if NumberOfDots = 3 then begin ThreeDotsOnLine := true; { number of chars before first dot = ii - 4 } CharsInMessage := ii - 4; { first char of test number is contained in line[ii] } FirstDigitPosition := ii { return leaving ii at the character after the third dot } end else begin if NumberOfDots > 1 then begin { incorrect number of dots - ignore the current line } warning; write(output, NumberOfDots : 3, ' CONSECUTIVE DOTS'); writeln(output, ' HAVE BEEN LOCATED') end; ThreeDotsOnLine := false end end else { state = notfound - no dots in the current line } ThreeDotsOnLine := false end; { of function ThreeDotsOnLine } {================================================================} procedure DetermineMessage; { This procedure is called after three consecutive dots have been located and checks that the characters appearing before the first dot form a valid message. The global variable 'message' is set. } const MaxMessageSize = 25; { The string ' IMPLEMENTATION DEPENDENT' is the longest message and contains 25 (MaxMessageSize) characters. } MaxMessPlusOne = 26; { MaxMessageSize + 1 } MinMessageSize = 5; { The strings ' PASS' and ' FAIL' are the shortest messages and contain 5 characters. } PassMessage = ' PASS '; FailMessage = ' FAIL '; ImpDependentMessage = ' IMPLEMENTATION DEPENDENT'; ImpDefinedMessage = ' IMPLEMENTATION DEFINED '; DeviatesMessage = ' DEVIATES '; OutputMessage = ' OUTPUT FROM TEST '; ErrorMessage = ' ERROR '; PretestMessage = ' PRETEST '; QualityMessage = ' QUALITY '; type MessageSize = 1..MaxMessageSize; MessageType = packed array[MessageSize] of char; var TextOfMessage : MessageType; { TextofMessage holds all the characters appearing before the three dots (these should contain the message) and is padded out with spaces. } nn : 1..MaxMessPlusOne; begin { check the length of the messge } if (CharsInMessage >= MinMessageSize) and (CharsInMessage <= MaxMessageSize) then begin for nn := 1 to CharsInMessage do { copy in the message } TextOfMessage[nn] := line[nn]; for nn := CharsInMessage + 1 to MaxMessageSize do { space fill to allow string comparison } TextOfMessage[nn] := space; { now determine which message is present } if TextOfMessage = PassMessage then message := pass else if TextOfMessage = FailMessage then message := fail else if TextOfMessage = DeviatesMessage then message := deviates else if TextOfMessage = QualityMessage then message := quality else if TextOfMessage = ImpDependentMessage then message := impldependent else if TextOfMessage = ImpDefinedMessage then message := impldefined else if TextOfMessage = OutputMessage then message := OutputFromTest else if TextOfMessage = ErrorMessage then message := error else if TextOfMessage = PretestMessage then message := pretest else { an unknown message } message := undefined end else { message is either too long or too short } message := undefined; if message = undefined then begin warning; write(output, ' THREE DOTS HAVE BEEN FOUND BUT'); writeln(output, ' MESSAGE IS INVALID') end end; { of procedure DetermineMessage } {================================================================} function NumberOK : boolean; { This function checks that the characters after the three dots form a valid test number. The following items are checked: 1/ A minus sign is present 2/ Character after third dot is a digit 3/ All characters between the three dots and the minus sign are either digits or dots 4/ No consecutive dots in the test number 5/ Character before the minus sign is not a dot 6/ Character after minus sign is a digit } const zero = '000000000000000000000'; { A string containing 21 (MaxStdFormSize) which is used to initialise the variable 'ThisTest' } MaxSections = 7; MaxSubSize = 3; { A variable of type StandardForm is a string whose length equals MaxSections * MaxSubSize. The string is regarded as being split into MaxSections sections and each of these sections is of size MaxSubSize. } type SubSize = 1..MaxSubSize; var NoConsecutiveDots, ValidCharacter : boolean; counter, LengthOfNumber : index; section : 0..MaxSections; DigitsInSubsection : 0..MaxSubSize; Subsection : packed array[SubSize] of char; procedure CopySubsection; { local to function NumberOK } { The CopySubsection procedure copies sequences of digits (contained in the test number) into the global variable ThisTest. ThisTest is regarded as split up into 7 (MaxSections) sections, each section containing 3 (MaxSubSize) characters. In the body of the NumberOK function, a sequence of digits (in the test number) is stored in the array 'Subsection'. CopySubsection copies the 'Subsection' array into one of the 7 (MaxSections) sections of ThisTest; to allow checking of the order in which tests appear, the last digit in 'subsection' must appear in the third (MaxSubSize) character position of the current section. e.g. If the line buffer contains ' PASS...1.2.3.14.15-7' then ThisTest will equal '001002003014015000007'. Note that the digits appearing after the minus sign are always in the last (MaxSections) section. } var mm : 1..MaxSubSize; position : 0..MaxStdFormSize; begin { of CopySubsection } { Note: ThisTest[MaxSubSize * section] must contain the last digit of the array 'Subsection'. Set the variable 'position' so that ThisTest[position + 1] will hold subsection[1]. } position := MaxSubSize * section - DigitsInSubsection; for mm := 1 to DigitsInSubsection do ThisTest[position+mm] := Subsection[mm] end; { of procedure CopySubsection } procedure IncorrectNumber; { local to function NumberOK } { This procedure is called whenever an error is found in the test number. It prints out a warning and sets the value of function NumberOK to false. } begin warning; NumberOK := false end; { of procedure IncorrectNumber } begin { of function NumberOK } { DetermineMessage has left the variable 'ii' (which is used in the scan procedure) at the character after the third dot. } scan('-','-'); if (state = found) and (ii < linelength) then begin { A minus sign which is not at end of line has been found. } ii := FirstDigitPosition; if IsDigit(line[ii]) then begin { character after third dot is a digit } ThisTest := zero; ValidCharacter := true; section := 0; NoConsecutiveDots := true; while ValidCharacter do begin { This while loop checks that the characters between the three dots and minus sign are all either digits or dots. The loop should terminate (if the test is correct) when the minus sign is reached. } if IsDigit(line[ii]) then begin { a new section } section := section + 1; if section = MaxSections then begin warning; write(output, ' THE VARIABLE ''THIS TEST'' IS TOO'); writeln(output, ' SMALL TO HOLD THE PROGRAM NAME'); writeln(' PROGRAM ABORTED'); goto 999 end; { NOTE: NO CHECK THAT THERE ARE MORE THAN THREE DIGITS IN A SECTION} DigitsInSubsection := 1; { copy consecutive digits into array 'Subsection' } Subsection[1] := line[ii]; ii := ii + 1; while IsDigit(line[ii]) do begin DigitsInSubsection := DigitsInSubsection + 1; Subsection[DigitsInSubsection] := line[ii]; ii := ii + 1 end; { Now copy 'Subsection' into 'ThisTest' } CopySubsection end else if IsDot(line[ii]) then begin if IsDot(line[ii-1]) then begin { two consecutive dots in test number } NoConsecutiveDots := false; ValidCharacter := false end else ii := ii + 1 end else ValidCharacter := false end; { of while } if (line[ii] = '-') and (NoConsecutiveDots) and (not IsDot(line[ii-1])) then begin { Characters before minus sign conform to the number syntax. Now check for digits after the minus sign. } ii := ii + 1; if IsDigit(line[ii]) then begin { Test number is OK. The digits after the minus sign must go inte the last section of ThisTest so } section := MaxSections; DigitsInSubsection := 0; while (ii < linelength) and IsDigit(line[ii]) do begin DigitsInSubsection := DigitsInSubsection + 1; subsection[DigitsInSubsection] := line[ii]; ii := ii + 1 end; if (ii = linelength) and IsDigit(line[ii]) then begin DigitsInSubsection := DigitsInSubsection + 1; subsection[DigitsInSubsection] := line[ii]; ii := ii + 1 end; CopySubsection; { set the function to true } NumberOK := true; LengthOfNumber := ii - FirstDigitPosition; LastDigitPosition := ii - 1; { fill in CurrentTest.Number } with CurrentTest do begin for counter := 1 to LengthOfNumber do number[counter] := line[FirstDigitPosition - 1 + counter]; for counter := LengthOfNumber+1 to maxnumbersize do number[counter] := space end end else begin IncorrectNumber; write(output, ' CHARACTER AFTER MINUS SIGN'); writeln(output, ' IS NOT A DIGIT') end end else begin { Number syntax is incorrect - either line[ii] <> '-' or NoConsecutiveDots = false or IsDot(line[ii-1]) = true. } IncorrectNumber; if NoConsecutiveDots then begin if line[ii] <> '-' then begin writeln(output,' TEST NAME IS INCORRECT: A', ' CHARACTER BETWEEN THE THREE DOTS AND'); writeln(output, ' MINUS SIGN IS NOT A DIGIT', ' OR A DOT') end else begin writeln(output, ' TEST NAME INCORRECT: THE', ' CHARACTER BEFORE THE MINUS SIGN'); writeln(output, ' IS NOT A DIGIT') end end else begin writeln(output, ' TWO CONSECUTIVE DOTS IN TEST NAME') end end end else begin { character after the third dot is not a digit } IncorrectNumber; writeln(output, ' FIRST CHARACTER OF TEST NAME', ' IS NOT A DIGIT') end end else begin { Either there is no minus sign or minus sign is the last character on the line. } IncorrectNumber; if state = notfound then writeln(output, ' TEST NAME DOES NOT CONTAIN A MINUS SIGN') else writeln(output, ' NO NUMBER AFTER MINUS SIGN') end end; { of function NumberOK } {================================================================} procedure FindThreeDots; begin { This while loop looks for a sequence of three dots in the line buffer. Once three dots have been located the line is checked thoroughly to see if it contains a message (PASS, FAIL etc.) and a test number. } readaline; if ThreeDotsOnLine then begin DetermineMessage; if message <> undefined then begin if NumberOK then DotSearching := false end end end; {================================================================} function TestOrderOK: boolean; { This function just checks that test numbers appear in ascending order. } begin if ThisTest > LastTest then TestOrderOK := true else TestOrderOK := false end; { of function TestOrderOK } {================================================================} procedure PrintNumber; begin write(StdOutFile, CurrentTest.Number,'*'); end; { of procedure PrintNumberAndResult } {================================================================} procedure PrintMessage; begin write(StdOutFile, ord(message):4); end; {================================================================} procedure ProcessOutput; { This procedure is only called if an OutputFromTest message has been found. It copies subsequent lines of text into a linked list, upto (but not including) a line which contains three dots, a valid message, and a test number. If this number matches the number from the OutputFromTest message, the test number, messages, and the number of special lines stored in the list are printed on one line. All the text stored in the linked list is then printed by the PrintSpecialLines procedure. If the test numbers do not match, the stored text is ignored and the space occupied by the text is freed by GrabBackStorage. } var HelpPtr : PtrToStoredLine; procedure StoreALine; { local to procedure ProcessOutput } { This procedure stores the current line (of special text) at the end of a linked list. The pointer variable 'FirstLinePtr' points to the first line of text which has been stored. When the procedure is invoked, the pointer variable 'LastLinePtr' already points to the record in which the current line is to be stored. } var kk : index; begin { Store the current line in LastLinePtr^.TextLine } with LastLinePtr^ do begin for kk := 1 to linelength do TextLine[kk] := line[kk]; length := linelength end; HelpPtr := LastLinePtr; { allocate storage for the next line to be stored } new(LastLinePtr); { and set the link } HelpPtr^.next := LastLinePtr end; { of procedure StoreALine } procedure GrabBackStorage; { local to procedure ProcessOutput } { If a test has passed, the PrintSpecialLines procedure is called which exits with LastLinePtr = FirstLinePtr. In this case GrabBackStorage does nothing. However if the test has failed, the linked list contains unwanted information; this is disposed of using this procedure. } begin while LastLinePtr <> FirstLinePtr do begin HelpPtr := FirstLinePtr; FirstLinePtr := FirstLinePtr^.next; dispose(HelpPtr) end { exit leaving FirstLinePtr = LastLinePtr } end; { of procedure GrabBackStorage } procedure PrintSpecialLines; { local to procedure ProcessOutput } { This procedure just prints out all the lines stored in the linked list. Note that LastLinePtr does not contain a stored line. } var jj : index; begin while LastLinePtr <> FirstLinePtr do begin with FirstLinePtr^ do begin for jj := 1 to length do write(StdOutFile, TextLine[jj]) end; writeln(StdOutFile); HelpPtr := FirstLinePtr; FirstLinePtr := FirstLinePtr^.next; dispose(HelpPtr) end { exit leaving FirstLinePtr = LastLinePtr } end; { of procedure PrintSpecialLines } function PermissibleMessage : boolean; begin PermissibleMessage := not(message in [error,pretest,OutputFromTest]) end; begin { of ProcessOutput } DotSearching := true; TotalSpecialLines := 0; while (not eof(TotalOutput)) and DotSearching do begin FindThreeDots; if DotSearching then begin if LineTruncated then begin writeln(output,'=========='); writeln(output,' WARNING: A LINE OF SPECIAL TEXT HAD', ' TO BE TRUNCATED'); writeln(output,' LINENUMBER = ', linecount : 4) end; TotalSpecialLines := TotalSpecialLines + 1; StoreALine end end; if not DotSearching then begin if CurrentTest.number = PreviousTest.number then begin if PermissibleMessage then begin PrintMessage; write(StdOutFile,'*'); writeln(StdOutFile,TotalSpecialLines:4,'*'); PrintSpecialLines; end else begin writeln(StdOutFile,'*'); warning; writeln(output,' PRETEST, ERROR OR OUTPUT FROM TEST', ' MUST NOT FOLLOW AN OUTPUT FROM TEST MESSAGE'); end end else begin InputNextLine := false; writeln(StdOutFile,'*') end end else begin writeln(StdOutFile,'*'); end; if FirstLinePtr <> LastLinePtr then GrabBackStorage end; { of procedure ProcessOutput } {================================================================} procedure ProcessPretestTest; begin DotSearching := true; while (not eof(TotalOutput)) and DotSearching do FindThreeDots; if not DotSearching then begin if CurrentTest.number = PreviousTest.number then begin if message = error then begin PrintMessage; writeln(StdOutFile,'*') end else begin writeln(StdOutFile,'*'); warning; writeln(output,' PRETEST NUMBER = CURRENT TEST NUMBER', ' BUT MESSAGE <> ERROR') end end else begin writeln(StdOutFile,'*'); InputNextLine := false end end else begin writeln(StdOutFile,'*') end end; {================================================================} begin { of main program } linecount := 0; new(FirstLinePtr); LastLinePtr := FirstLinePtr; reset(TotalOutput); rewrite(StdOutFile); PreviousTest.Number := '1.0-0 '; LastTest := '001000000000000000000'; LastMessage := undefined; InputNextLine := true; DotSearching := true; repeat while (not eof(TotalOutput)) and (DotSearching) do FindThreeDots; if eof(TotalOutput) and DotSearching then goto 999; { Now the current line contains a valid message, three dots and a test number, } if CurrentTest.Number <> PreviousTest.Number then begin { Check the order of the current test. } if not TestOrderOK then if message = LastMessage then begin { test order is incorrect } writeln(output, '=========='); writeln(output, ' WARNING: LINENUMBER ',linecount:4, ' TEST NAME IS NOT IN ASCENDING ORDER'); end; PrintNumber; PrintMessage; PreviousTest := CurrentTest; LastTest := ThisTest; LastMessage := message; case message of pass, fail, deviates, quality, impldependent, impldefined, error : begin writeln(StdOutFile,'*'); end; pretest : begin if eof(TotalOutput) then writeln(StdOutFile,'*') else ProcessPretestTest end; OutputFromTest : begin if eof(TotalOutput) then writeln(StdOutFile,'*') else ProcessOutput end end end else begin { current test = previous test - this is not regarded as a failure since some tests may output the test number more than once. } warning; writeln(output, 'CURRENT TEST NAME = PREVIOUS TEST NAME') end; DotSearching := true; if not InputNextLine then begin InputNextLine := true; DotSearching := false end; until eof(TotalOutput) and DotSearching; 999: end.