Browse Source

fcl-passrc: fixed type helper intdouble/uintdouble

git-svn-id: trunk@45121 -
Mattias Gaertner 5 years ago
parent
commit
4f7882c8af
2 changed files with 99 additions and 4 deletions
  1. 5 4
      packages/fcl-passrc/src/pasresolver.pp
  2. 94 0
      packages/pastojs/tests/tcmodules.pas

+ 5 - 4
packages/fcl-passrc/src/pasresolver.pp

@@ -431,7 +431,8 @@ const
   btArrayRangeTypes = btAllChars+btAllBooleans+btAllInteger;
   btAllRanges = btArrayRangeTypes+[btRange];
   btAllWithSubType = [btSet, btArrayLit, btArrayOrSet, btRange];
-  btAllStandardTypes = [
+  btAllIntrinsicTypes = btAllInteger+btAllStringAndChars+btAllFloats+btAllBooleans;
+  btAllFPCTypes = [
     btChar,
     {$ifdef FPC_HAS_CPSTRING}
     btAnsiChar,
@@ -2080,7 +2081,7 @@ type
     // built in types and functions
     procedure ClearBuiltInIdentifiers; virtual;
     procedure AddObjFPCBuiltInIdentifiers(
-      const TheBaseTypes: TResolveBaseTypes = btAllStandardTypes;
+      const TheBaseTypes: TResolveBaseTypes = btAllFPCTypes;
       const TheBaseProcs: TResolverBuiltInProcs = bfAllStandardProcs); virtual;
     function AddBaseType(const aName: string; Typ: TResolverBaseType): TResElDataBaseType;
     function AddCustomBaseType(const aName: string; aClass: TResElDataBaseTypeClass): TPasUnresolvedSymbolRef;
@@ -10435,7 +10436,7 @@ begin
         end;
       end;
     // default: search for type helpers
-    if (LeftResolved.BaseType in btAllStandardTypes)
+    if (LeftResolved.BaseType in btAllIntrinsicTypes)
         or (LeftResolved.BaseType=btContext)
         or (LeftResolved.BaseType=btCustom) then
       begin
@@ -22038,7 +22039,7 @@ begin
   if LoType=nil then
     RaiseMsg(20170216152004,nExprTypeMustBeClassOrRecordTypeGot,sExprTypeMustBeClassOrRecordTypeGot,
       [BaseTypeNames[ExprResolved.BaseType]],ErrorEl);
-  if (ExprResolved.BaseType in btAllStandardTypes) then
+  if (ExprResolved.BaseType in btAllIntrinsicTypes) then
     // ok
   else if (ExprResolved.BaseType=btContext) then
     // ok

+ 94 - 0
packages/pastojs/tests/tcmodules.pas

@@ -702,6 +702,7 @@ type
     Procedure TestTypeHelper_Constructor;
     Procedure TestTypeHelper_Word;
     Procedure TestTypeHelper_Double;
+    Procedure TestTypeHelper_NativeInt;
     Procedure TestTypeHelper_StringChar;
     Procedure TestTypeHelper_JSValue;
     Procedure TestTypeHelper_Array;
@@ -24090,6 +24091,99 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestTypeHelper_NativeInt;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch typehelpers}',
+  'type',
+  '  MaxInt = type nativeint;',
+  '  THelperI = type helper for MaxInt',
+  '    function ToStr: String;',
+  '  end;',
+  '  MaxUInt = type nativeuint;',
+  '  THelperU = type helper for MaxUInt',
+  '    function ToStr: String;',
+  '  end;',
+  'function THelperI.ToStr: String;',
+  'begin',
+  '  Result:=str(Self);',
+  'end;',
+  'function THelperU.ToStr: String;',
+  'begin',
+  '  Result:=str(Self);',
+  'end;',
+  'procedure DoIt(s: string);',
+  'begin',
+  'end;',
+  'var i: MaxInt;',
+  'begin',
+  '  DoIt(i.toStr);',
+  '  DoIt(i.toStr());',
+  '  (i*i).toStr;',
+  '  DoIt((i*i).toStr);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestTypeHelper_NativeInt',
+    LinesToStr([ // statements
+    'rtl.createHelper($mod, "THelperI", null, function () {',
+    '  this.ToStr = function () {',
+    '    var Result = "";',
+    '    Result = "" + this.get();',
+    '    return Result;',
+    '  };',
+    '});',
+    'rtl.createHelper($mod, "THelperU", null, function () {',
+    '  this.ToStr = function () {',
+    '    var Result = "";',
+    '    Result = "" + this.get();',
+    '    return Result;',
+    '  };',
+    '});',
+    'this.DoIt = function (s) {',
+    '};',
+    'this.i = 0;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.DoIt($mod.THelperI.ToStr.call({',
+    '  p: $mod,',
+    '  get: function () {',
+    '      return this.p.i;',
+    '    },',
+    '  set: function (v) {',
+    '      this.p.i = v;',
+    '    }',
+    '}));',
+    '$mod.DoIt($mod.THelperI.ToStr.call({',
+    '  p: $mod,',
+    '  get: function () {',
+    '      return this.p.i;',
+    '    },',
+    '  set: function (v) {',
+    '      this.p.i = v;',
+    '    }',
+    '}));',
+    '$mod.THelperI.ToStr.call({',
+    '  a: $mod.i * $mod.i,',
+    '  get: function () {',
+    '      return this.a;',
+    '    },',
+    '  set: function (v) {',
+    '      rtl.raiseE("EPropReadOnly");',
+    '    }',
+    '});',
+    '$mod.DoIt($mod.THelperI.ToStr.call({',
+    '  a: $mod.i * $mod.i,',
+    '  get: function () {',
+    '      return this.a;',
+    '    },',
+    '  set: function (v) {',
+    '      rtl.raiseE("EPropReadOnly");',
+    '    }',
+    '}));',
+    '']));
+end;
+
 procedure TTestModule.TestTypeHelper_StringChar;
 begin
   StartProgram(false);