Browse Source

* patch by Bart B to refactor ConvUtils (no functional changes), resolves #39813

(cherry picked from commit 98d297cf54f795967dca33cd43b14d5c006979c4)
florian 3 years ago
parent
commit
1f3f278f0b
1 changed files with 47 additions and 49 deletions
  1. 47 49
      packages/rtl-objpas/src/inc/convutil.inc

+ 47 - 49
packages/rtl-objpas/src/inc/convutil.inc

@@ -144,13 +144,13 @@ const
   macheps=1E-9;
   macheps=1E-9;
   zeroRes=1E-17;
   zeroRes=1E-17;
 
 
-Type ResourceData = record
-                      Description   : String;
-                      Value         : TConvUtilFloat;
-                      ToCommonFunc  : TConversionProc;
-                      FromCommonFunc: TConversionProc;
-                      Fam           : TConvFamily;
-                      Deleted       : Boolean;
+Type TResourceData = record
+                       Description   : String;
+                       Value         : TConvUtilFloat;
+                       ToCommonFunc  : TConversionProc;
+                       FromCommonFunc: TConversionProc;
+                       Fam           : TConvFamily;
+                       Deleted       : Boolean;
                      end;
                      end;
      TFamilyData = record
      TFamilyData = record
                      Description: String;
                      Description: String;
@@ -158,9 +158,16 @@ Type ResourceData = record
                    end;
                    end;
 
 
 
 
-var TheUnits    : array of ResourceData =nil;
+var TheUnits    : array of TResourceData =nil;
     TheFamilies : array of TFamilyData =nil;
     TheFamilies : array of TFamilyData =nil;
 
 
+
+Function CheckFamily(i:TConvFamily):Boolean; inline;
+
+begin
+  Result:=(i<Length(TheFamilies)) and (not TheFamilies[i].Deleted);
+end;
+
 function FindFamily(const ADescription: String; out AFam: TConvFamily): Boolean;
 function FindFamily(const ADescription: String; out AFam: TConvFamily): Boolean;
 
 
 var
 var
@@ -179,7 +186,12 @@ begin
   end;
   end;
 end;
 end;
 
 
-function FindConvType(AFam: TConvFamily; const ADescription: string; out AResourceData: ResourceData): Boolean;
+function CheckType(AType: TConvType): Boolean; inline;
+begin
+  result:=(AType<Length(TheUnits)) and (not TheUnits[AType].Deleted);
+end;
+
+function FindConvType(AFam: TConvFamily; const ADescription: string; out AResourceData: TResourceData): Boolean;
 
 
 var
 var
   i: Integer;
   i: Integer;
@@ -199,7 +211,7 @@ end;
 function FindConvType(AFam: TConvFamily; const ADescription: string): Boolean;
 function FindConvType(AFam: TConvFamily; const ADescription: string): Boolean;
 
 
 var
 var
-  Data: ResourceData;
+  Data: TResourceData;
 
 
 begin
 begin
   result:=FindConvType(AFam, ADescription, Data);
   result:=FindConvType(AFam, ADescription, Data);
@@ -267,7 +279,7 @@ end;
 function ConvFamilyToDescription(const AFamily: TConvFamily): string;
 function ConvFamilyToDescription(const AFamily: TConvFamily): string;
 
 
 begin
 begin
-  if (AFamily<length(TheFamilies)) and not (TheFamilies[AFamily].Deleted) then
+  if CheckFamily(AFamily) then
     result:=TheFamilies[AFamily].Description
     result:=TheFamilies[AFamily].Description
   else
   else
     result:=format(SConvUnknownDescriptionWithPrefix,['$',AFamily]);
     result:=format(SConvUnknownDescriptionWithPrefix,['$',AFamily]);
@@ -333,12 +345,10 @@ begin
      end;
      end;
 end;
 end;
 
 
-//since a conversion type actually can have any (incuding an empty) description we need a function that
-//properly checks and indicates wether or not AType actually exists
 function TryConvTypeToDescription(const AType: TConvType; out S: string): Boolean;
 function TryConvTypeToDescription(const AType: TConvType; out S: string): Boolean;
 
 
 begin
 begin
-  result:=(AType<length(TheUnits)) and (not TheUnits[AType].Deleted);
+  result:=CheckType(AType);
   if result then
   if result then
     S:=TheUnits[AType].Description;
     S:=TheUnits[AType].Description;
 end;
 end;
