mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-02 12:10:22 +02:00
pastojs: typeinfo(intrange type)
git-svn-id: trunk@39167 -
This commit is contained in:
parent
002b116322
commit
6d7d4be12f
@ -3756,7 +3756,7 @@ begin
|
||||
TIName:=Pas2JSBuiltInNames[pbitnTIDynArray];
|
||||
end
|
||||
else if C=TPasPointerType then
|
||||
TIName:=Pas2JSBuiltInNames[pbitnTIPointer]
|
||||
TIName:=Pas2JSBuiltInNames[pbitnTIPointer];
|
||||
end
|
||||
else if ParamResolved.BaseType=btSet then
|
||||
begin
|
||||
@ -3768,6 +3768,8 @@ begin
|
||||
ConvertRangeToElement(ParamResolved);
|
||||
if ParamResolved.BaseType in btAllJSInteger then
|
||||
TIName:=Pas2JSBuiltInNames[pbitnTIInteger]
|
||||
else if ParamResolved.BaseType in [btChar,btBoolean] then
|
||||
TIName:=Pas2JSBuiltInNames[pbitnTI]
|
||||
else if ParamResolved.BaseType=btContext then
|
||||
begin
|
||||
TypeEl:=ParamResolved.LoTypeEl;
|
||||
@ -3775,6 +3777,13 @@ begin
|
||||
if C=TPasEnumType then
|
||||
TIName:=Pas2JSBuiltInNames[pbitnTIEnum];
|
||||
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;
|
||||
//writeln('TPas2JSResolver.BI_TypeInfo_OnGetCallResult TIName=',TIName);
|
||||
if TIName='' then
|
||||
|
@ -634,6 +634,7 @@ type
|
||||
Procedure TestJSValue_ForIn;
|
||||
|
||||
// RTTI
|
||||
Procedure TestRTTI_IntRange;
|
||||
Procedure TestRTTI_ProcType;
|
||||
Procedure TestRTTI_ProcType_ArgFromOtherUnit;
|
||||
Procedure TestRTTI_EnumAndSetType;
|
||||
@ -18750,6 +18751,42 @@ begin
|
||||
'']));
|
||||
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;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
|
Loading…
Reference in New Issue
Block a user