View Issue Details

IDProjectCategoryView StatusLast Update
0038429FPCRTLpublic2021-02-01 05:37
Reporteravk Assigned ToSven Barth  
PrioritynormalSeverityminorReproducibilityhave not tried
Status closedResolutionfixed 
PlatformanyOSany 
Product Version3.3.1 
Fixed in Version3.3.1 
Summary0038429: TCustomVariantType.CastTo() is not called
DescriptionJust discovered that the overriden TCustomVariantType.CastTo() method is not called when the target type is simple,
as the attached example demonstrates.
Perhaps the attached patch will fix the problem.
Tagscustom variants, variants
Fixed in Revision48477
FPCOldBugId
FPCTarget-
Attached Files

Relationships

related to 0020849 resolvedMarco van de Voort VarCast fails on Custom Variants 

Activities

avk

2021-01-31 12:15

reporter  

example.zip (1,831 bytes)
variants.patch (3,990 bytes)   
Index: variants.pp
===================================================================
--- variants.pp	(revision 48462)
+++ variants.pp	(working copy)
@@ -2351,6 +2351,8 @@
 end;
 
 procedure DoVarCast(var aDest : TVarData; const aSource : TVarData; aVarType : LongInt);
+var
+  Handler: TCustomVariantType;
 begin
   with aSource do
     if vType = aVarType then
@@ -2358,39 +2360,41 @@
     else begin
       if (vType = varNull) and NullStrictConvert then
         VarCastError(varNull, aVarType);
-
-      case aVarType of
-        varEmpty, varNull: begin
-          DoVarClearIfComplex(aDest);
-          aDest.vType := aVarType;
-        end;
-        varSmallInt: SysVarFromInt(Variant(aDest), VariantToSmallInt(aSource), -2);
-        varInteger:  SysVarFromInt(Variant(aDest), VariantToLongInt(aSource), -4);
+      if (vType >= CMinVarType) and FindCustomVariantType(vType, Handler) then
+        Handler.CastTo(aDest, aSource, aVarType)
+      else
+        case aVarType of
+          varEmpty, varNull: begin
+            DoVarClearIfComplex(aDest);
+            aDest.vType := aVarType;
+          end;
+          varSmallInt: SysVarFromInt(Variant(aDest), VariantToSmallInt(aSource), -2);
+          varInteger:  SysVarFromInt(Variant(aDest), VariantToLongInt(aSource), -4);
 {$ifndef FPUNONE}
-        varSingle:   SysVarFromSingle(Variant(aDest), VariantToSingle(aSource));
-        varDouble:   SysVarFromDouble(Variant(aDest), VariantToDouble(aSource));
-        varCurrency: SysVarFromCurr(Variant(aDest), VariantToCurrency(aSource));
-        varDate:     SysVarFromTDateTime(Variant(aDest), VariantToDate(aSource));
+          varSingle:   SysVarFromSingle(Variant(aDest), VariantToSingle(aSource));
+          varDouble:   SysVarFromDouble(Variant(aDest), VariantToDouble(aSource));
+          varCurrency: SysVarFromCurr(Variant(aDest), VariantToCurrency(aSource));
+          varDate:     SysVarFromTDateTime(Variant(aDest), VariantToDate(aSource));
 {$endif}
-        varOleStr:   DoVarCastWStr(aDest, aSource);
-        varBoolean:  SysVarFromBool(Variant(aDest), VariantToBoolean(aSource));
-        varShortInt: SysVarFromInt(Variant(aDest), VariantToShortInt(aSource), -1);
-        varByte:     SysVarFromInt(Variant(aDest), VariantToByte(aSource), 1);
-        varWord:     SysVarFromInt(Variant(aDest), VariantToLongInt(aSource), 2);
-        varLongWord: SysVarFromInt(Variant(aDest), Integer(VariantToCardinal(aSource)), 4);
-        varInt64:    SysVarFromInt64(Variant(aDest), VariantToInt64(aSource));
-        varQWord:    SysVarFromWord64(Variant(aDest), VariantToQWord(aSource));
+          varOleStr:   DoVarCastWStr(aDest, aSource);
+          varBoolean:  SysVarFromBool(Variant(aDest), VariantToBoolean(aSource));
+          varShortInt: SysVarFromInt(Variant(aDest), VariantToShortInt(aSource), -1);
+          varByte:     SysVarFromInt(Variant(aDest), VariantToByte(aSource), 1);
+          varWord:     SysVarFromInt(Variant(aDest), VariantToLongInt(aSource), 2);
+          varLongWord: SysVarFromInt(Variant(aDest), Integer(VariantToCardinal(aSource)), 4);
+          varInt64:    SysVarFromInt64(Variant(aDest), VariantToInt64(aSource));
+          varQWord:    SysVarFromWord64(Variant(aDest), VariantToQWord(aSource));
 
-        varDispatch: DoVarCastDispatch(aDest, aSource);
-        varUnknown:  DoVarCastInterface(aDest, aSource);
-      else
-        case aVarType of
-          varString: DoVarCastLStr(aDest, aSource);
-          varAny:    VarCastError(vType, varAny);
+          varDispatch: DoVarCastDispatch(aDest, aSource);
+          varUnknown:  DoVarCastInterface(aDest, aSource);
         else
-          DoVarCastComplex(aDest, aSource, aVarType);
+          case aVarType of
+            varString: DoVarCastLStr(aDest, aSource);
+            varAny:    VarCastError(vType, varAny);
+          else
+            DoVarCastComplex(aDest, aSource, aVarType);
+          end;
         end;
-      end;
     end;
 
 end;
variants.patch (3,990 bytes)   

Sven Barth

2021-01-31 21:27

manager   ~0128716

I've used a slightly different location, but otherwise thank you for the patch.

Please test and close if okay.

avk

2021-02-01 05:37

reporter   ~0128720

Thank you very much.

Issue History

Date Modified Username Field Change
2021-01-31 12:15 avk New Issue
2021-01-31 12:15 avk File Added: example.zip
2021-01-31 12:15 avk File Added: variants.patch
2021-01-31 17:49 Sven Barth Tag Attached: variants
2021-01-31 17:49 Sven Barth Tag Attached: custom variants
2021-01-31 17:53 Sven Barth Relationship added related to 0020849
2021-01-31 18:19 Sven Barth Assigned To => Sven Barth
2021-01-31 18:19 Sven Barth Status new => assigned
2021-01-31 21:27 Sven Barth Status assigned => resolved
2021-01-31 21:27 Sven Barth Resolution open => fixed
2021-01-31 21:27 Sven Barth Fixed in Version => 3.3.1
2021-01-31 21:27 Sven Barth Fixed in Revision => 48477
2021-01-31 21:27 Sven Barth FPCTarget => -
2021-01-31 21:27 Sven Barth Note Added: 0128716
2021-02-01 05:37 avk Status resolved => closed
2021-02-01 05:37 avk Note Added: 0128720