@@ -389,7 +399,6 @@ function TryStrToConvUnit(AText: string; out AValue: Double; out AType: TConvTyp
 var
 var
   P: SizeInt;
   P: SizeInt;
   ValueStr, TypeStr: String;
   ValueStr, TypeStr: String;
-  Data: ResourceData;
 
 
 begin
 begin
   Result:=False;
   Result:=False;
@@ -412,13 +421,11 @@ begin
     raise EConversionError.CreateFmt(SConvStrParseError,[AText]);
     raise EConversionError.CreateFmt(SConvStrParseError,[AText]);
 end;
 end;
 
 
-//since a conversion family actually can have any (including an empty) description we need a function that
-//properly checks and indicates wether or not AType actually exists
 function TryConvTypeToFamily(const AType: TConvType; out AFam: TConvFamily): Boolean;
 function TryConvTypeToFamily(const AType: TConvType; out AFam: TConvFamily): Boolean;
 
 
 begin
 begin
   result:=false;
   result:=false;
-  if (AType<length(TheUnits)) and (not TheUnits[AType].Deleted) then begin
+  if CheckType(AType) then begin
     AFam:=TheUnits[AType].Fam;
     AFam:=TheUnits[AType].Fam;
     result:=true;
     result:=true;
   end;
   end;
@@ -459,9 +466,8 @@ end;
 function CompatibleConversionTypes(const AFrom, ATo: TConvType): Boolean;
 function CompatibleConversionTypes(const AFrom, ATo: TConvType): Boolean;
 
 
 begin
 begin
- //ConvTypeToFamily potentially raises an exception, make sure it doesn't here
-  result:= (AFrom<length(TheUnits)) and (ATo<length(TheUnits)) and
-           (not TheUnits[AFrom].Deleted) and (not TheUnits[ATo].Deleted) and
+  //ConvTypeToFamily potentially raises an exception, make sure it doesn't here
+  result:= CheckType(AFrom) and CheckType(ATo) and
            (ConvTypeToFamily(AFrom)=ConvTypeToFamily(ATo));
            (ConvTypeToFamily(AFrom)=ConvTypeToFamily(ATo));
 end;
 end;
 
 
@@ -493,7 +499,7 @@ var
 
 
 begin
 begin
   //Apparently this procedure is not supposed to raise exceptions
   //Apparently this procedure is not supposed to raise exceptions
-  if AFamily<Length(TheFamilies) then
+  if CheckFamily(AFamily) then
   begin
   begin
     TheFamilies[AFamily].Deleted:=True;
     TheFamilies[AFamily].Deleted:=True;
     for i:=0 to Length(TheUnits)-1 do
     for i:=0 to Length(TheUnits)-1 do
@@ -504,24 +510,19 @@ begin
   end;
   end;
 end;
 end;
 
 
-Function CheckFamily(i:TConvFamily):Boolean;
-
-begin
-  Result:=(i<Length(TheFamilies)) and (not TheFamilies[i].Deleted);
-end;
 
 
 procedure UnregisterConversionType(const AType: TConvType);
 procedure UnregisterConversionType(const AType: TConvType);
 
 
 begin
 begin
   //Apparently this procedure is not supposed to raise exceptions
   //Apparently this procedure is not supposed to raise exceptions
-  if AType<Length(TheUnits) then
+  if CheckType(AType) then
     TheUnits[AType].Deleted:=True;
     TheUnits[AType].Deleted:=True;
 end;
 end;
 
 
 Function InternalRegisterConversionType(Fam:TConvFamily; S:String;Value:TConvUtilFloat;
 Function InternalRegisterConversionType(Fam:TConvFamily; S:String;Value:TConvUtilFloat;
   const AToCommonFunc, AFromCommonFunc: TConversionProc):TConvType;
   const AToCommonFunc, AFromCommonFunc: TConversionProc):TConvType;
 
 
-var l1 : Longint;
+var len : Longint;
 
 
 begin
 begin
   If NOT CheckFamily(Fam) Then
   If NOT CheckFamily(Fam) Then
@@ -532,20 +533,20 @@ begin
     raise EConversionError.Create(SConvEmptyDescription);
     raise EConversionError.Create(SConvEmptyDescription);
   if IsZero(Value,zeroRes) then
   if IsZero(Value,zeroRes) then
     raise EZeroDivide.CreateFmt(SConvFactorZero,[S]);
     raise EZeroDivide.CreateFmt(SConvFactorZero,[S]);
-  l1:=length(theunits);
-  if l1>0 then
+  len:=length(theunits);
+  if len>0 then
     if FindConvType(Fam, S) then
     if FindConvType(Fam, S) then
       raise EConversionError.CreateFmt(SConvDuplicateType,[S,ConvFamilyToDescription(Fam)]);
       raise EConversionError.CreateFmt(SConvDuplicateType,[S,ConvFamilyToDescription(Fam)]);
-  if l1=Integer(High(TConvType))+1 then
+  if len=Integer(High(TConvType))+1 then
     raise EConversionError.CreateFmt(SConvTooManyConvTypes,[High(TConvType)]);
     raise EConversionError.CreateFmt(SConvTooManyConvTypes,[High(TConvType)]);
-  Setlength(theunits,l1+1);
-  theunits[l1].description:=s;
-  theunits[l1].value:=value;
-  theunits[l1].ToCommonFunc:=AToCommonFunc;
-  theunits[l1].FromCommonFunc:=AFromCommonFunc;
-  theunits[l1].fam:=fam;
-  theunits[l1].deleted:=false;
-  Result:=l1;
+  Setlength(theunits,len+1);
+  theunits[len].description:=s;
+  theunits[len].value:=value;
+  theunits[len].ToCommonFunc:=AToCommonFunc;
+  theunits[len].FromCommonFunc:=AFromCommonFunc;
+  theunits[len].fam:=fam;
+  theunits[len].deleted:=false;
+  Result:=len;
 end;
 end;
 
 
 Function RegisterConversionType(Fam:TConvFamily;Const S:String;Value:TConvUtilFloat):TConvType;
 Function RegisterConversionType(Fam:TConvFamily;Const S:String;Value:TConvUtilFloat):TConvType;
@@ -559,13 +560,10 @@ begin
   result:=InternalRegisterConversionType(Fam,S,(AToCommonFunc(1)-AToCommonFunc(0)),AToCommonFunc,AFromCommonFunc);
   result:=InternalRegisterConversionType(Fam,S,(AToCommonFunc(1)-AToCommonFunc(0)),AToCommonFunc,AFromCommonFunc);
 end;
 end;
 
 
-function SearchConvert(TheType:TConvType; out r:ResourceData):Boolean;
-
-var l1 : longint;
+function SearchConvert(TheType:TConvType; out r:TResourceData):Boolean;
 
 
 begin
 begin
-  l1:=length(TheUnits);
-  if (thetype>=l1) or (theunits[thetype].Deleted) then
+  if not CheckType(TheType) then
     exit(false);
     exit(false);
   r:=theunits[thetype];
   r:=theunits[thetype];
   result:=true;
   result:=true;
@@ -574,7 +572,7 @@ end;
 function Convert ( const Measurement  : Double; const FromType, ToType  : TConvType ) :TConvUtilFloat;
 function Convert ( const Measurement  : Double; const FromType, ToType  : TConvType ) :TConvUtilFloat;
 
 
 var
 var
-  fromrec,torec :   resourcedata;
+  fromrec,torec :   TResourceData;
   common: double;
   common: double;
 
 
 begin
 begin
@@ -610,7 +608,7 @@ end;
 function Convert ( const Measurement  : Double; const FromType1, FromType2, ToType1, ToType2  : TConvType ) :TConvUtilFloat;
 function Convert ( const Measurement  : Double; const FromType1, FromType2, ToType1, ToType2  : TConvType ) :TConvUtilFloat;
 var
 var
   fromrec1,fromrec2,torec1 ,
   fromrec1,fromrec2,torec1 ,
-  torec2 :   resourcedata;
+  torec2 :   TResourceData;
 
 
 begin
 begin
   if not SearchConvert(fromtype1,fromrec1) then
   if not SearchConvert(fromtype1,fromrec1) then
@@ -639,7 +637,7 @@ end;
 function ConvertFrom(const AFrom: TConvType; AValue: Double): TConvUtilFloat;
 function ConvertFrom(const AFrom: TConvType; AValue: Double): TConvUtilFloat;
 
 
 var
 var
-  fromrec :   resourcedata;
+  fromrec :   TResourceData;
 
 
 begin
 begin
   if not SearchConvert(AFrom, fromrec) then
   if not SearchConvert(AFrom, fromrec) then
@@ -653,7 +651,7 @@ end;
 function ConvertTo(const AValue: Double; const ATo: TConvType): TConvUtilFloat;
 function ConvertTo(const AValue: Double; const ATo: TConvType): TConvUtilFloat;
 
 
 var
 var
-  torec :   resourcedata;
+  torec :   TResourceData;
 
 
 begin
 begin
   if not SearchConvert(ATo, torec) then
   if not SearchConvert(ATo, torec) then