pastojs: fixed taliasofexternalclass.classmethod

git-svn-id: trunk@37844 -

packages/pastojs/src/fppas2js.pp

@@ -276,11 +276,9 @@ ToDos:
   - type alias type
   - documentation
 - move local types to unit scope
-- var absolute
-- check memleaks
 - make records more lightweight
 - pointer of record
-- nested types in class
+- nested classes
 - asm: pas() - useful for overloads and protect an identifier from optimization
 - ifthen
 - stdcall of methods: pass original 'this' as first parameter
@@ -296,7 +294,7 @@ Not in Version 1.0:
 - enums with custom values
 - library
 - constref
-- option typecast checking
+- option typecast checking -Ct
 - option verify method calls -CR
 - option range checking -Cr
 - option overflow checking -Co
@@ -12285,9 +12283,11 @@ var
 begin
   Result:='';
   {$IFDEF VerbosePas2JS}
-  //writeln('TPasToJSConverter.CreateReferencePath START El=',GetObjName(El),' Parent=',GetObjName(El.Parent),' Context=',GetObjName(AContext),' SelfContext=',GetObjName(AContext.GetSelfContext));
+  writeln('TPasToJSConverter.CreateReferencePath START El=',GetObjName(El),' Parent=',GetObjName(El.Parent),' Context=',GetObjName(AContext),' SelfContext=',GetObjName(AContext.GetSelfContext));
-  //AContext.WriteStack;
+  AContext.WriteStack;
   {$ENDIF}
+  if (El is TPasType) and (AContext<>nil) then
+    El:=AContext.Resolver.ResolveAliasType(TPasType(El));
 
   ElClass:=El.ClassType;
   if ElClass.InheritsFrom(TPasVariable) and (TPasVariable(El).AbsoluteExpr<>nil)

packages/pastojs/tests/tcmodules.pas

@@ -390,9 +390,9 @@ type
     Procedure TestClass_Const;
     Procedure TestClass_LocalVarSelfFail;
     Procedure TestClass_ArgSelfFail;
-    Procedure TestClass_NestedSelf;
+    Procedure TestClass_NestedProcSelf;
-    Procedure TestClass_NestedClassSelf;
+    Procedure TestClass_NestedProcClassSelf;
-    Procedure TestClass_NestedCallInherited;
+    Procedure TestClass_NestedProcCallInherited;
     Procedure TestClass_TObjectFree;
     Procedure TestClass_TObjectFreeNewInstance;
     Procedure TestClass_TObjectFreeLowerCase;
@@ -423,6 +423,7 @@ type
     Procedure TestExternalClass_Dollar;
     Procedure TestExternalClass_DuplicateVarFail;
     Procedure TestExternalClass_Method;
+    Procedure TestExternalClass_ClassMethod;
     Procedure TestExternalClass_NonExternalOverride;
     Procedure TestExternalClass_Property;
     Procedure TestExternalClass_ClassProperty;
@@ -9180,7 +9181,7 @@ begin
   ConvertProgram;
 end;
 
-procedure TTestModule.TestClass_NestedSelf;
+procedure TTestModule.TestClass_NestedProcSelf;
 begin
   StartProgram(false);
   Add([
@@ -9217,7 +9218,7 @@ begin
   'begin',
   '']);
   ConvertProgram;
-  CheckSource('TestClass_NestedSelf',
+  CheckSource('TestClass_NestedProcSelf',
     LinesToStr([ // statements
     'rtl.createClass($mod, "TObject", null, function () {',
     '  this.State = 0;',
@@ -9252,7 +9253,7 @@ begin
     '']));
 end;
 
-procedure TTestModule.TestClass_NestedClassSelf;
+procedure TTestModule.TestClass_NestedProcClassSelf;
 begin
   StartProgram(false);
   Add([
@@ -9286,7 +9287,7 @@ begin
   'begin',
   '']);
   ConvertProgram;
-  CheckSource('TestClass_NestedClassSelf',
+  CheckSource('TestClass_NestedProcClassSelf',
     LinesToStr([ // statements
     'rtl.createClass($mod, "TObject", null, function () {',
     '  this.State = 0;',
@@ -9318,7 +9319,7 @@ begin
     '']));
 end;
 
-procedure TTestModule.TestClass_NestedCallInherited;
+procedure TTestModule.TestClass_NestedProcCallInherited;
 begin
   StartProgram(false);
   Add([
@@ -9347,7 +9348,7 @@ begin
   'begin',
   '']);
   ConvertProgram;
-  CheckSource('TestClass_NestedCallInherited',
+  CheckSource('TestClass_NestedProcCallInherited',
     LinesToStr([ // statements
     'rtl.createClass($mod, "TObject", null, function () {',
     '  this.$init = function () {',
@@ -10303,6 +10304,54 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestExternalClass_ClassMethod;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch externalclass}',
+  'type',
+  '  TExtA = class external name ''ExtObj''',
+  '    class procedure DoIt(Id: longint = 1); external name ''$Execute'';',
+  '  end;',
+  '  TExtB = TExtA;',
+  'begin',
+  '  texta.doit;',
+  '  texta.doit();',
+  '  texta.doit(2);',
+  '  with texta do begin',
+  '    doit;',
+  '    doit();',
+  '    doit(3);',
+  '  end;',
+  '  textb.doit;',
+  '  textb.doit();',
+  '  textb.doit(4);',
+  '  with textb do begin',
+  '    doit;',
+  '    doit();',
+  '    doit(5);',
+  '  end;',
+  '']);
+  ConvertProgram;
+  CheckSource('TestExternalClass_ClassMethod',
+    LinesToStr([ // statements
+    '']),
+    LinesToStr([ // $mod.$main
+    'ExtObj.$Execute(1);',
+    'ExtObj.$Execute(1);',
+    'ExtObj.$Execute(2);',
+    'ExtObj.$Execute(1);',
+    'ExtObj.$Execute(1);',
+    'ExtObj.$Execute(3);',
+    'ExtObj.$Execute(1);',
+    'ExtObj.$Execute(1);',
+    'ExtObj.$Execute(4);',
+    'ExtObj.$Execute(1);',
+    'ExtObj.$Execute(1);',
+    'ExtObj.$Execute(5);',
+    '']));
+end;
+
 procedure TTestModule.TestExternalClass_NonExternalOverride;
 begin
   StartProgram(false);