MycLib/Test/AST/Test.Myc.Ast.NullPropagation.pas

unit Test.Myc.Ast.NullPropagation;

interface

uses
    DUnitX.TestFramework,
    System.SysUtils,
    System.Classes,
    Myc.Data.Value,
    Myc.Data.Scalar,
    Myc.Ast.Environment,
    Myc.Ast.Nodes, // For exception types
    Myc.Ast.Script; // WICHTIG: Für Parsing

type
    [TestFixture]
    [IgnoreMemoryLeaks]
    TTestNullPropagation = class
    private
        FEnv: TAstEnvironment;
    public
        [Setup]
        procedure Setup;
        [TearDown]
        procedure TearDown;

        [Test]
        [TestCase('ValidRecord', 'true,10')]
        [TestCase('VoidRecord', 'false,0')]
        procedure TestMemberAccessPropagation(const Condition: Boolean; const ExpectedVal: Int64);

        [Test]
        procedure TestNestedPropagation;

        [Test]
        procedure TestIndexerPropagation;

        [Test]
        procedure TestStrictArithmeticFailure;

        [Test]
        procedure TestStrictComparisonFailure;
    end;

implementation

{ TTestNullPropagation }

procedure TTestNullPropagation.Setup;
begin
    // Create a fresh standard environment for each test
    FEnv := TAstEnvironment.Construct(nil);
end;

procedure TTestNullPropagation.TearDown;
begin
    FEnv := Default(TAstEnvironment);
end;

procedure TTestNullPropagation.TestMemberAccessPropagation(const Condition: Boolean; const ExpectedVal: Int64);
var
    script: string;
    resultVal: TDataValue;
begin
    // Script:
    // 1. Define 'r' which is EITHER a Record {:a 10} OR Void depending on condition.
    // 2. Access field .a -> Should propagate Void if r is Void.

    script := Format('(do ' + '  (def r (if %s {:a 10}))' + '  (.a r)' + ')', [BoolToStr(Condition, True).ToLower]);

    resultVal := FEnv.Run(TAstScript.Parse(script));

    if Condition then
    begin
        // Case: Object exists
        Assert.AreEqual(TDataValueKind.vkScalar, resultVal.Kind, 'Should return a scalar');
        Assert.AreEqual(ExpectedVal, resultVal.AsScalar.Value.AsInt64, 'Should return the field value');
    end
    else
    begin
        // Case: Object is Void (Null Propagation)
        Assert.IsTrue(resultVal.IsVoid, 'Accessing member of Void should yield Void');
    end;
end;

procedure TTestNullPropagation.TestNestedPropagation;
var
    script: string;
    resultVal: TDataValue;
begin
    // Chained Access: (get (.data (if false ...)) 0)
    script := '(do ' + '  (def root (if false {:data (new-series "ordinal")}))' + '  (get (.data root) 0)' + ')';

    resultVal := FEnv.Run(TAstScript.Parse(script));

    Assert.IsTrue(resultVal.IsVoid, 'Nested access on Void root should propagate Void all the way up');
end;

procedure TTestNullPropagation.TestIndexerPropagation;
var
    script: string;
    resultVal: TDataValue;
begin
    // 1. Define 's' as Optional<Series>
    // 2. Access via Indexer
    script := '(do ' + '  (def s (if false (new-series "ordinal")))' + '  (get s 42)' + ')';

    // FIX: Parse String to AST Node
    resultVal := FEnv.Run(TAstScript.Parse(script));

    Assert.IsTrue(resultVal.IsVoid, 'Indexer access on Void series should yield Void');
end;

procedure TTestNullPropagation.TestStrictArithmeticFailure;
begin
    // Requirement: Implicit Lifting is FORBIDDEN for arithmetic.
    Assert.WillRaise(
        procedure
        begin
            FEnv.Run(
                TAstScript.Parse(
                    '''
                (do
                  (def a (if true 10)) ; a is Optional<Ordinal>
                  (+ a 5)              ; Error: Operator + not defined for Optional
                )
                '''
                )
            );
        end,
        ECompilationFailed,
        'Arithmetic on optional types must trigger a compilation error'
    );
end;

procedure TTestNullPropagation.TestStrictComparisonFailure;
begin
    // Requirement: Comparisons with Optional types are FORBIDDEN.
    Assert.WillRaise(
        procedure
        begin
            FEnv.Run(
                TAstScript.Parse(
                    '(do '
                        + '  (def a (if true 10))'
                        + // a is Optional<Ordinal>
                        '  (> a 5)'
                        + // Error
                        ')'
                )
            );
        end,
        ECompilationFailed,
        'Comparison on optional types must trigger a compilation error'
    );
end;

end.