"Cannot Import VARARRAYGET" when accessing a Variant as array

[uschuster]

When trying to access a Variant as array TPSExec does raise the exception "Cannot Import VARARRAYGET".

The console app below, which is based on the samples, does demonstrate this.

The expected output is:

A
2
3.000000000000

The actual output is:

EXCEPTION: Cannot Import VARARRAYGET

In order to make it work as expected it is enough to enable the two conditional ...VarArray... blocks in uPSRuntime.pas for all compilers instead of only for Delphi 5 and lower ("{$IFNDEF DELPHI6UP}"). The helper methods _VarArrayGet and _VarArraySet cannot be omitted for Delphi 6 or higher, because the signature of Variants.VarArrayGet and Variants.VarArrayPut differs.

program SampleVariantArrayAccess;

{$APPTYPE CONSOLE}

{$I PascalScript.inc}

uses
  {$IFDEF DELPHI6UP}
  Variants,
  {$ENDIF}
  uPSCompiler, uPSRuntime, uPSUtils;

function ReturnVariantArray: Variant;
begin
  Result := VarArrayCreate([0, 2], varVariant);
  Result[0] := 'A';
  Result[1] := 2;
  Result[2] := 3.0;
end;

procedure OutputStringToConsole(const AStr: string);
begin
  WriteLn(AStr);
end;

{$IFDEF UNICODE}
function ScriptOnUses(Sender: TPSPascalCompiler; const Name: AnsiString): Boolean;
{$ELSE}
function ScriptOnUses(Sender: TPSPascalCompiler; const Name: string): Boolean;
{$ENDIF}
begin
  if Name = 'SYSTEM' then
  begin
    Sender.AddDelphiFunction('function ReturnVariantArray: Variant');
    Sender.AddDelphiFunction('procedure OutputStringToConsole(const AStr: string)');
    Result := True;
  end else
    Result := False;
end;

procedure ExecOnException(Sender: TPSExec; ExError: TPSError; const ExParam: tbtstring; 
  ExObject: TObject; ProcNo, Position: Cardinal);
begin
  WriteLn('EXCEPTION: ' + PSErrorToString(ExError, ExParam));
end;

procedure ExecuteScript(const Script: string);
var
  Compiler: TPSPascalCompiler;
  Exec: TPSExec;
  I: Integer;
  {$IFDEF UNICODE}Data: AnsiString;{$ELSE}Data: string;{$ENDIF}
begin
  Compiler := TPSPascalCompiler.Create;
  Compiler.OnUses := ScriptOnUses;
  if not Compiler.Compile(Script) then
  begin
    for I := 0 to Compiler.MsgCount -1 do
      Writeln(Compiler.Msg[I].MessageToString);
    Compiler.Free;
    Exit;
  end;

  Compiler.GetOutput(Data);
  Compiler.Free;

  Exec := TPSExec.Create;
  Exec.RegisterDelphiFunction(@ReturnVariantArray, 'ReturnVariantArray', cdRegister);
  Exec.RegisterDelphiFunction(@OutputStringToConsole, 'OutputStringToConsole', cdRegister);
  Exec.OnException := ExecOnException;
  if not Exec.LoadData(Data) then
  begin
    Exec.Free;
    Exit;
  end;

  Exec.RunScript;
  Exec.Free;
end;

const
  Script =
    'var' + #13#10 +
    '  V: Variant;' + #13#10 +
    'begin' + #13#10 +
    '  V := ReturnVariantArray;' + #13#10 +
    '  OutputStringToConsole(V[0]);' + #13#10 +
    '  OutputStringToConsole(IntToStr(V[1]));' + #13#10 +
    '  OutputStringToConsole(FloatToStr(V[2]));' + #13#10 +
    'end.';

begin
  ExecuteScript(Script);
  ReadLn;
end.

[uschuster]

I have added pull request #181 for the fix.

[carlokok]

Thanks!