mirror of
https://gitlab.com/freepascal.org/fpc/pas2js.git
synced 2025-09-14 13:29:28 +02:00
pastojs: external static method
This commit is contained in:
mattias
parent
5ddb38a5bd
commit
30949ac5eb
@ -20756,6 +20756,20 @@ var
|
||||
aPath:=Prefix+aPath;
|
||||
end;
|
||||
|
||||
function PrependClassName(var Path: string; ClassOrRec: TPasMembersType): boolean;
|
||||
begin
|
||||
if (ClassOrRec.ClassType=TPasClassType) and TPasClassType(ClassOrRec).IsExternal then
|
||||
begin
|
||||
Prepend(Path,TPasClassType(ClassOrRec).ExternalName);
|
||||
Result:=true;
|
||||
end
|
||||
else
|
||||
begin
|
||||
Prepend(Path,ClassOrRec.Name);
|
||||
Result:=false;
|
||||
end;
|
||||
end;
|
||||
|
||||
function NeedsWithExpr: boolean;
|
||||
var
|
||||
Parent: TPasElement;
|
||||
@ -20966,11 +20980,17 @@ begin
|
||||
begin
|
||||
// redirect to helper-for-type
|
||||
ParentEl:=aResolver.ResolveAliasType(TPasClassType(ParentEl).HelperForType);
|
||||
IsClassRec:=(ParentEl.ClassType=TPasClassType)
|
||||
or (ParentEl.ClassType=TPasRecordType);
|
||||
if not IsClassRec then
|
||||
RaiseNotSupported(El,AContext,20190926091356);
|
||||
ShortName:=AContext.GetLocalName(ParentEl);
|
||||
end;
|
||||
|
||||
if Full then
|
||||
Prepend(Result,ParentEl.Name)
|
||||
begin
|
||||
if PrependClassName(Result,TPasMembersType(ParentEl)) then break;
|
||||
end
|
||||
else
|
||||
begin
|
||||
// Not in a Pascal dotscope and accessing a class member.
|
||||
@ -20980,14 +21000,18 @@ begin
|
||||
if ShortName<>'' then
|
||||
Prepend(Result,ShortName)
|
||||
else if El is TPasType then
|
||||
Prepend(Result,ParentEl.Name)
|
||||
begin
|
||||
if PrependClassName(Result,TPasMembersType(ParentEl)) then break;
|
||||
end
|
||||
else if El.Parent<>ParentEl then
|
||||
Prepend(Result,ParentEl.Name)
|
||||
begin
|
||||
if PrependClassName(Result,TPasMembersType(ParentEl)) then break;
|
||||
end
|
||||
else if (ParentEl.ClassType=TPasClassType)
|
||||
and (TPasClassType(ParentEl).HelperForType<>nil) then
|
||||
begin
|
||||
// helpers have no self
|
||||
Prepend(Result,ParentEl.Name);
|
||||
if PrependClassName(Result,TPasMembersType(ParentEl)) then break;
|
||||
end
|
||||
else if (SelfContext<>nil)
|
||||
and IsA(TPasType(SelfContext.ThisPas),TPasType(ParentEl)) then
|
||||
@ -20997,16 +21021,17 @@ begin
|
||||
end
|
||||
else
|
||||
begin
|
||||
if PrependClassName(Result,TPasMembersType(ParentEl)) then break;
|
||||
// missing JS var for Self
|
||||
{$IFDEF VerbosePas2JS}
|
||||
{AllowWriteln}
|
||||
writeln('TPasToJSConverter.CreateReferencePath missing JS var for Self: El=',GetElementDbgPath(El),':',El.ClassName,' CurParentEl=',GetElementDbgPath(ParentEl),':',ParentEl.ClassName,' AContext:');
|
||||
AContext.WriteStack;
|
||||
if Ref<>nil then
|
||||
writeln('TPasToJSConverter.CreateReferencePath Ref=',GetObjName(Ref.Element),' at ',aResolver.GetElementSourcePosStr(Ref.Element));
|
||||
{AllowWriteln-}
|
||||
{$ENDIF}
|
||||
RaiseNotSupported(El,AContext,20180125004049);
|
||||
//{$IFDEF VerbosePas2JS}
|
||||
//{AllowWriteln}
|
||||
//writeln('TPasToJSConverter.CreateReferencePath missing JS var for Self: El=',GetElementDbgPath(El),':',El.ClassName,' CurParentEl=',GetElementDbgPath(ParentEl),':',ParentEl.ClassName,' AContext:');
|
||||
//AContext.WriteStack;
|
||||
//if Ref<>nil then
|
||||
// writeln('TPasToJSConverter.CreateReferencePath Ref=',GetObjName(Ref.Element),' at ',aResolver.GetElementSourcePosStr(Ref.Element));
|
||||
//{AllowWriteln-}
|
||||
//{$ENDIF}
|
||||
//RaiseNotSupported(El,AContext,20180125004049);
|
||||
end;
|
||||
if (El.Parent=ParentEl) and (SelfContext<>nil)
|
||||
and not IsClassFunction(SelfContext.PasElement) then
|
||||
|
||||
@ -563,6 +563,7 @@ type
|
||||
Procedure TestExternalClass_DuplicateVarFail;
|
||||
Procedure TestExternalClass_Method;
|
||||
Procedure TestExternalClass_ClassMethod;
|
||||
Procedure TestExternalClass_ClassMethodStatic;
|
||||
Procedure TestExternalClass_FunctionResultInTypeCast;
|
||||
Procedure TestExternalClass_NonExternalOverride;
|
||||
Procedure TestExternalClass_OverloadHint;
|
||||
@ -15381,14 +15382,17 @@ begin
|
||||
' class procedure DoIt(Id: longint = 1); external name ''$Execute'';',
|
||||
' end;',
|
||||
' TExtB = TExtA;',
|
||||
'var p: Pointer;',
|
||||
'begin',
|
||||
' texta.doit;',
|
||||
' texta.doit();',
|
||||
' texta.doit(2);',
|
||||
' p:=@TExtA.DoIt;',
|
||||
' with texta do begin',
|
||||
' doit;',
|
||||
' doit();',
|
||||
' doit(3);',
|
||||
' p:=@DoIt;',
|
||||
' end;',
|
||||
' textb.doit;',
|
||||
' textb.doit();',
|
||||
@ -15402,14 +15406,17 @@ begin
|
||||
ConvertProgram;
|
||||
CheckSource('TestExternalClass_ClassMethod',
|
||||
LinesToStr([ // statements
|
||||
'this.p = null;',
|
||||
'']),
|
||||
LinesToStr([ // $mod.$main
|
||||
'ExtObj.$Execute(1);',
|
||||
'ExtObj.$Execute(1);',
|
||||
'ExtObj.$Execute(2);',
|
||||
'$mod.p = rtl.createCallback(ExtObj, "$Execute");',
|
||||
'ExtObj.$Execute(1);',
|
||||
'ExtObj.$Execute(1);',
|
||||
'ExtObj.$Execute(3);',
|
||||
'$mod.p = rtl.createCallback(ExtObj, "$Execute");',
|
||||
'ExtObj.$Execute(1);',
|
||||
'ExtObj.$Execute(1);',
|
||||
'ExtObj.$Execute(4);',
|
||||
@ -15419,6 +15426,45 @@ begin
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestExternalClass_ClassMethodStatic;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'{$modeswitch externalclass}',
|
||||
'type',
|
||||
' TExtA = class external name ''ExtObj''',
|
||||
' class procedure DoIt(Id: longint = 1); static;',
|
||||
' end;',
|
||||
'var p: Pointer;',
|
||||
'begin',
|
||||
' texta.doit;',
|
||||
' texta.doit();',
|
||||
' texta.doit(2);',
|
||||
' p:=@TExtA.DoIt;',
|
||||
' with texta do begin',
|
||||
' doit;',
|
||||
' doit();',
|
||||
' doit(3);',
|
||||
' p:=@DoIt;',
|
||||
' end;',
|
||||
'']);
|
||||
ConvertProgram;
|
||||
CheckSource('TestExternalClass_ClassMethodStatic',
|
||||
LinesToStr([ // statements
|
||||
'this.p = null;',
|
||||
'']),
|
||||
LinesToStr([ // $mod.$main
|
||||
'ExtObj.DoIt(1);',
|
||||
'ExtObj.DoIt(1);',
|
||||
'ExtObj.DoIt(2);',
|
||||
'$mod.p = ExtObj.DoIt;',
|
||||
'ExtObj.DoIt(1);',
|
||||
'ExtObj.DoIt(1);',
|
||||
'ExtObj.DoIt(3);',
|
||||
'$mod.p = ExtObj.DoIt;',
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestExternalClass_FunctionResultInTypeCast;
|
||||
begin
|
||||
StartProgram(false);
|
||||
@ -15467,32 +15513,33 @@ end;
|
||||
procedure TTestModule.TestExternalClass_NonExternalOverride;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('{$modeswitch externalclass}');
|
||||
Add('type');
|
||||
Add(' TExtA = class external name ''ExtObjA''');
|
||||
Add(' procedure ProcA; virtual;');
|
||||
Add(' procedure ProcB; virtual;');
|
||||
Add(' end;');
|
||||
Add(' TExtB = class external name ''ExtObjB'' (TExtA)');
|
||||
Add(' end;');
|
||||
Add(' TExtC = class (TExtB)');
|
||||
Add(' procedure ProcA; override;');
|
||||
Add(' end;');
|
||||
Add('procedure TExtC.ProcA;');
|
||||
Add('begin');
|
||||
Add(' ProcA;');
|
||||
Add(' Self.ProcA;');
|
||||
Add(' ProcB;');
|
||||
Add(' Self.ProcB;');
|
||||
Add('end;');
|
||||
Add('var');
|
||||
Add(' A: texta;');
|
||||
Add(' B: textb;');
|
||||
Add(' C: textc;');
|
||||
Add('begin');
|
||||
Add(' a.proca;');
|
||||
Add(' b.proca;');
|
||||
Add(' c.proca;');
|
||||
Add([
|
||||
'{$modeswitch externalclass}',
|
||||
'type',
|
||||
' TExtA = class external name ''ExtObjA''',
|
||||
' procedure ProcA; virtual;',
|
||||
' procedure ProcB; virtual;',
|
||||
' end;',
|
||||
' TExtB = class external name ''ExtObjB'' (TExtA)',
|
||||
' end;',
|
||||
' TExtC = class (TExtB)',
|
||||
' procedure ProcA; override;',
|
||||
' end;',
|
||||
'procedure TExtC.ProcA;',
|
||||
'begin',
|
||||
' ProcA;',
|
||||
' Self.ProcA;',
|
||||
' ProcB;',
|
||||
' Self.ProcB;',
|
||||
'end;',
|
||||
'var',
|
||||
' A: texta;',
|
||||
' B: textb;',
|
||||
' C: textc;',
|
||||
'begin',
|
||||
' a.proca;',
|
||||
' b.proca;',
|
||||
' c.proca;']);
|
||||
ConvertProgram;
|
||||
CheckSource('TestExternalClass_NonExternalOverride',
|
||||
LinesToStr([ // statements
|
||||
|
||||
Loading…
Reference in New Issue
Block a user