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

+228
-27
lines changed

‎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';

‎Test/FunctionsString/intostr_base.pas

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,6 @@
1+
for var i := 2 to 36 do begin
2+
PrintLn(IntToStr(0, i));
3+
PrintLn(IntToStr(123456789, i));
4+
PrintLn(IntToStr(-123456789, i));
5+
end;
6+

‎Test/FunctionsString/intostr_base.txt

Lines changed: 105 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,105 @@
1+
0
2+
111010110111100110100010101
3+
-111010110111100110100010101
4+
0
5+
22121022020212200
6+
-22121022020212200
7+
0
8+
13112330310111
9+
-13112330310111
10+
0
11+
223101104124
12+
-223101104124
13+
0
14+
20130035113
15+
-20130035113
16+
0
17+
3026236221
18+
-3026236221
19+
0
20+
726746425
21+
-726746425
22+
0
23+
277266780
24+
-277266780
25+
0
26+
123456789
27+
-123456789
28+
0
29+
63762A05
30+
-63762A05
31+
0
32+
35418A99
33+
-35418A99
34+
0
35+
1C767471
36+
-1C767471
37+
0
38+
12579781
39+
-12579781
40+
0
41+
AC89BC9
42+
-AC89BC9
43+
0
44+
75BCD15
45+
-75BCD15
46+
0
47+
51G2A21
48+
-51G2A21
49+
0
50+
3B60F89
51+
-3B60F89
52+
0
53+
2BG64AE
54+
-2BG64AE
55+
0
56+
1IBC1J9
57+
-1IBC1J9
58+
0
59+
194GH7F
60+
-194GH7F
61+
0
62+
11L0805
63+
-11L0805
64+
0
65+
J43JFB
66+
-J43JFB
67+
0
68+
FC2EGL
69+
-FC2EGL
70+
0
71+
CG15LE
72+
-CG15LE
73+
0
74+
AA44A1
75+
-AA44A1
76+
0
77+
8G86NI
78+
-8G86NI
79+
0
80+
74NQB1
81+
-74NQB1
82+
0
83+
60FSHJ
84+
-60FSHJ
85+
0
86+
52CE69
87+
-52CE69
88+
0
89+
49L302
90+
-49L302
91+
0
92+
3LNJ8L
93+
-3LNJ8L
94+
0
95+
353C3R
96+
-353C3R
97+
0
98+
2OD2I1
99+
-2OD2I1
100+
0
101+
2C9G1T
102+
-2C9G1T
103+
0
104+
21I3V9
105+
-21I3V9

‎Test/OverloadsFail/forwards_unit.pas

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -20,7 +20,7 @@ procedure Test(s : String; i : Integer); overload;
2020

2121
function Test(i : String) : String;
2222
begin
23-
Result:='Hello '+IntToStr(i);
23+
Result:='Hello '+IntToHex(i, 1);
2424
end;
2525

2626
end.

‎Test/SimpleScripts/func_ptr_constant.pas

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,3 @@
1-
var p := @IntToStr;
1+
var p := @IntToHex;
22

3-
if assigned(p) then PrintLn(p(5));
3+
if assigned(p) then PrintLn(p(5, 1));

‎Test/UBuildTests.pas

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -63,7 +63,7 @@ procedure TBuildTests.SetUp;
6363

6464
FTests:=TStringList.Create;
6565

66-
CollectFiles(ExtractFilePath(ParamStr(0))+'BuildScripts'+PathDelim, '*.dws', FTests);
66+
CollectFiles(ExtractFilePath(ParamStr(0))+'BuildScripts'+PathDelim, 'scope_to_main*.dws', FTests);
6767

6868
FCompiler:=TDelphiWebScript.Create(nil);
6969
FCompiler.OnInclude:=DoInclude;

0 commit comments

Comments
 (0)