--- Merging r20456 into '.':

U    packages/fcl-db/tests/testfieldtypes.pas
U    packages/fcl-db/tests/sqldbtoolsunit.pas
--- Merging r20457 into '.':
G    packages/fcl-db/tests/testfieldtypes.pas
--- Merging r20459 into '.':
U    packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp
--- Merging r20463 into '.':
U    packages/fcl-db/src/base/dataset.inc
--- Merging r20464 into '.':
U    packages/fcl-db/src/sqldb/mysql/mysqlconn.inc
--- Merging r20469 into '.':
U    packages/fcl-db/src/base/bufdataset.pas
--- Merging r20470 into '.':
G    packages/fcl-db/src/base/bufdataset.pas

# revisions: 20456,20457,20459,20463,20464,20469,20470
------------------------------------------------------------------------
r20456 | marco | 2012-03-01 12:34:47 +0100 (Thu, 01 Mar 2012) | 3 lines
Changed paths:
   M /trunk/packages/fcl-db/tests/sqldbtoolsunit.pas
   M /trunk/packages/fcl-db/tests/testfieldtypes.pas

 * Use double for mysql ftfloat related tests.
   Patches by Lacak2, Mantis #21388

------------------------------------------------------------------------
------------------------------------------------------------------------
r20457 | marco | 2012-03-01 12:36:55 +0100 (Thu, 01 Mar 2012) | 2 lines
Changed paths:
   M /trunk/packages/fcl-db/tests/testfieldtypes.pas

 * test for interval, mantis #19323

------------------------------------------------------------------------
------------------------------------------------------------------------
r20459 | marco | 2012-03-01 22:43:04 +0100 (Thu, 01 Mar 2012) | 2 lines
Changed paths:
   M /trunk/packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

 * Modification after feedback on #20454, last patch was a bit conservative.

------------------------------------------------------------------------
------------------------------------------------------------------------
r20463 | marco | 2012-03-02 10:55:06 +0100 (Fri, 02 Mar 2012) | 3 lines
Changed paths:
   M /trunk/packages/fcl-db/src/base/dataset.inc

 * Patch from Luiz. Move state change to calculatefields instead of the 
    handler. Mantis #20969

------------------------------------------------------------------------
------------------------------------------------------------------------
r20464 | marco | 2012-03-02 13:26:02 +0100 (Fri, 02 Mar 2012) | 3 lines
Changed paths:
   M /trunk/packages/fcl-db/src/sqldb/mysql/mysqlconn.inc

 * change mysql datetime parsing because mysql allows time >24hrs (interval like).
   Matnis #21368, Patch by Lacak2.

------------------------------------------------------------------------
------------------------------------------------------------------------
r20469 | marco | 2012-03-04 15:29:15 +0100 (Sun, 04 Mar 2012) | 2 lines
Changed paths:
   M /trunk/packages/fcl-db/src/base/bufdataset.pas

 * reduce redundant AS in bufdataset.buildindex. Might improve performance,
   but main purpose is to increase readability and debugability
------------------------------------------------------------------------
------------------------------------------------------------------------
r20470 | marco | 2012-03-04 19:10:28 +0100 (Sun, 04 Mar 2012) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/base/bufdataset.pas

 * one letter fix to last commit.
------------------------------------------------------------------------

git-svn-id: branches/fixes_2_6@20557 -

packages/fcl-db/src/base/bufdataset.pas

@@ -877,28 +877,33 @@ var PCurRecLinkItem : PBufRecLinkItem;
     FieldsAmount    : Integer;
     FieldNr         : integer;
     AField          : TField;
+    Index0,
+    DblLinkIndex    : TDoubleLinkedBufIndex;
 
   procedure PlaceNewRec(var e: PBufRecLinkItem; var esize: integer);
   begin
-    if (AIndex as TDoubleLinkedBufIndex).FFirstRecBuf=nil then
+    if DblLinkIndex.FFirstRecBuf=nil then
      begin
