Przeglądaj źródła

variants, varutils: another portion of misc fixes:
* Handle Variant to ShortString conversions entirely in variants unit, removed VarUtils.VariantToShortString
+ support varUString in DoVarClearComplex
* fixed missing result assignment in TCustomVariantType.VarDataIsEmptyParam
* TCustomVariantType.UnaryOp and BinaryOp now 'implemented', they raise EVariantInvalidOp

git-svn-id: trunk@16529 -

sergei 14 lat temu
rodzic
commit
ae7018cf85
3 zmienionych plików z 21 dodań i 23 usunięć
  1. 21 17
      rtl/inc/variants.pp
  2. 0 5
      rtl/objpas/cvarutil.inc
  3. 0 1
      rtl/objpas/varutilh.inc

+ 21 - 17
rtl/inc/variants.pp

@@ -707,14 +707,11 @@ end;
 
 
 
 
 procedure sysvartopstr (var s; const v : Variant);
 procedure sysvartopstr (var s; const v : Variant);
+var
+  tmp: AnsiString;
 begin
 begin
-  if VarType(v) = varNull then
-    if NullStrictConvert then
-      VarCastError(varNull, varString)
-    else
-      ShortString(s) := NullAsStringValue
-  else
-    ShortString(s) := VariantToShortString(TVarData(V));
+  sysvartolstr(tmp, v);
+  ShortString(s) := tmp;
 end;
 end;
 
 
 
 
@@ -2132,10 +2129,17 @@ begin
   with v do
   with v do
     if vType < varInt64 then
     if vType < varInt64 then
       VarResultCheck(VariantClear(v))
       VarResultCheck(VariantClear(v))
-    else if vType = varString then begin
-      AnsiString(vString) := '';
-      vType := varEmpty
-    end else if vType = varAny then
+    else if vType = varString then
+      begin
+        AnsiString(vString) := '';
+        vType := varEmpty;
+      end
+    else if vType = varUString then
+      begin
+        UnicodeString(vString) := '';
+        vType := varEmpty;
+      end
+    else if vType = varAny then
       ClearAnyProc(v)
       ClearAnyProc(v)
     else if vType and varArray <> 0 then
     else if vType and varArray <> 0 then
       DoVarClearArray(v)
       DoVarClearArray(v)
@@ -3667,9 +3671,9 @@ function TCustomVariantType._Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdc
 
 
 {$warnings off}
 {$warnings off}
 procedure TCustomVariantType.SimplisticClear(var V: TVarData);
 procedure TCustomVariantType.SimplisticClear(var V: TVarData);
-  begin
-    NotSupported('TCustomVariantType.SimplisticClear');
-  end;
+begin
+  VarDataInit(V);
+end;
 
 
 
 
 procedure TCustomVariantType.SimplisticCopy(var Dest: TVarData; const Source: TVarData;  const Indirect: Boolean = False);
 procedure TCustomVariantType.SimplisticCopy(var Dest: TVarData; const Source: TVarData;  const Indirect: Boolean = False);
@@ -3811,7 +3815,7 @@ end;
 function TCustomVariantType.VarDataIsEmptyParam(const V: TVarData): Boolean;
 function TCustomVariantType.VarDataIsEmptyParam(const V: TVarData): Boolean;
 
 
 begin
 begin
-  VarIsEmptyParam(Variant(V));
+  Result:=VarIsEmptyParam(Variant(V));
 end;
 end;
 
 
 
 
@@ -3955,14 +3959,14 @@ end;
 procedure TCustomVariantType.BinaryOp(var Left: TVarData; const Right: TVarData; const Operation: TVarOp);
 procedure TCustomVariantType.BinaryOp(var Left: TVarData; const Right: TVarData; const Operation: TVarOp);
 
 
 begin
 begin
-  NotSupported('TCustomVariantType.BinaryOp');
+  RaiseInvalidOp;
 end;
 end;
 
 
 
 
 procedure TCustomVariantType.UnaryOp(var Right: TVarData; const Operation: TVarOp);
 procedure TCustomVariantType.UnaryOp(var Right: TVarData; const Operation: TVarOp);
 
 
 begin
 begin
-  NotSupported('TCustomVariantType.UnaryOp');
+  RaiseInvalidOp;
 end;
 end;
 
 
 
 

+ 0 - 5
rtl/objpas/cvarutil.inc

@@ -1422,11 +1422,6 @@ begin
 end;
 end;
 
 
 
 
-Function VariantToShortString(const VargSrc : TVarData) : ShortString;
-begin
-  Result:=VariantToAnsiString(VargSrc);
-end;
-
 { ---------------------------------------------------------------------
 { ---------------------------------------------------------------------
     Some debug routines
     Some debug routines
   ---------------------------------------------------------------------}
   ---------------------------------------------------------------------}

+ 0 - 1
rtl/objpas/varutilh.inc

@@ -71,7 +71,6 @@ function VariantToInt64(const VargSrc : TVarData ) : Int64;
 function VariantToQWord(const VargSrc : TVarData ) : Qword;
 function VariantToQWord(const VargSrc : TVarData ) : Qword;
 function VariantToWideString(const VargSrc : TVarData) : WideString;
 function VariantToWideString(const VargSrc : TVarData) : WideString;
 function VariantToAnsiString(const VargSrc : TVarData) : AnsiString;
 function VariantToAnsiString(const VargSrc : TVarData) : AnsiString;
-function VariantToShortString(const VargSrc : TVarData) : ShortString;
 
 
 {Debug routines }
 {Debug routines }
 procedure DumpVariant(const VSrc : Variant);
 procedure DumpVariant(const VSrc : Variant);