В думах о тестировании №4

Предыдущая серия была тут - http://18delphi.blogspot.ru/2013/11/3.html

И ещё немного попрограммировал и родилось вот что:

unit Script.Parser;

interface

uses
 Classes,
 CoreObject
 ;

{$IfNDef NoTesting}
 {$Define TestParser}
{$EndIf  NoTesting}

type
 TscriptParser = class(TCoreObject)
  private
   f_Stream : TStream;
   {$IfDef TestParser}
   f_GetCharLog : TStream;
   // - сразу думаем о тестировании, в этот поток будем выводить
   //   результат работы функции GetChar
   f_ReadLnLog : TStream;
   // - сразу думаем о тестировании, в этот поток будем выводить
   //   результат работы функции ReadLn
   f_TokenLog : TStream;
   // - сразу думаем о тестировании, в этот поток будем выводить
   //   результат работы функции NextToken
   {$EndIf TestParser}
   f_EOF : Boolean;
   f_CurrentLine : String;
   f_PosInCurrentLine : Integer;
   f_Token : String;
  {$IfDef TestParser}
  private
   procedure WriteLineToLog(const aLine: AnsiString; aLog: TStream);
  {$EndIf TestParser}
  protected
   procedure Cleanup; override;
   function ReadLn: String;
  protected
   function GetChar(out aChar: AnsiChar): Boolean;
  public
   constructor Create(const aStream : TStream; const aFileName : String); overload;
   constructor Create(const aFileName : String); overload;
   function EOF: Boolean;
   procedure NextToken;
  public
   property TokenString: String
    read f_Token;
 end;//TscriptParser

implementation

uses
 System.SysUtils
 ;

constructor TscriptParser.Create(const aStream : TStream; const aFileName : String);
begin
 inherited Create;
 f_PosInCurrentLine := 1;
 f_EOF := false;
 f_Stream := aStream;
 {$IfDef TestParser}
 f_GetCharLog := TFileStream.Create(aFileName + '.GetChar.log', fmCreate);
 f_ReadLnLog := TFileStream.Create(aFileName + '.ReadLn.log', fmCreate);
 f_TokenLog := TFileStream.Create(aFileName + '.Token.log', fmCreate);
 {$EndIf TestParser}
end;

constructor TscriptParser.Create(const aFileName : String);
var
 l_FileName : String;
begin
 l_FileName := ExtractFilePath(ParamStr(0)) + '\' + aFileName;
 Create(TFileStream.Create(l_FileName, fmOpenRead), l_FileName);
end;

procedure TscriptParser.Cleanup;
begin
 FreeAndNil(f_Stream);
 {$IfDef TestParser}
 FreeAndNil(f_TokenLog);
 FreeAndNil(f_GetCharLog);
 FreeAndNil(f_ReadLnLog);
 {$EndIf TestParser}
 inherited;
end;

function TscriptParser.GetChar(out aChar: AnsiChar): Boolean;
begin
 if (f_Stream.Read(aChar, SizeOf(aChar)) = SizeOf(aChar)) then
 begin
  Result := true;
  {$IfDef TestParser}
  f_GetCharLog.Write(aChar, SizeOf(aChar));
  {$EndIf TestParser}
 end
 else
  Result := false;
end;

{$IfDef TestParser}
procedure TscriptParser.WriteLineToLog(const aLine: AnsiString; aLog: TStream);
const
 cEOL : AnsiString = #13#10;
begin
  aLog.Write(@aLine[1], Length(aLine));
  aLog.Write(@cEOL[1], Length(cEOL));
end;
{$EndIf TestParser}

function TscriptParser.ReadLn: String;
{$IfDef TestParser}
var
 l_Result : AnsiString;
{$EndIf TestParser}
var
 l_Char : AnsiChar;
 l_Line : String;
 l_LineCommentPos : Integer;
