{
 Test all with:
   ./runtests --format=plain --suite=TTestPascalParser

 Test specific with:
   ./runtests --format=plain --suite=TestRecord_ClassOperators
}
unit TestPascalParser;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, math, CodeToolManager, CodeCache, CodeAtom,
  LazLogger, fpcunit, testregistry, TestGlobals;

type

  { TCustomTestPascalParser }

  TCustomTestPascalParser = class(TTestCase)
  private
    FCode: TCodeBuffer;
  protected
    procedure SetUp; override;
    procedure TearDown; override;
    procedure DoParseModule(aCode: TCodeBuffer; out Tool: TCodeTool);
  public
    procedure Add(const s: string);
    procedure Add(Args: array of const);
    procedure StartUnit;
    procedure StartProgram;
    procedure ParseModule;
    property Code: TCodeBuffer read FCode;
  end;

  { TTestPascalParser }

  TTestPascalParser = class(TCustomTestPascalParser)
  published
    procedure TestAtomRing;
    procedure TestRecord_ClassOperators;
  end;

implementation

{ TCustomTestPascalParser }

procedure TCustomTestPascalParser.SetUp;
begin
  inherited SetUp;
  FCode:=CodeToolBoss.CreateFile('test1.pas');
end;

procedure TCustomTestPascalParser.TearDown;
begin
  inherited TearDown;
end;

procedure TCustomTestPascalParser.DoParseModule(aCode: TCodeBuffer; out
  Tool: TCodeTool);
var
  i: Integer;
  Line: String;
begin
  if not CodeToolBoss.Explore(aCode,Tool,true) then begin
    debugln(aCode.Filename+'------------------------------------------');
    for i:=1 to aCode.LineCount do begin
      Line:=aCode.GetLine(i-1,false);
      if i=CodeToolBoss.ErrorLine then
        System.Insert('|',Line,CodeToolBoss.ErrorColumn);
      debugln(Format('%:4d: ',[i]),Line);
    end;
    debugln('Error: '+CodeToolBoss.ErrorDbgMsg);
    Fail('PascalParser failed: '+CodeToolBoss.ErrorMessage);
  end;
end;

procedure TCustomTestPascalParser.Add(const s: string);
begin
  FCode.Source:=FCode.Source+s+LineEnding;
end;

procedure TCustomTestPascalParser.Add(Args: array of const);
begin
  FCode.Source:=FCode.Source+LinesToStr(Args);
end;

procedure TCustomTestPascalParser.StartUnit;
begin
  Add('unit test1;');
  Add('');
  Add('{$mode objfpc}{$H+}');
  Add('');
  Add('interface');
  Add('');
end;

procedure TCustomTestPascalParser.StartProgram;
begin
  Add('program test1;');
  Add('');
  Add('{$mode objfpc}{$H+}');
  Add('');
end;

procedure TCustomTestPascalParser.ParseModule;
var
  Tool: TCodeTool;
begin
  Add('end.');
  DoParseModule(Code,Tool);
end;

{ TTestPascalParser }

procedure TTestPascalParser.TestAtomRing;

  procedure CheckAtom(Msg: String; const Expected, Actual: TAtomPosition);
  begin
    AssertEquals(Msg+' StartPos',Expected.StartPos,Actual.StartPos);
    AssertEquals(Msg+' EndPos',Expected.EndPos,Actual.EndPos);
    if Expected.Flag<>Actual.Flag then
      Fail(Msg+' Flag Expected='+CommonAtomFlagNames[Expected.Flag]+' but found '+CommonAtomFlagNames[Actual.Flag]);
  end;

  procedure CheckIndexOf(Msg: string; R: TAtomRing);
  var
    i, Actual: Integer;
    P: TAtomPosition;
  begin
    for i:=1-R.PriorCount to R.NextCount do begin
      P:=R.GetAtomAt(i);
      if not R.IndexOf(P.StartPos,Actual) then
        Fail(Msg+' CheckIndexOf i='+IntToStr(i)+' IndexOf failed');
      AssertEquals(Msg+' CheckIndexOf',i,Actual);
    end;
  end;

var
  R: TAtomRing;
  P, P1, P2: TAtomPosition;
  i: Integer;
