View Issue Details

IDProjectCategoryView StatusLast Update
0035150FPCRTLpublic2019-03-27 15:11
ReporterMartin R.Assigned ToSven Barth 
PrioritynormalSeverityminorReproducibilityalways
Status resolvedResolutionfixed 
Product Version3.0.4Product Build 
Target VersionFixed in Version3.3.1 
Summary0035150: Assigning "int64" and "qword" variables to and from "OleVariant" is implemented wrong.
DescriptionAssigning "int64" and "qword" variables to and from "OleVariant" is implemented wrong in "variant.inc"
Assigning an int64 or qword to OleVariant looses the higher 4 bytes because it calls "VariantManager.VarFromInt" for both cases. And in the other direction, "VarToInt64" and "VarToWord64" are exchanged.
Steps To Reproducevar V : OleVariant;
    I64 : Int64;

I64 := 7513860751762750;
V := I64; // This sets V to 151004478
I64 := V; // Value of I64 is now 151004478
Additional Informationvariants.pp => Add:

procedure sysolevarfromint64(var Dest : olevariant; const Source : Int64);
begin
  DoVarClearIfComplex(TVarData(Dest));
  with TVarData(Dest) do begin
    vint64 := Source;
    vType := varint64;
  end;
end;

procedure sysolevarfromqword(var Dest : olevariant; const Source : QWord);
begin
  DoVarClearIfComplex(TVarData(Dest));
  with TVarData(Dest) do begin
    vqword := Source;
    vType := varqword;
  end;
end;

SysVariantManager
.....
    olevarfromint64: @sysolevarfromint64;
    olevarfromqword: @sysolevarfromqword;

--------------------------------------

variant.inc => change

operator :=(const source : olevariant) dest : qword;{$ifdef SYSTEMINLINE}inline;{$endif}
  begin
    dest:=variantmanager.vartoword64(variant(tvardata(source)));
  end;


operator :=(const source : olevariant) dest : int64;{$ifdef SYSTEMINLINE}inline;{$endif}
  begin
    dest:=variantmanager.vartoint64(variant(tvardata(source)));
  end;


operator :=(const source : qword) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
  begin
    variantmanager.olevarfromqword(dest,source);
  end;


operator :=(const source : int64) dest : olevariant;{$ifdef SYSTEMINLINE}inline;{$endif}
  begin
    variantmanager.olevarfromint64(dest,source);
  end;
TagsNo tags attached.
Fixed in Revision41571
FPCOldBugId
FPCTarget
Attached Files
  • project1.zip (1,409 bytes)
  • variant_int64_fix.diff (1,634 bytes)
    diff --git packages/rtl-objpas/src/inc/variants.pp packages/rtl-objpas/src/inc/variants.pp
    index 153453cb29..51dbcfccb0 100644
    --- packages/rtl-objpas/src/inc/variants.pp
    +++ packages/rtl-objpas/src/inc/variants.pp
    @@ -2488,12 +2488,20 @@ begin
       DoOleVarFromVar(TVarData(aDest), TVarData(aSource));
     end;
     
    -procedure sysolevarfromint(var Dest : olevariant; const Source : LongInt; const range : ShortInt);
    +procedure sysolevarfromint(var Dest : olevariant; const Source : int64; const range : ShortInt);
     begin
       DoVarClearIfComplex(TVarData(Dest));
       with TVarData(Dest) do begin
    -    vInteger := Source;
    -    vType := varInteger;
    +    case range of
    +      8, -8 : begin
    +                vint64 := Source;
    +                vType := varint64;
    +              end;
    +      4, -4 : begin
    +                vInteger := Source;
    +                vType := varInteger;
    +              end;
    +    end;
       end;
     end;
     
    diff --git rtl/inc/varianth.inc rtl/inc/varianth.inc
    index 91fa75cf8a..8417b54b71 100644
    --- rtl/inc/varianth.inc
    +++ rtl/inc/varianth.inc
    @@ -186,7 +186,7 @@ type
           olevarfrompstr: procedure(var dest : olevariant; const source : shortstring);
           olevarfromlstr: procedure(var dest : olevariant; const source : ansistring);
           olevarfromvar: procedure(var dest : olevariant; const source : variant);
    -      olevarfromint: procedure(var dest : olevariant; const source : longint;const range : shortint);
    +      olevarfromint: procedure(var dest : olevariant; const source : int64;const range : shortint);
     
           { operators }
           varop : procedure(var left : variant;const right : variant;opcode : tvarop);
    
    variant_int64_fix.diff (1,634 bytes)

