Codeunit 130401 CAL Test Management

namespace System.TestTools.TestRunner;

using System.Reflection;
using System.Tooling;
using System.Utilities;

codeunit 130401 "CAL Test Management"
{
    SingleInstance = true;

    trigger OnRun()
    begin
    end;

    var
        Window: Dialog;
        Mode: Option Test,Publish;
        AddingTestCodeunitsMsg: Label 'Adding Test Codeunits @1@@@@@@@', Locked = true;
        SelectTestsToRunQst: Label 'Active &Line,Active &Codeunit,&All', Locked = true;
        SelectTestsToImportQst: Label '&Select Test Codeunits,&All Test Codeunits', Locked = true;
        SelectTestsToImportFromTCMQst: Label '&Select Test Codeunits,&All Test Codeunits,Get Tests Codeunits based on Selected &Objects', Locked = true;
        SelectCodeunitsToRunQst: Label ',Active &Codeunit,&All', Locked = true;
        DefaultTxt: Label 'DEFAULT', Locked = true;
        DefaultSuiteTxt: Label 'Default Suite - Autogenerated', Locked = true;
        ObjectNotCompiledErr: Label 'Object not compiled.', Locked = true;
        WindowUpdateDateTime: DateTime;
        NoOfRecords: Integer;
        i: Integer;
        AddingTestsBasedOnChurnMsg: Label 'Adding %1 test codeunits based on churn @1@@@@@@@', Locked = true;
        NoModifiedObjectsFoundMsg: Label 'No modified objects found.', Locked = true;

    procedure SETPUBLISHMODE()
    begin
        Mode := Mode::Publish;
    end;

    procedure SETTESTMODE()
    begin
        Mode := Mode::Test;
    end;

    procedure ISPUBLISHMODE(): Boolean
    begin
        exit(Mode = Mode::Publish);
    end;

    procedure ISTESTMODE(): Boolean
    begin
        exit(Mode = Mode::Test);
    end;

    procedure DoesTestCodeunitExist(ID: Integer): Boolean
    var
        AllObjWithCaption: Record AllObjWithCaption;
    begin
        AllObjWithCaption.Reset();
        AllObjWithCaption.SetRange("Object ID", ID);
        AllObjWithCaption.SetRange("Object Type", AllObjWithCaption."Object Type"::Codeunit);
        AllObjWithCaption.SetRange("Object Subtype", 'Test');
        exit(not AllObjWithCaption.IsEmpty);
    end;

    [Scope('OnPrem')]
    procedure GetTestCodeunitsSelection(CALTestSuite: Record "CAL Test Suite")
    var
        CALTestLine: Record "CAL Test Line";
        AllObjWithCaption: Record AllObjWithCaption;
        TempAllObjWithCaption: Record AllObjWithCaption temporary;
        CALTestCoverageMap: Record "CAL Test Coverage Map";
        CALTestGetCodeunits: Page "CAL Test Get Codeunits";
        Selection: Integer;
    begin
        if CALTestCoverageMap.IsEmpty() then
            Selection := StrMenu(SelectTestsToImportQst, 1)
        else
            Selection := StrMenu(SelectTestsToImportFromTCMQst, 1);

        if Selection = 0 then
            exit;

        case Selection of
            1:
                begin
                    CALTestGetCodeunits.LookupMode := true;
                    if CALTestGetCodeunits.RunModal() = ACTION::LookupOK then begin
                        CALTestGetCodeunits.SetSelectionFilter(AllObjWithCaption);
                        AddTestCodeunits(CALTestSuite, AllObjWithCaption);
                    end;
                end;
            2:
                begin
                    CALTestLine.SetRange("Test Suite", CALTestSuite.Name);
                    CALTestLine.DeleteAll(true);
                    if GetTestCodeunits(TempAllObjWithCaption) then
                        RefreshSuite(CALTestSuite, TempAllObjWithCaption);
                end;
            3:
                GetTestCodeunitsForSelectedObjects(CALTestSuite.Name);
        end;
    end;

    local procedure GetTestCodeunits(var ToAllObjWithCaption: Record AllObjWithCaption): Boolean
    var
        FromAllObjWithCaption: Record AllObjWithCaption;
    begin
        FromAllObjWithCaption.SetRange("Object Type", ToAllObjWithCaption."Object Type"::Codeunit);
        FromAllObjWithCaption.SetRange("Object Subtype", 'Test');
        if FromAllObjWithCaption.Find('-') then
            repeat
                ToAllObjWithCaption := FromAllObjWithCaption;
                ToAllObjWithCaption.Insert();
            until FromAllObjWithCaption.Next() = 0;

        exit(ToAllObjWithCaption.Find('-'));
    end;

    local procedure GetTestCodeunitsForObjects(var AllObj: Record AllObj; CALTestSuiteName: Code[10])
    var
        TempMissingCUId: Record "Integer" temporary;
        TempTestCodeunitID: Record "Integer" temporary;
        CALTestMissingCodeunits: Page "CAL Test Missing Codeunits";
        TestLineNo: Integer;
        TestCodeunitsNumber: Integer;
    begin
        AllObj.SetFilter("Object Type", '<>%1', AllObj."Object Type"::TableData);
        if AllObj.FindSet() then begin
            TestCodeunitsNumber := GetTotalTestCodeunitIDs(AllObj, TempTestCodeunitID);
            OpenWindow(StrSubstNo(AddingTestsBasedOnChurnMsg, TestCodeunitsNumber), TestCodeunitsNumber);
            TestLineNo := GetLastTestLineNo(CALTestSuiteName);
            if TempTestCodeunitID.FindSet() then
                repeat
                    if DoesTestCodeunitExist(TempTestCodeunitID.Number) then begin
                        if not TestLineExists(CALTestSuiteName, TempTestCodeunitID.Number) then begin
                            TestLineNo := TestLineNo + 10000;
                            AddTestLine(CALTestSuiteName, TempTestCodeunitID.Number, TestLineNo);
                            UpdateWindow();
                        end
                    end else begin
                        TempMissingCUId.Number := TempTestCodeunitID.Number;
                        TempMissingCUId.Insert();
                    end;
                until TempTestCodeunitID.Next() = 0;
            Window.Close();
        end else
            Message(NoModifiedObjectsFoundMsg);

        if not TempMissingCUId.IsEmpty() then begin
            Commit();
            CALTestMissingCodeunits.Initialize(TempMissingCUId, CALTestSuiteName);
            CALTestMissingCodeunits.RunModal();
        end;
    end;

    local procedure GetTestCodeunitsForSelectedObjects(CALTestSuiteName: Code[10])
    var
        AllObj: Record AllObj;
        ALTestObjectsToSelect: Page "AL Test Objects To Select";
    begin
        ALTestObjectsToSelect.LookupMode := true;
        ALTestObjectsToSelect.SetTableView(AllObj);
        if ALTestObjectsToSelect.RunModal() = ACTION::LookupOK then begin
            ALTestObjectsToSelect.SetSelectionFilter(AllObj);
            GetTestCodeunitsForObjects(AllObj, CALTestSuiteName);
        end;
    end;

    local procedure GetTotalTestCodeunitIDs(var AllObj: Record AllObj; var TestCodeunitID: Record "Integer"): Integer
    var
        CALTestCoverageMap: Record "CAL Test Coverage Map";
    begin
        repeat
            CALTestCoverageMap.Reset();
            CALTestCoverageMap.SetRange("Object ID", AllObj."Object ID");
            CALTestCoverageMap.SetRange("Object Type", AllObj."Object Type");
            if CALTestCoverageMap.FindSet() then
                repeat
                    if not TestCodeunitID.Get(CALTestCoverageMap."Test Codeunit ID") then begin
                        TestCodeunitID.Number := CALTestCoverageMap."Test Codeunit ID";
                        TestCodeunitID.Insert();
                    end;
                until CALTestCoverageMap.Next() = 0;
        until AllObj.Next() = 0;
        exit(TestCodeunitID.Count);
    end;

    local procedure GetLastTestLineNo(TestSuiteName: Code[10]) LineNo: Integer
    var
        CALTestLine: Record "CAL Test Line";
    begin
        CALTestLine.SetRange("Test Suite", TestSuiteName);
        if CALTestLine.FindLast() then
            LineNo := CALTestLine."Line No.";
    end;

    [Scope('OnPrem')]
    procedure CreateNewSuite(var NewSuiteName: Code[10])
    var
        CALTestSuite: Record "CAL Test Suite";
    begin
        NewSuiteName := DefaultTxt;
        CALTestSuite.Init();
        CALTestSuite.Validate(Name, NewSuiteName);
        CALTestSuite.Validate(Description, DefaultSuiteTxt);
        CALTestSuite.Validate(Export, false);
        CALTestSuite.Insert(true);
    end;

    local procedure RefreshSuite(CALTestSuite: Record "CAL Test Suite"; var AllObjWithCaption: Record AllObjWithCaption)
    var
        CALTestLine: Record "CAL Test Line";
        LineNo: Integer;
    begin
        LineNo := LineNo + 10000;

        CALTestLine.Init();
        CALTestLine.Validate("Test Suite", CALTestSuite.Name);
        CALTestLine.Validate("Line No.", LineNo);
        CALTestLine.Validate("Line Type", CALTestLine."Line Type"::Group);
        CALTestLine.Validate(Name, DefaultSuiteTxt);
        CALTestLine.Validate(Run, true);
        CALTestLine.Insert(true);

        AddTestCodeunits(CALTestSuite, AllObjWithCaption);
    end;

    procedure AddTestCodeunits(CALTestSuite: Record "CAL Test Suite"; var AllObjWithCaption: Record AllObjWithCaption)
    var
        TestLineNo: Integer;
    begin
        if AllObjWithCaption.Find('-') then begin
            TestLineNo := GetLastTestLineNo(CALTestSuite.Name);
            OpenWindow(AddingTestCodeunitsMsg, AllObjWithCaption.Count);
            repeat
                TestLineNo := TestLineNo + 10000;
                AddTestLine(CALTestSuite.Name, AllObjWithCaption."Object ID", TestLineNo);
                UpdateWindow();
            until AllObjWithCaption.Next() = 0;
            Window.Close();
        end;
    end;

    [Scope('OnPrem')]
    procedure AddMissingTestCodeunits(var TestCodeunitIds: Record "Integer"; TestSuiteName: Code[10])
    var
        AllObj: Record AllObj;
        TestLineNo: Integer;
    begin
        TestLineNo := GetLastTestLineNo(TestSuiteName);
        OpenWindow(StrSubstNo(AddingTestsBasedOnChurnMsg, TestCodeunitIds.Count), TestCodeunitIds.Count);

        repeat
            AllObj.SetRange("Object Type", AllObj."Object Type"::Codeunit);
            AllObj.SetRange("Object ID", TestCodeunitIds.Number);
            if AllObj.FindFirst() then begin
                TestLineNo := TestLineNo + 10000;
                AddTestLine(TestSuiteName, AllObj."Object ID", TestLineNo);
                UpdateWindow();
                TestCodeunitIds.Delete();
            end;
        until TestCodeunitIds.Next() = 0;

        Window.Close();
    end;

    local procedure AddTestLine(TestSuiteName: Code[10]; TestCodeunitId: Integer; LineNo: Integer)
    var
        CALTestLine: Record "CAL Test Line";
        AllObj: Record AllObj;
        CodeunitIsValid: Boolean;
    begin
        if TestLineExists(TestSuiteName, TestCodeunitId) then
            exit;

        CALTestLine.Init();
        CALTestLine.Validate("Test Suite", TestSuiteName);
        CALTestLine.Validate("Line No.", LineNo);
        CALTestLine.Validate("Line Type", CALTestLine."Line Type"::Codeunit);
        CALTestLine.Validate("Test Codeunit", TestCodeunitId);
        CALTestLine.Validate(Run, true);

        CALTestLine.Insert(true);

        AllObj.SetRange("Object Type", AllObj."Object Type"::Codeunit);
        AllObj.SetRange("Object ID", TestCodeunitId);
        if Format(AllObj."App Package ID") <> '' then
            CodeunitIsValid := true;

        if not CodeunitIsValid then
            CodeunitIsValid := AllObj.FindFirst();

        if CodeunitIsValid then begin
            SETPUBLISHMODE();
            CALTestLine.SetRecFilter();
            CODEUNIT.Run(CODEUNIT::"CAL Test Runner", CALTestLine);
        end else begin
            CALTestLine.Validate(Result, CALTestLine.Result::Failure);
            CALTestLine.Validate("First Error", ObjectNotCompiledErr);
            CALTestLine.Modify(true);
        end;
    end;

    local procedure TestLineExists(TestSuiteName: Code[10]; TestCodeunitId: Integer): Boolean
    var
        CALTestLine: Record "CAL Test Line";
    begin
        CALTestLine.SetRange("Test Suite", TestSuiteName);
        CALTestLine.SetRange("Test Codeunit", TestCodeunitId);
        exit(not CALTestLine.IsEmpty);
    end;

    procedure ExtendTestCoverage(TestCodeunitId: Integer)
    var
        CodeCoverage: Record "Code Coverage";
        CALTestCoverageMap: Record "CAL Test Coverage Map";
    begin
        CodeCoverage.SetRange("Line Type", CodeCoverage."Line Type"::Object);
        if CodeCoverage.FindSet() then
            repeat
                if not CALTestCoverageMap.Get(TestCodeunitId, CodeCoverage."Object Type", CodeCoverage."Object ID") then begin
                    CALTestCoverageMap.Init();
                    CALTestCoverageMap."Test Codeunit ID" := TestCodeunitId;
                    CALTestCoverageMap."Object Type" := CodeCoverage."Object Type";
                    CALTestCoverageMap."Object ID" := CodeCoverage."Object ID";
                    CALTestCoverageMap.Insert();
                end;
            until CodeCoverage.Next() = 0;
    end;

    local procedure GetLineNoFilter(CALTestLine: Record "CAL Test Line"; Selection: Option ,"Function","Codeunit") LineNoFilter: Text
    var
        NoOfFunctions: Integer;
    begin
        LineNoFilter := '';
        case Selection of
            Selection::"Function":
                begin
                    CALTestLine.TestField("Line Type", CALTestLine."Line Type"::"Function");
                    LineNoFilter := Format(CALTestLine."Line No.");
                    CALTestLine.Reset();
                    CALTestLine.SetRange("Test Suite", CALTestLine."Test Suite");
                    CALTestLine.SetRange("Test Codeunit", CALTestLine."Test Codeunit");
                    CALTestLine.SetFilter("Function", 'OnRun|%1', '');
                    CALTestLine.FindSet();
                    repeat
                        LineNoFilter := LineNoFilter + '|' + Format(CALTestLine."Line No.");
                    until CALTestLine.Next() = 0;
                end;
            Selection::Codeunit:
                LineNoFilter :=
                  StrSubstNo('%1..%2', CALTestLine.GetMinCodeunitLineNo(), CALTestLine.GetMaxCodeunitLineNo(NoOfFunctions));
        end;
    end;

    procedure RunSelected(var CurrCALTestLine: Record "CAL Test Line")
    var
        CALTestLine: Record "CAL Test Line";
        CodeunitIsMarked: Boolean;
        LastCodeunitID: Integer;
        LineNoFilter: Text;
        Selection: Option ,"Function","Codeunit";
        Separator: Text[1];
    begin
        if CurrCALTestLine.IsEmpty() then
            exit;
        CALTestLine.Copy(CurrCALTestLine);
        Separator := '';
        LineNoFilter := '';
        CALTestLine.FindSet();
        repeat
            if CALTestLine."Line Type" = CALTestLine."Line Type"::Codeunit then begin
                LineNoFilter := LineNoFilter + Separator + GetLineNoFilter(CALTestLine, Selection::Codeunit);
                LastCodeunitID := CALTestLine."Test Codeunit";
                CodeunitIsMarked := true;
            end else
                if LastCodeunitID <> CALTestLine."Test Codeunit" then begin
                    LastCodeunitID := CALTestLine."Test Codeunit";
                    LineNoFilter := LineNoFilter + Separator + GetLineNoFilter(CALTestLine, Selection::"Function");
                    CodeunitIsMarked := false;
                end else
                    if not CodeunitIsMarked then
                        LineNoFilter := LineNoFilter + Separator + Format(CALTestLine."Line No.");
            Separator := '|';
        until CALTestLine.Next() = 0;

        CALTestLine.Reset();
        CALTestLine.SetRange("Test Suite", CurrCALTestLine."Test Suite");
        CALTestLine.SetFilter("Line No.", LineNoFilter);
        RunSuite(CALTestLine, true);
    end;

    procedure RunSuiteYesNo(var CurrCALTestLine: Record "CAL Test Line")
    var
        CALTestLine: Record "CAL Test Line";
        Selection: Option ,"Function","Codeunit";
        LineNoFilter: Text;
    begin
        if CurrCALTestLine.IsEmpty() then
            exit;
        CALTestLine.Copy(CurrCALTestLine);
        if CALTestLine."Line Type" = CALTestLine."Line Type"::Codeunit then
            Selection := StrMenu(SelectCodeunitsToRunQst, 2)
        else
            Selection := StrMenu(SelectTestsToRunQst, 1);

        if Selection = 0 then
            exit;

        LineNoFilter := GetLineNoFilter(CALTestLine, Selection);
        if LineNoFilter <> '' then
            CALTestLine.SetFilter("Line No.", LineNoFilter);
        RunSuite(CALTestLine, true);
    end;

    procedure RunSuite(var CALTestLine: Record "CAL Test Line"; IsTestMode: Boolean)
    var
        CALTestLine2: Record "CAL Test Line";
        CALTestRunner: Codeunit "CAL Test Runner";
    begin
        if IsTestMode() then begin
            SETTESTMODE();
            CALTestRunner.Run(CALTestLine);
        end else begin
            SETPUBLISHMODE();
            CALTestLine2.Copy(CALTestLine);
            CALTestLine2.SetRange("Line No.", CALTestLine."Line No.");
            CALTestLine2.TestField("Test Codeunit");
            CALTestLine2.TestField("Function", '');

            CALTestLine.DeleteChildren();
            CALTestLine2.DeleteChildren();

            CALTestRunner.Run(CALTestLine2);
        end;
        Clear(CALTestRunner);
    end;

    local procedure OpenWindow(DisplayText: Text; NoOfRecords2: Integer)
    begin
        i := 0;
        NoOfRecords := NoOfRecords2;
        WindowUpdateDateTime := CurrentDateTime;
        Window.Open(DisplayText);
    end;

    local procedure UpdateWindow()
    begin
        i := i + 1;
        if CurrentDateTime - WindowUpdateDateTime >= 1000 then begin
            WindowUpdateDateTime := CurrentDateTime;
            Window.Update(1, Round(i / NoOfRecords * 10000, 1));
        end;
    end;

    procedure EnableTestToRun()
    var
        CALTestEnabledCodeunit: Record "CAL Test Enabled Codeunit";
        AllObjWithCaption: Record AllObjWithCaption;
    begin
        CALTestEnabledCodeunit.DeleteAll();
        AllObjWithCaption.SetRange("Object Type", AllObjWithCaption."Object Type"::Codeunit);
        AllObjWithCaption.SetRange("Object Subtype", 'Test');
        if AllObjWithCaption.FindSet() then
            repeat
                CALTestEnabledCodeunit."No." := 0;
                CALTestEnabledCodeunit."Test Codeunit ID" := AllObjWithCaption."Object ID";
                CALTestEnabledCodeunit.Insert();
            until AllObjWithCaption.Next() = 0;
    end;

    [Scope('OnPrem')]
    procedure ExportTCM(FileName: Text)
    var
        CALTestCoverageMap: XMLport "CAL Test Coverage Map";
        OutStream: OutStream;
        File: File;
    begin
        if FileName = '' then
            exit;

        if Exists(FileName) then
            Erase(FileName);

        if File.Create(FileName) then begin
            File.CreateOutStream(OutStream);
            CALTestCoverageMap.SetDestination(OutStream);
            CALTestCoverageMap.ImportFile(false);
            CALTestCoverageMap.Export();
            File.Close();
        end;
    end;

    [Scope('OnPrem')]
    procedure ExportTestResults(FileName: Text; SkipPassed: Boolean; LastTestRun: Boolean)
    var
        CALExportTestResult: XMLport "CAL Export Test Result";
        OutStream: OutStream;
        File: File;
    begin
        if FileName = '' then
            exit;

        if Exists(FileName) then
            Erase(FileName);

        if File.Create(FileName) then begin
            File.CreateOutStream(OutStream);
            CALExportTestResult.SetParam(SkipPassed, LastTestRun);
            CALExportTestResult.SetDestination(OutStream);
            CALExportTestResult.ImportFile(false);
            CALExportTestResult.Export();
            File.Close();
        end;
    end;

    [Scope('OnPrem')]
    procedure ImportTestToRun(FileName: Text; Clean: Boolean)
    var
        CALTestEnabledCodeunit: Record "CAL Test Enabled Codeunit";
        CALImportEnabledCodeunit: XMLport "CAL Import Enabled Codeunit";
        InStream: InStream;
        File: File;
    begin
        if FileName = '' then
            exit;

        if not Exists(FileName) then
            exit;

        if Clean then
            CALTestEnabledCodeunit.DeleteAll();

        File.WriteMode(false);
        File.Open(FileName);
        File.CreateInStream(InStream);
        CALImportEnabledCodeunit.SetSource(InStream);
        CALImportEnabledCodeunit.ImportFile(true);
        CALImportEnabledCodeunit.Import();
        File.Close();
    end;
}