fcl-passrc: resolver: fixed find ancestor property

git-svn-id: trunk@41087 -

packages/fcl-passrc/src/pasresolver.pp

@@ -939,6 +939,8 @@ type
     destructor Destroy; override;
     function GetFirstNonHelperScope: TPasIdentifierScope;
     class function IsStoredInElement: boolean; override;
+    function FindAncestorIdentifier(const Identifier: String): TPasIdentifier;
+    function FindAncestorElement(const Identifier: String): TPasElement;
     function FindIdentifier(const Identifier: String): TPasIdentifier; override;
     procedure IterateElements(const aName: string; StartScope: TPasScope;
       const OnIterateElement: TIterateScopeElement; Data: Pointer;
@@ -2846,6 +2848,31 @@ begin
   Result:=false;
 end;
 
+function TPasGroupScope.FindAncestorIdentifier(const Identifier: String
+  ): TPasIdentifier;
+var
+  i: Integer;
+begin
+  for i:=1 to Count-1 do
+    begin
+    Result:=Scopes[i].FindIdentifier(Identifier);
+    if Result<>nil then exit;
+    end;
+  Result:=nil;
+end;
+
+function TPasGroupScope.FindAncestorElement(const Identifier: String
+  ): TPasElement;
+var
+  Item: TPasIdentifier;
+begin
+  Item:=FindAncestorIdentifier(Identifier);
+  if Item<>nil then
+    Result:=Item.Element
+  else
+    Result:=nil;
+end;
+
 function TPasGroupScope.FindIdentifier(const Identifier: String
   ): TPasIdentifier;
 var
@@ -6362,11 +6389,16 @@ var
   procedure GetPropType;
   var
     AncEl: TPasElement;
+    GroupScope: TPasGroupScope;
   begin
     if PropType<>nil then exit;
     AncEl:=nil;
     if (ClassScope<>nil) and (ClassScope.AncestorScope<>nil) then
-      AncEl:=ClassScope.AncestorScope.FindElement(PropEl.Name);
+      begin
+      CheckTopScope(TPasGroupScope);
+      GroupScope:=TPasGroupScope(TopScope);
+      AncEl:=GroupScope.FindAncestorElement(PropEl.Name);
+      end;
     if AncEl is TPasProperty then
       begin
       // override or redeclaration property

packages/fcl-passrc/tests/tcresolver.pas

@@ -11838,19 +11838,27 @@ end;
 procedure TTestResolver.TestPropertyTypeless;
 begin
   StartProgram(false);
-  Add('type');
+  Add([
-  Add('  {#TOBJ}TObject = class');
+  'type',
-  Add('    {#FB}FB: longint;');
+  '  {#TOBJ}TObject = class',
-  Add('    property {#TOBJ_B}B: longint write {@FB}FB;');
+  '    {#FB}FB: longint;',
-  Add('  end;');
+  '    property {#TOBJ_B}B: longint write {@FB}FB;',
-  Add('  {#TA}TClassA = class');
+  '    property {#TOBJ_D}D: longint write {@FB}FB;',
-  Add('    {#FC}FC: longint;');
+  '  end;',
-  Add('    property {#TA_B}{@TOBJ_B}B write {@FC}FC;');
+  '  {#TA}TClassA = class',
-  Add('  end;');
+  '    {#FC}FC: longint;',
-  Add('var');
+  '    property {#TA_B}{@TOBJ_B}B write {@FC}FC;',
-  Add('  {#v}{=TA}v: TClassA;');
+  '  end;',
-  Add('begin');
+  '  {#TB}TClassB = class(TClassA)',
-  Add('  {@v}v.{@TA_B}B:=3;');
+  '  published',
+  '    property {#TB_D}{@TOBJ_D}D;',
+  '  end;',
+  'var',
+  '  {#v}{=TA}v: TClassA;',
+  'begin',
+  '  {@v}v.{@TA_B}B:=3;',
+  '  {@v}v.{@TObj_D}D:=4;',
+  '']);
   ParseProgram;
 end;
 

packages/pastojs/src/fppas2js.pp

@@ -19821,8 +19821,9 @@ begin
         // create
         //    GetPathExpr: path1.path2
         //    GetExpr:     this.p.readvar
+        //    SetExpr:     this.p.readvar
         // Will create "{p:GetPathExpr, get:function(){return GetExpr;},
-        //                              set:function(v){GetExpr = v;}}"
+        //                              set:function(v){SetExpr = v;}}"
         GetPathExpr:=CreatePrimitiveDotExpr(LeftStr(GetPath,GetDotPos-1),El);
         GetExpr:=CreatePrimitiveDotExpr('this.'+GetPathName+'.'+copy(GetPath,GetDotPos+1),El);
         if ParamContext.Setter=nil then

packages/pastojs/tests/tcmodules.pas

@@ -625,6 +625,10 @@ type
     Procedure TestClassInterface_GUID;
     Procedure TestClassInterface_GUIDProperty;
 
+    // helpers
+    Procedure TestClassHelper_ClassVar; // ToDo
+    // todo: TestClassHelper_Overload
+
     // proc types
     Procedure TestProcType;
     Procedure TestProcType_Arg;
@@ -18345,6 +18349,61 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestClassHelper_ClassVar;
+begin
+  exit;
+
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '  end;',
+  '  THelper = class helper for TObject',
+  '  const',
+  '    One = 1;',
+  '    Two: word = 2;',
+  '  class var Glob: word;',
+  '  procedure Foo;',
+  '  class procedure Bar;',
+  '  end;',
+  'procedure THelper.foo;',
+  'begin',
+  '  Two:=One;',
+  '  Glob:=Glob;',
+  '  Self.Glob:=Self.Glob;',
+  '  with Self do Self.Glob:=Self.Glob;',
+  'end;',
+  'class procedure THelper.bar;',
+  'begin',
+  '  Two:=One;',
+  '  Glob:=Glob;',
+  '  Self.Glob:=Self.Glob;',
+  '  with Self do Self.Glob:=Self.Glob;',
+  'end;',
+  'var o: TObject;',
+  'begin',
+  '  tobject.two:=tobject.one;',
+  '  tobject.Glob:=tobject.Glob;',
+  '  with tobject do begin',
+  '    two:=one;',
+  '    Glob:=Glob;',
+  '  end;',
+  '  o.two:=o.one;',
+  '  o.Glob:=o.Glob;',
+  '  with o do begin',
+  '    two:=one;',
+  '    Glob:=Glob;',
+  '  end;',
+  '',
+  '']);
+  ConvertProgram;
+  CheckSource('TestClassHelper',
+    LinesToStr([ // statements
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
 procedure TTestModule.TestProcType;
 begin
   StartProgram(false);

utils/pas2js/dist/rtl.js

@@ -279,12 +279,16 @@ var rtl = {
       // if root is a "function" then c.$ancestor === c.__proto__, Object.getPrototypeOf(c) returns the root
     } else {
       c = {};
-      c.$create = function(fnname,args){
+      c.$create = function(fn,args){
         if (args == undefined) args = [];
         var o = Object.create(this);
         o.$init();
         try{
-          o[fnname].apply(o,args);
+          if (typeof(fn)==="string"){
+            o[fn].apply(o,args);
+          } else {
+            fn.apply(o,args);
+          };
           o.AfterConstruction();
         } catch($e){
           // do not call BeforeDestruction
@@ -308,17 +312,21 @@ var rtl = {
     // If newinstancefnname is given, use that function to create the new object.
     // If exist call BeforeDestruction and AfterConstruction.
     var c = Object.create(ancestor);
-    c.$create = function(fnname,args){
+    c.$create = function(fn,args){
       if (args == undefined) args = [];
       var o = null;
       if (newinstancefnname.length>0){
-        o = this[newinstancefnname](fnname,args);
+        o = this[newinstancefnname](fn,args);
       } else {
         o = Object.create(this);
       }
       if (o.$init) o.$init();
       try{
-        o[fnname].apply(o,args);
+        if (typeof(fn)==="string"){
+          o[fn].apply(o,args);
+        } else {
+          fn.apply(o,args);
+        };
         if (o.AfterConstruction) o.AfterConstruction();
       } catch($e){
         // do not call BeforeDestruction