* variants.pp, modified TCustomVariantType constructors to they pass basic tests (tests/units/variants/tcustomvariant.pp)

  * Changed allowed custom VarType range to $10F..$FFF (as specified in Delphi documentation).

git-svn-id: trunk@16323 -

rtl/inc/variants.pp

@@ -265,7 +265,7 @@ type
       CallDesc: PCallDesc; Params: Pointer); cdecl;
 
 Const
-  CMaxNumberOfCustomVarTypes = $06FF;
+  CMaxNumberOfCustomVarTypes = $0EFF;
   CMinVarType = $0100;
   CMaxVarType = CMinVarType + CMaxNumberOfCustomVarTypes;
   CIncVarType = $000F;
@@ -367,6 +367,7 @@ uses
 var
   customvarianttypes    : array of TCustomVariantType;
   customvarianttypelock : trtlcriticalsection;
+  customvariantcurrtype : LongInt;
 
 const
   { all variants for which vType and varComplexType = 0 do not require
@@ -3812,24 +3813,53 @@ begin
 end;
 
 
-constructor TCustomVariantType.Create;
+procedure RegisterCustomVariantType(obj: TCustomVariantType; RequestedVarType: TVarType;
+  UseFirstAvailable: Boolean);
+var
+  index,L: Integer;
 begin
-  inherited Create;
   EnterCriticalSection(customvarianttypelock);
   try
-    SetLength(customvarianttypes,Length(customvarianttypes)+1);
-    customvarianttypes[High(customvarianttypes)]:=self;
-    FVarType:=CMinVarType+High(customvarianttypes);
+    L:=Length(customvarianttypes);
+    if UseFirstAvailable then
+    begin
+      repeat
+        inc(customvariantcurrtype);
+        if customvariantcurrtype>=CMaxVarType then
+          raise EVariantError.Create(SVarTypeTooManyCustom);
+      until ((customvariantcurrtype-CMinVarType)>=L) or
+        (customvarianttypes[customvariantcurrtype-CMinVarType]=nil);
+      RequestedVarType:=customvariantcurrtype;
+    end
+    else if (RequestedVarType<CFirstUserType) or (RequestedVarType>CMaxVarType) then
+      raise EVariantError.CreateFmt(SVarTypeOutOfRangeWithPrefix, ['$', RequestedVarType]);
+
+    index:=RequestedVarType-CMinVarType;
+    if index>=L then
+      SetLength(customvarianttypes,L+1);
+    if Assigned(customvarianttypes[index]) then
+    begin
+      if customvarianttypes[index]=InvalidCustomVariantType then
+        raise EVariantError.CreateFmt(SVarTypeNotUsableWithPrefix, ['$', RequestedVarType])
+      else
+        raise EVariantError.CreateFmt(SVarTypeAlreadyUsedWithPrefix,
+          ['$', RequestedVarType, customvarianttypes[index].ClassName]);
+    end;
+    customvarianttypes[index]:=obj;
+    obj.FVarType:=RequestedVarType;
   finally
     LeaveCriticalSection(customvarianttypelock);
   end;
 end;
 
+constructor TCustomVariantType.Create;
+begin
+  RegisterCustomVariantType(Self,0,True);
+end;
 
 constructor TCustomVariantType.Create(RequestedVarType: TVarType);
-
 begin
-  FVarType:=RequestedVarType;
+  RegisterCustomVariantType(Self,RequestedVarType,False);
 end;
 
 
@@ -4450,6 +4480,8 @@ var
 
 Initialization
   InitCriticalSection(customvarianttypelock);
+  // start with one-less value, so first increment yields CFirstUserType
+  customvariantcurrtype:=CFirstUserType-1;
   SetSysVariantManager;
   SetClearVarToEmptyParam(TVarData(EmptyParam));
   VarClearProc:=@DoVarClear;