begin
  R:=TAtomRing.Create;
  try
    R.Size:=4;
    AssertEquals('1-empty count',0,R.PriorCount);
    AssertEquals('1-empty nextcount',0,R.NextCount);

    P1:=AtomPosition(1,2,cafWord);
    R.Add(P1);
    AssertEquals('2-first atom count',1,R.PriorCount);
    AssertEquals('2-first atom nextcount',0,R.NextCount);
    P:=R.GetAtomAt(0);
    CheckAtom('2-first atom',P1,P);

    CheckIndexOf('2-first atom',R);

    R.UndoLastAdd;
    //R.WriteDebugReport;
    AssertEquals('3-empty after undo count',0,R.PriorCount);
    AssertEquals('3-empty after undo nextcount',0,R.NextCount);

    P1:=AtomPosition(1,2,cafWord);
    R.Add(P1);
    //R.WriteDebugReport;
    AssertEquals('4-first atom count',1,R.PriorCount);
    AssertEquals('4-first atom nextcount',0,R.NextCount);
    P:=R.GetAtomAt(0);
    CheckAtom('4-first atom',P1,P);
    CheckIndexOf('4-first atom',R);

    P2:=AtomPosition(3,4,cafWord);
    R.Add(P2);
    //R.WriteDebugReport;

    AssertEquals('5-second atom count',2,R.PriorCount);
    AssertEquals('5-second atom nextcount',0,R.NextCount);
    P:=R.GetAtomAt(0);
    CheckAtom('5-second atom 0',P2,P);
    P:=R.GetAtomAt(-1);
    CheckAtom('5-second atom -1',P1,P);
    CheckIndexOf('5-second atom',R);

    R.UndoLastAdd;
    //R.WriteDebugReport;
    AssertEquals('6-undo after add two: count',1,R.PriorCount);
    AssertEquals('6-undo after add two: nextcount',1,R.NextCount);
    P:=R.GetAtomAt(0);
    CheckAtom('6-undo after add two: atom 0',P1,P);
    P:=R.GetAtomAt(1);
    CheckAtom('6-undo after add two: atom +1',P2,P);
    CheckIndexOf('6-undo after add two',R);

    P2:=AtomPosition(5,6,cafWord);
    R.Add(P2);
    //R.WriteDebugReport;

    AssertEquals('7-second atom count',2,R.PriorCount);
    AssertEquals('7-second atom nextcount',0,R.NextCount);
    P:=R.GetAtomAt(0);
    CheckAtom('7-second atom 0',P2,P);
    P:=R.GetAtomAt(-1);
    CheckAtom('7-second atom -1',P1,P);
    CheckIndexOf('7-second atom',R);

    R.Clear;
    //R.WriteDebugReport;
    for i:=1 to 5 do begin
      // add first
      P1:=AtomPosition(i*4,i*4+1,cafWord);
      R.Add(P1);
      //R.WriteDebugReport;
      AssertEquals('8-Added first: '+IntToStr(i)+' count',Min(i,R.Size),R.PriorCount);
      AssertEquals('8-Added first: '+IntToStr(i)+' nextcount',0,R.NextCount);
      P:=R.GetAtomAt(0);
      CheckAtom('8-Added first: atom 0',P1,P);
      CheckIndexOf('8-Added first',R);

      // add two
      P2:=AtomPosition(i*4+2,i*4+3,cafWord);
      R.Add(P2);
      //R.WriteDebugReport;
      AssertEquals('9-Added second: '+IntToStr(i)+' count',Min(i+1,R.Size),R.PriorCount);
      AssertEquals('9-Added second: '+IntToStr(i)+' nextcount',0,R.NextCount);
      P:=R.GetAtomAt(0);
      CheckAtom('9-Added second: '+IntToStr(i)+' atom 0',P2,P);
      P:=R.GetAtomAt(-1);
      CheckAtom('9-Added second: '+IntToStr(i)+' atom -1',P1,P);
      CheckIndexOf('9-Added second',R);

      // undo one
      R.UndoLastAdd;
      //R.WriteDebugReport;
      AssertEquals('10-Undo: '+IntToStr(i)+' count',Min(i,R.Size-1),R.PriorCount);
      AssertEquals('10-Undo: '+IntToStr(i)+' nextcount',1,R.NextCount);
      P:=R.GetAtomAt(0);
      CheckAtom('10-Undo: '+IntToStr(i)+' atom 0',P1,P);
      P:=R.GetAtomAt(1);
      CheckAtom('10-Undo: '+IntToStr(i)+' atom +1',P2,P);
      CheckIndexOf('10-Undo',R);
    end;

    FreeAndNil(R);
  finally
    if R<>nil then begin
      R.WriteDebugReport;
      R.Free;
    end;
  end;
