paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-30 19:40:21 +02:00
Code Issues Packages Projects Releases Wiki Activity

pastojs: added modeswitch ignoreinterfaces, typecast enum to integer

Browse Source 
git-svn-id: trunk@37336 -
This commit is contained in:
Mattias Gaertner 2017-09-27 20:04:33 +00:00
parent b69ffccb44
commit 503b95bfa7
2 changed files with 77 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -798,7 +798,8 @@ const
msAllPas2jsModeSwitches = msAllPas2jsModeSwitchesReadOnly+[
msDelphi,msObjfpc,
msHintDirective,msNestedComment,
msExternalClass];
msExternalClass,
msIgnoreInterfaces];
btAllJSBaseTypes = [
btChar,
@ -1789,6 +1790,8 @@ begin
begin
ClassEl:=TPasClassType(El);
if ClassEl.IsForward then continue;
if ClassEl.ObjKind=okInterface then
exit;
ClassScope:=El.CustomData as TPas2JSClassScope;
OldScopeCount:=FOverloadScopes.Count;
@ -6048,6 +6051,15 @@ begin
Result:=CondExpr;
exit;
end
else if ParamResolved.BaseType=btContext then
begin
if ParamResolved.TypeEl.ClassType=TPasEnumType then
begin
// e.g. longint(TEnum) -> value
Result:=ConvertElement(Param,AContext);
exit;
end;
end
else if IsParamPas2JSBaseType then
begin
if JSBaseType=pbtJSValue then
@ -7950,6 +7962,10 @@ var
AssignSt: TJSSimpleAssignStatement;
begin
Result:=nil;
if El.ObjKind=okInterface then
exit;
if El.ObjKind<>okClass then
RaiseNotSupported(El,AContext,20170927183645);
if El.IsForward then
begin
Result:=ConvertClassForwardType(El,AContext);

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

@ -437,6 +437,9 @@ type
Procedure TestExternalClass_BracketAccessor_MultiType;
Procedure TestExternalClass_BracketAccessor_Index;
// class interfaces
Procedure TestClassInterface_Ignore;
// proc types
Procedure TestProcType;
Procedure TestProcType_FunctionFPC;
@ -3031,8 +3034,10 @@ begin
Add(' s:=str(e);');
Add(' str(e,s);');
Add(' s:=str(e:3);');
Add(' e:=TMyEnum(i);');
Add(' i:=longint(e);');
ConvertProgram;
CheckSource('TestEnumNumber',
CheckSource('TestEnum_Functions',
LinesToStr([ // statements
'this.TMyEnum = {',
' "0":"Red",',
@ -3061,6 +3066,8 @@ begin
'$mod.s = $mod.TMyEnum[$mod.e];',
'$mod.s = $mod.TMyEnum[$mod.e];',
'$mod.s = rtl.spaceLeft($mod.TMyEnum[$mod.e], 3);',
'$mod.e=$mod.i;',
'$mod.i=$mod.e;',
'']));
end;
@ -10542,6 +10549,58 @@ begin
'']));
end;
procedure TTestModule.TestClassInterface_Ignore;
begin
StartProgram(false);
Add([
'{$modeswitch ignoreinterfaces}',
'type',
' TGUID = record end;',
' IUnknown = interface;',
' IUnknown = interface',
' [''{00000000-0000-0000-C000-000000000046}'']',
' function QueryInterface(const iid : tguid;out obj) : longint;',
' function _AddRef : longint; cdecl;',
' function _Release : longint; stdcall;',
' end;',
' IInterface = IUnknown;',
' TObject = class',
' ClassName: string;',
' end;',
' TInterfacedObject = class(TObject,IUnknown)',
' RefCount : longint;',
' end;',
'var i: TInterfacedObject;',
'begin',
' i.ClassName:=''a'';',
' i.RefCount:=3;',
'']);
ConvertProgram;
CheckSource('TestClassInterface_Ignore',
LinesToStr([ // statements
'this.TGUID = function (s) {',
'};',
'rtl.createClass($mod, "TObject", null, function () {',
' this.$init = function () {',
' this.ClassName = "";',
' };',
' this.$final = function () {',
' };',
'});',
'rtl.createClass($mod, "TInterfacedObject", $mod.TObject, function () {',
' this.$init = function () {',
' $mod.TObject.$init.call(this);',
' this.RefCount = 0;',
' };',
'});',
'this.i = null;',
'']),
LinesToStr([ // $mod.$main
'$mod.i.ClassName = "a";',
'$mod.i.RefCount = 3;',
'']));
end;
procedure TTestModule.TestProcType;
begin
StartProgram(false);