--- Merging r19569 into '.':

U    rtl/unix/unix.pp
U    rtl/unix/timezone.inc

# revisions: 19569
r19569 | michael | 2011-11-01 19:05:38 +0100 (Tue, 01 Nov 2011) | 1 line
Changed paths:
   M /trunk/rtl/unix/timezone.inc
   M /trunk/rtl/unix/unix.pp

* Added ReReadTimeZone


git-svn-id: http://svn.freepascal.org/svn/fpc/branches/fixes_2_6@25986 3ad0048d-3df7-0310-abae-a5850022a9f2

5 files changed, 218 insertions, 50 deletions

diff --git a/packages/fcl-db/src/memds/memds.pp b/packages/fcl-db/src/memds/memds.pp
index fd0668c73a..b98cad192d 100644
--- a/packages/fcl-db/src/memds/memds.pp
+++ b/packages/fcl-db/src/memds/memds.pp
@@ -82,6 +82,7 @@ type
     procedure MDSWriteRecord(Buffer:TRecordBuffer;ARecNo:Integer);
     procedure MDSAppendRecord(Buffer:TRecordBuffer);
     function  MDSFilterRecord(Buffer:TRecordBuffer): Boolean;
+    function  MDSLocateRecord(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions; out ARecNo: integer): Boolean;
   protected
     // Mandatory
     function  AllocRecordBuffer: TRecordBuffer; override;
@@ -129,6 +130,8 @@ type
     constructor Create(AOwner:tComponent); override;
     destructor Destroy; override;
     function BookmarkValid(ABookmark: TBookmark): Boolean; override;
+    function Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions): boolean; override;
+    function Lookup(const KeyFields: string; const KeyValues: Variant; const ResultFields: string): Variant; override;
     procedure CreateTable;
 
     Function  DataSize : Integer;
@@ -176,6 +179,9 @@ type
 
 implementation
 
+uses
+  Variants, FmtBCD;
+
 ResourceString
   SErrFieldTypeNotSupported = 'Fieldtype of Field "%s" not supported.';
   SErrBookMarkNotFound      = 'Bookmark %d not found.';
@@ -269,7 +275,7 @@ begin
   FIsOpen:=False;
 end;
 
-Destructor TMemDataset.Destroy;
+destructor TMemDataset.Destroy;
 begin
   FStream.Free;
   FreeMem(FFieldOffsets);
@@ -297,7 +303,7 @@ begin
  result:= getIntegerpointer(ffieldoffsets, fieldno-1)^;
 end;
 
-Procedure TMemDataset.RaiseError(Fmt : String; Args : Array of const);
+procedure TMemDataset.RaiseError(Fmt: String; Args: array of const);
 
 begin
   Raise MDSError.CreateFmt(Fmt,Args);
@@ -305,24 +311,31 @@ end;
 
 function TMemDataset.MDSGetBufferSize(FieldNo: integer): integer;
 var
- dt1: tfieldtype;
+ FD: TFieldDef;
 begin
- dt1:= FieldDefs.Items[FieldNo-1].Datatype;
- case dt1 of
-  ftString:   result:=FieldDefs.Items[FieldNo-1].Size+1;
-  ftFixedChar:result:=FieldDefs.Items[FieldNo-1].Size+1;
+ FD := FieldDefs.Items[FieldNo-1];
+ case FD.DataType of
+  ftString,
+    ftGuid:   result:=FD.Size+1;
+  ftFixedChar:result:=FD.Size+1;
   ftBoolean:  result:=SizeOf(Wordbool);
   ftCurrency,
   ftFloat:    result:=SizeOf(Double);
   ftBCD:      result:=SizeOf(currency);
   ftLargeInt: result:=SizeOf(int64);
   ftSmallInt: result:=SizeOf(SmallInt);
+  ftWord,
   ftInteger:  result:=SizeOf(longint);
   ftDateTime,
     ftTime,
     ftDate:   result:=SizeOf(TDateTime);
+  ftFmtBCD:   result:=SizeOf(TBCD);
+  ftWideString,
+  ftFixedWideChar: result:=(FD.Size+1)*SizeOf(WideChar);
+  ftBytes:    result := FD.Size;
+  ftVarBytes: result := FD.Size + SizeOf(Word);
  else
-  RaiseError(SErrFieldTypeNotSupported,[FieldDefs.Items[FieldNo-1].Name]);
+  RaiseError(SErrFieldTypeNotSupported,[FD.Name]);
  end;
 {$IFDEF FPC_REQUIRES_PROPER_ALIGNMENT}
  Result:=Align(Result,4);