-     (AIndex as TDoubleLinkedBufIndex).FFirstRecBuf:=e;
-     e[(AIndex as TDoubleLinkedBufIndex).IndNr].prior:=nil;
+     DblLinkIndex.FFirstRecBuf:=e;
+     e[DblLinkIndex.IndNr].prior:=nil;
      l:=e;
      end
    else
      begin
-     l[(AIndex as TDoubleLinkedBufIndex).IndNr].next:=e;
-     e[(AIndex as TDoubleLinkedBufIndex).IndNr].prior:=l;
+     l[DblLinkIndex.IndNr].next:=e;
+     e[DblLinkIndex.IndNr].prior:=l;
      l:=e;
      end;
-   e := e[(AIndex as TDoubleLinkedBufIndex).IndNr].next;
+   e := e[DblLinkIndex.IndNr].next;
    dec(esize);
   end;
 
 begin
-  // Build the DBCompareStructure
-  with AIndex do
+ // Build the DBCompareStructure
+ // One AS is enough, and makes debugging easier.
+  DblLinkIndex:=(AIndex as TDoubleLinkedBufIndex);
+  Index0:=(FIndexes[0] as TDoubleLinkedBufIndex);
+  with DblLinkIndex do
     begin
     IndexFields := TList.Create;
     DescIndexFields := TList.Create;
@@ -931,27 +936,27 @@ begin
     end;
 
 // This simply copies the index...
-  PCurRecLinkItem:=(FIndexes[0] as TDoubleLinkedBufIndex).FFirstRecBuf;
-  PCurRecLinkItem[(AIndex as TDoubleLinkedBufIndex).IndNr].next := PCurRecLinkItem[0].next;
-  PCurRecLinkItem[(AIndex as TDoubleLinkedBufIndex).IndNr].prior := PCurRecLinkItem[0].prior;
+  PCurRecLinkItem:=Index0.FFirstRecBuf;
+  PCurRecLinkItem[DblLinkIndex.IndNr].next := PCurRecLinkItem[0].next;
+  PCurRecLinkItem[DblLinkIndex.IndNr].prior := PCurRecLinkItem[0].prior;
 
-  if PCurRecLinkItem <> (FIndexes[0] as TDoubleLinkedBufIndex).FLastRecBuf then
+  if PCurRecLinkItem <> Index0.FLastRecBuf then
     begin
-    while PCurRecLinkItem^.next<>(FIndexes[0] as TDoubleLinkedBufIndex).FLastRecBuf do
+    while PCurRecLinkItem^.next<>Index0.FLastRecBuf do
       begin
       PCurRecLinkItem:=PCurRecLinkItem^.next;
 
-      PCurRecLinkItem[(AIndex as TDoubleLinkedBufIndex).IndNr].next := PCurRecLinkItem[0].next;
-      PCurRecLinkItem[(AIndex as TDoubleLinkedBufIndex).IndNr].prior := PCurRecLinkItem[0].prior;
+      PCurRecLinkItem[DblLinkIndex.IndNr].next := PCurRecLinkItem[0].next;
+      PCurRecLinkItem[DblLinkIndex.IndNr].prior := PCurRecLinkItem[0].prior;
       end;
     end;
 
 // Set FirstRecBuf and FCurrentRecBuf
-  (AIndex as TDoubleLinkedBufIndex).FFirstRecBuf:=(FIndexes[0] as TDoubleLinkedBufIndex).FFirstRecBuf;
-  (FCurrentIndex as TDoubleLinkedBufIndex).FCurrentRecBuf:=(AIndex as TDoubleLinkedBufIndex).FFirstRecBuf;
+  DblLinkIndex.FFirstRecBuf:=Index0.FFirstRecBuf;
+  (FCurrentIndex as TDoubleLinkedBufIndex).FCurrentRecBuf:=DblLinkIndex.FFirstRecBuf;
 // Link in the FLastRecBuf that belongs to this index