Activities

Cyrax

2019-02-26 00:39

reporter  

project1.zip (1,409 bytes)

Cyrax

2019-02-26 00:40

reporter   ~0114439

Last edited: 2019-02-26 00:44

View 2 revisions

Attached a test project which shows behaviour of this bug.

EDIT : Attached a patch which will fix this bug.

Cyrax

2019-02-26 00:44

reporter  

variant_int64_fix.diff (1,634 bytes)
diff --git packages/rtl-objpas/src/inc/variants.pp packages/rtl-objpas/src/inc/variants.pp
index 153453cb29..51dbcfccb0 100644
--- packages/rtl-objpas/src/inc/variants.pp
+++ packages/rtl-objpas/src/inc/variants.pp
@@ -2488,12 +2488,20 @@ begin
   DoOleVarFromVar(TVarData(aDest), TVarData(aSource));
 end;
 
-procedure sysolevarfromint(var Dest : olevariant; const Source : LongInt; const range : ShortInt);
+procedure sysolevarfromint(var Dest : olevariant; const Source : int64; const range : ShortInt);
 begin
   DoVarClearIfComplex(TVarData(Dest));
   with TVarData(Dest) do begin
-    vInteger := Source;
-    vType := varInteger;
+    case range of
+      8, -8 : begin
+                vint64 := Source;
+                vType := varint64;
+              end;
+      4, -4 : begin
+                vInteger := Source;
+                vType := varInteger;
+              end;
+    end;
   end;
 end;
 
diff --git rtl/inc/varianth.inc rtl/inc/varianth.inc
index 91fa75cf8a..8417b54b71 100644
--- rtl/inc/varianth.inc
+++ rtl/inc/varianth.inc
@@ -186,7 +186,7 @@ type
       olevarfrompstr: procedure(var dest : olevariant; const source : shortstring);
       olevarfromlstr: procedure(var dest : olevariant; const source : ansistring);
       olevarfromvar: procedure(var dest : olevariant; const source : variant);
-      olevarfromint: procedure(var dest : olevariant; const source : longint;const range : shortint);
+      olevarfromint: procedure(var dest : olevariant; const source : int64;const range : shortint);
 
       { operators }
       varop : procedure(var left : variant;const right : variant;opcode : tvarop);
variant_int64_fix.diff (1,634 bytes)

Cyrax

2019-02-26 00:52

reporter   ~0114442

Link to forum post https://forum.lazarus.freepascal.org/index.php/topic,44161.msg312213.html#msg312213

Sven Barth

2019-03-03 15:52

manager   ~0114598

I haven't used your patch, because that would have failed for types with a size < 4 (those pass +/- 1/2 for the range) and the type for 64-bit unsigned values needs to be varUInt64 (Delphi compatible).

Please test and close if okay.

Issue History

Date Modified Username Field Change
2019-02-25 23:16 Martin R. New Issue
2019-02-26 00:39 Cyrax File Added: project1.zip
2019-02-26 00:40 Cyrax Note Added: 0114439
2019-02-26 00:44 Cyrax File Added: variant_int64_fix.diff
2019-02-26 00:44 Cyrax Note Edited: 0114439 View Revisions
2019-02-26 00:52 Cyrax Note Added: 0114442
2019-03-03 15:52 Sven Barth Fixed in Revision => 41571
2019-03-03 15:52 Sven Barth Note Added: 0114598
2019-03-03 15:52 Sven Barth Status new => resolved
2019-03-03 15:52 Sven Barth Fixed in Version => 3.3.1
2019-03-03 15:52 Sven Barth Resolution open => fixed
2019-03-03 15:52 Sven Barth Assigned To => Sven Barth