@@ -343,6 +356,8 @@ begin
      Buffer:=ActiveBuffer;
   dsFilter:
      Buffer:=FFilterBuffer;
+  dsCalcFields:
+     Buffer:=CalcBuffer;
  else
    Buffer:=nil;
  end;
@@ -381,19 +396,14 @@ begin
 end;
 
 procedure TMemDataset.InternalInitRecord(Buffer: TRecordBuffer);
-
-var
-  I : integer;
-
 begin
- fillchar(buffer^,frecsize,0);
+  fillchar(Buffer^,FRecSize,0);
 end;
 
 procedure TMemDataset.InternalDelete;
 
 Var
   TS : TMemoryStream;
-  OldPos,NewPos,CopySize1,CopySize2 : Cardinal;
 
 begin
   if (FCurrRecNo<0) or (FCurrRecNo>=FRecCount) then
@@ -438,7 +448,7 @@ begin
     ReadFieldDefsFromStream(FOpenStream);
 end;
 
-Procedure TMemDataset.CheckMarker(F : TStream; Marker : Integer);
+procedure TMemDataset.CheckMarker(F: TStream; Marker: Integer);
 
 Var
   I,P : Integer;
@@ -510,7 +520,7 @@ begin
   FIsOpen:=True;
 end;
 
-Procedure TMemDataSet.LoadDataFromStream(F : TStream);
+procedure TMemDataset.LoadDataFromStream(F: TStream);
 
 Var
   Size : Integer;
@@ -524,7 +534,7 @@ begin
   FCurrRecNo:=-1;
 end;
 
-Procedure TMemDataSet.LoadFromStream(F : TStream);
+procedure TMemDataset.LoadFromStream(F: TStream);
 
 begin
   Close;
@@ -534,7 +544,7 @@ begin
   FFileModified:=False;
 end;
 
-Procedure TMemDataSet.LoadFromFile(AFileName : String);
+procedure TMemDataset.LoadFromFile(AFileName: String);
 
 Var
   F : TFileStream;
@@ -549,13 +559,13 @@ begin
 end;
 
 
-Procedure TMemDataset.SaveToFile(AFileName : String);
+procedure TMemDataset.SaveToFile(AFileName: String);
 
 begin
   SaveToFile(AFileName,True);
 end;
 
-Procedure TMemDataset.SaveToFile(AFileName : String; SaveData : Boolean);
+procedure TMemDataset.SaveToFile(AFileName: String; SaveData: Boolean);
 
 Var
   F : TFileStream;
@@ -571,19 +581,19 @@ begin
   end;
 end;
 
-Procedure TMemDataset.WriteMarker(F : TStream; Marker : Integer);
+procedure TMemDataset.WriteMarker(F: TStream; Marker: Integer);
 
 begin
   Writeinteger(F,Marker);
 end;
 
-Procedure TMemDataset.SaveToStream(F : TStream);
+procedure TMemDataset.SaveToStream(F: TStream);
 
 begin
   SaveToStream(F,True);
 end;
 
-Procedure TMemDataset.SaveToStream(F : TStream; SaveData : Boolean);
+procedure TMemDataset.SaveToStream(F: TStream; SaveData: Boolean);
 
 begin
   SaveFieldDefsToStream(F);
@@ -592,14 +602,10 @@ begin
   WriteMarker(F,smEOF);
 end;
 
-Procedure TMemDataset.SaveFieldDefsToStream(F : TStream);
+procedure TMemDataset.SaveFieldDefsToStream(F: TStream);
 
 Var
-  I,ACount : Integer;
-  FN : String;
-  FS : Integer;
-  B : Boolean;
-  FT : TFieldType;
+  I : Integer;
   FD : TFieldDef;
 
 begin
@@ -615,7 +621,7 @@ begin
     end;
 end;
 
-Procedure TMemDataset.SaveDataToStream(F : TStream; SaveData : Boolean);
+procedure TMemDataset.SaveDataToStream(F: TStream; SaveData: Boolean);
 
 begin
   if SaveData then
@@ -650,8 +656,9 @@ end;
 procedure TMemDataset.InternalPost;
 begin
   CheckActive;
-  if ((State<>dsEdit) and (State<>dsInsert)) then
+  if not (State in [dsEdit, dsInsert]) then
     Exit;
+  inherited InternalPost;
   if (State=dsEdit) then
     MDSWriteRecord(ActiveBuffer, FCurrRecNo)
   else
@@ -822,7 +829,7 @@ begin
   end;  
 end;
 