-  PCurRecLinkItem[(AIndex as TDoubleLinkedBufIndex).IndNr].next:=(AIndex as TDoubleLinkedBufIndex).FLastRecBuf;
-  (AIndex as TDoubleLinkedBufIndex).FLastRecBuf[(AIndex as TDoubleLinkedBufIndex).IndNr].prior:=PCurRecLinkItem;
+  PCurRecLinkItem[DblLinkIndex.IndNr].next:=DblLinkIndex.FLastRecBuf;
+  DblLinkIndex.FLastRecBuf[DblLinkIndex.IndNr].prior:=PCurRecLinkItem;
 
 // Mergesort. Used the algorithm as described here by Simon Tatham
 // http://www.chiark.greenend.org.uk/~sgtatham/algorithms/listsort.html
@@ -967,14 +972,14 @@ begin
 // and also preparing an empty list L which we will add elements to the end
 // of as we finish dealing with them.
 
-  p := (AIndex as TDoubleLinkedBufIndex).FFirstRecBuf;
-  (AIndex as TDoubleLinkedBufIndex).ffirstRecBuf := nil;
+  p := DblLinkIndex.FFirstRecBuf;
+  DblLinkIndex.ffirstRecBuf := nil;
   q := p;
   MergeAmount := 0;
 
 // Then:
 //    * If p is null, terminate this pass.
-  while p <> (AIndex as TDoubleLinkedBufIndex).FLastRecBuf do
+  while p <> DblLinkIndex.FLastRecBuf do
     begin
 
 //    * Otherwise, there is at least one element in the next pair of length-K
@@ -987,10 +992,10 @@ begin
 //      first. Let psize be the number of elements you managed to step q past.
 
     i:=0;
-    while (i<k) and (q<>(AIndex as TDoubleLinkedBufIndex).FLastRecBuf) do
+    while (i<k) and (q<>DblLinkIndex.FLastRecBuf) do
       begin
       inc(i);
-      q := q[(AIndex as TDoubleLinkedBufIndex).IndNr].next;
+      q := q[DblLinkIndex.IndNr].next;
       end;
     psize :=i;
 
@@ -1002,7 +1007,7 @@ begin
 //    * So, as long as either the p-list is non-empty (psize > 0) or the q-list
 //      is non-empty (qsize > 0 and q points to something non-null):
 
-    while (psize>0) or ((qsize>0) and (q <> (AIndex as TDoubleLinkedBufIndex).FLastRecBuf)) do
+    while (psize>0) or ((qsize>0) and (q <> DblLinkIndex.FLastRecBuf)) do
       begin
 //          o Choose which list to take the next element from. If either list
 //            is empty, we must choose from the other one. (By assumption, at
@@ -1013,9 +1018,9 @@ begin
 //            swapped, so stability is guaranteed.)
       if (psize=0)  then
         PlaceQRec := true
-      else if (qsize=0) or (q = (AIndex as TDoubleLinkedBufIndex).FLastRecBuf) then
+      else if (qsize=0) or (q = DblLinkIndex.FLastRecBuf) then
         PlaceQRec := False
-      else if IndexCompareRecords(p,q,aindex.DBCompareStruct) <= 0 then
+      else if IndexCompareRecords(p,q,DblLinkIndex.DBCompareStruct) <= 0 then
         PlaceQRec := False
       else
         PlaceQRec := True;
@@ -1038,13 +1043,13 @@ begin
 // algorithm terminates, and the output list L is sorted. Otherwise, double the
 // value of K, and go back to the beginning.
 
-  l[(AIndex as TDoubleLinkedBufIndex).IndNr].next:=(AIndex as TDoubleLinkedBufIndex).FLastRecBuf;
+  l[DblLinkIndex.IndNr].next:=DblLinkIndex.FLastRecBuf;
 
   k:=k*2;
 
   until MergeAmount = 1;
-  (AIndex as TDoubleLinkedBufIndex).FLastRecBuf[(AIndex as TDoubleLinkedBufIndex).IndNr].next:=(AIndex as TDoubleLinkedBufIndex).FFirstRecBuf;
-  (AIndex as TDoubleLinkedBufIndex).FLastRecBuf[(AIndex as TDoubleLinkedBufIndex).IndNr].prior:=l;
+  DblLinkIndex.FLastRecBuf[DblLinkIndex.IndNr].next:=DblLinkIndex.FFirstRecBuf;
+  DblLinkIndex.FLastRecBuf[DblLinkIndex.IndNr].prior:=l;
 end;
 
 function TCustomBufDataset.GetIndexDefs : TIndexDefs;

