I'm getting the same error using a TIBOTable. I've added a test,
"Test_InsertSingle", attached.

On 26/07/2013 05:51, IBO Support List wrote:
>
> An example would be great!
>
> And, if you are on IBO 5.2.0 if you would modify the
> build\RegressionTesting
> app to show the error that would be even better.
>
> Thanks,
> Jason
>
> -----Original Message-----
> From: IBObjects@yahoogroups.com <mailto:IBObjects%40yahoogroups.com>
> [mailto:IBObjects@yahoogroups.com
> <mailto:IBObjects%40yahoogroups.com>] On Behalf
> Of Felipe Aron
> Sent: Wednesday, July 24, 2013 5:05 AM
> To: IBObjects@yahoogroups.com <mailto:IBObjects%40yahoogroups.com>
> Subject: [IBO] Issue when table has just only one column
>
> Jason I believe has found a Issue:
>
> When a table have just one column, when insert a new registry occours a
> exception:
>
> *Token unknown * ... Statement: <no name>... *
>
> This table (Provider) has relation 1:1 - Example:
>
> Person <-> Provider
>
> where has just only one column with PK and FK (Person relation).
>
> If you prefer I make an example and send to you.
>
> --
> Analista-Programador
> #FollowMe: @felipearon <http://twitter.com/felipearon> (
> http://felipearon.net)
>
> [Non-text portions of this message have been removed]
>
> ------------------------------------
>
> __________________________________________________________
> IB Objects - direct, complete, custom connectivity to Firebird or
> InterBase
> without the need for BDE, ODBC or any other layer.
> __________________________________________________________
> http://www.ibobjects.com - your IBO community resource for Tech Info
> papers,
> keyword-searchable FAQ, community code contributions and more !
> Yahoo! Groups Links
>
>


----------

{$IFDEF FPC}
{$MODE DELPHI}
{$ENDIF FPC}

{$IFDEF DEBUG}
{$DEFINE NOSTOP}
{$ENDIF}

{ }
{ FixedTests }
{ }