-Function TMemDataset.DataSize : Integer;
+function TMemDataset.DataSize: Integer;
 
 begin
   Result:=FStream.Size;
@@ -849,7 +856,7 @@ begin
     end;
 end;
 
-procedure tmemdataset.calcrecordlayout;
+procedure TMemDataset.calcrecordlayout;
 var
   i,count : integer;
 begin
@@ -870,9 +877,9 @@ begin
 {$ENDIF}
  for i:= 0 to Count-1 do
    begin
-   GetIntegerPointer(ffieldoffsets, i)^ := frecsize;
+   GetIntegerPointer(ffieldoffsets, i)^ := FRecSize;
    GetIntegerPointer(ffieldsizes,   i)^ := MDSGetbufferSize(i+1);
-   FRecSize:= FRecSize+GetIntegerPointeR(FFieldSizes, i)^;
+   FRecSize:= FRecSize+GetIntegerPointer(FFieldSizes, i)^;
    end;
 end;
 
@@ -909,30 +916,30 @@ begin
     end;
 end;
 
-Function TMemDataset.GetRecNo: Longint;
+function TMemDataset.GetRecNo: Integer;
 
 begin
   UpdateCursorPos;
-  if (FCurrRecNo<0) then
-    Result:=1
+  if (FCurrRecNo<0) or (FRecCount=0) or (State=dsInsert) then
+    Result:=0
   else
     Result:=FCurrRecNo+1;
 end;
 
-Function TMemDataset.GetRecordCount: Longint;
+function TMemDataset.GetRecordCount: Integer;
 
 begin
   CheckActive;
   Result:=FRecCount;
 end;
 
-Procedure TMemDataset.CopyFromDataset(DataSet : TDataSet);
+procedure TMemDataset.CopyFromDataset(DataSet: TDataSet);
 
 begin
   CopyFromDataset(Dataset,True);
 end;
 
-Procedure TMemDataset.CopyFromDataset(DataSet : TDataSet; CopyData : Boolean);
+procedure TMemDataset.CopyFromDataset(DataSet: TDataSet; CopyData: Boolean);
 
 Var
   I  : Integer;
@@ -1020,4 +1027,115 @@ begin
   inc(Result, Pos);
 end;
 
+function TMemDataset.MDSLocateRecord(const KeyFields: string; const KeyValues: Variant;
+  Options: TLocateOptions; out ARecNo: integer): Boolean;
+var
+  SaveState: TDataSetState;
+  lstKeyFields: TList;
+  Matched: boolean;
+  AKeyValues: variant;
+  i: integer;
+  AField: TField;
+  s1,s2: string;
+begin
+  Result := false;
+  SaveState := SetTempState(dsFilter);
+  FFilterBuffer := TempBuffer;
+  lstKeyFields := TList.Create;
+  try
+    GetFieldList(lstKeyFields, KeyFields);
+    if VarArrayDimCount(KeyValues) = 0 then
+      begin
+      Matched := lstKeyFields.Count = 1;
+      AKeyValues := VarArrayOf([KeyValues]);
+      end
+    else if VarArrayDimCount(KeyValues) = 1 then
+      begin
+      Matched := VarArrayHighBound(KeyValues,1) + 1 = lstKeyFields.Count;
+      AKeyValues := KeyValues;
+      end
+    else
+      Matched := false;
+
+    if Matched then
+    begin
+      ARecNo:=0;
+      while ARecNo<FRecCount do
+      begin
+        MDSReadRecord(FFilterBuffer, ARecNo);
+        if Filtered then
+          Result:=MDSFilterRecord(FFilterBuffer)
+        else
+          Result:=true;
+        // compare field by field
+        i:=0;
+        while Result and (i<lstKeyFields.Count) do
+        begin
+          AField := TField(lstKeyFields[i]);
+          // string fields
+          if AField.DataType in [ftString, ftFixedChar] then
+          begin
+            s1 := AField.AsString;
+            s2 := VarToStr(AKeyValues[i]);
+            if loPartialKey in Options then
+              s1 := copy(s1, 1, length(s2));
+            if loCaseInsensitive in Options then
+              Result := AnsiCompareText(s1, s2)=0
+            else
+              Result := s1=s2;
+          end
+          // all other fields
+          else
+            Result := AField.Value=AKeyValues[i];
+          inc(i);
+        end;
+        if Result then
+          break;
+        inc(ARecNo);
+      end;
+    end;
+  finally
+    lstKeyFields.Free;
+    RestoreState(SaveState);
+  end;
+end;
+
+function TMemDataset.Locate(const KeyFields: string; const KeyValues: Variant;
+  Options: TLocateOptions): boolean;
+var
+  ARecNo: integer;
+begin
+  // Call inherited to make sure the dataset is bi-directional
+  Result := inherited;
+  CheckActive;
+
+  Result:=MDSLocateRecord(KeyFields, KeyValues, Options, ARecNo);
+  if Result then begin
+    // TODO: generate scroll events if matched record is found
+    FCurrRecNo:=ARecNo;
+    Resync([]);
+  end;
+end;
+
+function TMemDataset.Lookup(const KeyFields: string; const KeyValues: Variant;
+  const ResultFields: string): Variant;
+var
+  ARecNo: integer;
+  SaveState: TDataSetState;
+begin
+  if MDSLocateRecord(KeyFields, KeyValues, [], ARecNo) then
+  begin
+    SaveState := SetTempState(dsCalcFields);
+    try
+      // FFilterBuffer contains found record
+      CalculateFields(FFilterBuffer); // CalcBuffer is set to FFilterBuffer
+      Result:=FieldValues[ResultFields];
+    finally
+      RestoreState(SaveState);
+    end;
+  end
+  else
+    Result:=Null;
+end;
+
 end.
