Skip to content

Commit 9660ff6

Browse files
EricGrangeEricGrange
committed
Added IntToStr base variant + fixed overload issues + added & updated tests that were relying on IntToStr not being overloaded
1 parent 7f069c0 commit 9660ff6

16 files changed

Lines changed: 228 additions & 27 deletions

‎Source/dwsCompiler.pas‎

Lines changed: 36 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -4177,17 +4177,36 @@ procedure TdwsCompiler.ReadPostConditions(funcSymbol : TFuncSymbol; conditions :
41774177
TFindOverloadedFunc = class
41784178
OpSymbol : TOperatorSymbol;
41794179
CapturableUsesSym : TFuncSymbol;
4180-
function Callback(symbol : TSymbol) : Boolean;
4180+
function Callback1(symbol : TSymbol) : Boolean;
4181+
function Callback2(symbol : TSymbol) : Boolean;
41814182
end;
41824183

4183-
function TFindOverloadedFunc.Callback(symbol : TSymbol) : Boolean;
4184+
function TFindOverloadedFunc.Callback1(symbol : TSymbol) : Boolean;
41844185
var
41854186
funcSym : TFuncSymbol;
41864187
begin
41874188
Result:=False;
41884189
funcSym:=symbol.AsFuncSymbol;
41894190
if (funcSym<>nil) and (not symbol.IsType) then begin
4190-
if (funcSym.Params.Count=2) and (funcSym.Typ<>nil)
4191+
if (funcSym.Params.Count = 1) and (funcSym.Typ<>nil)
4192+
and (Length(opSymbol.Params) = 1)
4193+
and funcSym.Typ.IsOfType(opSymbol.Typ)
4194+
and funcSym.Params[0].Typ.IsOfType(opSymbol.Params[0]) then begin
4195+
CapturableUsesSym:=funcSym;
4196+
Result:=True;
4197+
end;
4198+
end;
4199+
end;
4200+
4201+
function TFindOverloadedFunc.Callback2(symbol : TSymbol) : Boolean;
4202+
var
4203+
funcSym : TFuncSymbol;
4204+
begin
4205+
Result:=False;
4206+
funcSym:=symbol.AsFuncSymbol;
4207+
if (funcSym<>nil) and (not symbol.IsType) then begin
4208+
if (funcSym.Params.Count = 2) and (funcSym.Typ<>nil)
4209+
and (Length(opSymbol.Params) = 2)
41914210
and funcSym.Typ.IsOfType(opSymbol.Typ)
41924211
and funcSym.Params[0].Typ.IsOfType(opSymbol.Params[0])
41934212
and funcSym.Params[1].Typ.IsOfType(opSymbol.Params[1]) then begin
@@ -4202,15 +4221,21 @@ function TFindOverloadedFunc.Callback(symbol : TSymbol) : Boolean;
42024221
function TdwsCompiler.ReadOperatorDecl : TOperatorSymbol;
42034222

42044223
procedure FindOverloadedFunc(var usesSym : TFuncSymbol; const usesName : String;
4205-
fromTable : TSymbolTable; opSymbol : TOperatorSymbol);
4224+
fromTable : TSymbolTable; opSymbol : TOperatorSymbol;
4225+
nbParams : Integer);
42064226
var
42074227
finder : TFindOverloadedFunc;
42084228
begin
4209-
finder:=TFindOverloadedFunc.Create;
4229+
finder := TFindOverloadedFunc.Create;
42104230
try
42114231
finder.CapturableUsesSym:=usesSym;
42124232
finder.OpSymbol:=opSymbol;
4213-
fromTable.EnumerateSymbolsOfNameInScope(usesName, finder.Callback);
4233+
case nbParams of
4234+
1 : fromTable.EnumerateSymbolsOfNameInScope(usesName, finder.Callback1);
4235+
2 : fromTable.EnumerateSymbolsOfNameInScope(usesName, finder.Callback2);
4236+
else
4237+
Assert(False);
4238+
end;
42144239
usesSym:=finder.CapturableUsesSym;
42154240
finally
42164241
finder.Free;
@@ -4295,7 +4320,7 @@ function TdwsCompiler.ReadOperatorDecl : TOperatorSymbol;
42954320
if usesSym<>nil then begin
42964321

42974322
if usesSym.IsOverloaded then
4298-
FindOverloadedFunc(usesSym, usesName, fromTable, Result);
4323+
FindOverloadedFunc(usesSym, usesName, fromTable, Result, expectedNbParams);
42994324

43004325
RecordSymbolUse(usesSym, usesPos, [suReference]);
43014326