end;

procedure TTestPascalParser.TestRecord_ClassOperators;
begin
  StartProgram;
  Add([
    'type',
    '  TFlag = (flag1);',
    '{$Define FPC_HAS_MANAGEMENT_OPERATORS}',
    '  TMyRecord = record',
    '    class operator Implicit(t: TMyRecord): TMyRecord;',
    '    class operator Explicit(t: TMyRecord): TMyRecord;',
    '    class operator Negative(t: TMyRecord): TMyRecord;',
    '    class operator Positive(t: TMyRecord): TMyRecord;',
    '    class operator Inc(t: TMyRecord): TMyRecord;',
    '    class operator Dec(t: TMyRecord): TMyRecord;',
    '    class operator LogicalNot(t: TMyRecord): TMyRecord;',
    '    class operator Trunc(t: TMyRecord): TMyRecord;',
    '    class operator Round(t: TMyRecord): TMyRecord;',
    '    class operator In(f: TFlag; t: TMyRecord): boolean;',
    '    class operator Equal(t1, t2: TMyRecord): boolean;',
    '    class operator NotEqual(t1, t2: TMyRecord): boolean;',
    '    class operator GreaterThan(t1, t2: TMyRecord): boolean;',
    '    class operator GreaterThanOrEqual(t1, t2: TMyRecord): boolean;',
    '    class operator LessThan(t1, t2: TMyRecord): boolean;',
    '    class operator LessThanOrEqual(t1, t2: TMyRecord): boolean;',
    '    class operator Add(t1, t2: TMyRecord): TMyRecord;',
    '    class operator Subtract(t1, t2: TMyRecord): TMyRecord;',
    '    class operator Multiply(t1, t2: TMyRecord): TMyRecord;',
    '    class operator Divide(t1, t2: TMyRecord): TMyRecord;',
    '    class operator IntDivide(t1, t2: TMyRecord): TMyRecord;',
    '    class operator Modulus(t1, t2: TMyRecord): TMyRecord;',
    '    class operator LeftShift(t1, t2: TMyRecord): TMyRecord;',
    '    class operator RightShift(t1, t2: TMyRecord): TMyRecord;',
    '    class operator LogicalAnd(b: boolean; t: TMyRecord): TMyRecord;',
    '    class operator LogicalOr(b: boolean; t: TMyRecord): TMyRecord;',
    '    class operator LogicalXor(b: boolean; t: TMyRecord): TMyRecord;',
    '    class operator BitwiseAnd(t1, t2: TMyRecord): TMyRecord;',
    '    class operator BitwiseOr(t1, t2: TMyRecord): TMyRecord;',
    '    class operator BitwiseXor(t1, t2: TMyRecord): TMyRecord;',
    '    // only IFDEF FPC_HAS_MANAGEMENT_OPERATORS',
    '    class operator Initialize(var t: TMyRecord);',
    '    class operator Finalize(var t: TMyRecord);',
    '    class operator Copy(var t: TMyRecord);',
    '    class operator AddRef(constref t1: TMyRecord ; var t2: TMyRecord);',
    '  end;',
    '',
    'class operator TMyRecord.Implicit(t: TMyRecord): TMyRecord;',
    'begin end;',
    '',
    '// only IFDEF FPC_HAS_MANAGEMENT_OPERATORS',
    'class operator TMyRecord.Initialize(var t: TMyRecord);',
    'begin end;',
    '',
    'begin'
    ]);
  ParseModule;
end;

initialization
  RegisterTest(TTestPascalParser);

end.