packages/fcl-db/src/base/dataset.inc

@@ -141,15 +141,22 @@ end;
 Procedure TDataset.CalculateFields(Buffer: TRecordBuffer);
 var
   i: Integer;
+  OldState: TDatasetState;
 begin
   FCalcBuffer := Buffer; 
-  if not IsUniDirectional and (FState <> dsInternalCalc) then try
-    ClearCalcFields(FCalcBuffer);
-    for i := 0 to FFieldList.Count - 1 do
-      if FFieldList[i].FieldKind = fkLookup then
-        FFieldList[i].CalcLookupValue;
-  finally
-    DoOnCalcFields;
+  if not IsUniDirectional and (FState <> dsInternalCalc) then
+  begin
+    OldState := FState;
+    FState := dsCalcFields;
+    try
+      ClearCalcFields(FCalcBuffer);
+      for i := 0 to FFieldList.Count - 1 do
+        if FFieldList[i].FieldKind = fkLookup then
+          FFieldList[i].CalcLookupValue;
+    finally
+      DoOnCalcFields;
+      FState := OldState;
+    end;
   end;
 end;
 
@@ -413,17 +420,9 @@ end;
 
 Procedure TDataset.DoOnCalcFields;
 
-var
-  oldState: TDataSetState;
-
 begin
- If assigned(FOnCalcfields) then
- begin
-   oldState := FState;
-   FState := dsCalcFields;
+ If Assigned(FOnCalcfields) then
    FOnCalcFields(Self);
-   FState := oldState;
-  end;
 end;
 
 Procedure TDataset.DoOnNewRecord;
@@ -473,19 +472,9 @@ end;
 
 Procedure TDataset.GetCalcFields(Buffer: TRecordBuffer);
 
-var
-  dss: TDataSetState;
 begin
   if (FCalcFieldsSize > 0) or FInternalCalcFields then
-  begin
-    dss := FState;
-    FState := dsCalcFields;
-    try
-      CalculateFields(Buffer);
-    finally
-      FState := dss;
-    end;
-  end;
+    CalculateFields(Buffer);
 end;
 
 Function TDataset.GetCanModify: Boolean;

packages/fcl-db/src/sqldb/mysql/mysqlconn.inc

@@ -818,11 +818,13 @@ function InternalStrToTime(S: string): TDateTime;
 
 var
   EH, EM, ES: Word;
+  p: integer;
 
 begin
-  EH := StrToInt(Copy(S, 1, 2));
-  EM := StrToInt(Copy(S, 4, 2));
-  ES := StrToInt(Copy(S, 7, 2));
+  p := 1;
+  EH := StrToInt(ExtractSubstr(S, p, [':'])); //hours can be 2 or 3 digits
+  EM := StrToInt(ExtractSubstr(S, p, [':']));
+  ES := StrToInt(ExtractSubstr(S, p, ['.']));
   Result := EncodeTimeInterval(EH, EM, ES, 0);
 end;
 
@@ -852,7 +854,7 @@ begin
     Result := 0
   else
     Result := EncodeDate(EY, EM, ED);
-  Result := Result + EncodeTime(EH, EN, ES, 0);;
+  Result := Result + EncodeTime(EH, EN, ES, 0);
 end;
 
 function TConnectionName.MySQLWriteData(AField: PMYSQL_FIELD; FieldDef: TFieldDef; Source, Dest: PChar; Len: integer; out CreateBlob : boolean): Boolean;

packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

@@ -505,7 +505,7 @@ begin
   Delete(S,1,P);
 end;
 
-Function ParseSQLiteDate(S : ShortString;sepc:ansichar=' ') : TDateTime;
+Function ParseSQLiteDate(S : ShortString) : TDateTime;
 
 Var
   Year, Month, Day : Integer;
