PageRenderTime 17ms CodeModel.GetById 0ms app.highlight 8ms RepoModel.GetById 0ms app.codeStats 1ms

/packages/fcl-db/tests/testfieldtypes.pas

https://github.com/slibre/freepascal
Pascal | 2286 lines | 1929 code | 274 blank | 83 comment | 69 complexity | a80a47ecf165eafd751103b400d33a60 MD5 | raw file
Possible License(s): LGPL-2.0, LGPL-2.1, LGPL-3.0

Large files files are truncated, but you can click here to view the full file

   1unit TestFieldTypes;
   2
   3{$mode objfpc}{$H+}
   4{$modeswitch nestedprocvars}
   5
   6interface
   7
   8uses
   9  Classes, SysUtils, fpcunit, testutils, testregistry,
  10  db;
  11
  12type
  13  TParamProc = procedure(AParam:TParam; i : integer);
  14  TFieldProc = procedure(AField:TField; i : integer);
  15  TGetSQLTextProc = function(const i: integer) : string; { is nested;}
  16  TCheckFieldValueProc = procedure(AField:TField; i : integer) is nested;
  17
  18  { TTestFieldTypes }
  19
  20  TTestFieldTypes= class(TTestCase)
  21  private
  22    procedure CreateTableWithFieldType(ADatatype : TFieldType; ASQLTypeDecl : string);
  23    procedure TestFieldDeclaration(ADatatype: TFieldType; ADataSize: integer);
  24    procedure TestSQLFieldType(ADatatype: TFieldType; ASQLTypeDecl: string;
  25      ADataSize: integer; AGetSQLTextProc: TGetSQLTextProc;
  26      ACheckFieldValueProc: TCheckFieldValueProc);
  27    procedure TestXXParamQuery(ADatatype : TFieldType; ASQLTypeDecl : string; testValuescount : integer; Cross : boolean = false);
  28    procedure TestSetBlobAsParam(asWhat : integer);
  29  protected
  30    procedure SetUp; override;
  31    procedure TearDown; override;
  32    procedure RunTest; override;
  33  published
  34    procedure TestEmptyUpdateQuery; // bug 13654
  35    procedure TestParseJoins; // bug 10148
  36    procedure TestDoubleFieldNames; // bug 8457
  37    procedure TestParseUnion; // bug 8442
  38    procedure TestInsertLargeStrFields; // bug 9600
  39    procedure TestNumericNames; // Bug9661
  40    procedure TestApplyUpdFieldnames; // Bug 12275;
  41    procedure TestServerFilter; // bug 15456
  42    procedure Test11Params;
  43    procedure TestRowsAffected; // bug 9758
  44    procedure TestLocateNull;
  45    procedure TestLocateOnMoreRecords;
  46    procedure TestStringsReplace;
  47    procedure TestCircularParams;
  48    procedure TestBug9744;
  49    procedure TestCrossStringDateParam;
  50    procedure TestGetFieldNames;
  51    procedure TestUpdateIndexDefs;
  52    procedure TestMultipleFieldPKIndexDefs;
  53    procedure TestGetIndexDefs;
  54    procedure TestSetBlobAsMemoParam;
  55    procedure TestSetBlobAsBlobParam;
  56    procedure TestSetBlobAsStringParam;
  57    procedure TestNonNullableParams;
  58    procedure TestDblQuoteEscComments;
  59    procedure TestpfInUpdateFlag; // bug 7565
  60    procedure TestScript;
  61    procedure TestInsertReturningQuery;
  62    procedure TestOpenStoredProc;
  63    procedure TestOpenSpecialStatements;
  64
  65    procedure TestTemporaryTable;
  66    procedure TestRefresh;
  67
  68    procedure TestParametersAndDates;
  69    procedure TestExceptOnsecClose;
  70    procedure TestErrorOnEmptyStatement;
  71
  72    procedure TestBlob;
  73    procedure TestChangeBlob;
  74    procedure TestBlobGetText;
  75    procedure TestBlobSize;
  76
  77    procedure TestLargeRecordSize;
  78    procedure TestInt;
  79    procedure TestNumeric;
  80    procedure TestFloat;
  81    procedure TestDate;
  82    procedure TestDateTime;       // bug 6925
  83    procedure TestString;
  84    procedure TestUnlVarChar;
  85
  86    procedure TestNullValues;
  87    procedure TestParamQuery;
  88    procedure TestStringParamQuery;
  89    procedure TestFixedStringParamQuery;
  90    procedure TestDateParamQuery;
  91    procedure TestSmallIntParamQuery;
  92    procedure TestIntParamQuery;
  93    procedure TestLargeIntParamQuery;
  94    procedure TestTimeParamQuery;
  95    procedure TestDateTimeParamQuery;
  96    procedure TestFmtBCDParamQuery;
  97    procedure TestFloatParamQuery;
  98    procedure TestBCDParamQuery;
  99    procedure TestBytesParamQuery;
 100    procedure TestVarBytesParamQuery;
 101    procedure TestBooleanParamQuery;
 102    procedure TestAggregates;
 103
 104    procedure TestStringLargerThen8192;
 105    procedure TestQueryAfterReconnect; // bug 16438
 106
 107    // SchemaType tests
 108    procedure TestTableNames;
 109    procedure TestFieldNames;
 110    procedure TestClearUpdateableStatus;
 111    procedure TestReadOnlyParseSQL; // bug 9254
 112    procedure TestGetTables;
 113
 114    // Test SQL-field type recognition
 115    procedure TestSQLClob;
 116    procedure TestSQLLargeint;
 117    procedure TestSQLInterval;
 118    procedure TestSQLIdentity;
 119    procedure TestSQLReal;
 120  end;
 121
 122implementation
 123
 124uses sqldbtoolsunit,toolsunit, variants, sqldb, bufdataset, strutils, dbconst, FmtBCD;
 125
 126Type HackedDataset = class(TDataset);
 127
 128const
 129  testFloatValuesCount = 21;
 130  testFloatValues : Array[0..testFloatValuesCount-1] of double = (-maxSmallint-1,-maxSmallint,-256,-255,-128,-127,-1,0,1,127,128,255,256,maxSmallint,maxSmallint+1,0.123456,-0.123456,4.35,12.434E7,9.876e-5,123.45678);
 131
 132  testBCDValuesCount = 10;
 133  testBCDValues : Array[0..testBCDValuesCount-1] of currency = (-100,54.53,1.2345,123.5345,0,1,-1,0,1.42,1324.4324);
 134
 135  testIntValuesCount = 17;
 136  testIntValues : Array[0..testIntValuesCount-1] of integer = (-maxInt,-maxSmallint-1,-maxSmallint,-256,-255,-128,-127,-1,0,1,127,128,255,256,maxSmallint,maxSmallint+1,MaxInt);
 137
 138  testDateValuesCount = 18;
 139  testDateValues : Array[0..testDateValuesCount-1] of string = (
 140    '2000-01-01',
 141    '1999-12-31',
 142    '2004-02-29',
 143    '2004-03-01',
 144    '1991-02-28',
 145    '1991-03-01',
 146    '2040-10-16',
 147    '1977-09-29',
 148    '1899-12-29',
 149    '1899-12-30',
 150    '1899-12-31',
 151    '1900-01-01',
 152    '1800-03-30',
 153    '1754-06-04',
 154    '1650-05-10',
 155    '0904-04-12',
 156    '0199-07-09',
 157    '0001-01-01'
 158  );
 159
 160  testBytesValuesCount = 5;
 161  testVarBytesValuesCount = 8;
 162  testBytesValues : Array[0..testVarBytesValuesCount-1] of shortstring = (
 163    #1#0#1#0#1, #0#0#1#0#1, #0''''#13#0#1, '\'#0'"\'#13, #13#13#0#10#10,
 164    '', #0, #0#1#2#3#4#5#6#7#8#9
 165  );
 166
 167  STestNotApplicable = 'This test does not apply to this sqldb-connection type';
 168
 169
 170procedure TTestFieldTypes.TestpfInUpdateFlag;
 171var ds   : TCustomBufDataset;
 172    AFld1, AFld2, AFld3 : Tfield;
 173begin
 174  ds := (DBConnector.GetNDataset(True,5) as TCustomBufDataset);
 175  with ds do
 176    begin
 177    AFld1 := TIntegerField.Create(ds);
 178    AFld1.FieldName := 'ID';
 179    AFld1.DataSet := ds;
 180    AFld1.ProviderFlags := AFld1.ProviderFlags + [pfInKey];
 181
 182    AFld2 := TStringField.Create(ds);
 183    AFld2.FieldName := 'NAME';
 184    AFld2.DataSet := ds;
 185
 186    AFld3 := TIntegerField.Create(ds);
 187    AFld3.FieldName := 'CALCFLD';
 188    AFld3.DataSet := ds;
 189    Afld3.FieldKind := fkCalculated;
 190    AFld3.ProviderFlags := [];  // do not include calculated fields into generated sql insert/update
 191
 192    Open;
 193    Edit;
 194    FieldByName('ID').AsInteger := 254;
 195    Post;
 196    ApplyUpdates;
 197    Append;
 198    FieldByName('ID').AsInteger := 255;
 199    Post;
 200    ApplyUpdates;
 201    Close;
 202    AFld1.Free;
 203    AFld2.Free;
 204    AFld3.Free;
 205    end;
 206end;
 207
 208procedure TTestFieldTypes.TestScript;
 209
 210var Ascript : TSQLScript;
 211
 212begin
 213  Ascript := tsqlscript.create(nil);
 214  try
 215    with Ascript do
 216      begin
 217      DataBase := TSQLDBConnector(DBConnector).Connection;
 218      transaction := TSQLDBConnector(DBConnector).Transaction;
 219      script.clear;
 220      script.append('create table a (id int);');
 221      script.append('create table b (id int);');
 222      ExecuteScript;
 223      // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
 224      TSQLDBConnector(DBConnector).CommitDDL;
 225      end;
 226  finally
 227    TSQLDBConnector(DBConnector).Connection.ExecuteDirect('drop table a');
 228    TSQLDBConnector(DBConnector).Connection.ExecuteDirect('drop table b');
 229    // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
 230    TSQLDBConnector(DBConnector).CommitDDL;
 231  end;
 232end;
 233
 234procedure TTestFieldTypes.TestLargeRecordSize;
 235
 236begin
 237  TSQLDBConnector(DBConnector).Connection.ExecuteDirect('create table FPDEV2 (plant varchar(8192),sampling_type varchar(8192),area varchar(8192), area_description varchar(8192), batch varchar(8192), sampling_datetime timestamp, status varchar(8192), batch_commentary varchar(8192))');
 238
 239  // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
 240  TSQLDBConnector(DBConnector).CommitDDL;
 241
 242  with TSQLDBConnector(DBConnector).Query do
 243    begin
 244    sql.clear;
 245    sql.append('insert into FPDEV2 (plant,sampling_type,batch,sampling_datetime,status,batch_commentary) values (''ZUBNE PASTE'',''OTISCI POVR￿INA'',''000037756'',''2005-07-01'',''NE ODGOVARA'',''Ovdje se upisuje komentar o kontrolnom broju..............'')');
 246    ExecSQL;
 247
 248    sql.clear;
 249    sql.append('select * from FPDEV2');
 250    open;
 251    AssertEquals('ZUBNE PASTE',FieldByName('plant').AsString);
 252    AssertEquals(EncodeDate(2005,07,01),FieldByName('sampling_datetime').AsDateTime);
 253    close;
 254    end;
 255end;
 256
 257procedure TTestFieldTypes.CreateTableWithFieldType(ADatatype: TFieldType;
 258  ASQLTypeDecl: string);
 259begin
 260  with TSQLDBConnector(DBConnector) do
 261  begin
 262    Connection.ExecuteDirect('create table FPDEV2 (FT ' +ASQLTypeDecl+ ')');
 263    // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
 264    CommitDDL;
 265  end;
 266end;
 267
 268procedure TTestFieldTypes.TestFieldDeclaration(ADatatype: TFieldType;
 269  ADataSize: integer);
 270begin
 271  with TSQLDBConnector(DBConnector).Query do
 272    begin
 273    SQL.Clear;
 274    SQL.Add('select * from FPDEV2');
 275    Open;
 276    AssertEquals(1,FieldCount);
 277    AssertTrue(CompareText('FT',fields[0].FieldName)=0);
 278    AssertEquals('DataSize', ADataSize, Fields[0].DataSize);
 279    AssertEquals('DataType', ord(ADatatype), ord(Fields[0].DataType));
 280    Close;
 281    end;
 282end;
 283
 284procedure TTestFieldTypes.TestInt;
 285
 286var
 287  i          : byte;
 288
 289begin
 290  CreateTableWithFieldType(ftInteger,'INT');
 291  TestFieldDeclaration(ftInteger,4);
 292
 293  for i := 0 to testIntValuesCount-1 do
 294    TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (' + inttostr(testIntValues[i]) + ')');
 295
 296  with TSQLDBConnector(DBConnector).Query do
 297    begin
 298    Open;
 299    for i := 0 to testIntValuesCount-1 do
 300      begin
 301      AssertEquals(testIntValues[i],fields[0].AsInteger);
 302      Next;
 303      end;
 304    close;
 305    end;
 306end;
 307
 308procedure TTestFieldTypes.TestNumeric;
 309
 310const
 311  testValuesCount = 13;
 312  testValues4 : Array[0..testValuesCount-1] of currency = (-99.99,-12.34,-10.2,-10,-0.5,-0.01,0,0.01,0.5,10,10.2,12.34,99.99);
 313  testValues9 : Array[0..testValuesCount-1] of currency = (-123456.789,-10000,-1875.25,-10,-0.5,-0.001,0,0.001,0.5,10,1875.25,10000,123456.789);
 314  FieldTypes: array [0..7] of TFieldType = (ftBCD, ftBCD, ftBCD, ftFmtBCD, ftLargeInt, ftFmtBCD, ftFmtBCD, ftFmtBCD);
 315  FieldSizes: array [0..7] of integer = (4,2,3,5,0,3,5,0); //scale
 316
 317var
 318  i,d        : integer;
 319  s,s4,s9    : string;
 320  t          : TFieldType;
 321
 322begin
 323  with TSQLDBConnector(DBConnector) do begin
 324    if SQLConnType = INTERBASE then
 325    begin
 326      //Interbase internal storage of exact numeric data types based on precision:
 327      // 1-4 (smallint), 5-9 (integer), 10-18 (int64)
 328      s := ''; //Interbase supports precision up to 18 only
 329      FieldTypes[5] := ftBCD; //ATM TIBConnection incorrectly maps NUMERIC(18,3) to ftBCD
 330    end
 331    else
 332      s := ', N19_0 NUMERIC(19,0)';
 333    Connection.ExecuteDirect('create table FPDEV2 (FT NUMERIC(18,4), N4_2 NUMERIC(4,2), N9_3 NUMERIC(9,3), N9_5 NUMERIC(9,5), N18_0 NUMERIC(18,0), N18_3 NUMERIC(18,3), N18_5 NUMERIC(18,5)' + s + ')');
 334    CommitDDL;
 335
 336    with Query do
 337    begin
 338      SQL.Text := 'select * from FPDEV2';
 339      Open;
 340
 341      for i := 0 to FieldCount-1 do
 342      begin
 343        case Fields[i].DataType of
 344          ftBCD:      d := sizeof(Currency);
 345          ftFmtBCD:   d := sizeof(TBCD);
 346          ftLargeInt: d := sizeof(int64);
 347          else        d := 0;
 348        end;
 349        t := FieldTypes[i];
 350        if t = ftLargeInt then t := ftFmtBCD; //acceptable alternative
 351
 352        AssertEquals(Fields[i].DataSize, d);
 353        AssertTrue(Fields[i].DataType in [FieldTypes[i], t]);
 354        AssertEquals(Fields[i].Size, FieldSizes[i]);
 355      end;
 356
 357      Close;
 358    end;
 359
 360    for i := 0 to testValuesCount-1 do
 361    begin
 362      s4 := CurrToStrF(testValues4[i],ffFixed,2,DBConnector.FormatSettings);
 363      s9 := CurrToStrF(testValues9[i],ffFixed,3,DBConnector.FormatSettings);
 364      Connection.ExecuteDirect(format('insert into FPDEV2 (N4_2,N9_5,FT,N9_3,N18_3,N18_5) values (%s,%s,%s,%s,%s,%s)', [s4,s4,s9,s9,s9,s9]));
 365    end;
 366
 367    with Query do
 368    begin
 369      Open;
 370      for i := 0 to testValuesCount-1 do
 371      begin
 372        AssertEquals(testValues4[i], Fields[1].AsCurrency);
 373        AssertEquals(testValues4[i], Fields[3].AsCurrency);
 374        AssertEquals(testValues9[i], Fields[0].AsCurrency);
 375        AssertEquals(testValues9[i], Fields[2].AsCurrency);
 376        AssertEquals(testValues9[i], Fields[5].AsCurrency);
 377        AssertEquals(testValues9[i], Fields[6].AsCurrency);
 378        Next;
 379      end;
 380      Close;
 381    end;
 382  end;
 383end;
 384
 385procedure TTestFieldTypes.TestFloat;
 386const
 387  testValuesCount = 21;
 388  testValues : Array[0..testValuesCount-1] of double = (-maxSmallint-1,-maxSmallint,-256,-255,-128,-127,-1,0,1,127,128,255,256,maxSmallint,maxSmallint+1,0.123456,-0.123456,4.35,12.434E7,9.876e-5,123.45678);
 389
 390var
 391  i          : byte;
 392
 393begin
 394  CreateTableWithFieldType(ftFloat,'FLOAT');
 395  TestFieldDeclaration(ftFloat,sizeof(double));
 396
 397  for i := 0 to testValuesCount-1 do
 398    TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (' + floattostr(testValues[i],DBConnector.FormatSettings) + ')');
 399
 400  with TSQLDBConnector(DBConnector).Query do
 401    begin
 402    Open;
 403    for i := 0 to testValuesCount-1 do
 404      begin
 405      AssertEquals(testValues[i],fields[0].AsFloat);
 406      Next;
 407      end;
 408    close;
 409    end;
 410end;
 411
 412procedure TTestFieldTypes.TestString;
 413
 414const
 415  testValuesCount = 19;
 416  testValues : Array[0..testValuesCount-1] of string = (
 417    '',
 418    'a',
 419    'ab',
 420    'abc',
 421    'abcd',
 422    'abcde',
 423    'abcdef',
 424    'abcdefg',
 425    'abcdefgh',
 426    'abcdefghi',
 427    'abcdefghij',
 428    'lMnOpQrStU',
 429    '1234567890',
 430    '_!@#$%^&*(',
 431    ')-;:/?.<>',
 432    '~`|{}- =',    // note that there's no \  (backslash) since some db's uses that as escape-character
 433    '  WRaP  ',
 434    'wRaP  ',
 435    ' wRAP'
 436  );
 437
 438var
 439  i             : byte;
 440
 441begin
 442  CreateTableWithFieldType(ftString,'VARCHAR(10)');
 443  TestFieldDeclaration(ftString,11);
 444
 445  for i := 0 to testValuesCount-1 do
 446    TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (''' + testValues[i] + ''')');
 447
 448  with TSQLDBConnector(DBConnector).Query do
 449    begin
 450    Open;
 451    for i := 0 to testValuesCount-1 do
 452      begin
 453      AssertEquals(testValues[i], Fields[0].AsString);
 454      Next;
 455      end;
 456    close;
 457    end;
 458end;
 459
 460procedure TTestFieldTypes.TestUnlVarChar;
 461
 462const
 463  testValuesCount = 21;
 464  testValues : Array[0..testValuesCount-1] of string = (
 465    '',
 466    'a',
 467    'ab',
 468    'abc',
 469    'abcd',
 470    'abcde',
 471    'abcdef',
 472    'abcdefg',
 473    'abcdefgh',
 474    'abcdefghi',
 475    'abcdefghij',
 476    'lMnOpQrStU',
 477    '1234567890',
 478    '_!@#$%^&*(',
 479    ')-;:/?.<>',
 480    '~`|{}- =',
 481    '  WRaP  ',
 482    'wRaP  ',
 483    ' wRAP',
 484    '0123456789',
 485    'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 !@#$%^&*()_+-=][|}{;:,./<>?abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 !@#$%^&*()_+-=][|}{;:,./<>?' + 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 !@#$%^&*()_+-=][|}{;:,./<>?'
 486    + 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 !@#$%^&*()_+-=][|}{;:,./<>?abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 !@#$%^&*()_+-=][|}{;:,./<>?' + 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 !@#$%^&*()_+-=][|}{;:,./<>?'
 487  );
 488
 489var
 490  i             : byte;
 491
 492begin
 493  if SQLConnType<>postgresql then Ignore('This test does only apply to Postgres, since others don''t support varchars without length given');
 494
 495  CreateTableWithFieldType(ftString,'VARCHAR');
 496  TestFieldDeclaration(ftString,dsMaxStringSize+1);
 497
 498  for i := 0 to testValuesCount-1 do
 499    TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (''' + testValues[i] + ''')');
 500
 501  with TSQLDBConnector(DBConnector).Query do
 502    begin
 503    Open;
 504    for i := 0 to testValuesCount-1 do
 505      begin
 506      AssertEquals(testValues[i],fields[0].AsString);
 507      Next;
 508      end;
 509    close;
 510    end;
 511end;
 512
 513procedure TTestFieldTypes.TestDate;
 514
 515var
 516  i             : byte;
 517
 518begin
 519  CreateTableWithFieldType(ftDate,'DATE');
 520  TestFieldDeclaration(ftDate,8);
 521
 522  for i := 0 to testDateValuesCount-1 do
 523    if SQLConnType=oracle then
 524      TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (to_date (''' + testDateValues[i] + ''',''YYYY-MM-DD''))')
 525    else
 526      TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (''' + testDateValues[i] + ''')');
 527
 528  with TSQLDBConnector(DBConnector).Query do
 529    begin
 530    Open;
 531    for i := 0 to testDateValuesCount-1 do
 532      begin
 533      AssertEquals(testDateValues[i],FormatDateTime('yyyy/mm/dd', fields[0].AsDateTime, DBConnector.FormatSettings));
 534      Next;
 535      end;
 536    close;
 537    end;
 538
 539end;
 540
 541procedure TTestFieldTypes.TestDateTime;
 542
 543const
 544  testValuesCount = 31;
 545  testValues : Array[0..testValuesCount-1] of string = (
 546    '2000-01-01',
 547    '1999-12-31',
 548    '2004-02-29',
 549    '2004-03-01',
 550    '1991-02-28',
 551    '1991-03-01',
 552    '1977-09-29',
 553    '2000-01-01 10:00:00',
 554    '2000-01-01 23:59:59',
 555    '1994-03-06 11:54:30',
 556    '2040-10-16',                   // MySQL 4.0 doesn't support datetimes before 1970 or after 2038
 557    '2100-01-01 01:01:01',
 558    '1903-04-02 01:04:02',
 559    '1900-01-01',
 560    '1899-12-31',
 561    '1899-12-30',
 562    '1899-12-29',
 563    '1899-12-30 18:00:51',
 564    '1899-12-30 04:00:51',
 565    '1899-12-29 04:00:51',
 566    '1899-12-29 18:00:51',
 567    '1815-09-24 03:47:22',
 568    '1800-03-30',
 569    '1754-06-04',
 570    '1650-05-10',                   // MS SQL 2005 doesn't support datetimes before 1753
 571    '1400-02-03 12:21:53',
 572    '1333-02-03 21:44:21',
 573    '0904-04-12',
 574    '0354-11-20 21:25:15',
 575    '0199-07-09',
 576    '0001-01-01'
 577  );
 578
 579var
 580  i : byte;
 581
 582begin
 583  CreateTableWithFieldType(ftDateTime,FieldtypeDefinitions[ftDateTime]);
 584  TestFieldDeclaration(ftDateTime,8);
 585
 586  for i := 0 to testValuesCount-1 do
 587    if SQLConnType=oracle then
 588      TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (to_date (''' + testValues[i] + ''',''YYYY-MM-DD HH24:MI:SS''))')
 589    else
 590      TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (''' + testValues[i] + ''')');
 591
 592  with TSQLDBConnector(DBConnector).Query do
 593    begin
 594    Open;
 595    for i := 0 to testValuesCount-1 do
 596      begin
 597      if length(testValues[i]) < 12 then
 598        AssertEquals(testValues[i],FormatDateTime('yyyy/mm/dd', fields[0].AsDateTime, DBConnector.FormatSettings))
 599      else
 600        AssertEquals(testValues[i],FormatDateTime('yyyy/mm/dd hh:mm:ss', fields[0].AsDateTime, DBConnector.FormatSettings));
 601      Next;
 602      end;
 603    close;
 604    end;
 605end;
 606
 607
 608procedure TTestFieldTypes.TestChangeBlob;
 609
 610var s : string;
 611
 612begin
 613  TSQLDBConnector(DBConnector).Connection.ExecuteDirect('create table FPDEV2 (ID int,FT '+FieldtypeDefinitions[ftblob]+')');
 614  TSQLDBConnector(DBConnector).CommitDDL;
 615
 616  TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (ID,FT) values (1,''Test deze blob'')');
 617
 618  with TSQLDBConnector(DBConnector).Query do
 619    begin
 620    sql.clear;
 621    sql.add('select * from FPDEV2');
 622    Open;
 623    fields[1].ProviderFlags := [pfInUpdate]; // blob niet in de where
 624    UpdateMode := upWhereAll;
 625
 626    AssertEquals('Test deze blob',fields[1].AsString);
 627    edit;
 628// Dat werkt niet lekker, omdat de stream vernield wordt...
 629//    fields[0].asstring := 'Deze blob is gewijzigd!';
 630
 631    With Createblobstream(fields[1],bmwrite) do
 632      begin
 633      s := 'Deze blob is gewijzigd!';
 634      WriteBuffer(Pointer(s)^,Length(s));
 635      post;
 636      free;
 637      end;
 638    AssertEquals('Deze blob is gewijzigd!',fields[1].AsString);
 639
 640    ApplyUpdates(0);
 641
 642    TSQLDBConnector(DBConnector).Transaction.CommitRetaining; // For debug-purposes
 643
 644    close;
 645
 646    open;
 647    AssertEquals('Deze blob is gewijzigd!',fields[1].AsString);
 648    close;
 649    end;
 650end;
 651
 652procedure TTestFieldTypes.TestBlobGetText;
 653begin
 654  CreateTableWithFieldType(ftBlob,FieldtypeDefinitions[ftBlob]);
 655  TestFieldDeclaration(ftBlob,0);
 656
 657  TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (''Test deze blob'')');
 658  TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (Null)');
 659
 660  with TSQLDBConnector(DBConnector).Query do
 661    begin
 662    Open;
 663    AssertFalse(fields[0].IsNull);
 664    AssertEquals('(BLOB)',fields[0].DisplayText);
 665    AssertEquals('Test deze blob',fields[0].AsString);
 666    Next;
 667    AssertTrue(fields[0].IsNull);
 668    AssertEquals('(blob)',fields[0].Text);
 669    AssertEquals('',fields[0].AsString);
 670    close;
 671    end;
 672end;
 673
 674procedure TTestFieldTypes.TestBlobSize;
 675begin
 676  CreateTableWithFieldType(ftBlob,FieldtypeDefinitions[ftBlob]);
 677
 678  TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (''Test deze blob'')');
 679
 680  with TSQLDBConnector(DBConnector).Query do
 681    begin
 682    sql.text := 'select * from FPDEV2';
 683    Open;
 684    AssertEquals(14,TBlobField(fields[0]).BlobSize);
 685    close;
 686    end;
 687end;
 688
 689
 690procedure TTestFieldTypes.TestBlob;
 691
 692begin
 693  CreateTableWithFieldType(ftBlob,FieldtypeDefinitions[ftBlob]);
 694  TestFieldDeclaration(ftBlob,0);
 695
 696  TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (''Test deze blob'')');
 697
 698  with TSQLDBConnector(DBConnector).Query do
 699    begin
 700    Open;
 701    AssertEquals('Test deze blob',fields[0].AsString);
 702    close;
 703    end;
 704end;
 705
 706procedure TTestFieldTypes.TestNullValues;
 707begin
 708  TSQLDBConnector(DBConnector).Connection.ExecuteDirect('create table FPDEV2 (FIELD1 INT, FIELD2 INT)');
 709  // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
 710  TSQLDBConnector(DBConnector).CommitDDL;
 711
 712  TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FIELD1) values (1)');
 713
 714  with TSQLDBConnector(DBConnector).Query do
 715    begin
 716    sql.clear;
 717    sql.append('select * from FPDEV2');
 718    open;
 719    AssertEquals(1,FieldByName('FIELD1').AsInteger);
 720    AssertTrue('Null-values test failed',FieldByName('FIELD2').IsNull);
 721    close;
 722    end;
 723end;
 724
 725
 726procedure TTestFieldTypes.TestParamQuery;
 727// Tests running insert queries using parameters
 728const
 729  DecoyFieldData1='decoytest';
 730  DecoyFieldData2=':decoy ::test $decoy2 $$2';
 731begin
 732  TSQLDBConnector(DBConnector).Connection.ExecuteDirect('create table FPDEV2 (FIELD1 INT, FIELD2 INT, FIELD3 INT, DECOY VARCHAR(30))');
 733
 734  // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
 735  TSQLDBConnector(DBConnector).CommitDDL;
 736
 737  with TSQLDBConnector(DBConnector).Query do
 738    begin
 739    sql.clear;
 740    sql.append('insert into FPDEV2 (field1) values (:field1)');
 741    Params.ParamByName('field1').AsInteger := 1;
 742    ExecSQL;
 743
 744    sql.clear;
 745    sql.append('insert into FPDEV2 (field1,field2,decoy) values (:field1,:field2,'''+DecoyFieldData1+''')');
 746    Params.ParamByName('field1').AsInteger := 2;
 747    Params.ParamByName('field2').DataType := ftInteger;
 748    Params.ParamByName('field2').Value := Null;
 749    ExecSQL;
 750
 751    sql.clear;
 752    sql.append('insert into FPDEV2 (field1,field2,field3) values (:field1,:field2,:field3)');
 753    Params.ParamByName('field1').AsInteger := 3;
 754    Params.ParamByName('field2').AsInteger := 2;
 755    Params.ParamByName('field3').AsInteger := 3;
 756    ExecSQL;
 757
 758    sql.clear;
 759    sql.append('insert into FPDEV2 (field1,field2,field3,decoy) values (:field1,:field2,:field3,'''+DecoyFieldData2+''')');
 760    Params.ParamByName('field1').AsInteger := 4;
 761    Params.ParamByName('field2').AsInteger := 2;
 762    Params.ParamByName('field3').AsInteger := 3;
 763    ExecSQL;
 764
 765    sql.clear;
 766    sql.append('insert into FPDEV2 (field1,field2,field3) values (:field1,:field2,:field1)');
 767    Params.ParamByName('field1').AsInteger := 5;
 768    Params.ParamByName('field2').AsInteger := 2;
 769    ExecSQL;
 770
 771    sql.clear;
 772    sql.append('select * from FPDEV2 order by FIELD1');
 773    open;
 774    AssertEquals(1,FieldByName('FIELD1').asinteger);
 775    AssertTrue(FieldByName('FIELD2').IsNull);
 776    AssertTrue(FieldByName('FIELD3').IsNull);
 777    AssertTrue(FieldByName('DECOY').IsNull);
 778    next;
 779    AssertEquals(2,FieldByName('FIELD1').asinteger);
 780    AssertTrue(FieldByName('FIELD2').IsNull);
 781    AssertTrue(FieldByName('FIELD3').IsNull);
 782    AssertEquals(DecoyFieldData1,FieldByName('DECOY').AsString);
 783    next;
 784    AssertEquals(3,FieldByName('FIELD1').asinteger);
 785    AssertEquals(2,FieldByName('FIELD2').asinteger);
 786    AssertEquals(3,FieldByName('FIELD3').asinteger);
 787    AssertTrue(FieldByName('DECOY').IsNull);
 788    next;
 789    AssertEquals(4,FieldByName('FIELD1').asinteger);
 790    AssertEquals(2,FieldByName('FIELD2').asinteger);
 791    AssertEquals(3,FieldByName('FIELD3').asinteger);
 792    AssertEquals(DecoyFieldData2,FieldByName('DECOY').AsString);
 793    next;
 794    AssertEquals(5,FieldByName('FIELD1').asinteger);
 795    AssertEquals(2,FieldByName('FIELD2').asinteger);
 796    AssertEquals(5,FieldByName('FIELD3').asinteger);
 797    AssertTrue(FieldByName('DECOY').IsNull);
 798    close;
 799
 800    end;
 801  TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
 802end;
 803
 804procedure TTestFieldTypes.TestSmallIntParamQuery;
 805begin
 806  TestXXParamQuery(ftSmallInt,FieldtypeDefinitions[ftSmallInt],testValuesCount);
 807end;
 808
 809procedure TTestFieldTypes.TestIntParamQuery;
 810begin
 811  TestXXParamQuery(ftInteger,'INT',testIntValuesCount);
 812end;
 813
 814procedure TTestFieldTypes.TestLargeIntParamQuery;
 815begin
 816  TestXXParamQuery(ftLargeInt,FieldtypeDefinitions[ftLargeInt],testValuesCount);
 817end;
 818
 819procedure TTestFieldTypes.TestFmtBCDParamQuery;
 820begin
 821  TestXXParamQuery(ftFMTBcd,FieldtypeDefinitions[ftFMTBcd],testValuesCount);
 822end;
 823
 824procedure TTestFieldTypes.TestDateParamQuery;
 825begin
 826  TestXXParamQuery(ftDate,FieldtypeDefinitions[ftDate],testDateValuesCount);
 827end;
 828
 829procedure TTestFieldTypes.TestCrossStringDateParam;
 830begin
 831  TestXXParamQuery(ftDate,FieldtypeDefinitions[ftDate],testDateValuesCount,True);
 832end;
 833
 834procedure TTestFieldTypes.TestTimeParamQuery;
 835begin
 836  TestXXParamQuery(ftTime,FieldtypeDefinitions[ftTime],testValuesCount);
 837end;
 838
 839procedure TTestFieldTypes.TestDateTimeParamQuery;
 840begin
 841  TestXXParamQuery(ftDateTime,FieldtypeDefinitions[ftDateTime],testValuesCount);
 842end;
 843
 844procedure TTestFieldTypes.TestFloatParamQuery;
 845
 846begin
 847  TestXXParamQuery(ftFloat,FieldtypeDefinitions[ftFloat],testFloatValuesCount);
 848end;
 849
 850procedure TTestFieldTypes.TestBCDParamQuery;
 851begin
 852  TestXXParamQuery(ftBCD,'NUMERIC(10,4)',testBCDValuesCount);
 853end;
 854
 855procedure TTestFieldTypes.TestBytesParamQuery;
 856begin
 857  TestXXParamQuery(ftBytes, FieldtypeDefinitions[ftBytes], testBytesValuesCount, true);
 858end;
 859
 860procedure TTestFieldTypes.TestVarBytesParamQuery;
 861begin
 862  TestXXParamQuery(ftVarBytes, FieldtypeDefinitions[ftVarBytes], testVarBytesValuesCount, not(SQLServerType in [ssMSSQL, ssSybase]));
 863end;
 864
 865procedure TTestFieldTypes.TestBooleanParamQuery;
 866begin
 867  TestXXParamQuery(ftBoolean, FieldtypeDefinitions[ftBoolean], testValuesCount);
 868end;
 869
 870procedure TTestFieldTypes.TestStringParamQuery;
 871
 872begin
 873  TestXXParamQuery(ftString,'VARCHAR(10)',testValuesCount);
 874end;
 875
 876procedure TTestFieldTypes.TestFixedStringParamQuery;
 877begin
 878  TestXXParamQuery(ftFixedChar,'CHAR(10)',testValuesCount);
 879end;
 880
 881
 882procedure TTestFieldTypes.TestXXParamQuery(ADatatype : TFieldType; ASQLTypeDecl : string; testValuesCount : integer; Cross : boolean = false);
 883
 884var i : integer;
 885
 886begin
 887  if ASQLTypeDecl = '' then
 888    Ignore('Fields of the type ' + FieldTypeNames[ADatatype] + ' are not supported by this sqldb-connection type');
 889
 890  TSQLDBConnector(DBConnector).Connection.ExecuteDirect('create table FPDEV2 (ID INT, FIELD1 '+ASQLTypeDecl+')');
 891
 892  // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
 893  TSQLDBConnector(DBConnector).CommitDDL;
 894
 895  with TSQLDBConnector(DBConnector).Query do
 896    begin
 897    sql.clear;
 898    sql.append('insert into FPDEV2 (ID,FIELD1) values (:id,:field1)');
 899
 900    // There is no Param.AsFixedChar, so the datatype has to be set manually
 901    if ADatatype=ftFixedChar then
 902      Params.ParamByName('field1').DataType := ftFixedChar;
 903
 904    for i := 0 to testValuesCount -1 do
 905      begin
 906      Params.ParamByName('id').AsInteger := i;
 907      case ADataType of
 908        ftSmallInt: Params.ParamByName('field1').AsSmallInt := testSmallIntValues[i];
 909        ftInteger: Params.ParamByName('field1').AsInteger := testIntValues[i];
 910        ftLargeInt: Params.ParamByName('field1').AsLargeInt := testLargeIntValues[i];
 911        ftBoolean: Params.ParamByName('field1').AsBoolean := testBooleanValues[i];
 912        ftFloat  : Params.ParamByName('field1').AsFloat   := testFloatValues[i];
 913        ftBCD    : Params.ParamByName('field1').AsCurrency:= testBCDValues[i];
 914        ftFixedChar,
 915        ftString : Params.ParamByName('field1').AsString  := testValues[ADataType,i];
 916        ftTime   : Params.ParamByName('field1').AsTime  := TimeStringToDateTime(testTimeValues[i]);
 917        ftDate   : if cross then
 918                     Params.ParamByName('field1').AsString:= testDateValues[i]
 919                   else
 920                     Params.ParamByName('field1').AsDate := StrToDate(testDateValues[i],'yyyy/mm/dd','-');
 921        ftDateTime:Params.ParamByName('field1').AsDateTime := StrToDateTime(testValues[ADataType,i], DBConnector.FormatSettings);
 922        ftFMTBcd : Params.ParamByName('field1').AsFMTBCD := StrToBCD(testFmtBCDValues[i],DBConnector.FormatSettings);
 923        ftBytes  : if cross then
 924                     Params.ParamByName('field1').Value := StringToByteArray(testBytesValues[i])
 925                   else
 926                     Params.ParamByName('field1').AsBlob := testBytesValues[i];
 927        ftVarBytes:if cross then
 928                     Params.ParamByName('field1').AsString := testBytesValues[i]
 929                   else
 930                     Params.ParamByName('field1').AsBlob := testBytesValues[i];
 931      else
 932        AssertTrue('no test for paramtype available',False);
 933      end;
 934      ExecSQL;
 935      end;
 936    TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
 937
 938    sql.clear;
 939    sql.append('select * from FPDEV2 order by ID');
 940    open;
 941
 942    for i := 0 to testValuesCount -1 do
 943      begin
 944      AssertEquals(i,FieldByName('ID').AsInteger);
 945      case ADataType of
 946        ftSmallInt: AssertEquals(testSmallIntValues[i],FieldByName('FIELD1').AsInteger);
 947        ftInteger: AssertEquals(testIntValues[i],FieldByName('FIELD1').AsInteger);
 948        ftLargeInt: AssertEquals(testLargeIntValues[i],FieldByName('FIELD1').AsLargeInt);
 949        ftBoolean: AssertEquals(testBooleanValues[i],FieldByName('FIELD1').AsBoolean);
 950        ftFloat  : AssertEquals(testFloatValues[i],FieldByName('FIELD1').AsFloat);
 951        ftBCD    : AssertEquals(testBCDValues[i],FieldByName('FIELD1').AsCurrency);
 952        ftFixedChar : AssertEquals(PadRight(testStringValues[i],10),FieldByName('FIELD1').AsString);
 953        ftString : AssertEquals(testStringValues[i],FieldByName('FIELD1').AsString);
 954        ftTime   : AssertEquals(testTimeValues[i],DateTimeToTimeString(FieldByName('FIELD1').AsDateTime));
 955        ftDate   : AssertEquals(testDateValues[i],DateTimeToStr(FieldByName('FIELD1').AsDateTime, DBConnector.FormatSettings));
 956        ftDateTime : AssertEquals(testValues[ADataType,i], DateTimeToStr(FieldByName('FIELD1').AsDateTime, DBConnector.FormatSettings));
 957        ftFMTBcd : AssertEquals(testFmtBCDValues[i], BCDToStr(FieldByName('FIELD1').AsBCD, DBConnector.FormatSettings));
 958        ftVarBytes,
 959        ftBytes  : AssertEquals(testBytesValues[i], shortstring(FieldByName('FIELD1').AsString));
 960      else
 961        AssertTrue('no test for paramtype available',False);
 962      end;
 963      Next;
 964      end;
 965    close;
 966    end;
 967  TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
 968end;
 969
 970
 971procedure TTestFieldTypes.TestSetBlobAsParam(asWhat: integer);
 972const
 973  TestValue='Test deze BLob';
 974var
 975  ASQL          : TSQLQuery;
 976begin
 977  CreateTableWithFieldType(ftBlob,FieldtypeDefinitions[ftBlob]);
 978  TestFieldDeclaration(ftBlob,0);
 979
 980  ASQL := DBConnector.GetNDataset(True,1) as tsqlquery;
 981  with ASql  do
 982    begin
 983    sql.Text := 'insert into FPDEV2 (FT) values (:BlobParam)';
 984    case asWhat of
 985      0: Params.ParamByName('blobParam').AsMemo := TestValue;
 986      1: Params.ParamByName('blobParam').AsString := TestValue;
 987      2: Params.ParamByName('blobParam').AsBlob := TestValue;
 988    end;
 989    ExecSQL;
 990    end;
 991
 992  with TSQLDBConnector(DBConnector).Query do
 993    begin
 994    Open;
 995    if not eof then
 996      AssertEquals(TestValue, Fields[0].AsString);
 997    close;
 998    end;
 999end;
1000
1001procedure TTestFieldTypes.TestSetBlobAsMemoParam;
1002begin
1003  // Firebird/Interbase ODBC driver : if parameter of ValueType=SQL_C_CHAR is bind to BLOB column
1004  // driver interprets character data as hexadecimal string and performs conversion ('FF10'=#255#16)
1005  TestSetBlobAsParam(0);
1006end;
1007
1008procedure TTestFieldTypes.TestSetBlobAsStringParam;
1009begin
1010  TestSetBlobAsParam(1);
1011end;
1012
1013procedure TTestFieldTypes.TestSetBlobAsBlobParam;
1014begin
1015  TestSetBlobAsParam(2);
1016end;
1017
1018
1019procedure TTestFieldTypes.TestAggregates;
1020begin
1021  TSQLDBConnector(DBConnector).Connection.ExecuteDirect('create table FPDEV2 (FIELD1 INT, FIELD2 INT)');
1022  // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
1023  TSQLDBConnector(DBConnector).CommitDDL;
1024
1025  TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 values (1,1)');
1026  TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 values (2,3)');
1027  TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 values (3,4)');
1028  TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 values (4,4)');
1029
1030  TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
1031
1032  with TSQLDBConnector(DBConnector).Query do
1033    begin
1034    sql.clear;
1035    sql.append('select count(*) from FPDEV2');
1036    open;
1037    AssertEquals(4,Fields[0].AsInteger);
1038    close;
1039
1040    sql.clear;
1041    sql.append('select sum(FIELD1) from FPDEV2');
1042    open;
1043    AssertEquals(10,Fields[0].AsInteger);
1044    close;
1045
1046    sql.clear;
1047    sql.append('select avg(FIELD2) from FPDEV2');
1048    open;
1049    AssertEquals(3,Fields[0].AsInteger);
1050    close;
1051
1052    end;
1053
1054end;
1055
1056procedure TTestFieldTypes.TestQueryAfterReconnect;
1057var DS: TDataset;
1058begin
1059  ds := DBConnector.GetNDataset(true,5);
1060  with ds do
1061    begin
1062    open;
1063    close;
1064    TSQLDBConnector(DBConnector).Connection.Close;
1065    TSQLDBConnector(DBConnector).Connection.Open;
1066    open;
1067    close;
1068    end;
1069end;
1070
1071procedure TTestFieldTypes.TestLocateNull;
1072var DS: TCustomBufDataset;
1073begin
1074  ds := TSQLDBConnector(DBConnector).GetNDataset(true,5) as TCustomBufDataset;
1075  with ds do
1076    begin
1077    open;
1078    edit;
1079    fieldbyname('name').Clear;
1080    post;
1081    next;
1082    AssertFalse(Locate('name',VarArrayOf(['TestName1']),[]));
1083    AssertTrue(Locate('name',VarArrayOf([Null]),[]));
1084    AssertEquals(1,fieldbyname('ID').AsInteger);
1085    end;
1086end;
1087
1088procedure TTestFieldTypes.TestLocateOnMoreRecords;
1089var DS: TCustomBufDataset;
1090begin
1091  with TSQLDBConnector(DBConnector) do
1092    begin
1093    ds := GetNDataset(true,30) as TCustomBufDataset;
1094    with query do
1095      begin
1096      SQL.Text:='update FPDEV set NAME = null where ID<11;';
1097      ExecSQL;
1098      SQL.Text:='update FPDEV set NAME = null where (ID>11) and (ID<23);';
1099      ExecSQL;
1100    end;
1101    with ds do
1102      begin
1103      Open;
1104      // Must be exactly 11 to trigger bug/test
1105      AssertTrue(Locate('name',VarArrayOf(['TestName11']),[]));
1106      AssertEquals(11,fieldbyname('ID').AsInteger);
1107
1108      // Must be exactly 23 to trigger bug/test
1109      AssertTrue(Locate('name',VarArrayOf(['TestName23']),[]));
1110      AssertEquals(23,fieldbyname('ID').AsInteger);
1111      end;
1112    end;
1113
1114end;
1115
1116procedure TTestFieldTypes.TestRefresh;
1117var ADataset: TDataset;
1118    i: integer;
1119    AFldID, AFldName: TField;
1120begin
1121  ADataset := TSQLDBConnector(DBConnector).GetNDataset(true,5);
1122
1123  Adataset.Open;
1124  AFldId:=Adataset.Fields[0];
1125  AFldName:=Adataset.Fields[1];
1126  for i := 1 to 5 do
1127    begin
1128    AssertEquals(i,AFldID.asinteger);
1129    AssertEquals('TestName'+inttostr(i),AFldName.asstring);
1130    ADataset.Next;
1131    end;
1132
1133  ADataset.Next;
1134  AssertTrue(ADataset.EOF);
1135  TSQLDBConnector(DBConnector).Connection.ExecuteDirect('update FPDEV set NAME=''test'' where ID=2');
1136
1137  ADataset.Refresh;
1138
1139  ADataset.First;
1140  for i := 1 to 5 do
1141    begin
1142    AssertEquals(i,AFldID.AsInteger);
1143    if i = 2 then
1144      AssertEquals('test',AFldName.AsString)
1145    else
1146      AssertEquals('TestName'+inttostr(i),AFldName.AsString);
1147    ADataset.Next;
1148    end;
1149  ADataset.Next;
1150  AssertTrue(ADataset.EOF);
1151end;
1152
1153procedure TTestFieldTypes.TestEmptyUpdateQuery;
1154begin
1155  TSQLDBConnector(DBConnector).Connection.ExecuteDirect('update FPDEV set name=''nothing'' where (1=0)');
1156end;
1157
1158procedure TTestFieldTypes.TestNonNullableParams;
1159var ASQLQuery : TSQLQuery;
1160    Passed: Boolean;
1161begin
1162  // Check for an exception when a null value is stored into a non-nullable
1163  // field using a parameter
1164  // There was a bug in IBConnection so that in this case the last used value
1165  // for the parameter was used.
1166
1167  // To make sure that any changes are cancelled in the case the test fails
1168  TSQLDBConnector(DBConnector).GetNDataset(true,5);
1169
1170  ASQLQuery := TSQLDBConnector(DBConnector).Query;
1171  ASQLQuery.SQL.text := 'update fpdev set ID=:ID1 where id = :ID2';
1172  ASQLQuery.Params[0].Clear;
1173  ASQLQuery.Params[1].AsInteger := 1;
1174  AssertTrue(ASQLQuery.Params[0].IsNull);
1175  Passed:=False;
1176  try
1177    @ASQLQuery.ExecSQL;
1178  except
1179    on E: Exception do
1180      if E.ClassType.InheritsFrom(EDatabaseError) then
1181        Passed := true;
1182  end;
1183  AssertTrue(Passed);
1184end;
1185
1186procedure TTestFieldTypes.TestStringLargerThen8192;
1187// See also: TestInsertLargeStrFields
1188var
1189  s             : string;
1190  i             : integer;
1191
1192begin
1193  CreateTableWithFieldType(ftString,'VARCHAR(9000)');
1194  TestFieldDeclaration(ftString,9001);
1195
1196  setlength(s,9000);
1197  for i := 1 to 9000 do
1198    s[i]:=chr((i mod 10)+ord('a'));
1199  TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (''' + s + ''')');
1200
1201  with TSQLDBConnector(DBConnector).Query do
1202    begin
1203    Open;
1204    AssertEquals(s,fields[0].AsString);
1205    close;
1206    end;
1207end;
1208
1209procedure TTestFieldTypes.TestTableNames;
1210var TableList : TStringList;
1211    i         : integer;
1212begin
1213  TableList := TStringList.Create;
1214  try
1215    TSQLDBConnector(DBConnector).Connection.GetTableNames(TableList);
1216    AssertTrue(TableList.Find('fpdev',i));
1217  finally
1218    TableList.Free;
1219  end;
1220end;
1221
1222procedure TTestFieldTypes.TestFieldNames;
1223var FieldList : TStringList;
1224    i         : integer;
1225begin
1226  FieldList := TStringList.Create;
1227  try
1228    TSQLDBConnector(DBConnector).Connection.GetFieldNames('fpdev',FieldList);
1229    AssertTrue(FieldList.Find('id',i));
1230  finally
1231    FieldList.Free;
1232  end;
1233end;
1234
1235procedure TTestFieldTypes.TestInsertReturningQuery;
1236begin
1237  if not(SQLServerType in [ssFirebird, ssOracle, ssPostgreSQL]) then Ignore(STestNotApplicable);
1238  with TSQLDBConnector(DBConnector) do
1239    begin
1240    // This only works with databases that supports 'insert into .. returning'
1241    // for example: PostgreSQL, Oracle, Firebird version 2.0 and up
1242    CreateTableWithFieldType(ftInteger,'int');
1243    Query.SQL.Text:='insert into FPDEV2 values(154) returning FT';
1244    Query.Open;
1245    AssertTrue(CompareText('FT',Query.Fields[0].FieldName)=0);
1246    AssertEquals(154,Query.fields[0].AsInteger);
1247    Query.Close;
1248    end;
1249end;
1250
1251procedure TTestFieldTypes.TestOpenStoredProc;
1252begin
1253  with TSQLDBConnector(DBConnector) do
1254  begin
1255    case SQLServerType of
1256      ssMySQL:
1257        begin
1258        Connection.ExecuteDirect('create procedure FPDEV_PROC() select 1 union select 2;');
1259        Query.SQL.Text:='call FPDEV_PROC';
1260        end;
1261      ssFirebird, ssInterbase:
1262        begin
1263        Connection.ExecuteDirect('create procedure FPDEV_PROC returns (r integer) as begin r=1; end');
1264        Query.SQL.Text:='execute procedure FPDEV_PROC';
1265        end;
1266      ssMSSQL, ssSybase:
1267        begin
1268        Connection.ExecuteDirect('create procedure FPDEV_PROC as select 1 union select 2;');
1269        Query.SQL.Text:='execute FPDEV_PROC';
1270        end;
1271      else
1272        begin
1273        Ignore('This test does not apply to this sqldb-connection type, since it does not support selectable stored procedures.');
1274        Exit;
1275        end;
1276    end;
1277    Transaction.CommitRetaining;
1278
1279    try
1280      Query.Open;
1281      AssertEquals(1, Query.Fields[0].AsInteger);
1282      Query.Next;
1283      if not(SQLServerType in [ssFirebird, ssInterbase]) then
1284      begin
1285        AssertFalse('Eof after 1st row', Query.Eof);
1286        AssertEquals(2, Query.Fields[0].AsInteger);
1287        Query.Next;
1288      end;
1289      AssertTrue('No Eof after last row', Query.Eof);
1290      Query.Close;
1291    finally
1292      Connection.ExecuteDirect('drop procedure FPDEV_PROC');
1293      Transaction.CommitRetaining;
1294    end;
1295  end;
1296end;
1297
1298procedure TTestFieldTypes.TestOpenSpecialStatements;
1299const CTE_SELECT = 'WITH a AS (SELECT * FROM FPDEV) SELECT * FROM a';
1300type TTestStatements = array of string;
1301var statements: TTestStatements;
1302    s: string;
1303begin
1304  // tests non-select statements (other than "SELECT ..."), which return result-set
1305  // at least one row must be returned
1306  with TSQLDBConnector(DBConnector) do
1307  begin
1308    case SQLServerType of
1309      ssSQLite:
1310        statements := TTestStatements.Create('pragma table_info(FPDEV)');
1311      ssFirebird:
1312        statements := TTestStatements.Create(
1313          CTE_SELECT (*FB 2.1*),
1314          'EXECUTE BLOCK RETURNS (U VARCHAR(255)) AS BEGIN SELECT rdb$get_context(''SYSTEM'',''CURRENT_USER'') FROM rdb$database INTO U; SUSPEND; END' (*FB 2.0*)
1315        );
1316      ssPostgreSQL:
1317        statements := TTestStatements.Create(CTE_SELECT, 'EXPLAIN '+CTE_SELECT);
1318      ssMSSQL:
1319        statements := TTestStatements.Create(CTE_SELECT  (*MS SQL 2005*));
1320      ssMySQL:
1321        statements := TTestStatements.Create(
1322          'check table FPDEV',  // bug 14519
1323          'show tables from '+Connection.DatabaseName  // bug 16842
1324        )
1325      else
1326        Ignore(STestNotApplicable);
1327    end;
1328
1329    for s in statements do
1330    begin
1331      Query.SQL.Text := s;
1332      Query.Open;
1333      AssertTrue(Query.FieldCount>0);
1334      AssertFalse('Eof after open', Query.Eof);
1335      Query.Next;
1336      Query.Close;
1337    end;
1338  end;
1339end;
1340
1341procedure TTestFieldTypes.TestClearUpdateableStatus;
1342// Test if CanModify is correctly disabled in case of a select query without
1343// a from-statement.
1344begin
1345  if not (SQLServerType in [ssMySQL]) then Ignore('This test does only apply to MySQL because the used SQL-statement is MySQL only.');
1346  with TSQLDBConnector(DBConnector) do
1347    begin
1348    with (GetNDataset(false,5) as TSQLQuery) do
1349      begin
1350      Open;
1351      AssertEquals(True,CanModify);
1352      Close;
1353      SQL.Text:='select last_insert_id();';
1354      Open;
1355      AssertEquals(False,CanModify);
1356      close;
1357      end;
1358    end;
1359end;
1360
1361procedure TTestFieldTypes.TestReadOnlyParseSQL;
1362begin
1363  with TSQLDBConnector(DBConnector) do
1364    begin
1365
1366    GetFieldDataset(True);
1367    with query do
1368      begin
1369      AssertFalse(ReadOnly);
1370      AssertTrue(ParseSQL);
1371
1372      // If ParseSQL is false, and no update-queries are given, the query
1373      // shouldn't be updateable after open.
1374      ParseSQL := False;
1375      AssertFalse(ParseSQL);
1376      AssertFalse(ReadOnly);
1377      SQL.Text := 'select * from FPDEV;';
1378      open;
1379      AssertFalse(ParseSQL);
1380      AssertFalse(ReadOnly);
1381      AssertFalse(CanModify);
1382      close;
1383
1384      // If ParseSQL is true, the query should be updateable after open.
1385      ReadOnly := False;
1386      ParseSQL := True;
1387      AssertTrue(ParseSQL);
1388      AssertFalse(ReadOnly);
1389      SQL.Text := 'select * from FPDEV';
1390      open;
1391      AssertTrue(ParseSQL);
1392      AssertFalse(ReadOnly);
1393      AssertTrue(CanModify);
1394      edit;
1395      FieldByName('ID').AsInteger:=321;
1396      post;
1397      Applyupdates;
1398      close;
1399
1400      // If ParseSQL is true, but the supplied query isn't updateable, then
1401      // the query shouldn't be updateable after open.
1402      ReadOnly := False;
1403      SQL.Text:='select ID,NAME from FPDEV where ID<5';
1404      sql.Add('union');
1405      sql.Add('select ID,NAME from FPDEV where ID>5');
1406      AssertTrue(ParseSQL);
1407      AssertFalse(ReadOnly);
1408      open;
1409      AssertTrue(ParseSQL);
1410      AssertFalse(ReadOnly);
1411      AssertFalse(CanModify);
1412      close;
1413
1414      // As above, but now with an update-query, so that the query should
1415      // be updateable again.
1416      ReadOnly := False;
1417      AssertTrue(ParseSQL);
1418      AssertFalse(ReadOnly);
1419      UpdateSQL.Text:='update FPDEV set ID=:ID where ID=:OLD_ID';
1420      open;
1421      AssertTrue(ParseSQL);
1422      AssertFalse(ReadOnly);
1423      AssertTrue(CanModify);
1424      edit;
1425      post;
1426      Applyupdates;
1427      close;
1428
1429      // Also if ParseSQL is False, the query should be updateable if a update-
1430      // query is given.
1431      ReadOnly := False;
1432      ParseSQL := False;
1433      AssertFalse(ParseSQL);
1434      AssertFalse(ReadOnly);
1435      open;
1436      AssertFalse(ParseSQL);
1437      AssertFalse(ReadOnly);
1438      AssertTrue(CanModify);
1439      edit;
1440      FieldByName('ID').AsInteger:=1;
1441      post;
1442      Applyupdates;
1443      close;
1444
1445      // But if ReadOnly is true, then CanModify should always be false
1446      ReadOnly := True;
1447      ParseSQL := False;
1448      AssertFalse(ParseSQL);
1449      AssertTrue(ReadOnly);
1450      open;
1451      AssertFalse(ParseSQL);
1452      AssertTrue(ReadOnly);
1453      AssertFalse(CanModify);
1454      close;
1455      end;
1456    end;
1457end;
1458
1459procedure TTestFieldTypes.TestParseJoins;
1460begin
1461  with TSQLDBConnector(DBConnector) do
1462    begin
1463    with query do
1464      begin
1465      SQL.Text:='select TT.NAME from FPDEV left join FPDEV TT on TT.ID=FPDEV.ID';
1466      Open;
1467      AssertFalse(CanModify);
1468      Close;
1469
1470      SQL.Text:='select T1.NAME from FPDEV T1,FPDEV T2 where T1.ID=T2.ID';
1471      Open;
1472      AssertFalse(CanModify);
1473      Close;
1474      end;
1475    end;
1476end;
1477
1478procedure TTestFieldTypes.TestDoubleFieldNames;
1479begin
1480  with TSQLDBConnector(DBConnector) do
1481    begin
1482    with query do
1483      begin
1484      SQL.Text:='select FPDEV.*,TT.* from FPDEV left join FPDEV TT on TT.ID=FPDEV.ID';
1485      Open;
1486      AssertTrue(assigned(FindField('ID')));
1487      AssertTrue (assigned(FindField('ID_1')));
1488      AssertTrue(assigned(FindField('NAME')));
1489      AssertTrue(assigned(FindField('NAME_1')));
1490
1491      AssertEquals(1,fieldbyname('ID').AsInteger);
1492      AssertEquals(1,fieldbyname('ID_1').AsInteger);
1493      AssertEquals('TestName1',fieldbyname('NAME').AsString);
1494      AssertEquals('TestName1',fieldbyname('NAME_1').AsString);
1495      close;
1496      end;
1497    end;
1498end;
1499
1500procedure TTestFieldTypes.TestParseUnion;
1501begin
1502  with TSQLDBConnector(DBConnector) do
1503    begin
1504    with query do
1505      begin
1506      SQL.Text:='select NAME from FPDEV where ID<5';
1507      sql.Add('union');
1508      sql.Add('select NAME from FPDEV where ID>5');
1509      Open;
1510      close;
1511      end;
1512    end;
1513end;
1514
1515procedure TTestFieldTypes.TestInsertLargeStrFields;
1516// See also: TestStringLargerThen8192
1517const
1518  FieldValue1='test1';
1519var
1520  FieldValue2: string;
1521begin
1522  FieldValue2:=StringOfChar('t', 16000);
1523  with TSQLDBConnector(DBConnector) do
1524    begin
1525    Connection.ExecuteDirect('create table FPDEV2 (  ' +
1526                              '  ID INT NOT NULL ,   ' +
1527                              '  NAME VARCHAR(16000),' +
1528                              '  PRIMARY KEY (ID)    ' +
1529                              ')                     ');
1530    // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
1531    TSQLDBConnector(DBConnector).CommitDDL;
1532
1533    query.sql.Text:='select * from FPDEV2';
1534    Query.Open;
1535    Query.InsertRecord([1,FieldValue1]); // string length <= 8192 (dsMaxStringSize)
1536    Query.InsertRecord([2,FieldValue2]); // string length >  8192 (dsMaxStringSize)
1537    Query.ApplyUpdates;
1538    Query.Close;
1539    Query.Open;
1540    AssertEquals(FieldValue1, Query.FieldByName('NAME').AsString);
1541    Query.Next;
1542    AssertEquals(length(FieldValue2), length(Query.FieldByName('NAME').AsString));
1543    AssertEquals(FieldValue2, Query.FieldByName('NAME').AsString);
1544    Query.Close;
1545    end;
1546end;
1547
1548procedure TTestFieldTypes.TestNumericNames;
1549begin
1550  with TSQLDBConnector(DBConnector) do
1551    begin
1552    Connection.ExecuteDirect('create table FPDEV2 (' +
1553                              '  '+connection.FieldNameQuoteChars[0]+'2ID'+connection.FieldNameQuoteChars[1]+' INT NOT NULL,' +
1554                              '  '+connection.FieldNameQuoteChars[0]+'3TEST'+connection.FieldNameQuoteChars[1]+' VARCHAR(10),' +
1555                              '  PRIMARY KEY ('+connection.FieldNameQuoteChars[0]+'2ID'+connection.FieldNameQuoteChars[0]+') ' +
1556                              ') ');
1557    // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
1558    TSQLDBConnector(DBConnector).CommitDDL;
1559
1560    with query do
1561      begin
1562      SQL.Text:='select * from FPDEV2';
1563      Open;
1564      Edit;
1565      fieldbyname('2ID').AsInteger:=1;
1566      fieldbyname('3TEST').AsString:='3test';
1567      Post;
1568      ApplyUpdates(0);
1569      close;
1570      open;
1571      AssertEquals('3test',FieldByName('3TEST').AsString);
1572      Edit;
1573      fieldbyname('3TEST').AsString:='test3';
1574      Post;
1575      ApplyUpdates(0);
1576      open;
1577      AssertEquals('test3',FieldByName('3TEST').AsString);
1578      close;
1579      end;
1580    end;
1581end;
1582
1583procedure TTestFieldTypes.TestApplyUpdFieldnames;
1584begin
1585  with TSQLDBConnector(DBConnector) do
1586    begin
1587    AssertEquals(-1,query.RowsAffected);
1588    Connection.ExecuteDirect('create table FPDEV2 (' +
1589                              '  ID INT NOT NULL,  ' +
1590                              '  '+Connection.FieldNameQuoteChars[0]+'NAME-TEST'+Connection.FieldNameQuoteChars[1]+' VARCHAR(250), ' +
1591                              '  PRIMARY KEY (ID)  ' +
1592                              ')                   ');
1593    // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
1594    TSQLDBConnector(DBConnector).CommitDDL;
1595
1596    Connection.ExecuteDirect('insert into FPDEV2(ID,'+Connection.FieldNameQuoteChars[0]+'NAME-TEST'+Connection.FieldNameQuoteChars[1]+') values…

Large files files are truncated, but you can click here to view the full file