@@ -5146,10 +5171,12 @@ function TdwsCompiler.ReadImplicitCall(codeExpr : TTypedExpr; isWrite: Boolean;
51465171
and codeExprTyp.IsOfType(expecting)
51475172
and not FTok.Test(ttBLEFT)) then
51485173
Result:=codeExpr
5174+
else if not funcSym.IsOverloaded then
5175+
Result := ReadFunc(funcSym, codeExpr, expecting)
51495176
else begin
5150-
Assert(not funcSym.IsOverloaded);
5177+
FMsgs.AddCompilerStopFmt(codeExpr.ScriptPos, CPH_AmbiguousMatchingOverloadsForCall, [ funcSym.Name ]);
5178+
Result := codeExpr;
51515179
// Result:=ReadFuncOverloaded(funcSym, fromTable, varExpr, expecting)
5152-
Result:=ReadFunc(funcSym, codeExpr, expecting);
51535180
end;
51545181
end else Result:=codeExpr;
51555182

‎Source/dwsStringFunctions.pas‎

Lines changed: 20 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -40,6 +40,9 @@ TChrFunc = class sealed (TInternalMagicStringFunction)
4040
TIntToStrFunc = class(TInternalMagicStringFunction)
4141
procedure DoEvalAsString(const args : TExprBaseListExec; var Result : String); override;
4242
end;
43+
TIntToStrBaseFunc = class(TInternalMagicStringFunction)
44+
procedure DoEvalAsString(const args : TExprBaseListExec; var Result : String); override;
45+
end;
4346

