Browse Source

* fixed TBinaryObjectReader.ReadSingle(), .ReadCurrency() and .ReadDate():
explicitly typecasting a qword to single/currency/tdatetime is no different
from assigning it directly, since integer types are assignment-compatible
with floating point types (mantis #25170)

git-svn-id: trunk@26146 -

Jonas Maebe 11 years ago
parent
commit
5e129b4ac5
3 changed files with 109 additions and 3 deletions
  1. 1 0
      .gitattributes
  2. 24 3
      rtl/objpas/classes/reader.inc
  3. 84 0
      tests/webtbs/tw25170.pp

+ 1 - 0
.gitattributes

@@ -13708,6 +13708,7 @@ tests/webtbs/tw25101.pp svneol=native#text/pascal
 tests/webtbs/tw25122.pp svneol=native#text/plain
 tests/webtbs/tw25132.pp svneol=native#text/pascal
 tests/webtbs/tw2514.pp svneol=native#text/plain
+tests/webtbs/tw25170.pp svneol=native#text/plain
 tests/webtbs/tw25198.pp svneol=native#text/plain
 tests/webtbs/tw25210.pp svneol=native#text/pascal
 tests/webtbs/tw2525.pp svneol=native#text/plain

+ 24 - 3
rtl/objpas/classes/reader.inc

@@ -207,20 +207,41 @@ begin
 end;
 
 function TBinaryObjectReader.ReadSingle: Single;
+var
+  r: record
+    case byte of
+      1: (d: dword);
+      2: (s: single);
+  end;
 begin
-  Result:=single(ReadDWord);
+  r.d:=ReadDWord;
+  Result:=r.s;
 end;
 {$endif}
 
 function TBinaryObjectReader.ReadCurrency: Currency;
+var
+  r: record
+    case byte of
+      1: (q: qword);
+      2: (c: currency);
+  end;
 begin
-  Result:=currency(ReadQWord);
+  r.c:=ReadQWord;
+  Result:=r.c;
 end;
 
 {$ifndef FPUNONE}
 function TBinaryObjectReader.ReadDate: TDateTime;
+var
+  r: record
+    case byte of
+      1: (q: qword);
+      2: (d: TDateTime);
+  end;
 begin
-  Result:=TDateTime(ReadQWord);
+  r.q:=ReadQWord;
+  Result:=r.d;
 end;
 {$endif}
 

+ 84 - 0
tests/webtbs/tw25170.pp

@@ -0,0 +1,84 @@
+{ %opt=-Sa }
+
+{$mode objfpc}
+
+program write_read_date;
+
+
+// Problem - when write date and read date using binary object reader/writer,
+//readed value is not same as writed
+
+uses
+  classes, sysutils, dateutils;
+
+
+type
+  // just for access protected ReadQWord
+  TBinaryObjectReaderFake = class(TBinaryObjectReader)
+  end;
+
+procedure test;
+var
+  mS: TMemoryStream;
+  mW: TBinaryObjectWriter;
+  mR: TBinaryObjectReaderFake;
+  mDateIn, mDateOut, mDateOut2: TDateTime;
+  mQW: QWord;
+begin
+  // for date 41488.5270635417 is content of stream [$11, $50, $5C, $B4, $DD, $10, $42, $E4, $40]
+  // which is OK, so with write is probably no problem
+  mDateIn := 41488.5270635417;
+  mS := TMemoryStream.Create;
+  try
+    //
+    mW := TBinaryObjectWriter.Create(mS, 100);
+    try
+      mW.WriteDate(mDateIn);
+    finally
+      mW.Free
+    end;
+    // this will read bad date
+    mS.Position := 0;
+    mR := TBinaryObjectReaderFake.Create(mS, 100);
+    try
+      Assert(mR.ReadValue = vaDate);
+      mDateOut := mR.ReadDate;
+    finally
+      mR.Free
+    end;
+    // when use ReadQWord, date is readed correctly
+    mS.Position := 0;
+    mR := TBinaryObjectReaderFake.Create(mS, 100);
+    try
+      Assert(mR.ReadValue = vaDate);
+      mQW := mR.ReadQWord;
+      // typecast will not help
+      //mDateOut2 := TDateTime(mQW);
+      Move(mQW, mDateOut2, SizeOf(mQW));
+    finally
+      mR.Free
+    end;
+  finally
+    mS.Free;
+  end;
+  if CompareDateTime(mDateIn, mDateOut) <> 0 then
+    begin
+      writeln(qword(mDateIn),' <> ',qword(mDateOut));
+      Writeln('read date is different from written date');
+      halt(1);
+    end
+  else
+    Writeln('read date is same as written date');
+  if CompareDateTime(mDateIn, mDateOut2) <> 0 then
+    begin
+      Writeln('this situation should not happen');
+      halt(2);
+    end
+  else
+    Writeln('read date as QWord is same as written date')
+end;
+
+begin
+  test;
+end.
+