diff --git a/packages/fcl-db/tests/memdstoolsunit.pas b/packages/fcl-db/tests/memdstoolsunit.pas
index ed1823856f..04bf026562 100644
--- a/packages/fcl-db/tests/memdstoolsunit.pas
+++ b/packages/fcl-db/tests/memdstoolsunit.pas
@@ -23,6 +23,9 @@ type
 
 implementation
 
+uses
+  StrUtils, FmtBCD;
+
 { TMemDSDBConnector }
 
 procedure TMemDSDBConnector.CreateNDatasets;
@@ -51,6 +54,7 @@ var MemDS  : TMemDataset;
 
 begin
   MemDs := TMemDataset.Create(nil);
+  MemDS.Name := 'NDataset';
   MemDS.FieldDefs.Add('ID',ftInteger);
   MemDS.FieldDefs.Add('NAME',ftString,50);
   MemDS.CreateTable;
@@ -73,22 +77,29 @@ var MemDS  : TMemDataset;
     i      : integer;
 
 begin
+  // Values >= 24:00:00.000 can't be handled by StrToTime function
+  testTimeValues[2] := '23:59:59.000';
+  testTimeValues[3] := '23:59:59.003';
+
   MemDs := TMemDataset.Create(nil);
   with MemDS do
     begin
+    Name := 'FieldDataset';
     FieldDefs.Add('ID',ftInteger);
     FieldDefs.Add('FSTRING',ftString,10);
     FieldDefs.Add('FSMALLINT',ftSmallint);
     FieldDefs.Add('FINTEGER',ftInteger);
-//    FieldDefs.Add('FWORD',ftWord);
+    FieldDefs.Add('FWORD',ftWord);
     FieldDefs.Add('FBOOLEAN',ftBoolean);
     FieldDefs.Add('FFLOAT',ftFloat);
-//    FieldDefs.Add('FCURRENCY',ftCurrency);
-//    FieldDefs.Add('FBCD',ftBCD);
+    FieldDefs.Add('FCURRENCY',ftCurrency);
+    FieldDefs.Add('FBCD',ftBCD);
     FieldDefs.Add('FDATE',ftDate);
     FieldDefs.Add('FTIME',ftTime);
     FieldDefs.Add('FDATETIME',ftDateTime);
+    FieldDefs.Add('FFIXEDCHAR',ftFixedChar,10);
     FieldDefs.Add('FLARGEINT',ftLargeint);
+    FieldDefs.Add('FFMTBCD',ftFmtBCD);
     CreateTable;
     Open;
     for i := 0 to testValuesCount-1 do
@@ -98,11 +109,17 @@ begin
       FieldByName('FSTRING').AsString := testStringValues[i];
       FieldByName('FSMALLINT').AsInteger := testSmallIntValues[i];
       FieldByName('FINTEGER').AsInteger := testIntValues[i];
+      FieldByName('FWORD').AsInteger := testWordValues[i];
       FieldByName('FBOOLEAN').AsBoolean := testBooleanValues[i];
       FieldByName('FFLOAT').AsFloat := testFloatValues[i];
