paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-07 20:50:42 +02:00
Code Issues Packages Projects Releases Wiki Activity

pastojs: typeinfo(intrange type)

Browse Source 
git-svn-id: trunk@39167 -
This commit is contained in:
Mattias Gaertner 2018-06-04 13:41:40 +00:00
parent 002b116322
commit 6d7d4be12f
2 changed files with 47 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
packages/pastojs/src/fppas2js.pp
View File

@ -3756,7 +3756,7 @@ begin
TIName:=Pas2JSBuiltInNames[pbitnTIDynArray]; TIName:=Pas2JSBuiltInNames[pbitnTIDynArray];
end end
else if C=TPasPointerType then else if C=TPasPointerType then
TIName:=Pas2JSBuiltInNames[pbitnTIPointer] TIName:=Pas2JSBuiltInNames[pbitnTIPointer];
end end
else if ParamResolved.BaseType=btSet then else if ParamResolved.BaseType=btSet then
begin begin
@ -3768,6 +3768,8 @@ begin
ConvertRangeToElement(ParamResolved); ConvertRangeToElement(ParamResolved);
if ParamResolved.BaseType in btAllJSInteger then if ParamResolved.BaseType in btAllJSInteger then
TIName:=Pas2JSBuiltInNames[pbitnTIInteger] TIName:=Pas2JSBuiltInNames[pbitnTIInteger]
else if ParamResolved.BaseType in [btChar,btBoolean] then
TIName:=Pas2JSBuiltInNames[pbitnTI]
else if ParamResolved.BaseType=btContext then else if ParamResolved.BaseType=btContext then
begin begin
TypeEl:=ParamResolved.LoTypeEl; TypeEl:=ParamResolved.LoTypeEl;
@ -3775,6 +3777,13 @@ begin
if C=TPasEnumType then if C=TPasEnumType then
TIName:=Pas2JSBuiltInNames[pbitnTIEnum]; TIName:=Pas2JSBuiltInNames[pbitnTIEnum];
end; end;
end
else if C=TPasRangeType then
begin
if ParamResolved.BaseType in btAllJSInteger then
TIName:=Pas2JSBuiltInNames[pbitnTIInteger]
else if ParamResolved.BaseType in [btChar,btBoolean] then
TIName:=Pas2JSBuiltInNames[pbitnTI]
end; end;
//writeln('TPas2JSResolver.BI_TypeInfo_OnGetCallResult TIName=',TIName); //writeln('TPas2JSResolver.BI_TypeInfo_OnGetCallResult TIName=',TIName);
if TIName='' then if TIName='' then

37
packages/pastojs/tests/tcmodules.pas
View File

@ -634,6 +634,7 @@ type
Procedure TestJSValue_ForIn; Procedure TestJSValue_ForIn;
// RTTI // RTTI
Procedure TestRTTI_IntRange;
Procedure TestRTTI_ProcType; Procedure TestRTTI_ProcType;
Procedure TestRTTI_ProcType_ArgFromOtherUnit; Procedure TestRTTI_ProcType_ArgFromOtherUnit;
Procedure TestRTTI_EnumAndSetType; Procedure TestRTTI_EnumAndSetType;
@ -18750,6 +18751,42 @@ begin
''])); '']));
end; end;
procedure TTestModule.TestRTTI_IntRange;
begin
Converter.Options:=Converter.Options-[coNoTypeInfo];
StartProgram(false);
Add([
'{$modeswitch externalclass}',
'type',
' TTypeInfo = class external name ''rtl.tTypeInfo''',
' end;',
' TTypeInfoInteger = class external name ''rtl.tTypeInfoInteger''(TTypeInfo)',
' end;',
' TGraphicsColor = -$7FFFFFFF-1..$7FFFFFFF;',
' TColor = type TGraphicsColor;',
'var',
' p: TTypeInfo;',
'begin',
' p:=typeinfo(TGraphicsColor);',
' p:=typeinfo(TColor);',
'']);
ConvertProgram;
CheckSource('TestRTTI_IntRange',
LinesToStr([ // statements
'$mod.$rtti.$Int("TGraphicsColor", {',
' minvalue: -2147483648,',
' maxvalue: 2147483647,',
' ordtype: 4',
'});',
'$mod.$rtti.$inherited("TColor", $mod.$rtti["TGraphicsColor"], {});',
'this.p = null;',
'']),
LinesToStr([ // $mod.$main
'$mod.p = $mod.$rtti["TGraphicsColor"];',
'$mod.p = $mod.$rtti["TColor"];',
'']));
end;
procedure TTestModule.TestRTTI_ProcType; procedure TTestModule.TestRTTI_ProcType;
begin begin
Converter.Options:=Converter.Options-[coNoTypeInfo]; Converter.Options:=Converter.Options-[coNoTypeInfo];