@@ -513,7 +513,7 @@ begin
  Result:=0;
  If TryStrToInt(NextWord(S,'-'),Year) then
    if TryStrToInt(NextWord(S,'-'),Month) then
-     if TryStrToInt(NextWord(S,sepc),Day) then
+     if TryStrToInt(NextWord(S,' '),Day) then
         Result:=EncodeDate(Year,Month,Day);
 end;
 
@@ -559,7 +559,7 @@ begin
     else if (Pos(':',S)<>0) then
       TS:=S;
     end;
-  Result:=ComposeDateTime(ParseSQLiteDate(DS,'-'),ParseSQLiteTime(TS,False));
+  Result:=ComposeDateTime(ParseSQLiteDate(DS),ParseSQLiteTime(TS,False));
 end;
 
 function TSQLite3Connection.LoadField(cursor : TSQLCursor;FieldDef : TfieldDef;buffer : pointer; out CreateBlob : boolean) : boolean;

packages/fcl-db/tests/sqldbtoolsunit.pas

@@ -122,6 +122,7 @@ begin
     begin
     //MySQL recognizes BOOLEAN, but as synonym for TINYINT, not true sql boolean datatype
     FieldtypeDefinitions[ftBoolean] := '';
+    FieldtypeDefinitions[ftFloat] := 'DOUBLE';
     // Use 'DATETIME' for datetime-fields instead of timestamp, because
     // mysql's timestamps are only valid in the range 1970-2038.
     // Downside is that fields defined as 'TIMESTAMP' aren't tested

packages/fcl-db/tests/testfieldtypes.pas

@@ -110,6 +110,7 @@ type
     // Test SQL-field type recognition
     procedure TestSQLClob;
     procedure TestSQLLargeint;
+    procedure TestSQLInterval;
   end;
 
 implementation
@@ -808,7 +809,7 @@ end;
 procedure TTestFieldTypes.TestFloatParamQuery;
 
 begin
-  TestXXParamQuery(ftFloat,'FLOAT',testFloatValuesCount);
+  TestXXParamQuery(ftFloat,FieldtypeDefinitions[ftFloat],testFloatValuesCount);
 end;
 
 procedure TTestFieldTypes.TestBCDParamQuery;
@@ -1794,6 +1795,44 @@ begin
   TestSQLFieldType(ftLargeint, datatype, 8, @TestSQLLargeint_GetSQLText, @CheckFieldValue);
 end;
 
+var testIntervalValuesCount: integer;
+const testIntervalValues: array[0..4] of shortstring = ('00:00:00.000','00:00:01.000','23:59:59.000','838:59:59.000','1000:00:00.000');
+// Placed here, as long as bug 18702 is not solved
+function TestSQLInterval_GetSQLText(const a: integer) : string;
+begin
+  if a < testIntervalValuesCount then
+    Result := QuotedStr(testIntervalValues[a])
+  else
+    Result := 'NULL'
+end;
+procedure TTestFieldTypes.TestSQLInterval;
+  procedure CheckFieldValue(AField: TField; a: integer);
+  begin
+    if a < testIntervalValuesCount then
+      AssertEquals(testIntervalValues[a], DateTimeToTimeString(AField.AsDateTime))
+    else
+      AssertTrue(AField.IsNull);
+  end;
+var datatype: string;
+begin
+  if sqlDBType = postgresql then
+  begin
+    datatype:='INTERVAL';
+    testIntervalValuesCount := 5;
+  end
+  else
+  begin
+    datatype:=FieldtypeDefinitions[ftTime];
+    if sqlDBType = sqlite3 then
+      testIntervalValuesCount := 5
+    else if sqlDBType in MySQLdbTypes then
+      testIntervalValuesCount := 4
+    else
+      testIntervalValuesCount := 3;
+  end;
+  TestSQLFieldType(ftTime, datatype, sizeof(TDateTime), @TestSQLInterval_GetSQLText, @CheckFieldValue);
+end;
+
 procedure TTestFieldTypes.TestUpdateIndexDefs;
 var ds : TSQLQuery;
 begin