Added IntToStr base variant + fixed overload issues + added & updated…

… tests that were relying on IntToStr not being overloaded

Source/dwsCompiler.pas

@@ -4177,17 +4177,36 @@ procedure TdwsCompiler.ReadPostConditions(funcSymbol : TFuncSymbol; conditions :
    TFindOverloadedFunc = class
       OpSymbol : TOperatorSymbol;
       CapturableUsesSym : TFuncSymbol;
-      function Callback(symbol : TSymbol) : Boolean;
+      function Callback1(symbol : TSymbol) : Boolean;
+      function Callback2(symbol : TSymbol) : Boolean;
    end;
 
-function TFindOverloadedFunc.Callback(symbol : TSymbol) : Boolean;
+function TFindOverloadedFunc.Callback1(symbol : TSymbol) : Boolean;
 var
    funcSym : TFuncSymbol;
 begin
    Result:=False;
    funcSym:=symbol.AsFuncSymbol;
    if (funcSym<>nil) and (not symbol.IsType) then begin
-      if     (funcSym.Params.Count=2) and (funcSym.Typ<>nil)
+      if     (funcSym.Params.Count = 1) and (funcSym.Typ<>nil)
+         and (Length(opSymbol.Params) = 1)
+         and funcSym.Typ.IsOfType(opSymbol.Typ)
+         and funcSym.Params[0].Typ.IsOfType(opSymbol.Params[0]) then begin
+         CapturableUsesSym:=funcSym;
+         Result:=True;
+      end;
+   end;
+end;
+
+function TFindOverloadedFunc.Callback2(symbol : TSymbol) : Boolean;
+var
+   funcSym : TFuncSymbol;
+begin
+   Result:=False;
+   funcSym:=symbol.AsFuncSymbol;
+   if (funcSym<>nil) and (not symbol.IsType) then begin
+      if     (funcSym.Params.Count = 2) and (funcSym.Typ<>nil)
+         and (Length(opSymbol.Params) = 2)
          and funcSym.Typ.IsOfType(opSymbol.Typ)
          and funcSym.Params[0].Typ.IsOfType(opSymbol.Params[0])
          and funcSym.Params[1].Typ.IsOfType(opSymbol.Params[1]) then begin
@@ -4202,15 +4221,21 @@ function TFindOverloadedFunc.Callback(symbol : TSymbol) : Boolean;
 function TdwsCompiler.ReadOperatorDecl : TOperatorSymbol;
 
    procedure FindOverloadedFunc(var usesSym : TFuncSymbol; const usesName : String;
-                                fromTable : TSymbolTable; opSymbol : TOperatorSymbol);
+                                fromTable : TSymbolTable; opSymbol : TOperatorSymbol;
+                                nbParams : Integer);
    var
       finder : TFindOverloadedFunc;
    begin
-      finder:=TFindOverloadedFunc.Create;
+      finder := TFindOverloadedFunc.Create;
       try
          finder.CapturableUsesSym:=usesSym;
          finder.OpSymbol:=opSymbol;
-         fromTable.EnumerateSymbolsOfNameInScope(usesName, finder.Callback);
+         case nbParams of
+            1 : fromTable.EnumerateSymbolsOfNameInScope(usesName, finder.Callback1);
+            2 : fromTable.EnumerateSymbolsOfNameInScope(usesName, finder.Callback2);
+         else
+            Assert(False);
+         end;
          usesSym:=finder.CapturableUsesSym;
       finally
          finder.Free;
@@ -4295,7 +4320,7 @@ function TdwsCompiler.ReadOperatorDecl : TOperatorSymbol;
       if usesSym<>nil then begin
 
          if usesSym.IsOverloaded then
-            FindOverloadedFunc(usesSym, usesName, fromTable, Result);
+            FindOverloadedFunc(usesSym, usesName, fromTable, Result, expectedNbParams);
 
          RecordSymbolUse(usesSym, usesPos, [suReference]);
 
@@ -5146,10 +5171,12 @@ function TdwsCompiler.ReadImplicitCall(codeExpr : TTypedExpr; isWrite: Boolean;
               and codeExprTyp.IsOfType(expecting)
               and not FTok.Test(ttBLEFT)) then
          Result:=codeExpr
+      else if not funcSym.IsOverloaded then
+         Result := ReadFunc(funcSym, codeExpr, expecting)
       else begin
-         Assert(not funcSym.IsOverloaded);
+         FMsgs.AddCompilerStopFmt(codeExpr.ScriptPos, CPH_AmbiguousMatchingOverloadsForCall, [ funcSym.Name ]);
+         Result := codeExpr;
          // Result:=ReadFuncOverloaded(funcSym, fromTable, varExpr, expecting)
-         Result:=ReadFunc(funcSym, codeExpr, expecting);
       end;
    end else Result:=codeExpr;
 

Source/dwsStringFunctions.pas

@@ -40,6 +40,9 @@   TChrFunc = class sealed (TInternalMagicStringFunction)
   TIntToStrFunc = class(TInternalMagicStringFunction)
     procedure DoEvalAsString(const args : TExprBaseListExec; var Result : String); override;
   end;
