215 lines
6.2 KiB
ObjectPascal
215 lines
6.2 KiB
ObjectPascal
unit Test.Myc.Ast.Tuples;
|
|
|
|
interface
|
|
|
|
uses
|
|
DUnitX.TestFramework,
|
|
System.SysUtils,
|
|
Myc.Ast.Environment,
|
|
Myc.Ast.Script,
|
|
Myc.Data.Value,
|
|
Myc.Data.Scalar,
|
|
Myc.Ast.Nodes, // For EAstException/EEvaluatorException if needed
|
|
Myc.Ast.Evaluator;
|
|
|
|
type
|
|
[TestFixture]
|
|
[IgnoreMemoryLeaks]
|
|
TTestTuples = class
|
|
private
|
|
FEnv: TAstEnvironment;
|
|
function Run(const Code: string): TDataValue;
|
|
public
|
|
[Setup]
|
|
procedure Setup;
|
|
[TearDown]
|
|
procedure TearDown;
|
|
|
|
// --- Basic Literals ---
|
|
[Test]
|
|
procedure Test_EmptyTuple;
|
|
[Test]
|
|
procedure Test_SingleElement;
|
|
[Test]
|
|
procedure Test_HomogeneousVector;
|
|
[Test]
|
|
procedure Test_HeterogeneousTuple;
|
|
|
|
// --- Indexing (Get) ---
|
|
[Test]
|
|
[TestCase('Index0', '[10 20 30],0,10')]
|
|
[TestCase('Index1', '[10 20 30],1,20')]
|
|
[TestCase('Index2', '[10 20 30],2,30')]
|
|
procedure Test_Indexing(const Script, IndexStr, ExpectedStr: string);
|
|
|
|
[Test]
|
|
procedure Test_Indexing_OutOfBounds;
|
|
|
|
// --- Nesting (Matrices) ---
|
|
[Test]
|
|
procedure Test_Matrix_2x2;
|
|
[Test]
|
|
procedure Test_Jagged_Array; // Not a matrix, but a tuple of tuples
|
|
|
|
// --- Complex Expressions inside Tuples ---
|
|
[Test]
|
|
procedure Test_Expressions_Inside_Tuple;
|
|
[Test]
|
|
procedure Test_Tuple_Inside_Block;
|
|
|
|
// --- Variable Binding ---
|
|
[Test]
|
|
procedure Test_Def_And_Access;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
Myc.Ast.Scope; // For IExecutionScope
|
|
|
|
{ TTestTuples }
|
|
|
|
procedure TTestTuples.Setup;
|
|
begin
|
|
// Create a fresh standard environment for each test
|
|
FEnv := TAstEnvironment.Construct(nil);
|
|
FEnv.SetStandardMode;
|
|
end;
|
|
|
|
procedure TTestTuples.TearDown;
|
|
begin
|
|
// Interfaces represent the env, automatic cleanup handled by ARC
|
|
FEnv := Default(TAstEnvironment);
|
|
end;
|
|
|
|
function TTestTuples.Run(const Code: string): TDataValue;
|
|
begin
|
|
// Parse, Compile, Link, Run pipeline
|
|
var ast := TAstScript.Parse(Code);
|
|
Result := FEnv.Run(ast);
|
|
end;
|
|
|
|
procedure TTestTuples.Test_EmptyTuple;
|
|
begin
|
|
var res := Run('[]');
|
|
Assert.AreEqual(TDataValueKind.vkTuple, res.Kind);
|
|
Assert.AreEqual(0, res.AsTuple.Count);
|
|
end;
|
|
|
|
procedure TTestTuples.Test_SingleElement;
|
|
begin
|
|
var res := Run('[42]');
|
|
Assert.AreEqual(TDataValueKind.vkTuple, res.Kind);
|
|
Assert.AreEqual(1, res.AsTuple.Count);
|
|
Assert.AreEqual<Int64>(42, res.AsTuple[0].AsScalar.Value.AsInt64);
|
|
end;
|
|
|
|
procedure TTestTuples.Test_HomogeneousVector;
|
|
begin
|
|
// [1 2 3 4]
|
|
var res := Run('[1 2 3 4]');
|
|
Assert.AreEqual(TDataValueKind.vkTuple, res.Kind);
|
|
Assert.AreEqual(4, res.AsTuple.Count);
|
|
Assert.AreEqual<Int64>(4, res.AsTuple[3].AsScalar.Value.AsInt64);
|
|
end;
|
|
|
|
procedure TTestTuples.Test_HeterogeneousTuple;
|
|
begin
|
|
// [1 "Text" 3.14]
|
|
var res := Run('[1 "Text" 3.14]');
|
|
Assert.AreEqual(TDataValueKind.vkTuple, res.Kind);
|
|
var tpl := res.AsTuple;
|
|
|
|
Assert.AreEqual(3, tpl.Count);
|
|
|
|
// Check types
|
|
Assert.AreEqual(TDataValueKind.vkScalar, tpl[0].Kind);
|
|
Assert.AreEqual(TDataValueKind.vkText, tpl[1].Kind);
|
|
Assert.AreEqual(TDataValueKind.vkScalar, tpl[2].Kind);
|
|
|
|
// Check values
|
|
Assert.AreEqual<Int64>(1, tpl[0].AsScalar.Value.AsInt64);
|
|
Assert.AreEqual('Text', tpl[1].AsText);
|
|
Assert.AreEqual(3.14, tpl[2].AsScalar.Value.AsDouble, 0.0001);
|
|
end;
|
|
|
|
procedure TTestTuples.Test_Indexing(const Script, IndexStr, ExpectedStr: string);
|
|
begin
|
|
// (get [10 20 30] 1) -> 20
|
|
var code := Format('(get %s %s)', [Script, IndexStr]);
|
|
var res := Run(code);
|
|
|
|
Assert.AreEqual(TDataValueKind.vkScalar, res.Kind);
|
|
Assert.AreEqual<Int64>(StrToInt64(ExpectedStr), res.AsScalar.Value.AsInt64);
|
|
end;
|
|
|
|
procedure TTestTuples.Test_Indexing_OutOfBounds;
|
|
begin
|
|
// Should throw exception
|
|
Assert.WillRaise(procedure begin Run('(get [1 2] 5)'); end, EEvaluatorException);
|
|
|
|
Assert.WillRaise(procedure begin Run('(get [1 2] -1)'); end, EEvaluatorException);
|
|
end;
|
|
|
|
procedure TTestTuples.Test_Matrix_2x2;
|
|
begin
|
|
// [[1 2] [3 4]]
|
|
// This tests the parser's ability to handle nested brackets and the evaluator's reconstruction.
|
|
var res := Run('[[1 2] [3 4]]');
|
|
Assert.AreEqual(TDataValueKind.vkTuple, res.Kind);
|
|
|
|
var outer := res.AsTuple;
|
|
Assert.AreEqual(2, outer.Count);
|
|
|
|
var row0 := outer[0].AsTuple;
|
|
var row1 := outer[1].AsTuple;
|
|
|
|
Assert.AreEqual<Int64>(1, row0[0].AsScalar.Value.AsInt64);
|
|
Assert.AreEqual<Int64>(2, row0[1].AsScalar.Value.AsInt64);
|
|
Assert.AreEqual<Int64>(3, row1[0].AsScalar.Value.AsInt64);
|
|
Assert.AreEqual<Int64>(4, row1[1].AsScalar.Value.AsInt64);
|
|
end;
|
|
|
|
procedure TTestTuples.Test_Jagged_Array;
|
|
begin
|
|
// [[1] [2 3]] -> Valid tuple of tuples, but not a matrix in strict sense (though runtime handles it as nested tuples)
|
|
var res := Run('[[1] [2 3]]');
|
|
Assert.AreEqual(2, res.AsTuple.Count);
|
|
Assert.AreEqual(1, res.AsTuple[0].AsTuple.Count);
|
|
Assert.AreEqual(2, res.AsTuple[1].AsTuple.Count);
|
|
end;
|
|
|
|
procedure TTestTuples.Test_Expressions_Inside_Tuple;
|
|
begin
|
|
// [(+ 1 2) (* 10 2)] -> [3 20]
|
|
var res := Run('[(+ 1 2) (* 10 2)]');
|
|
|
|
Assert.AreEqual(2, res.AsTuple.Count);
|
|
Assert.AreEqual<Int64>(3, res.AsTuple[0].AsScalar.Value.AsInt64);
|
|
Assert.AreEqual<Int64>(20, res.AsTuple[1].AsScalar.Value.AsInt64);
|
|
end;
|
|
|
|
procedure TTestTuples.Test_Tuple_Inside_Block;
|
|
begin
|
|
// (do [1 2] [3 4]) -> Should return the last tuple [3 4]
|
|
var res := Run('(do [1 2] [3 4])');
|
|
Assert.AreEqual(TDataValueKind.vkTuple, res.Kind);
|
|
Assert.AreEqual<Int64>(3, res.AsTuple[0].AsScalar.Value.AsInt64);
|
|
end;
|
|
|
|
procedure TTestTuples.Test_Def_And_Access;
|
|
begin
|
|
// This mimics the case that previously crashed
|
|
// (do (def x [10 20 30]) (get x 1))
|
|
var code := '(do ' + ' (def x [10 20 30]) ' + ' (get x 1) ' + ')';
|
|
|
|
var res := Run(code);
|
|
Assert.AreEqual(TDataValueKind.vkScalar, res.Kind);
|
|
Assert.AreEqual<Int64>(20, res.AsScalar.Value.AsInt64);
|
|
end;
|
|
|
|
initialization
|
|
TDUnitX.RegisterTestFixture(TTestTuples);
|
|
|
|
end.
|