4447
TStrToIntFunc = class(TInternalMagicIntFunction)
4548
function DoEvalAsInteger(const args : TExprBaseListExec) : Int64; override;
@@ -405,6 +408,20 @@ procedure TIntToStrFunc.DoEvalAsString(const args : TExprBaseListExec; var Resul
405408
FastInt64ToStr(args.AsInteger[0], Result);
406409
end;
407410

411+
{ TIntToStrBaseFunc }
412+
413+
procedure TIntToStrBaseFunc.DoEvalAsString(const args : TExprBaseListExec; var Result : String);
414+
var
415+
v : Int64;
416+
base : Integer;
417+
begin
418+
v := args.AsInteger[0];
419+
base := args.AsInteger[1];
420+
if base = 10 then
421+
FastInt64ToStr(v, Result)
422+
else Result := Int64ToStrBase(v, base);
423+
end;
424+
408425
{ TStrToIntFunc }
409426

410427
function TStrToIntFunc.DoEvalAsInteger(const args : TExprBaseListExec) : Int64;
@@ -1370,11 +1387,12 @@ initialization
13701387

13711388
RegisterInternalStringFunction(TChrFunc, 'Chr', ['i', SYS_INTEGER], [iffStateLess]);
13721389

1373-
RegisterInternalStringFunction(TIntToStrFunc, 'IntToStr', ['i', SYS_INTEGER], [iffStateLess], 'ToString');
1390+
RegisterInternalStringFunction(TIntToStrFunc, 'IntToStr', ['i', SYS_INTEGER], [ iffStateLess, iffOverloaded ], 'ToString');
1391+
RegisterInternalStringFunction(TIntToStrBaseFunc, 'IntToStr', ['i', SYS_INTEGER, 'base', SYS_INTEGER], [ iffStateLess, iffOverloaded ], 'ToString');
13741392
RegisterInternalIntFunction(TStrToIntFunc, 'StrToInt', ['str', SYS_STRING], [ iffStateLess, iffOverloaded ], 'ToInteger');
13751393
RegisterInternalIntFunction(TStrToIntDefFunc, 'StrToIntDef', ['str', SYS_STRING, 'def', SYS_INTEGER], [iffStateLess], 'ToIntegerDef');
13761394
RegisterInternalIntFunction(TStrToIntDefFunc, 'VarToIntDef', ['val', SYS_VARIANT, 'def', SYS_INTEGER], [iffStateLess]);
1377-
RegisterInternalIntFunction(TStrToIntBaseFunc, 'StrToInt', ['str', SYS_STRING, 'base', SYS_INTEGER ], [ iffStateLess, iffOverloaded ]);
1395+
RegisterInternalIntFunction(TStrToIntBaseFunc, 'StrToInt', ['str', SYS_STRING, 'base', SYS_INTEGER], [ iffStateLess, iffOverloaded ]);
13781396
RegisterInternalBoolFunction(TTryStrToIntBaseFunc, 'TryStrToInt', ['str', SYS_STRING, 'base', SYS_INTEGER, '@value', SYS_INTEGER ], [ iffStateLess ], 'ToInteger');
13791397

13801398
RegisterInternalStringFunction(TIntToHexFunc, 'IntToHex', ['v', SYS_INTEGER, 'digits', SYS_INTEGER], [iffStateLess], 'ToHexString');

‎Source/dwsUtils.pas‎

Lines changed: 39 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1077,6 +1077,8 @@ function Int32ToStrU(val : Integer) : UnicodeString;
10771077
function StrUToInt64(const s : UnicodeString; const default : Int64) : Int64;
10781078
function TryStrToIntBase(const s : UnicodeString; base : Integer; var value : Int64) : Boolean;
10791079

1080+
function Int64ToStrBase(val : Int64; base : Integer) : String;
1081+
10801082
function Int64ToHex(val : Int64; digits : Integer) : String; inline;
10811083

10821084
function TryStrToDouble(const s : String; var val : Double) : Boolean; overload; inline;
@@ -2049,6 +2051,43 @@ function TryStrToIntBase(const s : UnicodeString; base : Integer; var value : In
20492051
end;
20502052
end;
20512053

2054+
// Int64ToStrBase
2055+
//
2056+
function Int64ToStrBase(val : Int64; base : Integer) : String;
2057+
var
2058+
uv : UInt64;
2059+
buf : array [0..64] of Char;
2060+
p, digit : Integer;
2061+
neg : Boolean;
2062+
begin
2063+
if (base < 2) or (base > 36) then
2064+
raise EConvertError.CreateFmt('Invalid base for integer to string conversion (%d)', [ base ]);
2065+
2066+
if val = 0 then Exit('0');
2067+
2068+
neg := (val < 0);
2069+
if neg then
2070+
uv := -val
2071+
else uv := val;
2072+
p := High(buf);
2073+
2074+
while uv <> 0 do begin
2075+
digit := uv mod Cardinal(base);
2076+
uv := uv div Cardinal(base);
2077+
if digit < 10 then
2078+
buf[p] := Char(Ord('0') + digit)
2079+
else buf[p] := Char((Ord('A') - 10) + digit);
2080+
Dec(p);
2081+
end;
2082+
2083+
if neg then begin
2084+
buf[p] := '-';
2085+
Dec(p);
2086+
end;
2087+
2088+
SetString(Result, PChar(@buf[p+1]), High(buf)-p);
2089+
end;
2090+
20522091
// FastStringReplace
20532092
//
20542093
procedure FastStringReplace(var str : UnicodeString; const sub, newSub : UnicodeString);

‎Test/BuildScripts/ScopePrint.pas‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
// comment
1+
// comment
22
unit ScopePrint;
33

44
// comment
@@ -25,9 +25,9 @@ procedure PrintLn(s : String);
2525
Default.PrintLn('>');
2626
end;
2727

28-
function IntToStr(i : Integer) : String;
28+
function IntToHex(i : Integer) : String;
2929
begin
3030
Result:='bug';
3131
end;
3232

33-
end.
33+
end.

‎Test/FailureScripts/array_bounds.txt‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,6 @@ Syntax Error: Lower bound exceeded! Index -1 [line: 4, column: 6]
22
Syntax Error: Upper bound exceeded! Index 5 [line: 5, column: 5]
33
Syntax Error: Lower bound exceeded! Index 0 [line: 6, column: 4]
44
Syntax Error: Upper bound exceeded! Index 10 [line: 7, column: 6]
5-
Syntax Error: More arguments expected [line: 8, column: 4]
6-
Syntax Error: Array index expected "Integer" but got "String" [line: 8, column: 4]
5+
Syntax Error: There is no overloaded version of "IntToStr" that can be called with these arguments [line: 8, column: 4]
6+
Syntax Error: Array index expected "Integer" but got "Any Type" [line: 8, column: 4]
77
Syntax Error: Array bounds are of different types [line: 10, column: 25]

‎Test/FailureScripts/func_ptr4.txt‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,2 +1,2 @@
1-
Syntax Error: More arguments expected [line: 3, column: 7]
2-
Syntax Error: Incompatible types: "class function ClassType: TClass" and "function IntToStr(Integer): String" [line: 3, column: 6]
1+
Syntax Error: There is no overloaded version of "IntToStr" that can be called with these arguments [line: 3, column: 7]
2+
Syntax Error: Incompatible types: "class function ClassType: TClass" and "function IntToStr(Integer, Integer): String" [line: 3, column: 6]

‎Test/FailureScripts/func_ptr5.txt‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,2 +1,2 @@
11
Syntax Error: Destructor can only be invoked on instance [line: 3, column: 15]
2-
Syntax Error: Incompatible types: "function IntToStr(Integer): String" and "destructor Destroy" [line: 3, column: 6]
2+
Syntax Error: Incompatible types: "function IntToStr(Integer, Integer): String" and "destructor Destroy" [line: 3, column: 6]

‎Test/FailureScripts/func_ptr_constant_ambiguous.pas‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
var p := @IntToStr;
2+
3+
if assigned(p) then PrintLn(p(5));

‎Test/FailureScripts/func_ptr_constant_ambiguous.txt‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,2 @@
1+
Hint: "assigned" does not match case of declaration ("Assigned") [line: 3, column: 4]
2+
Syntax Error: Ambiguous matching overloads of "IntToStr" [line: 3, column: 13]

‎Test/FailureScripts/func_toomanyargs.pas‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,7 @@ procedure MyProc(a : Integer);
22
begin
33
end;
44

5-
IntToStr(45, 12);
5+
IntToBin(45, 12, 0);
66
MyProc(45, 12);
77

88
var v := '12';

0 commit comments

Comments
 (0)