+  TIntToStrBaseFunc = class(TInternalMagicStringFunction)
+    procedure DoEvalAsString(const args : TExprBaseListExec; var Result : String); override;
+  end;
 
   TStrToIntFunc = class(TInternalMagicIntFunction)
     function DoEvalAsInteger(const args : TExprBaseListExec) : Int64; override;
@@ -405,6 +408,20 @@ procedure TIntToStrFunc.DoEvalAsString(const args : TExprBaseListExec; var Resul
    FastInt64ToStr(args.AsInteger[0], Result);
 end;
 
+{ TIntToStrBaseFunc }
+
+procedure TIntToStrBaseFunc.DoEvalAsString(const args : TExprBaseListExec; var Result : String);
+var
+   v : Int64;
+   base : Integer;
+begin
+   v := args.AsInteger[0];
+   base := args.AsInteger[1];
+   if base = 10 then
+      FastInt64ToStr(v, Result)
+   else Result := Int64ToStrBase(v, base);
+end;
+
 { TStrToIntFunc }
 
 function TStrToIntFunc.DoEvalAsInteger(const args : TExprBaseListExec) : Int64;
@@ -1370,11 +1387,12 @@ initialization
 
    RegisterInternalStringFunction(TChrFunc, 'Chr', ['i', SYS_INTEGER], [iffStateLess]);
 
-   RegisterInternalStringFunction(TIntToStrFunc, 'IntToStr', ['i', SYS_INTEGER], [iffStateLess], 'ToString');
+   RegisterInternalStringFunction(TIntToStrFunc, 'IntToStr', ['i', SYS_INTEGER], [ iffStateLess, iffOverloaded ], 'ToString');
+   RegisterInternalStringFunction(TIntToStrBaseFunc, 'IntToStr', ['i', SYS_INTEGER, 'base', SYS_INTEGER], [ iffStateLess, iffOverloaded ], 'ToString');
    RegisterInternalIntFunction(TStrToIntFunc, 'StrToInt', ['str', SYS_STRING], [ iffStateLess, iffOverloaded ], 'ToInteger');
    RegisterInternalIntFunction(TStrToIntDefFunc, 'StrToIntDef', ['str', SYS_STRING, 'def', SYS_INTEGER], [iffStateLess], 'ToIntegerDef');
    RegisterInternalIntFunction(TStrToIntDefFunc, 'VarToIntDef', ['val', SYS_VARIANT, 'def', SYS_INTEGER], [iffStateLess]);
-   RegisterInternalIntFunction(TStrToIntBaseFunc, 'StrToInt', ['str', SYS_STRING, 'base', SYS_INTEGER ], [ iffStateLess, iffOverloaded ]);
+   RegisterInternalIntFunction(TStrToIntBaseFunc, 'StrToInt', ['str', SYS_STRING, 'base', SYS_INTEGER], [ iffStateLess, iffOverloaded ]);
    RegisterInternalBoolFunction(TTryStrToIntBaseFunc, 'TryStrToInt', ['str', SYS_STRING, 'base', SYS_INTEGER, '@value', SYS_INTEGER ], [ iffStateLess ], 'ToInteger');
 
    RegisterInternalStringFunction(TIntToHexFunc, 'IntToHex', ['v', SYS_INTEGER, 'digits', SYS_INTEGER], [iffStateLess], 'ToHexString');

Source/dwsUtils.pas

@@ -1077,6 +1077,8 @@ function  Int32ToStrU(val : Integer) : UnicodeString;
 function  StrUToInt64(const s : UnicodeString; const default : Int64) : Int64;
 function  TryStrToIntBase(const s : UnicodeString; base : Integer; var value : Int64) : Boolean;
 
+function Int64ToStrBase(val : Int64; base : Integer) : String;
+
 function Int64ToHex(val : Int64; digits : Integer) : String; inline;
 
 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
    end;
 end;
 
+// Int64ToStrBase
+//
+function Int64ToStrBase(val : Int64; base : Integer) : String;
+var
+   uv : UInt64;
+   buf : array [0..64] of Char;
+   p, digit : Integer;
+   neg : Boolean;
+begin
+   if (base < 2) or (base > 36) then
+      raise EConvertError.CreateFmt('Invalid base for integer to string conversion (%d)', [ base ]);
+
+   if val = 0 then Exit('0');
+
+   neg := (val < 0);
+   if neg then
+      uv := -val
+   else uv := val;
+   p := High(buf);
+
+   while uv <> 0 do begin
+      digit := uv mod Cardinal(base);
+      uv := uv div Cardinal(base);
+      if digit < 10 then
+         buf[p] := Char(Ord('0') + digit)
+      else buf[p] := Char((Ord('A') - 10) + digit);
+      Dec(p);
+   end;
+
+   if neg then begin
+      buf[p] := '-';
+      Dec(p);
+   end;
+
+   SetString(Result, PChar(@buf[p+1]), High(buf)-p);
+end;
+
 // FastStringReplace
 //
 procedure FastStringReplace(var str : UnicodeString; const sub, newSub : UnicodeString);

Test/BuildScripts/ScopePrint.pas

@@ -1,4 +1,4 @@
-// comment
+// comment
 unit ScopePrint;
 
 // comment
@@ -25,9 +25,9 @@ procedure PrintLn(s : String);
    Default.PrintLn('>');
 end;
 
-function IntToStr(i : Integer) : String;
+function IntToHex(i : Integer) : String;
 begin
    Result:='bug';
 end;
 
-end.
+end.

Test/FailureScripts/array_bounds.txt

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

Test/FailureScripts/func_ptr4.txt

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

Test/FailureScripts/func_ptr5.txt

@@ -1,2 +1,2 @@
 Syntax Error: Destructor can only be invoked on instance [line: 3, column: 15]
-Syntax Error: Incompatible types: "function IntToStr(Integer): String" and "destructor Destroy" [line: 3, column: 6]
+Syntax Error: Incompatible types: "function IntToStr(Integer, Integer): String" and "destructor Destroy" [line: 3, column: 6]

Test/FailureScripts/func_ptr_constant_ambiguous.pas

@@ -0,0 +1,3 @@
+var p := @IntToStr;
+
+if assigned(p) then PrintLn(p(5));

Test/FailureScripts/func_ptr_constant_ambiguous.txt

@@ -0,0 +1,2 @@
+Hint: "assigned" does not match case of declaration ("Assigned") [line: 3, column: 4]
+Syntax Error: Ambiguous matching overloads of "IntToStr" [line: 3, column: 13]

Test/FailureScripts/func_toomanyargs.pas

@@ -2,7 +2,7 @@ procedure MyProc(a : Integer);
 begin
 end;
 
-IntToStr(45, 12);
+IntToBin(45, 12, 0);
 MyProc(45, 12);
 
 var v := '12';

Test/FunctionsString/intostr_base.pas

@@ -0,0 +1,6 @@
+for var i := 2 to 36 do begin
+   PrintLn(IntToStr(0, i));
+   PrintLn(IntToStr(123456789, i));
+   PrintLn(IntToStr(-123456789, i));
+end;
+

Test/FunctionsString/intostr_base.txt

@@ -0,0 +1,105 @@
+0
+111010110111100110100010101
+-111010110111100110100010101
+0
+22121022020212200
+-22121022020212200
+0
+13112330310111
+-13112330310111
+0
+223101104124
+-223101104124
+0
+20130035113
+-20130035113
+0
+3026236221
+-3026236221
+0
+726746425
+-726746425
+0
+277266780
+-277266780
+0
+123456789
+-123456789
+0
+63762A05
+-63762A05
+0
+35418A99
+-35418A99
+0
+1C767471
+-1C767471
+0
+12579781
+-12579781
+0
+AC89BC9
+-AC89BC9
+0
+75BCD15
+-75BCD15
+0
+51G2A21
+-51G2A21
+0
+3B60F89
+-3B60F89
+0
+2BG64AE
+-2BG64AE
+0
+1IBC1J9
+-1IBC1J9
+0
+194GH7F
+-194GH7F
+0
+11L0805
+-11L0805
+0
+J43JFB
+-J43JFB
+0
+FC2EGL
+-FC2EGL
+0
+CG15LE
+-CG15LE
+0
+AA44A1
+-AA44A1
+0
+8G86NI
+-8G86NI
+0
+74NQB1
+-74NQB1
+0
+60FSHJ
+-60FSHJ
+0
+52CE69
+-52CE69
+0
+49L302
+-49L302
+0
+3LNJ8L
+-3LNJ8L
+0
+353C3R
+-353C3R
+0
+2OD2I1
+-2OD2I1
+0
+2C9G1T
+-2C9G1T
+0
+21I3V9
+-21I3V9

Test/OverloadsFail/forwards_unit.pas

@@ -20,7 +20,7 @@ procedure Test(s : String; i : Integer); overload;
 
 function Test(i : String) : String;
 begin
-   Result:='Hello '+IntToStr(i);
+   Result:='Hello '+IntToHex(i, 1);
 end;
 
 end.

Test/SimpleScripts/func_ptr_constant.pas

@@ -1,3 +1,3 @@
-var p := @IntToStr;
+var p := @IntToHex;
 
-if assigned(p) then PrintLn(p(5));
+if assigned(p) then PrintLn(p(5, 1));

Test/UBuildTests.pas

@@ -63,7 +63,7 @@ procedure TBuildTests.SetUp;
 
    FTests:=TStringList.Create;
 
-   CollectFiles(ExtractFilePath(ParamStr(0))+'BuildScripts'+PathDelim, '*.dws', FTests);
+   CollectFiles(ExtractFilePath(ParamStr(0))+'BuildScripts'+PathDelim, 'scope_to_main*.dws', FTests);
 
    FCompiler:=TDelphiWebScript.Create(nil);
    FCompiler.OnInclude:=DoInclude;