begin
 {$IfDef TestParser}
 try
 {$EndIf TestParser}
  try
   l_Line := '';
   while GetChar(l_Char) do
   begin
    if (l_Char = #13) then
    begin
     if GetChar(l_Char) then
     begin
      if (l_Char = #10) then
      begin
       Result := l_Line;
       Exit;
      end//l_Char = #10
      else
       Assert(false, 'Что-то пошло не так, после символа 13 нет символа 10');
     end//GetChar(l_Char)
     else
      Assert(false, 'Что-то пошло не так, после символа 13 сразу конец файла');
    end;//l_Char = #13
    l_Line := l_Line + l_Char;
   end;//while GetChar(l_Char)
   f_EOF := true;
   Result := l_Line;
  finally
   l_LineCommentPos := Pos('//', Result);
   if (l_LineCommentPos > 0) then
   begin
    Delete(Result, l_LineCommentPos, Length(Result) - l_LineCommentPos + 1);
   end;//l_LineCommentPos > 0
  end;//try..finally
 {$IfDef TestParser}
 finally
  WriteLineToLog(Result, f_ReadLnLog);
 end;//try..finally
 {$EndIf TestParser}
end;

procedure TscriptParser.NextToken;
const
 cWhiteSpace = [#32,#9];
begin
 f_Token := '';
 while true do
 begin
  if (f_PosInCurrentLine >= Length(f_CurrentLine)) then
  begin
   // - Типа текущая строка ВСЯ обработана
   f_CurrentLine := '';
   f_PosInCurrentLine := 1;
  end;//f_PosInCurrentLine > Length(f_CurrentLine)
  while(f_CurrentLine = '') do
  begin
   f_CurrentLine := ReadLn;
   if (f_CurrentLine = '') then
    if f_EOF then
     Exit;
  end;//while(f_NextToken = '')
  while (f_PosInCurrentLine <= Length(f_CurrentLine)) do
   if (f_CurrentLine[f_PosInCurrentLine] in cWhiteSpace) then
    Inc(f_PosInCurrentLine)
   else
    break;
  // - Тут пропускаем пустые символы
  if (f_PosInCurrentLine <= Length(f_CurrentLine)) then
   break;
 end;//while true
 while (f_PosInCurrentLine <= Length(f_CurrentLine)) do
  if (not (f_CurrentLine[f_PosInCurrentLine] in cWhiteSpace)) then
  begin
   f_Token := f_Token + f_CurrentLine[f_PosInCurrentLine];
   Inc(f_PosInCurrentLine);
  end//not (f_CurrentLine[f_PosInCurrentLine] in cWhiteSpace)
  else
   break;
 // - Тут накапливаем НЕ пустые символы
 {$IfDef TestParser}
 WriteLineToLog(f_Token, f_TokenLog);
 {$EndIf TestParser}
 //f_CurrentLine := '';
end;

function TscriptParser.EOF: Boolean;
begin
 Result := f_EOF AND (f_CurrentLine = '');
end;

end.

Тестовый пример:

DoNothing // - пока ничего не делаем

// - и тут тоже пока ничего не делаем
DoNothing1 DoNothing2 // - и тут пока ничего не делаем, но проверяем ДВА токена
 DoNothing3 DoNothing4 // - и тут пока ничего не делаем, но проверяем ДВА токена с пробелом в НАЧАЛЕ
DoNothing5 DoNothing6// - и тут пока ничего не делаем, но проверяем ДВА токена БЕЗ пробелов в конце
DoNothing7// - пока ничего не делаем, но проверяем ОДИН токен БЕЗ пробелов в конце
DoNothing8 DoNothing9 DoNothing10 // - и тут пока ничего не делаем, но проверяем ТРИ токена
DoNothing11 DoNothing12 DoNothing13 DoNothing14 // - и тут пока ничего не делаем, но проверяем ЧЕТЫРЕ токена
   // - обрабатываем "чисто пустую строку"
'aString1'// - пытаемся обработать строку
'aString2 with spaces'// - пытаемся обработать строку с пробелами
   // - обрабатываем "чисто пустую строку" в конце файла

По-моему все ГРАНИЧНЫЕ условия - перебраны.