{***************************************************************}
{ }
{ IB Objects Components and Resources Library }
{ }
{ Copyright (C) 1996-2013 Jason Wharton }
{ and CPS - Computer Programming Solutions, Malta, ID }
{ }
{ This source code unit is released under the terms of the }
{ CPS Trustware License. }
{ It may be distributed or deployed as source code or in }
{ compiled form only in compliance with the terms and }
{ conditions of the CPS Trustware License which may be }
{ examined at http://www.ibobjects.com/ibo_trustware.html }
{ }
{***************************************************************}

{******************************************************************************}
{ CONTRIBUTED MODIFICATIONS }
{ Additions or modifications listed below using format: }
{ }
{ Joe Citizen <joe@...> }
{ mm/dd/yyyy }
{ xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx }
{ xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx }
{ xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx }
{ Copyright (C) 2001 Joe Citizen }
{ }
{------------------------------------------------------------------------------}
{ Place your credits and information in the top of the section }
{ below with any other descriptions or explanations desired. }
{------------------------------------------------------------------------------}
{ }
{ }
{******************************************************************************}

{$INCLUDE IB_Directives.inc}

{: This unit contains completed tests that shall be repeated to make sure there
is no regression and that the expected good behavior is preserved.}
unit
FixedTests;

interface

uses
{$IFDEF FPC}
fpcunit, testutils, testregistry,
{$ELSE}
TestFramework,
{$ENDIF}
IB_Header,
IB_Components,
IBOTest;

type

{ TTestCaseFixed }

TTestCaseFixed = class(TIBOTestCase)
private
procedure DoColumnCoding( Sender: TIB_Column;
EncodingName,
EncodingKey: string;
IsEncoding: Boolean;
var RawBytes: RawByteString );

protected
// procedure SetUp; override;
// procedure TearDown; override;
published
procedure Test_BlobAsStringCompare;
procedure Test_BinaryBlobVariant;
procedure Test_IBOStoredProc;
procedure Test_InputParamCount;
procedure Test_IBOTableBoolDefaultRequired;
procedure Test_BlobLoad;
procedure Test_RecordCount;
procedure Test_IsEmpty;
procedure Test_CursorGenInsEditDel;
procedure Test_Filter;
procedure Test_DMLCaching;
procedure Test_IBOQueryNumericFields;
procedure Test_IBOQuery;
procedure Test_IBOQueryParamsPrepared;
procedure Test_ScriptParseProblem;
procedure Test_StringList;
procedure Test_LiteralText;
procedure Test_Array;
procedure Test_ApplyUpdatesActivateTrans;
procedure Test_BatchExecute;
procedure Test_KeyLinksAutoDefineError;
procedure Test_PessimisticLocking;
procedure Test_SetToNull;
procedure Test_FieldNameCharSet;
procedure Test_FieldNameAlignment;
procedure Test_UpdateForTransBlobs;
procedure Test_SearchedEditsFalse;
procedure Test_InsertWithoutOpen;
procedure Test_ScriptAutoDDL;
procedure Test_KeyLinksAutoDefine;
procedure Test_InsertReturningClause;
procedure Test_BlobReadWrite;
procedure Test_ReservedAndSpecialTokens;
procedure Test_ImportExport;
procedure Test_FullTextSearch;
procedure Test_IBOExtract;
procedure Test_BufferSynchroColumns;
procedure Test_BatchDateFormat;
procedure Test_RelAliasName;
procedure Test_IBONumerics;
procedure Test_IBOTablePersistentFields;
procedure Test_MemoryLeak_001;
procedure Test_LocateAndTrimming;
procedure Test_LocateWithSubselect;
procedure Test_LocateEdgeFluke;
procedure Test_MasterSourceRecordCountSync;
procedure Test_IBOTable_LocateOnLookupField;
procedure Test_AppendRecordCursorPosition;
procedure Test_TransactionIssues;
procedure Test_WriteZeroLengthBlobAsValue;
procedure Test_ReadNaN;
procedure Test_InsertSingle;
end;

implementation

uses
{$IFDEF FPC}
LCLIntf,
{$ELSE}
Windows,
{$ENDIF}

SysUtils, Classes, Math, DB,
{$IFDEF FPC}
dbconst,
{$ELSE}
DBConsts,
{$ENDIF}

{$IFDEF IBO_VCL60_OR_GREATER}
Variants,
{$ENDIF}
IB_Session,
IB_StringList,
IB_Access,
IB_Utils,
IB_Parse,
IB_LogFiles,
IB_Import,
IB_Export,
IB_Schema,
IB_Monitor,
IB_FTS_Meta,
IB_FTS_Search,
IBODataset,
IBOExtract,
IBOConnectionInfo

{$IFDEF IBO_VCL2009_OR_GREATER}
, FixedTestsUC
{$ENDIF}
;

procedure TTestCaseFixed.Test_InputParamCount;
procedure TestStatement( aStmt: string;
aPrmCnt: integer;
aWhere: string = '' );
var
q: TIBOQuery;
begin
q := TIBOQuery.Create( Session );
try
q.SQL.Text := aStmt;
if aWhere <> '' then
q.SQLWhere.Text := aWhere;
Say('SQL = ' + Trim( q.SQL.Text ));
Say( 'ParamCount = ' + IntToStr( q.ParamCount ));
CheckEquals( aPrmCnt, q.ParamCount, 'Inaccurate input parameter count.' );
finally
FreeAndNil( q );
end;
end;
begin
Say( '---------------------' );
Say( 'Test: InputParamCount' );
Say( '---------------------' );
TestStatement( 'EXECUTE PROCEDURE ADD_EMP_PROJ (:PAR1, :PAR2)', 2 );
TestStatement( 'SELECT 0 FROM ADD_EMP_PROJ (:PAR1, :PAR2)', 2 );
TestStatement( 'SELECT 0 FROM ADD_EMP_PROJ', 1, 'WHERE ADD_EMP = :PAR1' );
TestStatement( 'SELECT 0 FROM ADD_EMP_PROJ', 1, 'WHERE (EMP = :PAR1)' );
Say( '---------------------' );
Say( 'Success!' );
Say( '---------------------' );
end;

procedure TTestCaseFixed.Test_IBOStoredProc;
var
sp: TIBOStoredProc;
begin
Say( '---------------------' );
Say( 'Testing IBOStoredProc' );
Say( '---------------------' );
Create_Database( 'RegTest' );
sp := TIBOStoredProc.Create( Session );
try
sp.IB_Connection := Connection;
sp.IB_Transaction := Transaction;
sp.StoredProcName := 'TEST_CHAR';
sp.Prepare;
CheckTrue( sp.Params[0].ParamType = ptInput, 'Invalid param type.' );
CheckTrue( sp.Params[0].DataType = ftFixedChar, 'Invalid data type.' );
sp.ExecProc;
sp.Unprepare;
sp.ExecProc;
sp.Unprepare;
sp.ExecProc;
Say( '---------------------' );
Say( 'Success!' );
Say( '---------------------' );
finally
sp.Free;
end;
Remove_Database( 'RegTest' );
end;

procedure TTestCaseFixed.Test_IBOQueryNumericFields;
var
d: TIBOQuery;
d1, d2: double;
begin
Say( '----------------------------');
Say( 'Testing Numeric Field' );
Say( '----------------------------');
Create_Database( 'RegTest' );
d := TIBOQuery.Create( Session );
try
d.IB_Connection := Connection;
d.IB_Transaction := Transaction;
d.SQL.Text := 'SELECT CAST(12345.45 AS NUMERIC(18,2)) as ttt FROM RDB$DATABASE';
d.Open;
d1 := 12345.45;
d2 := d.Fields[0].AsFloat;
CheckEquals( d1, d2, 'Invalid number.' );
finally
d.Free;
end;
Say( '----------------------------');
Say( 'Success!' );
Say( '----------------------------');
Remove_Database( 'RegTest' );
end;

procedure TTestCaseFixed.Test_IBOQuery;
var
d: TIBOQuery;
v: variant;
{$IFDEF FPC}
{$IF Defined(FPC_FULLVERSION) and (FPC_FULLVERSION >= 20701)}
b: TBookmark;
bkm: TBookmark;
{$ELSEIF 1=1}
b: TBookmarkStr;
bkm: TBookmarkStr;
{$IFEND}
{$ELSE}
{$IFDEF IBO_VCL2009_OR_GREATER}
b: TBookmark;
bkm: TBookmark;
{$ELSE}
b: TBookmarkStr;
bkm: TBookmarkStr;
{$ENDIF}
{$ENDIF}
rbs: RawByteString;
begin
rbs := '00000100000001000000';
{$IFDEF FPC}
{$IF Defined(FPC_FULLVERSION) and (FPC_FULLVERSION >= 20701)}
SetLength( bkm, Length( rbs ));
Move( rbs[1], bkm[0], Length( rbs ));
{$ELSEIF 1=1}
bkm := rbs;
{$IFEND}
{$ELSE}
{$IFDEF IBO_VCL2009_OR_GREATER}
SetLength( bkm, Length( rbs ));
Move( rbs[1], bkm[0], Length( rbs ));
{$ELSE}
bkm := rbs;
{$ENDIF}
{$ENDIF}
Say( '----------------------------');
Say( 'Testing LiteralText' );
Say( '----------------------------');
Create_Database( 'RegTest' );
d := TIBOQuery.Create( Session );
try
d.IB_Connection := Connection;
d.IB_Transaction := Transaction;
d.SQL.Text := 'SELECT ''test'' as ttt FROM RDB$DATABASE';
d.RequestLive := true;
d.Open;
Say( 'd.Fields[0].ClassName = ' + d.Fields[0].ClassName );
b := d.Bookmark;
CheckTrue( CompareBookmarks( b, bkm ), 'Invalid Bookmark.' );
d.Insert; // Test SetBookmarkData();
d.Cancel;
CheckEqualsString( 'test', d.Fields[0].AsString, 'Invalid literal text.' );
v := d.Fields[0].Value;
CheckEqualsString( 'test', v, 'Invalid literal text.' );
finally
d.Free;
end;
Connection.Disconnect;

Connection.Connect;
d := TIBOQuery.Create( Session );
try
d.IB_Connection := Connection;
d.IB_Transaction := Transaction;
d.SQL.Text := 'SELECT ''test'' as ttt FROM RDB$DATABASE';
d.Open;
Say( 'd.Fields[0].ClassName = ' + d.Fields[0].ClassName );
CheckEqualsString( 'test', d.Fields[0].AsString, 'Invalid literal text.' );
v := d.Fields[0].Value;
CheckEqualsString( 'test', v, 'Invalid literal text.' );
finally
d.Free;
end;
Say( '----------------------------');
Say( 'Success!' );
Say( '----------------------------');
Remove_Database( 'RegTest' );
end;

procedure TTestCaseFixed.Test_IBOQueryParamsPrepared;
var
q: TIBOQuery;
begin
Say( '------------------------------' );
Say( 'Testing IBOQueryParamsPrepared' );
Say( '------------------------------' );
Create_Database( 'RegTest' );
q := TIBOQuery.Create( Session );
try
q.IB_Connection := Connection;
q.IB_Transaction := Transaction;
q.SQL.Text := 'SELECT KEY1, COL1 FROM TESTING';
q.Open;
q.Close;
q.SQLWhere.Text := 'WHERE COL1 = :COL1';
CheckEquals( 1, q.ParamsCount, 'Invalid param count.' );

q.SQL.Clear;
q.SQL.Add( 'select *' );
q.SQL.Add( 'from testme' );
q.SQL.Add( 'where ( tcolc10 = :str ) or ( tcolv20 = :str )' );
q.Prepare;
CheckEquals( 1, q.ParamCount, 'Invalid ParamCount.' );

q.SQL.Clear;

q.SQL.Add( 'select v.id_num,' );
// InterBase didn't support this SQL below so I simplified it.
// q.SQL.Add( ' iif(v.nota_propria = ''S'', v.emissao, coalesce(v.saida, v.emissao)) as usar_data,' );
q.SQL.Add( ' v.saida as usar_data,' );
q.SQL.Add( ' pn.icms, sum(pn.frete) as frete,' );
q.SQL.Add( ' sum(pn.seguro) as seguro, sum(pn.outrasdesp) as outras_despesas,' );
q.SQL.Add( ' sum(pn.total) as valor_nota, sum(pn.base_icms) as icms_base,' );
q.SQL.Add( ' sum(pn.valor_ipi) as valor_ipi, sum(pn.valor_icms) as valor_icms,' );
q.SQL.Add( ' sum(pn.subtotliq + pn.valor_ipi) as subtotal,' );
q.SQL.Add( ' sum(pn.frete + pn.seguro + pn.outrasdesp) as freteoutrasseg,' );
q.SQL.Add( ' count(pn.codprod) as numitens' );
q.SQL.Add( 'from notas v' );
q.SQL.Add( 'left join prodnota pn on pn.id_num = v.id_num' );
q.SQL.Add( 'where (((v.entrada_saida = ''S'') and' );
q.SQL.Add( ' (v.emissao between :dia1 and :dia2)) or ((v.entrada_saida = ''E'') and' );
q.SQL.Add( ' (v.saida between :dia1 and :dia2))) and (v.serie <> ''Z'')' );
// InterBase didn't support this SQL below so I simplified it.
// q.SQL.Add( 'group by 1, 2, 3' );
q.SQL.Add( 'group by v.id_num, v.saida, pn.icms' );
q.SQL.Add( 'union all' );
q.SQL.Add( 'select v2.id_num,' );
// InterBase didn't support this SQL below so I simplified it.
// q.SQL.Add( ' iif(v2.nota_propria = ''S'', v2.emissao, coalesce(v2.saida, v2.emissao)) as usar_data,' );
q.SQL.Add( ' v2.saida as usar_data,' );
q.SQL.Add( ' pn2.icms, sum(pn2.frete) as frete,' );
q.SQL.Add( ' sum(pn2.seguro) as seguro, sum(pn2.outrasdesp) as outras_despesas,' );
q.SQL.Add( ' sum(pn2.seguro + pn2.outrasdesp - pn2.descto_rateado + pn2.subtotal + pn2.valor_ipi + pn2.valor_icms_sub + pn2.frete) as valor_nota, sum(pn2.base_icms) as icms_base,' );
q.SQL.Add( ' sum(pn2.valor_ipi) as valor_ipi, sum(pn2.valor_icms) as valor_icms,' );
q.SQL.Add( ' sum(pn2.subtotliq + pn2.valor_ipi) as subtotal,' );
q.SQL.Add( ' sum(pn2.frete + pn2.seguro + pn2.outrasdesp) as freteoutrasseg,' );
q.SQL.Add( ' count(pn2.codprod) as numitens' );
q.SQL.Add( 'from vendcanc v2' );
q.SQL.Add( 'left join prodcanc pn2 on pn2.id_num = v2.id_num' );
q.SQL.Add( 'where (((v2.entrada_saida = ''S'') and' );
q.SQL.Add( ' (v2.emissao between :dia1 and :dia2)) or ((v2.entrada_saida = ''E'') and' );
q.SQL.Add( ' (v2.saida between :dia1 and :dia2))) and' );
q.SQL.Add( ' (v2.emissao between :dia1 and :dia2) and (V2.serie <> ''Z'')' );
// InterBase didn't support this SQL below so I simplified it.
// q.SQL.Add( 'group by 1, 2, 3' );
q.SQL.Add( 'group by v2.id_num, v2.saida, pn2.icms' );

q.Prepare;
CheckEquals( 2, q.ParamCount, 'Invalid ParamCount.' );
Say( '---------------------' );
Say( 'Success!' );
Say( '---------------------' );
finally
q.Free;
end;
Remove_Database( 'RegTest' );
end;

procedure TTestCaseFixed.Test_IBOTableBoolDefaultRequired;
function BoolReq(const isReq: boolean): string;
begin
Result := 'false';
if isReq then
Result := 'true';
end;
var
tb: TIBOTable;
procedure ShowTb;
var
I: Integer;
begin
tb.Open;
Say( '-----------------------------------------' );
Say( 'tb.PreparedInserts = ' + BoolReq( tb.PreparedInserts ));
Say( 'tb.PreparedEdits = ' + BoolReq( tb.PreparedEdits ));
Say( '-----------------------------');
for I := 0 to tb.FieldCount - 1 do
begin
Say( 'tb.' + tb.Fields[I].FieldName +
'.Required = ' +
BoolReq( tb.Fields[I].Required ));
Say( 'tb.InternalDataset.' +
tb.InternalDataset.Fields[I].FieldName +
'.Required = ' +
BoolReq( tb.InternalDataset.Fields[I].Required ));
Say( 'tb.InternalDataset.' +
tb.InternalDataset.Fields[I].FieldName +
'.IsNullable = ' +
BoolReq( tb.InternalDataset.Fields[I].IsNullable ));
Say( 'tb.InternalDataset.' +
tb.InternalDataset.Fields[I].FieldName +
'.Defaulted = ' +
BoolReq( tb.InternalDataset.Fields[I].IsDefaulted ));
end;
Say( '-------------------------------------------');
end;
begin
Say( '-----------------------------------------' );
Say( 'Testing Required/Defaults/PreparedInserts' );
Say( '-----------------------------------------' );
Create_Database( 'BUG_0002' );
tb := TIBOTable.Create( Session );
try
tb.IB_Connection := Connection;
tb.IB_Transaction := Transaction;
tb.TableName := 'BOOL_TABLE';
tb.PreparedInserts := false;
tb.PreparedEdits := false;
ShowTb;
CheckEquals( false, tb.FieldByName('BOOL1').Required,
'Incorrect value for Required.' );
CheckEquals( false, tb.FieldByName('BOOL2').Required,
'Incorrect value for Required.' );
CheckEquals( true, tb.FieldByName('BOOL3').Required,
'Incorrect value for Required.' );
CheckEquals( false, tb.FieldByName('BOOL4').Required,
'Incorrect value for Required.' );
tb.Close;
tb.Unprepare;
tb.PreparedInserts := true;
tb.PreparedEdits := true;
ShowTb;
CheckEquals( true, tb.FieldByName('BOOL1').Required,
'Incorrect value for Required.' );
CheckEquals( false, tb.FieldByName('BOOL2').Required,
'Incorrect value for Required.' );
CheckEquals( true, tb.FieldByName('BOOL3').Required,
'Incorrect value for Required.' );
CheckEquals( false, tb.FieldByName('BOOL4').Required,
'Incorrect value for Required.' );
Say( '---------------------' );
Say( 'Success!' );
Say( '---------------------' );
finally
tb.Free;
end;
Remove_Database( 'BUG_0002' );
end;

procedure TTestCaseFixed.Test_RecordCount;
var
Q: TIB_Query;
D: TIB_Query;
DS: TIB_DataSource;

procedure Test_RC( aStmt: string; aCnt: integer );
var
rc: int64;
ii: integer;
ss: string;
begin
Q.Unprepare;
Say( 'SQL = ' + aStmt );
Q.SQL.Text := aStmt;
Q.Open;
for ii := 0 to Q.ParamCount - 1 do
begin
ss := Q.Params[ii].FieldName;
Q.Params[ii].AsInteger := StrToInt( Copy( ss, 2, 20 ));
Say( ss + ' = ' + Q.Params[ii].AsString );
end;
rc := Q.RecordCount;
Say( 'RecordCount = ' + IntToStr( rc ));
Say( '----------------');
CheckEquals( aCnt, rc, 'Incorrect RecordCount.');
end;

var
cnt: int64;
begin
Say( '-----------------------------------' );
Say( 'Testing RecordCount with FIRST/SKIP' );
Say( '-----------------------------------' );
Create_Database( 'BUG_0003' );
Q := TIB_Query.Create( Session );
D := TIB_Query.Create( Session );
DS := TIB_DataSource.Create( Session );
try
Q.IB_Connection := Connection;
Q.IB_Transaction := Transaction;

// These only work in Firebird.
if Connection.Characteristics.dbFBVersion <> '' then
begin
Test_RC( 'SELECT ID, COL1, COL2 FROM COUNT_TEST', 10 );
Test_RC( 'SELECT FIRST 5 ID, COL1, COL2 FROM COUNT_TEST', 5 );
Test_RC( 'SELECT FIRST 5 SKIP 2 ID, COL1, COL2 FROM COUNT_TEST', 5 );
Test_RC( 'SELECT FIRST 5 SKIP 8 ID, COL1, COL2 FROM COUNT_TEST', 2 );
Test_RC( 'SELECT FIRST 5/*jk*/SKIP 8 ID, COL1, COL2 FROM COUNT_TEST', 2 );
Test_RC( 'SELECT SKIP 2 ID, COL1, COL2 FROM COUNT_TEST', 8 );
Test_RC( 'SELECT SKIP /*junk*/ 2 ID, COL1, COL2 FROM COUNT_TEST', 8 );
Test_RC( 'SELECT SKIP 12 ID, COL1, COL2 FROM COUNT_TEST', 0 );
Test_RC( 'SELECT FIRST (5) SKIP (2) ID, COL1, COL2 FROM COUNT_TEST', 5 );
Test_RC( 'SELECT FIRST :P5 ID, COL1, COL2 FROM COUNT_TEST', 5 );
Test_RC( 'SELECT FIRST (:P5) ID, COL1, COL2 FROM COUNT_TEST', 5 );
Test_RC( 'SELECT FIRST :P5 SKIP :P8 ID, COL1, COL2 FROM COUNT_TEST', 2 );
end;
Say( '------------------------------------' );
Say( 'Testing RecordCount with ROWS m TO n' );
Say( '------------------------------------' );
if ( Connection.Characteristics.dbFBVersion = '' ) or
(( Connection.Characteristics.dbFBVersion <> '' ) and
( Connection.Characteristics.dbServer_Major_Version >= 2 )) then
begin
Test_RC( 'SELECT ID, COL1, COL2 FROM COUNT_TEST ROWS 2', 2 );
Test_RC( 'SELECT ID, COL1, COL2 FROM COUNT_TEST ROWS 2 TO 4', 3 );
Test_RC( 'SELECT ID, COL1, COL2 FROM COUNT_TEST ROWS 2 TO 1', 0 );
Test_RC( 'SELECT ID, COL1, COL2 FROM COUNT_TEST ROWS 8 TO 12', 3 );
Test_RC( 'SELECT ID, COL1, COL2 FROM COUNT_TEST ROWS :P8 TO :P12', 3 );
Test_RC( 'SELECT ID, COL1, COL2 FROM COUNT_TEST ROWS (:P8) TO :P12', 3 );
end;

// Note: InterBase also supports the BY, PERCENT and WITH TIES keywords.

Say( '-------------------------------' );
Say( 'Testing RecordCount with Filter' );
Say( '-------------------------------' );
Q.SQL.Text := 'SELECT ID, COL1, COL2 FROM COUNT_TEST';
Q.Filter := 'COL1=''One''';
Q.Filtered := true;
Q.Open;
cnt := Q.RecordCount;
Say( 'RecordCount = ' + IntToStr( cnt ));
CheckEquals( 1, cnt, 'Inacurate filtered record count.' );
Q.Close;
Q.Filter := '';
Q.Filtered := false;
Say( '-----------------------------------' );
Say( 'Test RecordCount with Master-Detail' );
Say( '-----------------------------------' );
Q.SQL.Text := 'SELECT ID, COL1, COL2 FROM COUNT_TEST';
DS.Dataset := Q;
Q.Open;
D.IB_Connection := Connection;
D.IB_Transaction := Transaction;
D.MasterSource := DS;
D.SQL.Text := 'SELECT ID, COL1, COL2 FROM COUNT_TEST';
D.MasterLinks.Text := 'ID=ID';
D.Open;
cnt := D.RecordCount;
Say( 'RecordCount = ' + IntToStr( cnt ));
CheckEquals( 1, cnt, 'Inacurate master-detail record count.' );
Say( '-------------------------------------------');
Say( 'Success!' );
Say( '-------------------------------------------');
finally
DS.Free;
Q.Free;
D.Free;
end;
Remove_Database( 'BUG_0003' );
end;

procedure TTestCaseFixed.Test_IsEmpty;
var
Q: TIB_Query;
begin
Say( '-------------------------------' );
Say( 'Testing IsEmpty()' );
Say( '-------------------------------' );
Create_Database( 'BUG_0003' );
Q := TIB_Query.Create( Session );
try
Q.IB_Connection := Connection;
Q.IB_Transaction := Transaction;
Q.SQL.Text := 'SELECT ID, COL1, COL2 FROM COUNT_TEST';
Q.Open;
CheckEquals( false, Q.IsEmpty, 'Q.IsEmpty failed.' );
CheckEquals( false, Q.IsEmpty( 10 ), 'Q.IsEmpty(10) failed.' );
CheckEquals( true, Q.IsEmpty( 11 ), 'Q.IsEmpty(11) failed.' );
Say( '-------------------------------------------');
Say( 'Success!' );
Say( '-------------------------------------------');
finally
Q.Free;
end;
Remove_Database( 'BUG_0003' );
end;

procedure TTestCaseFixed.Test_CursorGenInsEditDel;
var
C: TIB_Cursor;
begin
Say( '-------------------------------' );
Say( 'Testing CursorGenInsEditDel' );
Say( '-------------------------------' );
Create_Database( 'BUG_0003' );
C := TIB_Cursor.Create( Session );
{$IFDEF FPC}
// This has to do with the TIB_StringList and the handling of duplicates?
// This is needed because Fields.RelAliasList gets "ORDER" and ORDER in it.
// These two items should be treated as duplicates and one of them ignored.
CheckForReservedTokens := true;
{$ENDIF}
try
C.IB_Connection := Connection;
C.IB_Transaction := Transaction;
C.GeneratorLinks.Clear;
C.GeneratorLinks.Add( Format( '"Id"=%s', ['GEN_TEST'] ));
C.ReadOnly := False;
C.RequestLive := True;
C.SQL.Clear;
C.SQL.Add( 'SELECT "Id", "Col.Col", "ORDER"' );
C.SQL.Add( 'FROM "ORDER"' );
C.SQL.Add( 'WHERE ( "Id" = :ID )' );
C.ParamByName('ID').AsInteger := 2000;
C.Open;
Say( 'RelAliasList.Count = ' + IntToStr( C.RelAliasList.Count ));
Say( 'RelAliasList.Text = ' + C.RelAliasList.Text );
CheckTrue( C.RelAliasList.Count = 1, 'RelAliasList.Count should be 1' );
Say( 'RelationCount = ' + IntToStr( C.Fields.RelationCount ));
CheckTrue( C.Fields.RelationCount = 1, 'RelationCount should be 1' );
C.Insert;
C.FieldByName('"ORDER"').AsInt64 := 5000;
C.FieldByName('"Col.Col"').AsString := '5000';
CheckTrue( C.FieldByName('"Id"').AsInteger = 100 );
C.Post;
CheckTrue( C.FieldByName('"Id"').AsInteger = 100 );
C.ParamByName('ID').AsInteger := 100;
C.PessimisticLocking := true;
C.Close;
C.First;
CheckFalse( C.Eof );
C.Edit;
C.FieldByName('"ORDER"').AsInt64 := 6000;
C.FieldByName('"Col.Col"').AsString := '6000';
C.Post;
C.PessimisticLocking := false;
C.Close;
C.First;
CheckFalse( C.Eof );
C.Edit;
C.FieldByName('"ORDER"').AsInt64 := 7000;
C.FieldByName('"Col.Col"').AsString := '7000';
C.Post;
C.Close;
C.First;
CheckFalse( C.Eof );
C.Delete;
C.Close;
C.First;
CheckTrue( C.Eof );
Say( '-------------------------------------------');
Say( 'Success!' );
Say( '-------------------------------------------');
finally
{$IFDEF FPC}
CheckForReservedTokens := false;
{$ENDIF}
C.Free;
end;
Remove_Database( 'BUG_0003' );
end;

procedure TTestCaseFixed.Test_Filter;
var
Q: TIB_Query;
procedure TestFilt( aFilt: string );
begin
Q.Unprepare;
Q.Open;
Say( 'Filter = ' + aFilt );
Q.Filtered := true;
Q.Filter := aFilt;
Say( 'RefinedSQL:' );
Say( Q.RefinedSQL );

Q.Unprepare;
Q.Open;
Say( 'Filter = ' + aFilt );
Q.Filter := aFilt;
Q.Filtered := true;
Q.Unprepare;
Q.Filter := '';
Q.Filtered := false;
end;
procedure TestInMem( aFilt: string;
aRecs: array of integer );
var
cnt: integer;
begin
Q.Prepare;
Q.Filtered := true;
Say( 'In Memory Filter = ' + aFilt );
Q.Filter := aFilt;
Q.First;
cnt := Q.RecordCount;
while not Q.Eof do
begin
Say( ' RowVal: ' + IntToStr( Q['ID'] ));
if Q.RowNum <= High( aRecs ) + 1 then
CheckTrue( Q['ID'] = aRecs[ Q.RowNum - 1 ] )
else
Say( ' Record is not present in test array.' );
Q.Next;
end;
CheckTrue( cnt = High( aRecs ) + 1 );
end;
var
T: TIBOTable;
F: TField;
begin
Say( '-------------------------------' );
Say( 'Testing Filter' );
Say( '-------------------------------' );
Create_Database( 'BUG_0003' );

Q := TIB_Query.Create( Session );
try
Q.IB_Connection := Connection;
Q.IB_Transaction := Transaction;
Q.SQL.Text := 'SELECT ID, COL1, COL2 FROM COUNT_TEST C';
TestFilt( 'ID = ''2''' );
TestFilt( '(C.ID <> ''2'') and (not ((C.COL1 = ''Two'') and (C.COL2 <> ''Three'')))' );
TestFilt( '(C.ID <> ''2'') and not ((C.COL1 = ''Two'') and (C.COL2 <> ''Three''))' );
TestFilt( '( C.COL1 like ''%M A%'' )' );
// TestFilt( '( C.COL1 like (''%M A%'') )' );// Not critical to support this.
TestFilt( '( (C.COL1) like ''%M A%'' )' );
TestFilt( '( UPPER (C.COL1) like ''%M A%'' )' );
TestFilt( 'NOT ( UPPER (C.COL1) like ''%M A%'' )' );
TestFilt( 'C.ID between 2 and 5' );
TestFilt( 'C.ID between ''2'' and 5' );
Q.Unprepare;
Q.FilterOptions := [ fopInMemory, fopCaseInsensitive ];
Q.Filtered := true;
Q.Open;
Q.FetchAll;
CheckTrue( LikeCompare( '%o%', 'four' ));
CheckTrue( not LikeCompare( '%o', 'four' ));
TestInMem( 'C.ID = 2', [ 2 ] );
TestInMem( 'C.ID <> 2', [ 0,1,3,4,5,6,7,8,9 ] );
TestInMem( 'NOT C.ID <> 2', [ 2 ] );
TestInMem( 'C.ID = 2', [ 2 ] );
TestInMem( 'C.ID > 5', [ 6,7,8,9 ] );
TestInMem( 'C.ID >= 5', [ 5,6,7,8,9 ] );
TestInMem( 'C.ID < 3', [ 0,1,2 ] );
TestInMem( 'C.ID <= 3', [ 0,1,2,3 ] );
TestInMem( '( C.ID <= 3 )', [ 0,1,2,3 ] );
TestInMem( '(( C.ID <= 3 ))', [ 0,1,2,3 ] );
TestInMem( '( NOT ( C.ID <= 3 ))', [ 4,5,6,7,8,9 ] );
TestInMem( 'NOT ( NOT ( C.ID <= 3 ))', [ 0,1,2,3 ] );
TestInMem( '(( C.ID <= 3 ) AND ( C.ID >= 2 ))', [ 2,3 ] );
TestInMem( '(( C.ID > 6 ) OR ( C.ID < 2 ))', [ 0,1,7,8,9 ] );
TestInMem( '(( C.ID > 6 ) OR ( C.ID < 2 )) AND ( C.ID <> 9 )', [0,1,7,8] );
TestInMem( 'C.ID between ''2'' and 5', [ 2,3,4,5 ] );
TestInMem( 'NOT C.ID between ''2'' and 5', [ 0,1,6,7,8,9 ] );
TestInMem( 'NOT C.ID NOT between ''2'' and 5', [ 2,3,4,5 ] );
TestInMem( '(C.ID <> ''2'') and not ((C.COL1 = ''Two'') and (C.COL2 <> ''Three''))', [ 0,1,3,4,5,6,7,8,9 ] );
TestInMem( '( (C.COL1) like ''%M A%'' )', [] );
TestInMem( '( ((C.COL1)) like ''%M A%'' )', [] );
TestInMem( '( ((C.COL1)) like ''%o%'' )', [ 0,1,2,4 ] );
TestInMem( 'C.COL2 between ''2'' and 5', [ 2,3,4,5 ] );
TestInMem( 'C.COL1 between ''Three'' and Two', [ 2,3 ] );
TestInMem( 'C.COL1 Starting ''T''', [ 2,3 ] );
TestInMem( 'C.COL1 like ''T%''', [ 2,3 ] );
TestInMem( 'C.COL1 like ''Tw%''', [ 2 ] );
TestInMem( 'C.COL1 between ''Three'' and Two', [ 2,3 ] );
TestInMem( 'C.COL1 between ''three'' and two', [ 2,3 ] );
CheckTrue( Q.RecordCount = 2 );
Q.FilterOptions := [ fopInMemory{, fopCaseInsensitive} ];
CheckTrue( Q.RecordCount = 0 );
TestInMem( 'C.COL1 between ''three'' and two', [ ] );
TestInMem( 'C.COL1 between ''Ten'' and ''Zero''', [ 0,2,3 ] );
TestInMem( '( ((C.COL1)) like ''%o%'' )', [ 0,2,4 ] );
TestInMem( '( ((C.COL1)) like ''%o'' )', [ 0,2 ] );
{todo: Put in support for the SIMILAR and IN operators.}
Q.Close;
Say( '-------------------------------------------');
Say( 'Success!' );
Say( '-------------------------------------------');
finally
Q.Free;
end;

T := TIBOTable.Create( Session );
try
T.IB_Connection := Connection;
T.IB_Transaction := Transaction;
T.PreparedEdits := true;
T.RecordCountAccurate := true;
T.FetchWholeRows := true;
T.FieldOptions := [];
T.TableName := 'tilesets';
T.Filtered := false;
with TIntegerField.Create( T ) do
begin
Name := 'tilesetsID';
FieldName := 'aid';
Origin := 'tilesets.id';
ProviderFlags := [pfInUpdate, pfInWhere, pfInKey];
Dataset := T;
end;
T.Open;
CheckTrue( T.InternalDataset.KeyLinksAreDBKey,
'KeyLinks should be the DB_KEY' );
T.Filter := 'id = 1';
T.Filtered := true;
CheckTrue( T.FieldCount = 1 );
CheckTrue( T.InternalDataset.FieldCount = 2 );

T.Unprepare;
F := TIntegerField.Create( T );
with F do
begin
Name := 'tilesetsGroupOrder';
FieldName := 'group_order';
ProviderFlags := [pfInUpdate, pfInWhere, pfInKey];
Dataset := T;
end;
T.Open;
CheckTrue( not T.InternalDataset.KeyLinksAreDBKey,
'KeyLinks should NOT be the DB_KEY' );
T.Filter := 'id = 2';
T.Filtered := true;
CheckTrue( T.FieldCount = 2 );
CheckTrue( T.InternalDataset.FieldCount = 2 );

T.Unprepare;
F.Name := 'tilesetsgroupId';
F.FieldName := 'group_id';
T.Open;
CheckTrue( not T.InternalDataset.KeyLinksAreDBKey,
'KeyLinks should NOT be the DB_KEY' );
T.Filter := 'id = 2';
T.Filtered := true;
CheckTrue( T.FieldCount = 2 );
CheckTrue( T.InternalDataset.FieldCount = 2 );

finally
T.Free;
end;

Remove_Database( 'BUG_0003' );
end;

procedure TTestCaseFixed.Test_BlobLoad;
var
q: TIB_Query;
sl1, sl2: TIB_StringList;
begin
Say( '----------------------------');
Say( 'Testing BlobLoad' );
Say( '----------------------------');
Create_Database( 'RegTest' );
sl1 := TIB_StringList.Create;
sl2 := TIB_StringList.Create;
q := TIB_Query.Create( Session );
try
q.IB_Connection := Connection;
q.IB_Transaction := Transaction;
q.RequestLive := true;
q.SQL.Text := 'SELECT * FROM TEST_BLOB';
q.Open;
q.Edit;
q.FieldByName('col1').LoadFromFile( ddlPathPrefix + 'slice.txt' );
q.Post;
q.Close;
if FileExists( ddlPathPrefix + 'slice.new' ) then
DeleteFile( ddlPathPrefix + 'slice.new' );
q.Open;
q.FieldByName('col1').SaveToFile( ddlPathPrefix + 'slice.new' );
q.Close;
sl1.LoadFromFile( ddlPathPrefix + 'slice.txt' );
sl2.LoadFromFile( ddlPathPrefix + 'slice.new' );
CheckTrue( sl1.Equals( sl2 ), 'Problem with BLOB load/save from/to file.' );
if FileExists( ddlPathPrefix + 'slice.new' ) then
DeleteFile( ddlPathPrefix + 'slice.new' );
Say( 'Testing Blob.Clear' );
q.Open;
q.Edit;
q.FieldByName('col1').Clear;
q.Post;
q.Close;
q.Open;
CheckTrue( q.FieldByName('col1').IsNull, 'Problem with Blob.Clear.' );
Say( '----------------------------');
Say( 'Success!' );
Say( '----------------------------');
finally
sl1.Free;
sl2.Free;
q.Free;
end;
Remove_Database( 'RegTest' );
end;

procedure TTestCaseFixed.Test_DMLCaching;
function MakeQuery: TIB_Query;
begin
Result := TIB_Query.Create( Session );
Result.IB_Connection := Connection;
Result.IB_Transaction := Transaction;
Result.SQL.Text := 'SELECT CUSTOMER_ID, LASTNAME FROM CUSTOMER';
Result.KeyRelation := 'CUSTOMER';
if Result.ReturningClauseSupported( dssInsert ) then
Result.FieldsReadOnly.Text := 'CUSTOMER_ID=TRUE'
else
Result.GeneratorLinks.Add( 'CUSTOMER_ID=GEN_CUSTOMER_ID' );
Result.RequestLive := true;
Result.AutoFetchAll := true;
Result.FetchWholeRows := false;
Result.DMLCacheFlags := [ dcfAnnounceEdit,
dcfAnnounceInsert,
dcfAnnounceDelete,
dcfReceiveEdit,
dcfReceiveInsert,
dcfReceiveDelete ];
Result.KeyLinks.Text := 'CUSTOMER_ID';
Result.KeyLinksAutoDefine := False;
Result.BufferSynchroFlags := [ bsAfterInsert ];
Result.Open;
end;
var
q1: TIB_Query;
q2: TIB_Query;
c1, c2: integer;
v: variant;
begin
Say( '-------------------------------------------');
Say( 'Testing DMLCaching' );
Say( '-------------------------------------------');
Create_Database( 'DMLCaching' );
q1 := MakeQuery;
q2 := MakeQuery;
try
q1.Insert;
q1['LASTNAME'] := 'Smith';
q2.Insert;
q2['LASTNAME'] := 'Jones';
q2.Post;
c1 := q1.BufferRowCount;
q1.Post;
c2 := q1.BufferRowCount;
CheckEquals(6, c1, 'IncorrectCount.' );
CheckEquals(7, c2, 'IncorrectCount.' );
v := q1.Lookup( 'CUSTOMER_ID', q2['CUSTOMER_ID'], 'LASTNAME' );
CheckEqualsString( 'Jones', v, 'Record doesn''t exist.' );
Say( '-------------------------------------------');
Say( 'Success!' );
Say( '-------------------------------------------');
finally
q1.Free;
q2.Free;
end;
Remove_Database( 'DMLCaching' );
end;

procedure TTestCaseFixed.Test_ScriptParseProblem;
begin
Say( '--------------------------' );
Say( 'Testing ScriptParseProblem' );
Say( '--------------------------' );
Create_Database( 'BUG_0004' );
Say( '-------------------------------------------');
Say( 'Success!' );
Say( '-------------------------------------------');
Remove_Database( 'BUG_0004' );
end;

procedure TTestCaseFixed.Test_StringList;
var
sl: TIB_StringList;
ii: integer;
begin
Say( '-------------------------------------------');
Say( 'Testing StringList' );
Say( '-------------------------------------------');
sl := TIB_StringProperty.Create;
try
sl.Add('"ORDER"');
sl.Add('ORDER');
CheckTrue( sl.Count = 2 );
sl.StoresLinks := true;
sl.Clear;
sl.Sorted := true;
sl.Add('"ORDER"');
sl.Add('ORDER');
CheckTrue( sl.Count = 1 );
finally
sl.Free;
end;
sl := TIB_StringList.Create;
try
sl.Add('EL=P1=001;P2=02;P3=003');
sl.IndexParamValue[ 0, 'P2' ] := '002';
CheckEqualsString( '001', sl.IndexParamValue[0,'P1'], 'Invalid IndexParamValue 001.' );
CheckEqualsString( '002', sl.IndexParamValue[0,'P2'], 'Invalid IndexParamValue 002.' );
CheckEqualsString( '003', sl.IndexParamValue[0,'P3'], 'Invalid IndexParamValue 003.' );
sl.IndexParamValue[ 0, 'P3' ] := '03';
CheckEqualsString( '03', sl.IndexParamValue[0,'P3'], 'Invalid IndexParamValue 03.' );
sl.IndexParamValue[ 0, 'P1' ] := '01';
CheckEqualsString( '01', sl.IndexParamValue[0,'P1'], 'Invalid IndexParamValue 01.' );
sl.IndexParamValue[ 0, 'P2' ] := '02';
CheckEqualsString( '02', sl.IndexParamValue[0,'P2'], 'Invalid IndexParamValue 02.' );
finally
sl.Free;
end;
sl := TIB_StringList.Create;
try
sl.Sorted := True;
sl.StoresLinks := True;
sl.Add('EMPLOYEE_CONTACTS=ID,CONTACT_ID');
Say( 'Added: EMPLOYEE_CONTACTS=ID,CONTACT_ID' );
sl.Add('EMPLOYEE=ID');
Say( 'Added: EMPLOYEE=ID' );
Say( 'List contents:' );
Say( sl.Text );
ii := -1;
if sl.FindIndex('EMPLOYEE_CONTACTS', ii) then
Say( 'I found it: ' + sl.IndexValues[ii] )
else
begin
Say( 'Could not find index: EMPLOYEE_CONTACTS in this list:' );
Say( sl.Text );

Say( '' );
Say( 'Resorting' );
sl.Sort; {added for testing JLW}
if sl.FindIndex('EMPLOYEE_CONTACTS', ii) then
Say( 'I found it: ' + sl.IndexValues[ii] )
else
raise Exception.Create('I still can�t find it!');
end;
finally
sl.Free;
end;
Say( '-------------------------------------------');
Say( 'Success!' );
Say( '-------------------------------------------');
end;

procedure TTestCaseFixed.Test_LiteralText;
var
q: TIB_Query;
c: TIB_Cursor;
d: TIBOQuery;
v: variant;
begin
Say( '----------------------------');
Say( 'Testing LiteralText' );
Say( '----------------------------');
Create_Database( 'RegTest' );
q := TIB_Query.Create( Session );
try
q.IB_Connection := Connection;
q.IB_Transaction := Transaction;
q.SQL.Text := 'SELECT ''test'' FROM RDB$DATABASE';
q.Open;
CheckEqualsString( 'test', q.Fields[0].AsString, 'Invalid literal text.' );
finally
q.Free;
end;
c := TIB_Cursor.Create( Session );
try
c.IB_Connection := Connection;
c.IB_Transaction := Transaction;
c.SQL.Text := 'SELECT ''test'' FROM RDB$DATABASE';
c.First;
CheckEqualsString( 'test', c.Fields[0].AsString, 'Invalid literal text.' );
finally
c.Free;
end;
d := TIBOQuery.Create( Session );
try
d.IB_Connection := Connection;
d.IB_Transaction := Transaction;
d.SQL.Text := 'SELECT ''test'' as ttt FROM RDB$DATABASE';
d.Open;
Say( 'd.Fields[0].ClassName = ' + d.Fields[0].ClassName );
CheckEqualsString( 'test', d.Fields[0].AsString, 'Invalid literal text.' );
v := d.Fields[0].Value;
CheckEqualsString( 'test', v, 'Invalid literal text' );
finally
d.Free;
end;
Connection.Disconnect;
Connection.Connect;
d := TIBOQuery.Create( Session );
try
d.IB_Connection := Connection;
d.IB_Transaction := Transaction;
d.SQL.Text := 'SELECT ''test'' as ttt FROM RDB$DATABASE';
d.Open;
Say( 'd.Fields[0].ClassName = ' + d.Fields[0].ClassName );
CheckEqualsString( 'test', d.Fields[0].AsString, 'Invalid literal text.' );
v := d.Fields[0].Value;
CheckEqualsString( 'test', v, 'Invalid literal text.' );
finally
d.Free;
end;
Say( '----------------------------');
Say( 'Success!' );
Say( '----------------------------');
Remove_Database( 'RegTest' );
end;

procedure TTestCaseFixed.Test_Array;
var
q: TIB_Query;
qr: TIBOQuery;
ca: array [1..5] of array [1..10] of ansichar;
ia: array [1..5, 1..2] of integer;
ra: array [0..8, 0..2] of single;
da: array [1..8, 1..2] of double;
ii: integer;
jj: integer;
kk: integer;
ll: integer;
DimBoundsV: array [0..1] of integer;
DimBounds: array [0..5] of integer;
DimBoundsB: array [0..7] of integer;
v: variant;
tmpArrayCol: TIB_ColumnArray;
tmpArrayFld: TIBOArrayField;
sca: string;
sva: string;
sia: string;
sra: string;
sda: string;
sd42a: string;
sd84a: string;
sd18a: string;
sba: string;
vca: variant;
vva: variant;
via: variant;
vra: variant;
vda: variant;
vd42a: variant;
vd84a: variant;
vd18a: variant;
vba: variant;
slicestr: string;
sqlstr: string;
colstr: string;
vrar: variant;
begin
Say( '-----------------------------------' );
Say( 'Testing Array Column Support' );
Say( '-----------------------------------' );
Create_Database( 'TEST_0001' );
q := TIB_Query.Create( Session );
try
q.IB_Connection := Connection;
q.IB_Transaction := Transaction;
q.RequestLive := true;
q.SQL.Add( 'SELECT a.*' );
q.SQL.Add( ' , DOUBLEARRAY[1,1] as dbl11' );
q.SQL.Add( ' , DOUBLEARRAY[1,2] as dbl12' );
q.SQL.Add( ' , DOUBLEARRAY[2,1] as dbl21' );
q.SQL.Add( ' , DOUBLEARRAY[2,2] as dbl22' );
q.SQL.Add( ' , DOUBLEARRAY[3,1] as dbl31' );
q.SQL.Add( ' , DOUBLEARRAY[3,2] as dbl32' );
q.SQL.Add( ' , DOUBLEARRAY[4,1] as dbl41' );
q.SQL.Add( ' , DOUBLEARRAY[4,2] as dbl42' );
q.SQL.Add( ' , DOUBLEARRAY[5,1] as dbl51' );
q.SQL.Add( ' , DOUBLEARRAY[5,2] as dbl52' );
q.SQL.Add( ' , DOUBLEARRAY[6,1] as dbl61' );
q.SQL.Add( ' , DOUBLEARRAY[6,2] as dbl62' );
q.SQL.Add( ' , DOUBLEARRAY[7,1] as dbl71' );
q.SQL.Add( ' , DOUBLEARRAY[7,2] as dbl72' );
q.SQL.Add( ' , DOUBLEARRAY[8,1] as dbl81' );
q.SQL.Add( ' , DOUBLEARRAY[8,2] as dbl82' );
q.SQL.Add( 'FROM ARRAYS a' );
q.ColumnAttributes.Add( 'DBL11=COMPUTED' );
q.ColumnAttributes.Add( 'DBL12=COMPUTED' );
q.ColumnAttributes.Add( 'DBL21=COMPUTED' );
q.ColumnAttributes.Add( 'DBL22=COMPUTED' );
q.ColumnAttributes.Add( 'DBL31=COMPUTED' );
q.ColumnAttributes.Add( 'DBL32=COMPUTED' );
q.ColumnAttributes.Add( 'DBL41=COMPUTED' );
q.ColumnAttributes.Add( 'DBL42=COMPUTED' );
q.ColumnAttributes.Add( 'DBL51=COMPUTED' );
q.ColumnAttributes.Add( 'DBL52=COMPUTED' );
q.ColumnAttributes.Add( 'DBL61=COMPUTED' );
q.ColumnAttributes.Add( 'DBL62=COMPUTED' );
q.ColumnAttributes.Add( 'DBL71=COMPUTED' );
q.ColumnAttributes.Add( 'DBL72=COMPUTED' );
q.ColumnAttributes.Add( 'DBL81=COMPUTED' );
q.ColumnAttributes.Add( 'DBL82=COMPUTED' );

q.Insert;
q['ID'] := 1;

// CHARARRAY CHAR(10)[5],

ca[1] := 'One ';
ca[2] := 'Two ';
ca[3] := 'Three ';
ca[4] := 'Four ';
ca[5] := 'Five ';

tmpArrayCol := q.FieldByName('CHARARRAY') as TIB_ColumnArray;
tmpArrayCol.PutArray( @ca, SizeOf( ca ));

// VARCHARARRAY VARCHAR(10)[5],

DimBoundsV[0] := 1;
DimBoundsV[1] := 5;
v := VarArrayCreate( DimBoundsV, varOLEStr );
v[1] := 'One';
v[2] := 'Two';
v[3] := 'Three';
v[4] := 'Four';
v[5] := 'Five';
q['VARCHARARRAY'] := v;

// INTEGERARRAY INTEGER[5, 2],

for ii := 1 to 5 do
for jj := 1 to 2 do
ia[ii,jj] := ii * 5 + jj;

tmpArrayCol := q.FieldByName('INTEGERARRAY') as TIB_ColumnArray;
tmpArrayCol.PutArray( @ia, SizeOf( ia ));

// REALARRAY FLOAT[0:8, 0:2],

for ii := 0 to 8 do
for jj := 0 to 2 do
ra[ii,jj] := (( ii + 1 ) * 8 ) / ( jj + 1 );

tmpArrayCol := q.FieldByName('REALARRAY') as TIB_ColumnArray;
tmpArrayCol.PutArray( @ra, SizeOf( ra ));

// DOUBLEARRAY FLOAT[1:8, 1:2],

for ii := 1 to 8 do
for jj := 1 to 2 do
da[ii,jj] := (( ii + 1 ) * 8 ) / ( jj + 1 );

tmpArrayCol := q.FieldByName('DOUBLEARRAY') as TIB_ColumnArray;
tmpArrayCol.PutArray( @da, SizeOf( da ));

// DECIMALARRAY DECIMAL()[2, 2, 2],

DimBounds[0] := 1;
DimBounds[1] := 2;
DimBounds[2] := 1;
DimBounds[3] := 2;
DimBounds[4] := 1;
DimBounds[5] := 2;
v := VarArrayCreate( DimBounds, varDouble );

// DECIMALARRAY42 DECIMAL(4,2)[2, 2, 2],

v[1,1,1] := 1.1;
v[1,1,2] := 2.2;
v[1,2,1] := 3.3;
v[1,2,2] := 4.4;
v[2,1,1] := 5.5;
v[2,1,2] := 6.6;
v[2,2,1] := 7.7;
v[2,2,2] := 8.8;
q['DECIMALARRAY42'] := v;

// DECIMALARRAY84 DECIMAL(8,4)[2, 2, 2],

v[1,1,1] := 1.111;
v[1,1,2] := 2.222;
v[1,2,1] := 3.333;
v[1,2,2] := 4.444;
v[2,1,1] := 5.555;
v[2,1,2] := 6.666;
v[2,2,1] := 7.777;
v[2,2,2] := 8.888;
q['DECIMALARRAY84'] := v;

// DECIMALARRAY18 DECIMAL(18,6)[2, 2, 2],

v[1,1,1] := 1.11111;
v[1,1,2] := 2.22222;
v[1,2,1] := 3.33333;
v[1,2,2] := 4.44444;
v[2,1,1] := 5.55555;
v[2,1,2] := 6.66666;
v[2,2,1] := 7.77777;
v[2,2,2] := 8.88888;
q['DECIMALARRAY18'] := v;

// BIGINTARRAY BIGINT[2, 3, 4, 5],

DimBoundsB[0] := 1;
DimBoundsB[1] := 2;
DimBoundsB[2] := 1;
DimBoundsB[3] := 3;
DimBoundsB[4] := 1;
DimBoundsB[5] := 4;
DimBoundsB[6] := 1;
DimBoundsB[7] := 5;
v := VarArrayCreate( DimBoundsB, varOLEStr );
for ii := 1 to 5 do
for jj := 1 to 4 do
for kk := 1 to 3 do
for ll := 1 to 2 do
v[ll,kk,jj,ii] := IntToStr( ll ) +
IntToStr( kk ) +
IntToStr( jj ) +
IntToStr( ii );
q['BIGINTARRAY'] := v;

q.Post;
q.Close;

// Test to see if stuff works.

q.Open;
q.First;
sca := q.FieldByName('CHARARRAY').AsString;
sva := q.FieldByName('VARCHARARRAY').AsString;
sia := q.FieldByName('INTEGERARRAY').AsString;
sra := q.FieldByName('REALARRAY').AsString;
sda := q.FieldByName('DOUBLEARRAY').AsString;
sd42a := q.FieldByName('DECIMALARRAY42').AsString;
sd84a := q.FieldByName('DECIMALARRAY84').AsString;
sd18a := q.FieldByName('DECIMALARRAY18').AsString;
sba := q.FieldByName('BIGINTARRAY').AsString;
Say( 'CHARARRAY:'#13#10 + sca );
Say( 'VARCHARARRAY:'#13#10 + sva );
Say( 'INTEGERARRAY:'#13#10 + sia );
Say( 'REALARRAY:'#13#10 + sra );
Say( 'DOUBLEARRAY:'#13#10 + sda );
Say( 'DECIMALARRAY42:'#13#10 + sd42a );
Say( 'DECIMALARRAY84:'#13#10 + sd84a );
Say( 'DECIMALARRAY18:'#13#10 + sd18a );
Say( 'BIGINTARRAY:'#13#10 + sba );
vca := q['CHARARRAY'];
vva := q['VARCHARARRAY'];
via := q['INTEGERARRAY'];
vra := q['REALARRAY'];
vda := q['DOUBLEARRAY'];
vd42a := q['DECIMALARRAY42'];
vd84a := q['DECIMALARRAY84'];
vd18a := q['DECIMALARRAY18'];
vba := q['BIGINTARRAY'];
q.Insert;
q['ID'] := 2;
q.FieldByName('CHARARRAY').AsString := sca;
q.FieldByName('VARCHARARRAY').AsString := sva;
q.FieldByName('INTEGERARRAY').AsString := sia;
q.FieldByName('REALARRAY').AsString := sra;
q.FieldByName('DOUBLEARRAY').AsString := sda;
q.FieldByName('DECIMALARRAY42').AsString := sd42a;
q.FieldByName('DECIMALARRAY84').AsString := sd84a;
q.FieldByName('DECIMALARRAY18').AsString := sd18a;
q.FieldByName('BIGINTARRAY').AsString := sba;
q.Post;
q.Insert;
q['ID'] := 300;
q['CHARARRAY' ] := vca;
q['VARCHARARRAY' ] := vva;
q['INTEGERARRAY' ] := via;
q['REALARRAY' ] := vra;
q['DOUBLEARRAY' ] := vda;
q['DECIMALARRAY42'] := vd42a;
q['DECIMALARRAY84'] := vd84a;
q['DECIMALARRAY18'] := vd18a;
q['BIGINTARRAY' ] := vba;
q.Post;
q.Close;
q.Open;
q.First;
if q.Locate( 'ID', 2, [] ) then
begin
CheckEqualsString( sca, q.FieldByName( 'CHARARRAY' ).AsString, 'Oops.' );
CheckEqualsString( sva, q.FieldByName( 'VARCHARARRAY' ).AsString, 'Oops.' );
CheckEqualsString( sia, q.FieldByName( 'INTEGERARRAY' ).AsString, 'Oops.' );
CheckEqualsString( sra, q.FieldByName( 'REALARRAY' ).AsString, 'Oops.' );
CheckEqualsString( sda, q.FieldByName( 'DOUBLEARRAY' ).AsString, 'Oops.' );
CheckEqualsString( sd42a, q.FieldByName( 'DECIMALARRAY42').AsString, 'Oops.' );
CheckEqualsString( sd84a, q.FieldByName( 'DECIMALARRAY84').AsString, 'Oops.' );
CheckEqualsString( sd18a, q.FieldByName( 'DECIMALARRAY18').AsString, 'Oops.' );
CheckEqualsString( sba, q.FieldByName( 'BIGINTARRAY' ).AsString, 'Oops.' );
CheckTrue( VarSameValueEx( q['CHARARRAY' ], vca ), 'Oops.' );
CheckTrue( VarSameValueEx( q['VARCHARARRAY' ], vva ), 'Oops.' );
CheckTrue( VarSameValueEx( q['INTEGERARRAY' ], via ), 'Oops.' );
CheckTrue( VarSameValueEx( q['REALARRAY' ], vra ), 'Oops.' );
CheckTrue( VarSameValueEx( q['DOUBLEARRAY' ], vda ), 'Oops.' );
CheckTrue( VarSameValueEx( q['DECIMALARRAY42'], vd42a ), 'Oops.' );
CheckTrue( VarSameValueEx( q['DECIMALARRAY84'], vd84a ), 'Oops.' );
CheckTrue( VarSameValueEx( q['DECIMALARRAY18'], vd18a ), 'Oops.' );
CheckTrue( VarSameValueEx( q['BIGINTARRAY' ], vba ), 'Oops.' );
end
else
raise Exception.Create( 'Failed to locate record ID = 2' );
if q.Locate( 'ID', 300, [] ) then
begin
CheckEqualsString( sca, q.FieldByName('CHARARRAY' ).AsString, 'Oops.' );
CheckEqualsString( sva, q.FieldByName('VARCHARARRAY' ).AsString, 'Oops.' );
CheckEqualsString( sia, q.FieldByName('INTEGERARRAY' ).AsString, 'Oops.' );
{$IFDEF IBO_VCL60_OR_GREATER}
CheckEqualsString( sra, q.FieldByName('REALARRAY' ).AsString, 'Oops.' );
{$ENDIF}
CheckEqualsString( sda, q.FieldByName('DOUBLEARRAY' ).AsString, 'Oops.' );
CheckEqualsString( sd42a, q.FieldByName('DECIMALARRAY42').AsString, 'Oops.' );
CheckEqualsString( sd84a, q.FieldByName('DECIMALARRAY84').AsString, 'Oops.' );
CheckEqualsString( sd18a, q.FieldByName('DECIMALARRAY18').AsString, 'Oops.' );
CheckEqualsString( sba, q.FieldByName('BIGINTARRAY' ).AsString, 'Oops.' );
CheckTrue( VarSameValueEx( q['CHARARRAY' ], vca ), 'Oops.' );
CheckTrue( VarSameValueEx( q['VARCHARARRAY' ], vva ), 'Oops.' );
CheckTrue( VarSameValueEx( q['INTEGERARRAY' ], via ), 'Oops.' );
CheckTrue( VarSameValueEx( q['REALARRAY' ], vra ), 'Oops.' );
CheckTrue( VarSameValueEx( q['DOUBLEARRAY' ], vda ), 'Oops.' );
CheckTrue( VarSameValueEx( q['DECIMALARRAY42'], vd42a ), 'Oops.' );
CheckTrue( VarSameValueEx( q['DECIMALARRAY84'], vd84a ), 'Oops.' );
CheckTrue( VarSameValueEx( q['DECIMALARRAY18'], vd18a ), 'Oops.' );
CheckTrue( VarSameValueEx( q['BIGINTARRAY' ], vba ), 'Oops.' );
end
else
raise Exception.Create( 'Failed to locate record ID = 300' );

q.First;
{$IFDEF IBO_VCL60_OR_GREATER}
vrar := VarArrayCreate( [1,1], varWord );
{$ELSE}
vrar := VarArrayCreate( [1,1], varInteger );
{$ENDIF}
vrar[1] := 300;
if not q.Locate( 'ID', vrar, [] ) then
raise Exception.Create( 'Failed to locate record ID = 300' );

tmpArrayCol := q.FieldByName('DOUBLEARRAY') as TIB_ColumnArray;

slicestr := tmpArrayCol.GetStrSlice( [1,2,1,2] );
Say( 'GetStrSlice[1,2,1,2]:'#13#10 + slicestr );

slicestr := tmpArrayCol.GetStrSlice( [3,5,1,2] );
Say( 'GetStrSlice[3,5,1,2]:'#13#10 + slicestr );

slicestr := tmpArrayCol.GetStrSlice( [3,5,1,1] );
Say( 'GetStrSlice[3,5,1,1]:'#13#10 + slicestr );

slicestr := tmpArrayCol.GetStrSlice( [3,5,2,2] );
Say( 'GetStrSlice[3,5,2,2]:'#13#10 + slicestr );

slicestr := tmpArrayCol.GetStrSlice( [3,3,2,2] );
Say( 'GetStrSlice[3,3,2,2]:'#13#10 + slicestr );

slicestr := tmpArrayCol.GetStrSlice( [3,3,1,2] );
Say( 'GetStrSlice[3,3,1,2]:'#13#10 + slicestr );

slicestr := tmpArrayCol.GetStrSlice( [3,4,1,2] );
Say( 'GetStrSlice[3,4,1,2]:'#13#10 + slicestr );

Say( 'Dbl11 = ' + q.FieldByName('dbl11').AsString );
Say( 'Dbl12 = ' + q.FieldByName('dbl12').AsString );
Say( 'Dbl21 = ' + q.FieldByName('dbl21').AsString );
Say( 'Dbl22 = ' + q.FieldByName('dbl22').AsString );
Say( 'Dbl31 = ' + q.FieldByName('dbl31').AsString );
Say( 'Dbl32 = ' + q.FieldByName('dbl32').AsString );
Say( 'Dbl41 = ' + q.FieldByName('dbl41').AsString );
Say( 'Dbl42 = ' + q.FieldByName('dbl42').AsString );
Say( 'Dbl51 = ' + q.FieldByName('dbl51').AsString );
Say( 'Dbl52 = ' + q.FieldByName('dbl52').AsString );
Say( 'Dbl61 = ' + q.FieldByName('dbl61').AsString );
Say( 'Dbl62 = ' + q.FieldByName('dbl62').AsString );
Say( 'Dbl71 = ' + q.FieldByName('dbl71').AsString );
Say( 'Dbl72 = ' + q.FieldByName('dbl72').AsString );
Say( 'Dbl81 = ' + q.FieldByName('dbl81').AsString );
Say( 'Dbl82 = ' + q.FieldByName('dbl82').AsString );

Say( '----------------------------------------' );
Say( 'FieldSource' );
Say( '----------------------------------------' );
for ii := 0 to q.FieldCount - 1 do
with q.Fields[ii] do
if not Computed then
Say( FieldSource[ false ] );

sqlstr := q.SQL.Text;
colstr := q.ColumnAttributes.Text;

if Connection.Characteristics.dbFBVersion = '' then
begin

Say( '---------------------------------' );
Say( 'Test array of BOOLEAN' );
Say( '---------------------------------' );

q.ExecuteImmediate( 'create table test_ba' +
'( id integer not null primary key' +
', boolcol boolean' +
', sintarray smallint[ 2 ]' +
', boolarray boolean[ 2 ] )' );
Transaction.SavePoint;
q.ExecuteDML( 'insert into test_ba( id, boolcol ) values ( 1, true )' );
Transaction.SavePoint;
q.SQL.Clear;
q.SQL.Add( 'select id' );
q.SQL.Add( ' , boolcol' );
q.SQL.Add( ' , boolarray' );
q.SQL.Add( ' , sintarray' );
q.SQL.Add( 'from test_ba' );
q.KeyLinks.Text := 'ID';
q.Open;

Say( '---------' );
Say( 'SQL Types' );
Say( '---------' );
for ii := 0 to q.FieldCount - 1 do
Say( q.Fields[ii].FieldName + ' ' + q.Fields[ii].SQLTypeSource[ false ] );
Say( '---------' );

Say( 'boolarray = ' + q.FieldByName( 'boolarray' ).AsString );
CheckEqualsString( '', q.FieldByName( 'boolarray' ).AsString );
Say( 'sintarray = ' + q.FieldByName( 'sintarray' ).AsString );
CheckEqualsString( '', q.FieldByName( 'sintarray' ).AsString );
Say( 'boolcol = ' + q.FieldByName( 'boolcol' ).AsString );
CheckEqualsString( ISC_TRUE_Str, q.FieldByName( 'boolcol' ).AsString );

q.Edit;
v := CreateVarArray( 1, [1,2], varSmallInt );
v[1] := ISC_TRUE;
v[2] := ISC_FALSE;
q.FieldByName( 'sintarray' ).Value := v;
v := CreateVarArray( 1, [1,2], varBoolean );
v[1] := true;
v[2] := false;
q.FieldByName( 'boolarray' ).Value := v;
v := CreateVarArray( 1, [1,2], varSmallInt );
v[1] := ISC_TRUE;
v[2] := ISC_FALSE;
q.FieldByName( 'boolarray' ).Value := v;
v := CreateVarArray( 1, [1,2], varOLEStr );
v[1] := ISC_TRUE_Str;
v[2] := ISC_FALSE_Str;
q.FieldByName( 'boolarray' ).Value := v;
q.Post;
Say( 'boolarray = ' + q.FieldByName( 'boolarray' ).AsString );
CheckEqualsString( '(' + ISC_TRUE_Str + ', ' + ISC_FALSE_Str + ')',
q.FieldByName( 'boolarray' ).AsString );
Say( 'sintarray = ' + q.FieldByName( 'sintarray' ).AsString );
CheckEqualsString( '(1, 0)', q.FieldByName( 'sintarray' ).AsString );
Say( 'boolcol = ' + q.FieldByName( 'boolcol' ).AsString );
CheckEqualsString( ISC_TRUE_Str, q.FieldByName( 'boolcol' ).AsString );

q.Close;
q.ExecuteDML( 'update test_ba set boolcol = FALSE where id = 1' );
q.Open;

q.Edit;
q.FieldByName( 'boolarray' ).AsString := '( 1, 0 )';
q.Post;
Say( 'boolarray = ' + q.FieldByName( 'boolarray' ).AsString );
CheckEqualsString( '(' + ISC_TRUE_Str + ', ' + ISC_FALSE_Str + ')',
q.FieldByName( 'boolarray' ).AsString );
Say( 'sintarray = ' + q.FieldByName( 'sintarray' ).AsString );
CheckEqualsString( '(1, 0)', q.FieldByName( 'sintarray' ).AsString );
Say( 'boolcol = ' + q.FieldByName( 'boolcol' ).AsString );
CheckEqualsString( ISC_FALSE_Str, q.FieldByName( 'boolcol' ).AsString );
q.SQL.Clear;
q.SQL.Add( 'select b.id' );
q.SQL.Add( ' , b.boolcol' );
q.SQL.Add( ' , boolarray' );
q.SQL.Add( ' , sintarray' );
q.SQL.Add( ' , boolarray[1] as b1' );
q.SQL.Add( ' , boolarray[2] b2' );
q.SQL.Add( 'from test_ba b' );
q.KeyLinks.Text := 'ID';
q.Open;
Say( 'b1 = ' + q.FieldByName( 'b1' ).AsString );
Say( 'b2 = ' + q.FieldByName( 'b2' ).AsString );

q.Edit;
q.FieldByName( 'boolarray' ).Value := v;
q.Post;
CheckEqualsString( '(' + ISC_TRUE_Str + ', ' + ISC_FALSE_Str + ')',
q.FieldByName( 'boolarray' ).AsString );
end;

finally
q.Free;
end;

Say( '--------------------------------------' );
Say( 'TIBODataset array support' );
Say( '--------------------------------------' );

qr := TIBOQuery.Create( Session );
try
qr.IB_Connection := Connection;
qr.IB_Transaction := Transaction;
qr.SQL.Text := sqlstr;
qr.ColumnAttributes.Text := colstr;
qr.RequestLive := true;
qr.Open;

qr.Insert;
qr['ID'] := 4;

// CHARARRAY CHAR(10)[5],

ca[1] := 'One ';
ca[2] := 'Two ';
ca[3] := 'Three ';
ca[4] := 'Four ';
ca[5] := 'Five ';

tmpArrayFld := qr.FieldByName('CHARARRAY') as TIBOArrayField;
tmpArrayFld.PutArray( @ca, SizeOf( ca ));

// VARCHARARRAY VARCHAR(10)[5],

DimBoundsV[0] := 1;
DimBoundsV[1] := 5;
v := VarArrayCreate( DimBoundsV, varOLEStr );
v[1] := 'One';
v[2] := 'Two';
v[3] := 'Three';
v[4] := 'Four';
v[5] := 'Five';
{$IFDEF FPC}
qr.FieldByName('VARCHARARRAY').Value := v;
{$ELSE}
qr['VARCHARARRAY'] := v;
{$ENDIF}

// INTEGERARRAY INTEGER[5, 2],

for ii := 1 to 5 do
for jj := 1 to 2 do
ia[ii,jj] := ii * 5 + jj;

tmpArrayFld := qr.FieldByName('INTEGERARRAY') as TIBOArrayField;
tmpArrayFld.PutArray( @ia, SizeOf( ia ));

// REALARRAY FLOAT[0:8, 0:2],

for ii := 0 to 8 do
for jj := 0 to 2 do
ra[ii,jj] := (( ii + 1 ) * 8 ) / ( jj + 1 );

tmpArrayFld := qr.FieldByName('REALARRAY') as TIBOArrayField;
tmpArrayFld.PutArray( @ra, SizeOf( ra ));

// DOUBLEARRAY FLOAT[1:8, 1:2],

for ii := 1 to 8 do
for jj := 1 to 2 do
da[ii,jj] := (( ii + 1 ) * 8 ) / ( jj + 1 );

tmpArrayFld := qr.FieldByName('DOUBLEARRAY') as TIBOArrayField;
tmpArrayFld.PutArray( @da, SizeOf( da ));

// DECIMALARRAY DECIMAL()[2, 2, 2],

DimBounds[0] := 1;
DimBounds[1] := 2;
DimBounds[2] := 1;
DimBounds[3] := 2;
DimBounds[4] := 1;
DimBounds[5] := 2;
v := VarArrayCreate( DimBounds, varDouble );

// DECIMALARRAY42 DECIMAL(4,2)[2, 2, 2],

v[1,1,1] := 1.1;
v[1,1,2] := 2.2;
v[1,2,1] := 3.3;
v[1,2,2] := 4.4;
v[2,1,1] := 5.5;
v[2,1,2] := 6.6;
v[2,2,1] := 7.7;
v[2,2,2] := 8.8;
{$IFDEF FPC}
qr.FieldByName('DECIMALARRAY42').Value := v;
{$ELSE}
qr['DECIMALARRAY42'] := v;
{$ENDIF}

// DECIMALARRAY84 DECIMAL(8,4)[2, 2, 2],

v[1,1,1] := 1.111;
v[1,1,2] := 2.222;
v[1,2,1] := 3.333;
v[1,2,2] := 4.444;
v[2,1,1] := 5.555;
v[2,1,2] := 6.666;
v[2,2,1] := 7.777;
v[2,2,2] := 8.888;
{$IFDEF FPC}
qr.FieldByName('DECIMALARRAY84').Value := v;
{$ELSE}
qr['DECIMALARRAY84'] := v;
{$ENDIF}

// DECIMALARRAY18 DECIMAL(18,6)[2, 2, 2],

v[1,1,1] := 1.11111;
v[1,1,2] := 2.22222;
v[1,2,1] := 3.33333;
v[1,2,2] := 4.44444;
v[2,1,1] := 5.55555;
v[2,1,2] := 6.66666;
v[2,2,1] := 7.77777;
v[2,2,2] := 8.88888;
{$IFDEF FPC}
qr.FieldByName('DECIMALARRAY18').Value := v;
{$ELSE}
qr['DECIMALARRAY18'] := v;
{$ENDIF}

// BIGINTARRAY BIGINT[2, 3, 4, 5],

DimBoundsB[0] := 1;
DimBoundsB[1] := 2;
DimBoundsB[2] := 1;
DimBoundsB[3] := 3;
DimBoundsB[4] := 1;
DimBoundsB[5] := 4;
DimBoundsB[6] := 1;
DimBoundsB[7] := 5;
tmpArrayFld := qr.FieldByName('BIGINTARRAY') as TIBOArrayField;
v := VarArrayCreate( DimBoundsB, varOLEStr );
for ll := 1 to 2 do
for kk := 1 to 3 do
for jj := 1 to 4 do
for ii := 1 to 5 do
begin
v[ll,kk,jj,ii] := IntToStr( ll ) +
IntToStr( kk ) +
IntToStr( jj ) +
IntToStr( ii );
Say( '[' + IntToStr( ll ) + ', ' +
IntToStr( kk ) + ', ' +
IntToStr( jj ) + ', ' +
IntToStr( ii ) + ' ] = ' +
IntToStr( SysGetElementNo( tmpArrayFld.ArrayDesc,
[ll,kk,jj,ii] )));
end;

Say( 'Element Count = ' +
IntToStr( SysGetElementCount( tmpArrayFld.ArrayDesc )));
{$IFDEF FPC}
qr.FieldByName('BIGINTARRAY').Value := v;
{$ELSE}
qr['BIGINTARRAY'] := v;
{$ENDIF}

qr.Post;

Say( tmpArrayFld.AsString );

qr.Close;

// Test to see if stuff works.

qr.Open;
if not qr.Locate( 'ID', 4, [] ) then
raise Exception.Create( 'Failed to locate record ID = 4' );
sca := qr.FieldByName('CHARARRAY').AsString;
sva := qr.FieldByName('VARCHARARRAY').AsString;
sia := qr.FieldByName('INTEGERARRAY').AsString;
sra := qr.FieldByName('REALARRAY').AsString;
sda := qr.FieldByName('DOUBLEARRAY').AsString;
sd42a := qr.FieldByName('DECIMALARRAY42').AsString;
sd84a := qr.FieldByName('DECIMALARRAY84').AsString;
sd18a := qr.FieldByName('DECIMALARRAY18').AsString;
sba := qr.FieldByName('BIGINTARRAY').AsString;
Say( 'CHARARRAY:'#13#10 + sca );
Say( 'VARCHARARRAY:'#13#10 + sva );
Say( 'INTEGERARRAY:'#13#10 + sia );
Say( 'REALARRAY:'#13#10 + sra );
Say( 'DOUBLEARRAY:'#13#10 + sda );
Say( 'DECIMALARRAY42:'#13#10 + sd42a );
Say( 'DECIMALARRAY84:'#13#10 + sd84a );
Say( 'DECIMALARRAY18:'#13#10 + sd18a );
Say( 'BIGINTARRAY:'#13#10 + sba );
vca := qr['CHARARRAY'];
vva := qr['VARCHARARRAY'];
via := qr['INTEGERARRAY'];
vra := qr['REALARRAY'];
vda := qr['DOUBLEARRAY'];
vd42a := qr['DECIMALARRAY42'];
vd84a := qr['DECIMALARRAY84'];
vd18a := qr['DECIMALARRAY18'];
vba := qr['BIGINTARRAY'];
qr.Insert;
qr['ID'] := 5;
qr.FieldByName('CHARARRAY').AsString := sca;
qr.FieldByName('VARCHARARRAY').AsString := sva;
qr.FieldByName('INTEGERARRAY').AsString := sia;
qr.FieldByName('REALARRAY').AsString := sra;
qr.FieldByName('DOUBLEARRAY').AsString := sda;
qr.FieldByName('DECIMALARRAY42').AsString := sd42a;
qr.FieldByName('DECIMALARRAY84').AsString := sd84a;
qr.FieldByName('DECIMALARRAY18').AsString := sd18a;
qr.FieldByName('BIGINTARRAY').AsString := sba;
qr.Post;
qr.Insert;
qr['ID'] := 6;
{$IFDEF FPC}
qr.FieldByName('BIGINTARRAY' ).Value := v;
qr.FieldByName('CHARARRAY' ).Value := vca;
qr.FieldByName('VARCHARARRAY' ).Value := vva;
qr.FieldByName('INTEGERARRAY' ).Value := via;
qr.FieldByName('REALARRAY' ).Value := vra;
qr.FieldByName('DOUBLEARRAY' ).Value := vda;
qr.FieldByName('DECIMALARRAY42').Value := vd42a;
qr.FieldByName('DECIMALARRAY84').Value := vd84a;
qr.FieldByName('DECIMALARRAY18').Value := vd18a;
qr.FieldByName('BIGINTARRAY' ).Value := vba;
{$ELSE}
qr['CHARARRAY' ] := vca;
qr['VARCHARARRAY' ] := vva;
qr['INTEGERARRAY' ] := via;
qr['REALARRAY' ] := vra;
qr['DOUBLEARRAY' ] := vda;
qr['DECIMALARRAY42'] := vd42a;
qr['DECIMALARRAY84'] := vd84a;
qr['DECIMALARRAY18'] := vd18a;
qr['BIGINTARRAY' ] := vba;
{$ENDIF}
qr.Post;
qr.Close;
qr.Open;
qr.First;
if qr.Locate( 'ID', 5, [] ) then
begin
CheckEqualsString( sca, qr.FieldByName('CHARARRAY' ).AsString, 'Oops.' );
CheckEqualsString( sva, qr.FieldByName('VARCHARARRAY' ).AsString, 'Oops.' );
CheckEqualsString( sia, qr.FieldByName('INTEGERARRAY' ).AsString, 'Oops.' );
CheckEqualsStr<br/><br/>(Message over 64 KB, truncated)