paweld/pas2js
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/pas2js.git synced 2025-04-06 02:27:48 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-passrc: fixed type helper nativeint/nativeuint

Browse Source
This commit is contained in:
mattias 2020-04-26 19:24:44 +00:00
parent dd3581a9ac
commit 31c1d6e401
2 changed files with 99 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
compiler/packages/fcl-passrc/src/pasresolver.pp
View File

@ -427,7 +427,8 @@ const
{$ifdef HasInt64},btQWordBool{$endif}];
btArrayRangeTypes = btAllChars+btAllBooleans+btAllInteger;
btAllRanges = btArrayRangeTypes+[btRange];
btAllStandardTypes = [
btAllIntrinsicTypes = btAllInteger+btAllStringAndChars+btAllFloats+btAllBooleans;
btAllFPCTypes = [
btChar,
{$ifdef FPC_HAS_CPSTRING}
btAnsiChar,
@ -1805,7 +1806,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;
@ -9082,7 +9083,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
@ -17243,7 +17244,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
compiler/packages/pastojs/tests/tcmodules.pas
View File

@ -690,6 +690,7 @@ type
Procedure TestTypeHelper_Constructor;
Procedure TestTypeHelper_Word;
Procedure TestTypeHelper_Double;
Procedure TestTypeHelper_NativeInt;
Procedure TestTypeHelper_StringChar;
Procedure TestTypeHelper_JSValue;
Procedure TestTypeHelper_Array;
@ -23462,6 +23463,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);