-      ShortDateFormat := 'yyyy-mm-dd';
-      FieldByName('FDATE').AsDateTime := StrToDate(testDateValues[i]);
+      FieldByName('FCURRENCY').AsCurrency := testCurrencyValues[i];
+      FieldByName('FBCD').AsCurrency := testCurrencyValues[i];
+      FieldByName('FDATE').AsDateTime := StrToDateTime(testDateValues[i], Self.FormatSettings);
+      FieldByName('FTIME').AsDateTime := StrToTime(testTimeValues[i], Self.FormatSettings);
+      FieldByName('FDATETIME').AsDateTime := StrToDateTime(testValues[ftDateTime,i], Self.FormatSettings);
+      FieldByName('FFIXEDCHAR').AsString := PadRight(testStringValues[i], 10);
       FieldByName('FLARGEINT').AsLargeInt := testLargeIntValues[i];
+      FieldByName('FFMTBCD').AsBCD := StrToBCD(testFmtBCDValues[i], Self.FormatSettings);
       Post;
       end;
     Close;
diff --git a/packages/fcl-db/tests/testdbbasics.pas b/packages/fcl-db/tests/testdbbasics.pas
index de40276c3d..abd81470c3 100644
--- a/packages/fcl-db/tests/testdbbasics.pas
+++ b/packages/fcl-db/tests/testdbbasics.pas
@@ -134,6 +134,7 @@ type
     procedure TestLocate;
     procedure TestLocateCaseIns;
     procedure TestLocateCaseInsInts;
+    procedure TestLookup;
 
     procedure TestFirst;
     procedure TestIntFilter;
@@ -521,7 +522,7 @@ begin
 
     append;
     FieldByName('id').AsInteger := 1;
-    CheckEquals(0,RecNo);
+    CheckEquals(0,RecNo,'RecNo after 3rd Append');
     CheckEquals(1,RecordCount);
 
     Close;
@@ -884,20 +885,25 @@ begin
   with DBConnector.GetNDataset(true,13) do
     begin
     open;
+    CheckTrue(Locate('id',3,[]));
+
     CheckTrue(Locate('id',vararrayof([5]),[]));
     CheckEquals(5,FieldByName('id').AsInteger);
+
     CheckFalse(Locate('id',vararrayof([15]),[]));
-    CheckTrue(Locate('id',vararrayof([12]),[]));
-    CheckEquals(12,FieldByName('id').AsInteger);
+
+    CheckTrue(Locate('id',vararrayof([13]),[]));
+    CheckEquals(13,FieldByName('id').AsInteger);
     close;
+
     open;
     CheckTrue(Locate('id',vararrayof([12]),[]));
     CheckEquals(12,FieldByName('id').AsInteger);
+
     CheckTrue(Locate('id;name',vararrayof([4,'TestName4']),[]));
     CheckEquals(4,FieldByName('id').AsInteger);
 
     CheckFalse(Locate('id;name',vararrayof([4,'TestName5']),[]));
-
     end;
 end;
 
@@ -956,6 +962,26 @@ begin
     end;
 end;
 
+procedure TTestCursorDBBasics.TestLookup;
+var v: variant;
+begin
+  // Lookup doesn't move the record pointer of the dataset
+  //  and no scroll events should be generated (only OnCalcFields when matched record is found)
+  with DBConnector.GetNDataset(13) do
+  begin
+    Open;
+    Next;
+    CheckEquals('TestName5', Lookup('id',5,'name'));
+    CheckTrue(Lookup('id',15,'name')=Null);
+    v:=Lookup('id',7,'id;name');
+    CheckEquals(7, v[0]);
+    CheckEquals('TestName7', v[1]);
+    // Lookup shouldn't change current record
+    CheckEquals(2, FieldByName('id').AsInteger);
+    Close;
+  end;
+end;
+
 procedure TTestDBBasics.TestSetFieldValues;
 var PassException : boolean;
 begin
diff --git a/rtl/unix/timezone.inc b/rtl/unix/timezone.inc
index b933cfb04e..e7474baeaf 100644
--- a/rtl/unix/timezone.inc
+++ b/rtl/unix/timezone.inc
@@ -337,3 +337,9 @@ begin
   num_types:=0;
 end;
 
+Procedure ReReadLocalTime;
+
+begin
+  DoneLocalTime;
+  InitLocalTime;
+end;
diff --git a/rtl/unix/unix.pp b/rtl/unix/unix.pp
index a472f7ca8c..2aa65edd99 100644
--- a/rtl/unix/unix.pp
+++ b/rtl/unix/unix.pp
@@ -71,6 +71,7 @@ procedure GetLocalTimezone(timer:cint;var leap_correct,leap_hit:cint);
 procedure GetLocalTimezone(timer:cint);
 procedure ReadTimezoneFile(fn:string);
 function  GetTimezoneFile:string;
+Procedure ReReadLocalTime;
 {$ENDIF}
 
 {**  Process Handling  **}