fcl-passrc: resolver: type helper constructors

git-svn-id: trunk@41075 -

packages/fcl-passrc/src/pasresolver.pp

@@ -1122,6 +1122,11 @@ type
     procedure WriteIdentifiers(Prefix: string); override;
   end;
 
+  { TPasDotHelperScope }
+
+  TPasDotHelperScope = class(TPasDotBaseScope)
+  end;
+
   TResolvedReferenceFlag = (
     rrfDotScope, // found reference via a dot scope (TPasDotBaseScope)
     rrfImplicitCallWithoutParams, // a TPrimitiveExpr is an implicit call without params
@@ -1466,7 +1471,7 @@ type
     procedure ResolveArrayParamsArgs(Params: TParamsExpr;
       const ResolvedValue: TPasResolverResult; Access: TResolvedRefAccess); virtual;
     function ResolveBracketOperatorClassOrRec(Params: TParamsExpr;
-      const ResolvedValue: TPasResolverResult; ClassOrRecScope: TPasClassOrRecordScope;
+      const ResolvedValue: TPasResolverResult;
       Access: TResolvedRefAccess): boolean; virtual;
     procedure ResolveSetParamsExpr(Params: TParamsExpr); virtual;
     procedure ResolveArrayValues(El: TArrayValues); virtual;
@@ -1966,7 +1971,7 @@ type
     function GetPathStart(El: TPasExpr): TPasExpr;
     function GetNewInstanceExpr(El: TPasExpr): TPasExpr;
     function ParentNeedsExprResult(El: TPasExpr): boolean;
-    function GetReference_ConstructorType(Ref: TResolvedReference): TPasMembersType;
+    function GetReference_ConstructorType(Ref: TResolvedReference; Expr: TPasExpr): TPasResolverResult;
     function GetParamsValueRef(Params: TParamsExpr): TResolvedReference;
     function IsDynArray(TypeEl: TPasType; OptionalOpenArray: boolean = true): boolean;
     function IsOpenArray(TypeEl: TPasType): boolean;
@@ -8883,7 +8888,7 @@ begin
         end;
       end;
     // default: search for type helpers
-    DotScope:=PushHelperDotScope(LTypeEl);
+    DotScope:=PushHelperDotScope(LeftResolved.HiTypeEl);
     if DotScope<>nil then
       begin
       if LeftResolved.IdentEl is TPasType then
@@ -9376,9 +9381,9 @@ procedure TPasResolver.ResolveArrayParamsArgs(Params: TParamsExpr;
 
 var
   PropEl: TPasProperty;
-  ClassOrRecScope: TPasClassOrRecordScope;
   i: Integer;
   TypeEl: TPasType;
+  C: TClass;
 begin
   if ResolvedValue.BaseType in btAllStrings then
     begin
@@ -9402,13 +9407,15 @@ begin
   else if ResolvedValue.BaseType=btContext then
     begin
     TypeEl:=ResolvedValue.LoTypeEl;
-    if TypeEl is TPasMembersType then
+    C:=TypeEl.ClassType;
+    if (C=TPasClassType)
+        or (C=TPasRecordType)
+        or (C=TPasClassOfType) then
       begin
-      ClassOrRecScope:=NoNil(TypeEl.CustomData) as TPasClassOrRecordScope;
-      if ResolveBracketOperatorClassOrRec(Params,ResolvedValue,ClassOrRecScope,Access) then
+      if ResolveBracketOperatorClassOrRec(Params,ResolvedValue,Access) then
         exit;
       end
-    else if TypeEl.ClassType=TPasArrayType then
+    else if C=TPasArrayType then
       begin
       if ResolvedValue.IdentEl is TPasType then
         RaiseMsg(20170216152215,nIllegalQualifierAfter,sIllegalQualifierAfter,
@@ -9418,7 +9425,7 @@ begin
         AccessExpr(Params.Params[i],rraRead);
       exit;
       end
-    else if TypeEl.ClassType=TPasPointerType then
+    else if C=TPasPointerType then
       begin
       if CheckStringOrPointerIndex(false) then exit;
       end;
@@ -9428,28 +9435,46 @@ begin
 end;
 
 function TPasResolver.ResolveBracketOperatorClassOrRec(Params: TParamsExpr;
-  const ResolvedValue: TPasResolverResult;
-  ClassOrRecScope: TPasClassOrRecordScope; Access: TResolvedRefAccess): boolean;
+  const ResolvedValue: TPasResolverResult; Access: TResolvedRefAccess): boolean;
 var
   PropEl: TPasProperty;
   Value: TPasExpr;
+  Group: TPasGroupScope;
+  i: Integer;
+  Scope: TPasIdentifierScope;
+  TypeEl: TPasType;
+  IsClassOf: Boolean;
 begin
-  PropEl:=ClassOrRecScope.DefaultProperty;
-  if PropEl<>nil then
-    begin
-    // class has default property
-    if (ResolvedValue.IdentEl is TPasType) and (not PropEl.IsClass) then
-      RaiseMsg(20170216152213,nIllegalQualifierAfter,sIllegalQualifierAfter,
-        ['[',GetResolverResultDescription(ResolvedValue,true)],Params);
-    Value:=Params.Value;
-    if Value.CustomData is TResolvedReference then
-      SetResolvedRefAccess(Value,TResolvedReference(Value.CustomData),rraRead);
-    CreateReference(PropEl,Params,Access);
-    CheckCallPropertyCompatibility(PropEl,Params,true);
-    FinishPropertyParamAccess(Params,PropEl);
-    exit(true);
+  TypeEl:=ResolvedValue.LoTypeEl;
+  IsClassOf:=TypeEl.ClassType=TPasClassOfType;
+  if IsClassOf then
+    TypeEl:=ResolveAliasType(TPasClassOfType(TypeEl).DestType);
+
+  Group:=CreateGroupScope(TypeEl);
+  PropEl:=nil;
+  for i:=0 to Group.Count-1 do
+    begin
+    Scope:=Group.Scopes[i];
+    if Scope is TPasClassOrRecordScope then
+      begin
+      PropEl:=TPasClassOrRecordScope(Scope).DefaultProperty;
+      if PropEl<>nil then break;
+      end;
     end;
-  Result:=false;
+  Group.Free;
+  if PropEl=nil then exit(false);
+
+  // class/record/interface has default property
+  if (IsClassOf or (ResolvedValue.IdentEl is TPasType)) and (not PropEl.IsClass) then
+    RaiseMsg(20170216152213,nIllegalQualifierAfter,sIllegalQualifierAfter,
+      ['[',GetResolverResultDescription(ResolvedValue,true)],Params);
+  Value:=Params.Value;
+  if Value.CustomData is TResolvedReference then
+    SetResolvedRefAccess(Value,TResolvedReference(Value.CustomData),rraRead);
+  CreateReference(PropEl,Params,Access);
+  CheckCallPropertyCompatibility(PropEl,Params,true);
+  FinishPropertyParamAccess(Params,PropEl);
+  Result:=true;
 end;
 
 procedure TPasResolver.ResolveSetParamsExpr(Params: TParamsExpr);
@@ -11223,11 +11248,11 @@ procedure TPasResolver.ComputeArrayParams(Params: TParamsExpr; out
 
 var
   TypeEl: TPasType;
-  ClassScope: TPasClassScope;
   ArrayEl: TPasArrayType;
   ArgNo: Integer;
   OrigResolved: TPasResolverResult;
   ClassOrRecordScope: TPasClassOrRecordScope;
+  Ref: TResolvedReference;
 begin
   ComputeElement(Params.Value,ResolvedEl,
     Flags-[rcNoImplicitProc,rcNoImplicitProcType],StartEl);
@@ -11271,21 +11296,21 @@ begin
     begin
     TypeEl:=ResolvedEl.LoTypeEl;
     if (TypeEl.ClassType=TPasClassType)
-        or (TypeEl.ClassType=TPasRecordType) then
+        or (TypeEl.ClassType=TPasRecordType)
+        or (TypeEl.ClassType=TPasClassOfType) then
       begin
-      ClassOrRecordScope:=NoNil(TypeEl.CustomData) as TPasClassOrRecordScope;
-      if ClassOrRecordScope.DefaultProperty<>nil then
-        ComputeIndexProperty(ClassOrRecordScope.DefaultProperty)
-      else
+      if not (Params.CustomData is TResolvedReference) then
+        RaiseNotYetImplemented(20190125143203,Params,GetObjName(Params.CustomData));
+      Ref:=TResolvedReference(Params.CustomData);
+      if Ref.Declaration is TPasProperty then
+        ComputeIndexProperty(TPasProperty(Ref.Declaration))
+      else if TypeEl is TPasMembersType then
+        begin
+        ClassOrRecordScope:=NoNil(TypeEl.CustomData) as TPasClassOrRecordScope;
         ComputeArrayParams_Class(Params,ResolvedEl,ClassOrRecordScope,Flags,StartEl);
-      end
-    else if TypeEl.ClassType=TPasClassOfType then
-      begin
-      ClassScope:=ResolveAliasType(TPasClassOfType(TypeEl).DestType).CustomData as TPasClassScope;
-      if ClassScope.DefaultProperty<>nil then
-        ComputeIndexProperty(ClassScope.DefaultProperty)
+        end
       else
-        RaiseInternalError(20161010174916);
+        RaiseNotYetImplemented(20161010174916,Params);
       end
     else if TypeEl.ClassType=TPasArrayType then
       begin
@@ -11333,7 +11358,7 @@ procedure TPasResolver.ComputeArrayParams_Class(Params: TParamsExpr;
   var ResolvedEl: TPasResolverResult; ClassOrRecScope: TPasClassOrRecordScope;
   Flags: TPasResolverComputeFlags; StartEl: TPasElement);
 begin
-  RaiseInternalError(20161010174916);
+  RaiseNotYetImplemented(20190125142240,Params);
   if Params=nil then ;
   if ClassOrRecScope=nil then ;
   if Flags=[] then ;
@@ -11352,7 +11377,6 @@ var
   Ref: TResolvedReference;
   DeclType: TPasType;
   Param0: TPasExpr;
-  ClassOrRec: TPasMembersType;
 begin
   Ref:=GetParamsValueRef(Params);
   if Ref=nil then
@@ -11410,8 +11434,7 @@ begin
       else if (Proc.ClassType=TPasConstructor) then
         begin
         // constructor -> return value of type class
-        ClassOrRec:=GetReference_ConstructorType(Ref);
-        SetResolverValueExpr(ResolvedEl,btContext,ClassOrRec,ClassOrRec,Params.Value,[rrfReadable]);
+        ResolvedEl:=GetReference_ConstructorType(Ref,Params.Value);
         end
       else
         // procedure call, result is neither readable nor writable
@@ -15706,31 +15729,46 @@ begin
       if Ref.Context<>nil then
         RaiseInternalError(20170131141936);
       Ref.Context:=TResolvedRefCtxConstructor.Create;
+      TypeEl:=nil;
+      ClassRecScope:=nil;
       C:=StartScope.ClassType;
       if C.InheritsFrom(TPasDotClassOrRecordScope) then
         ClassRecScope:=TPasDotClassOrRecordScope(StartScope).ClassRecScope
-      else if C.InheritsFrom(TPasWithExprScope)  then
-        ClassRecScope:=TPasWithExprScope(StartScope).ClassRecScope
-      else if C.InheritsFrom(TPasProcedureScope) then
+      else if C=ScopeClass_WithExpr then
+        begin
+        ClassRecScope:=TPasWithExprScope(StartScope).ClassRecScope;
+        if ClassRecScope=nil then
+          TypeEl:=TPasWithExprScope(StartScope).Scope.Element as TPasType;
+        end
+      else if C=ScopeClass_Procedure then
         ClassRecScope:=TPasProcedureScope(StartScope).ClassRecScope
+      else if C=TPasDotHelperScope then
+        TypeEl:=NoNil(TPasDotHelperScope(StartScope).Element) as TPasType
       else
         RaiseInternalError(20170131150855,GetObjName(StartScope));
-      if ClassRecScope=nil then
-        RaiseInternalError(20190123120156,GetObjName(StartScope));
-      TypeEl:=ClassRecScope.Element as TPasType;
-      TResolvedRefCtxConstructor(Ref.Context).Typ:=TypeEl;
-      if OnlyTypeMembers and (ClassRecScope is TPasClassScope) then
-        begin
-        AbstractProcs:=TPasClassScope(ClassRecScope).AbstractProcs;
-        if (length(AbstractProcs)>0) then
+      if TypeEl<>nil then
+        TResolvedRefCtxConstructor(Ref.Context).Typ:=TypeEl
+      else
+        begin
+        if ClassRecScope=nil then
+          RaiseInternalError(20190123120156,GetObjName(StartScope));
+        TypeEl:=ClassRecScope.Element as TPasType;
+        if (TypeEl.ClassType=TPasClassType) and (TPasClassType(TypeEl).HelperForType<>nil) then
+          TypeEl:=ResolveAliasType(TPasClassType(TypeEl).HelperForType);
+        TResolvedRefCtxConstructor(Ref.Context).Typ:=TypeEl;
+        if OnlyTypeMembers and (ClassRecScope is TPasClassScope) then
           begin
-          if IsClassOf then
-            // aClass.Create: do not warn
-          else
-            for i:=0 to length(AbstractProcs)-1 do
-              LogMsg(20171227110746,mtWarning,nConstructingClassXWithAbstractMethodY,
-                sConstructingClassXWithAbstractMethodY,
-                [TypeEl.Name,AbstractProcs[i].Name],FindData.ErrorPosEl);
+          AbstractProcs:=TPasClassScope(ClassRecScope).AbstractProcs;
+          if (length(AbstractProcs)>0) then
+            begin
+            if IsClassOf then
+              // aClass.Create: do not warn
+            else
+              for i:=0 to length(AbstractProcs)-1 do
+                LogMsg(20171227110746,mtWarning,nConstructingClassXWithAbstractMethodY,
+                  sConstructingClassXWithAbstractMethodY,
+                  [TypeEl.Name,AbstractProcs[i].Name],FindData.ErrorPosEl);
+            end;
           end;
         end;
       end;
@@ -16482,6 +16520,7 @@ var
   AncestorScope, HelperScope: TPasClassScope;
   C: TClass;
 begin
+  TypeEl:=ResolveAliasType(TypeEl);
   IsClass:=TypeEl.ClassType=TPasClassType;
   if IsClass and (TPasClassType(TypeEl).HelperForType<>nil) then
     begin
@@ -16705,7 +16744,8 @@ begin
     Group.Free;
     exit(nil);
     end;
-  Result:=TPasDotBaseScope.Create;
+  Result:=TPasDotHelperScope.Create;
+  Result.Element:=TypeEl;
   Result.Owner:=Self;
   Result.GroupScope:=Group;
   PushScope(Result);
@@ -16897,15 +16937,14 @@ begin
   NewEntry.HelperForType:=HelperForType;
   NewEntry.Added:=length(List);
   // keep list sorted for 1. HelperForType and 2. Added
-  for i:=0 to length(List)-1 do
+  i:=0;
+  while i<length(List) do
     begin
     Entry:=List[i];
-    if ComparePRHelperEntries(NewEntry,Entry)<=0 then continue;
-    Insert(NewEntry,List,i);
-    exit;
+    if ComparePRHelperEntries(NewEntry,Entry)<=0 then break;
+    inc(i);
     end;
-  // append
-  Insert(NewEntry,List,length(List));
+  Insert(NewEntry,List,i);
 end;
 
 procedure TPasResolver.AddActiveHelper(Helper: TPasClassType);
@@ -17000,6 +17039,9 @@ end;
 
 procedure TPasResolver.RaiseInternalError(id: TMaxPrecInt; const Msg: string);
 begin
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.RaiseInternalError [',id,'] ',Msg);
+  {$ENDIF}
   raise Exception.Create('Internal error: ['+IntToStr(id)+'] '+Msg);
 end;
 
@@ -20884,7 +20926,6 @@ procedure TPasResolver.ComputeElement(El: TPasElement; out
     Ref: TResolvedReference;
     Proc: TPasProcedure;
     ProcType: TPasProcedureType;
-    ClassOrRec: TPasMembersType;
   begin
     Ref:=TResolvedReference(Expr.CustomData);
     ComputeElement(Ref.Declaration,ResolvedEl,Flags+[rcNoImplicitProc],StartEl);
@@ -20929,9 +20970,7 @@ procedure TPasResolver.ComputeElement(El: TPasElement; out
           else if (ResolvedEl.IdentEl.ClassType=TPasConstructor) then
             begin
             // constructor -> return value of type class
-            ClassOrRec:=GetReference_ConstructorType(Ref);
-            SetResolverValueExpr(ResolvedEl,btContext,ClassOrRec,ClassOrRec,
-                                 TPrimitiveExpr(Expr),[rrfReadable]);
+            ResolvedEl:=GetReference_ConstructorType(Ref,Expr);
             end
           else if ParentNeedsExprResult(Expr) then
             begin
@@ -20982,7 +21021,6 @@ procedure TPasResolver.ComputeElement(El: TPasElement; out
     Proc: TPasProcedure;
     TypeEl: TPasProcedureType;
     HasName: Boolean;
-    ClassOrRec: TPasMembersType;
   begin
     // "inherited;"
     Ref:=TResolvedReference(El.CustomData);
@@ -21007,8 +21045,7 @@ procedure TPasResolver.ComputeElement(El: TPasElement; out
         and (rrfNewInstance in Ref.Flags) then
       begin
       // new instance constructor -> return value of type class
-      ClassOrRec:=GetReference_ConstructorType(Ref);
-      SetResolverValueExpr(ResolvedEl,btContext,ClassOrRec,ClassOrRec,Expr,[rrfReadable]);
+      ResolvedEl:=GetReference_ConstructorType(Ref,Expr);
       end
     else if ParentNeedsExprResult(Expr) then
       begin
@@ -21687,10 +21724,25 @@ begin
     Result:=(TPasImplRaise(P).ExceptAddr=El);
 end;
 
-function TPasResolver.GetReference_ConstructorType(Ref: TResolvedReference
-  ): TPasMembersType;
+function TPasResolver.GetReference_ConstructorType(Ref: TResolvedReference;
+  Expr: TPasExpr): TPasResolverResult;
+var
+  TypeEl: TPasType;
 begin
-  Result:=(Ref.Context as TResolvedRefCtxConstructor).Typ as TPasMembersType;
+  TypeEl:=(Ref.Context as TResolvedRefCtxConstructor).Typ;
+  if TypeEl=nil then
+    RaiseNotYetImplemented(20190125205339,Expr)
+  else if TypeEl is TPasMembersType then
+    SetResolverValueExpr(Result,btContext,TypeEl,TypeEl,Expr,[rrfReadable])
+  else
+    begin
+    writeln('AAA1 TPasResolver.GetReference_ConstructorType ',GetObjName(TypeEl));
+    ComputeElement(TypeEl,Result,[rcType]);
+    writeln('AAA2 TPasResolver.GetReference_ConstructorType ',GetResolverResultDbg(Result));
+    Result.ExprEl:=Expr;
+    Result.Flags:=[rrfReadable];
+    writeln('AAA3 TPasResolver.GetReference_ConstructorType ',GetResolverResultDbg(Result));
+    end;
 end;
 
 function TPasResolver.GetParamsValueRef(Params: TParamsExpr): TResolvedReference;

packages/fcl-passrc/src/pscanner.pp

@@ -1119,7 +1119,7 @@ const
 
 const
   // all mode switches supported by FPC
-  msAllFPCModeSwitches = [low(TModeSwitch)..High(TModeSwitch)];
+  msAllModeSwitches = [low(TModeSwitch)..High(TModeSwitch)];
 
   DelphiModeSwitches = [msDelphi,msClass,msObjpas,msResult,msStringPchar,
      msPointer2Procedure,msAutoDeref,msTPProcVar,msInitFinal,msDefaultAnsistring,
@@ -1130,7 +1130,7 @@ const
 
   DelphiUnicodeModeSwitches = delphimodeswitches + [msSystemCodePage,msDefaultUnicodestring];
 
-  // mode switches of $mode FPC, don't confuse with msAllFPCModeSwitches
+  // mode switches of $mode FPC, don't confuse with msAllModeSwitches
   FPCModeSwitches = [msFpc,msStringPchar,msNestedComment,msRepeatForward,
     msCVarSupport,msInitFinal,msHintDirective,msProperty,msDefaultInline];
   //FPCBoolSwitches bsObjectChecks
@@ -2665,7 +2665,7 @@ begin
   FMaxIncludeStackDepth:=DefaultMaxIncludeStackDepth;
 
   FCurrentModeSwitches:=FPCModeSwitches;
-  FAllowedModeSwitches:=msAllFPCModeSwitches;
+  FAllowedModeSwitches:=msAllModeSwitches;
   FCurrentBoolSwitches:=bsFPCMode;
   FAllowedBoolSwitches:=bsAll;
   FAllowedValueSwitches:=vsAllValueSwitches;

packages/fcl-passrc/tests/tcresolver.pas

@@ -867,37 +867,39 @@ type
     Procedure TestHint_Garbage;
 
     // helpers
-    Procedure ClassHelper;
-    Procedure ClassHelper_AncestorIsNotHelperForDescendantFail;
-    Procedure ClassHelper_HelperForParentFail;
-    Procedure ClassHelper_ForInterfaceFail;
-    Procedure ClassHelper_FieldFail;
-    Procedure ClassHelper_AbstractFail;
-    Procedure ClassHelper_VirtualObjFPCFail;
-    Procedure ClassHelper_VirtualDelphiFail;
-    Procedure ClassHelper_DestructorFail;
-    Procedure ClassHelper_ClassRefersToTypeHelperOfAncestor;
-    Procedure ClassHelper_InheritedObjFPC;
-    Procedure ClassHelper_InheritedObjFPC2;
-    Procedure ClassHelper_InheritedObjFPCStrictPrivateFail;
-    Procedure ClassHelper_InheritedDelphi;
-    Procedure ClassHelper_NestedInheritedParentFail;
-    Procedure ClassHelper_AccessFields;
-    Procedure ClassHelper_CallClassMethodFail;
-    Procedure ClassHelper_AsTypeFail;
-    Procedure ClassHelper_Enumerator;
-    Procedure ClassHelper_FromUnitInterface;
-    // ToDo ClassHelper_Constructor
-    // ToDo ClassHelper_DefaultProperty
-    // ToDo ClassHelper_MultiScopeHelpers
-    Procedure RecordHelper;
-    // RecordHelper_Constructor
-    Procedure TypeHelper;
-    Procedure TypeHelper_HelperForProcTypeFail;
-    Procedure TypeHelper_DefaultPropertyFail;
-    Procedure TypeHelper_Enum;
-    Procedure TypeHelper_Enumerator;
-    // TypeHelper_Constructor
+    Procedure TestClassHelper;
+    Procedure TestClassHelper_AncestorIsNotHelperForDescendantFail;
+    Procedure TestClassHelper_HelperForParentFail;
+    Procedure TestClassHelper_ForInterfaceFail;
+    Procedure TestClassHelper_FieldFail;
+    Procedure TestClassHelper_AbstractFail;
+    Procedure TestClassHelper_VirtualObjFPCFail;
+    Procedure TestClassHelper_VirtualDelphiFail;
+    Procedure TestClassHelper_DestructorFail;
+    Procedure TestClassHelper_ClassRefersToTypeHelperOfAncestor;
+    Procedure TestClassHelper_InheritedObjFPC;
+    Procedure TestClassHelper_InheritedObjFPC2;
+    Procedure TestClassHelper_InheritedObjFPCStrictPrivateFail;
+    Procedure TestClassHelper_InheritedDelphi;
+    Procedure TestClassHelper_NestedInheritedParentFail;
+    Procedure TestClassHelper_AccessFields;
+    Procedure TestClassHelper_CallClassMethodFail;
+    Procedure TestClassHelper_AsTypeFail;
+    Procedure TestClassHelper_Enumerator;
+    Procedure TestClassHelper_FromUnitInterface;
+    Procedure TestClassHelper_Constructor_NewInstance;
+    Procedure TestClassHelper_DefaultProperty;
+    Procedure TestClassHelper_DefaultClassProperty;
+    Procedure TestClassHelper_MultipleScopeHelpers;
+    Procedure TestRecordHelper;
+    Procedure TestRecordHelper_Constructor_NewInstance;
+    Procedure TestTypeHelper;
+    Procedure TestTypeHelper_HelperForProcTypeFail;
+    Procedure TestTypeHelper_DefaultPropertyFail;
+    Procedure TestTypeHelper_Enum;
+    Procedure TestTypeHelper_Enumerator;
+    Procedure TestTypeHelper_Constructor_NewInstance;
+    // Todo: warn hides method
 
     // attributes
     Procedure TestAttributes_Ignore;
@@ -8080,8 +8082,16 @@ begin
   'begin',
   '  TRec.{#p}Create(4); // new object',
   '  r:=TRec.{#q}Create(5); // new object',
-  '  r.{#r}Create(6); // normal call',
-  '  r:=r.{#s}Create(7); // normal call',
+  '  with TRec do begin',
+  '    {#r}Create(6); // new object',
+  '    r:={#s}Create(7); // new object',
+  '  end;',
+  '  r.{#t}Create(8); // normal call',
+  '  r:=r.{#u}Create(9); // normal call',
+  '  with r do begin',
+  '    {#v}Create(10); // normal call',
+  '    r:={#w}Create(11); // normal call',
+  '  end;',
   '']);
   ParseProgram;
   aMarker:=FirstSrcMarker;
@@ -8106,7 +8116,7 @@ begin
         break;
         end;
       case aMarker^.Identifier of
-      'a','r','s':// should be normal call
+      'a','t','u','v','w':// should be normal call
         if ActualNewInstance then
           RaiseErrorAtSrcMarker('expected normal call at "#'+aMarker^.Identifier+', but got newinstance"',aMarker);
       else // should be newinstance
@@ -12169,25 +12179,26 @@ end;
 procedure TTestResolver.TestDefaultProperty;
 begin
   StartProgram(false);
-  Add('type');
-  Add('  TObject = class');
-  Add('    function GetB(Index: longint): longint;');
-  Add('    procedure SetB(Index: longint; Value: longint);');
-  Add('    property B[Index: longint]: longint read GetB write SetB; default;');
-  Add('  end;');
-  Add('function TObject.GetB(Index: longint): longint;');
-  Add('begin');
-  Add('end;');
-  Add('procedure TObject.SetB(Index: longint; Value: longint);');
-  Add('begin');
-  Add('  if Value=Self[Index] then ;');
-  Add('  Self[Index]:=Value;');
-  Add('end;');
-  Add('var o: TObject;');
-  Add('begin');
-  Add('  o[3]:=4;');
-  Add('  if o[5]=6 then;');
-  Add('  if 7=o[8] then;');
+  Add([
+  'type',
+  '  TObject = class',
+  '    function GetB(Index: longint): longint;',
+  '    procedure SetB(Index: longint; Value: longint);',
+  '    property B[Index: longint]: longint read GetB write SetB; default;',
+  '  end;',
+  'function TObject.GetB(Index: longint): longint;',
+  'begin',
+  'end;',
+  'procedure TObject.SetB(Index: longint; Value: longint);',
+  'begin',
+  '  if Value=Self[Index] then ;',
+  '  Self[Index]:=Value;',
+  'end;',
+  'var o: TObject;',
+  'begin',
+  '  o[3]:=4;',
+  '  if o[5]=6 then;',
+  '  if 7=o[8] then;']);
   ParseProgram;
 end;
 
@@ -15640,7 +15651,7 @@ begin
   CheckResolverUnexpectedHints(true);
 end;
 
-procedure TTestResolver.ClassHelper;
+procedure TTestResolver.TestClassHelper;
 begin
   StartProgram(false);
   Add([
@@ -15667,7 +15678,7 @@ begin
   ParseProgram;
 end;
 
-procedure TTestResolver.ClassHelper_AncestorIsNotHelperForDescendantFail;
+procedure TTestResolver.TestClassHelper_AncestorIsNotHelperForDescendantFail;
 begin
   StartProgram(false);
   Add([
@@ -15688,7 +15699,7 @@ begin
     nDerivedXMustExtendASubClassY);
 end;
 
-procedure TTestResolver.ClassHelper_HelperForParentFail;
+procedure TTestResolver.TestClassHelper_HelperForParentFail;
 begin
   StartProgram(false);
   Add([
@@ -15706,7 +15717,7 @@ begin
     nTypeXIsNotYetCompletelyDefined);
 end;
 
-procedure TTestResolver.ClassHelper_ForInterfaceFail;
+procedure TTestResolver.TestClassHelper_ForInterfaceFail;
 begin
   StartProgram(false);
   Add([
@@ -15722,7 +15733,7 @@ begin
     nXExpectedButYFound);
 end;
 
-procedure TTestResolver.ClassHelper_FieldFail;
+procedure TTestResolver.TestClassHelper_FieldFail;
 begin
   StartProgram(false);
   Add([
@@ -15738,7 +15749,7 @@ begin
     nParserNoFieldsAllowed);
 end;
 
-procedure TTestResolver.ClassHelper_AbstractFail;
+procedure TTestResolver.TestClassHelper_AbstractFail;
 begin
   StartProgram(false);
   Add([
@@ -15755,7 +15766,7 @@ begin
     nInvalidXModifierY);
 end;
 
-procedure TTestResolver.ClassHelper_VirtualObjFPCFail;
+procedure TTestResolver.TestClassHelper_VirtualObjFPCFail;
 begin
   StartProgram(false);
   Add([
@@ -15773,7 +15784,7 @@ begin
     nInvalidXModifierY);
 end;
 
-procedure TTestResolver.ClassHelper_VirtualDelphiFail;
+procedure TTestResolver.TestClassHelper_VirtualDelphiFail;
 begin
   StartProgram(false);
   Add([
@@ -15792,7 +15803,7 @@ begin
     nInvalidXModifierY);
 end;
 
-procedure TTestResolver.ClassHelper_DestructorFail;
+procedure TTestResolver.TestClassHelper_DestructorFail;
 begin
   StartProgram(false);
   Add([
@@ -15810,7 +15821,7 @@ begin
     nParserXNotAllowedInY);
 end;
 
-procedure TTestResolver.ClassHelper_ClassRefersToTypeHelperOfAncestor;
+procedure TTestResolver.TestClassHelper_ClassRefersToTypeHelperOfAncestor;
 begin
   StartProgram(false);
   Add([
@@ -15837,7 +15848,7 @@ begin
   ParseProgram;
 end;
 
-procedure TTestResolver.ClassHelper_InheritedObjFPC;
+procedure TTestResolver.TestClassHelper_InheritedObjFPC;
 begin
   StartProgram(false);
   Add([
@@ -15896,7 +15907,7 @@ begin
   ParseProgram;
 end;
 
-procedure TTestResolver.ClassHelper_InheritedObjFPC2;
+procedure TTestResolver.TestClassHelper_InheritedObjFPC2;
 begin
   StartProgram(false);
   Add([
@@ -15944,7 +15955,7 @@ begin
   ParseProgram;
 end;
 
-procedure TTestResolver.ClassHelper_InheritedObjFPCStrictPrivateFail;
+procedure TTestResolver.TestClassHelper_InheritedObjFPCStrictPrivateFail;
 begin
   StartProgram(false);
   Add([
@@ -15960,7 +15971,7 @@ begin
   CheckResolverException('Can''t access strict private member i',nCantAccessXMember);
 end;
 
-procedure TTestResolver.ClassHelper_InheritedDelphi;
+procedure TTestResolver.TestClassHelper_InheritedDelphi;
 begin
   StartProgram(false);
   Add([
@@ -16020,7 +16031,7 @@ begin
   ParseProgram;
 end;
 
-procedure TTestResolver.ClassHelper_NestedInheritedParentFail;
+procedure TTestResolver.TestClassHelper_NestedInheritedParentFail;
 begin
   StartProgram(false);
   Add([
@@ -16046,7 +16057,7 @@ begin
   CheckResolverException('identifier not found "Fly"',nIdentifierNotFound);
 end;
 
-procedure TTestResolver.ClassHelper_AccessFields;
+procedure TTestResolver.TestClassHelper_AccessFields;
 begin
   StartProgram(false);
   Add([
@@ -16073,7 +16084,7 @@ begin
   ParseProgram;
 end;
 
-procedure TTestResolver.ClassHelper_CallClassMethodFail;
+procedure TTestResolver.TestClassHelper_CallClassMethodFail;
 begin
   StartProgram(false);
   Add([
@@ -16091,7 +16102,7 @@ begin
   CheckResolverException(sHelpersCannotBeUsedAsTypes,nHelpersCannotBeUsedAsTypes);
 end;
 
-procedure TTestResolver.ClassHelper_AsTypeFail;
+procedure TTestResolver.TestClassHelper_AsTypeFail;
 begin
   StartProgram(false);
   Add([
@@ -16105,7 +16116,7 @@ begin
   CheckResolverException(sHelpersCannotBeUsedAsTypes,nHelpersCannotBeUsedAsTypes);
 end;
 
-procedure TTestResolver.ClassHelper_Enumerator;
+procedure TTestResolver.TestClassHelper_Enumerator;
 begin
   StartProgram(false);
   Add([
@@ -16140,7 +16151,7 @@ begin
   ParseProgram;
 end;
 
-procedure TTestResolver.ClassHelper_FromUnitInterface;
+procedure TTestResolver.TestClassHelper_FromUnitInterface;
 begin
   AddModuleWithIntfImplSrc('unit2.pas',
     LinesToStr([
@@ -16172,7 +16183,187 @@ begin
   ParseProgram;
 end;
 
-procedure TTestResolver.RecordHelper;
+procedure TTestResolver.TestClassHelper_Constructor_NewInstance;
+var
+  aMarker: PSrcMarker;
+  Elements: TFPList;
+  i: Integer;
+  El: TPasElement;
+  Ref: TResolvedReference;
+  ActualNewInstance, ActualImplicitCallWithoutParams: Boolean;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '  end;',
+  '  THelper = class helper for TObject',
+  '    constructor Create;',
+  '    class function DoSome: TObject;',
+  '  end;',
+  'constructor THelper.Create;',
+  'begin',
+  '  {#a}Create; // normal call',
+  '  TObject.{#b}Create; // new instance',
+  'end;',
+  'class function THelper.DoSome: TObject;',
+  'begin',
+  '  Result:={#c}Create; // new instance',
+  'end;',
+  'var',
+  '  o: TObject;',
+  'begin',
+  '  TObject.{#p}Create; // new object',
+  '  o:=TObject.{#q}Create; // new object',
+  '  with TObject do begin',
+  '    {#r}Create; // new object',
+  '    o:={#s}Create; // new object',
+  '  end;',
+  '  o.{#t}Create; // normal call',
+  '  o:=o.{#u}Create; // normal call',
+  '  with o do begin',
+  '    {#v}Create; // normal call',
+  '    o:={#w}Create; // normal call',
+  '  end;',
+  '']);
+  ParseProgram;
+  aMarker:=FirstSrcMarker;
+  while aMarker<>nil do
+    begin
+    //writeln('TTestResolver.TestClassHelper_Constructor_NewInstance ',aMarker^.Identifier,' ',aMarker^.StartCol,' ',aMarker^.EndCol);
+    Elements:=FindElementsAt(aMarker);
+    try
+      ActualNewInstance:=false;
+      ActualImplicitCallWithoutParams:=false;
+      for i:=0 to Elements.Count-1 do
+        begin
+        El:=TPasElement(Elements[i]);
+        //writeln('TTestResolver.TestClassHelper_Constructor_NewInstance ',aMarker^.Identifier,' ',i,'/',Elements.Count,' El=',GetObjName(El),' ',GetObjName(El.CustomData));
+        if not (El.CustomData is TResolvedReference) then continue;
+        Ref:=TResolvedReference(El.CustomData);
+        if not (Ref.Declaration is TPasProcedure) then continue;
+        //writeln('TTestResolver.TestClassHelper_Constructor_NewInstance ',GetObjName(Ref.Declaration),' rrfNewInstance=',rrfNewInstance in Ref.Flags);
+        if (Ref.Declaration is TPasConstructor) then
+          ActualNewInstance:=rrfNewInstance in Ref.Flags;
+        ActualImplicitCallWithoutParams:=rrfImplicitCallWithoutParams in Ref.Flags;
+        break;
+        end;
+      if not ActualImplicitCallWithoutParams then
+        RaiseErrorAtSrcMarker('expected implicit call at "#'+aMarker^.Identifier+', but got function ref"',aMarker);
+      case aMarker^.Identifier of
+      'a','t','u','v','w':// should be normal call
+        if ActualNewInstance then
+          RaiseErrorAtSrcMarker('expected normal call at "#'+aMarker^.Identifier+', but got newinstance"',aMarker);
+      else // should be newinstance
+        if not ActualNewInstance then
+          RaiseErrorAtSrcMarker('expected newinstance at "#'+aMarker^.Identifier+', but got normal call"',aMarker);
+      end;
+    finally
+      Elements.Free;
+    end;
+    aMarker:=aMarker^.Next;
+    end;
+end;
+
+procedure TTestResolver.TestClassHelper_DefaultProperty;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '    function GetB(Index: longint): longint;',
+  '    procedure SetB(Index: longint; Value: longint);',
+  '  end;',
+  '  THelper = class helper for TObject',
+  '    property B[Index: longint]: longint read GetB write SetB; default;',
+  '  end;',
+  'function TObject.GetB(Index: longint): longint;',
+  'begin',
+  'end;',
+  'procedure TObject.SetB(Index: longint; Value: longint);',
+  'begin',
+  '  if Value=Self[Index] then ;',
+  '  Self[Index]:=Value;',
+  'end;',
+  'var o: TObject;',
+  'begin',
+  '  o[3]:=4;',
+  '  if o[5]=6 then;',
+  '  if 7=o[8] then;',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClassHelper_DefaultClassProperty;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TClass = class of TObject;',
+  '  TObject = class',
+  '    class function GetB(Index: longint): longint; static;',
+  '    class procedure SetB(Index: longint; Value: longint); static;',
+  '  end;',
+  '  THelper = class helper for TObject',
+  '    class property B[Index: longint]: longint read GetB write SetB; default;',
+  '  end;',
+  'class function TObject.GetB(Index: longint): longint;',
+  'begin',
+  'end;',
+  'class procedure TObject.SetB(Index: longint; Value: longint);',
+  'begin',
+  '  if Value=TObject[Index] then ;',
+  '  TObject[Index]:=Value;',
+  'end;',
+  'var c: TClass;',
+  'begin',
+  '  c[3]:=4;',
+  '  if c[5]=6 then;',
+  '  if 7=c[8] then;',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClassHelper_MultipleScopeHelpers;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch multiplescopehelpers}',
+  'type',
+  '  TObject = class',
+  '  end;',
+  '  TFlyHelper = class helper for TObject',
+  '    procedure {#Fly}Fly;',
+  '    procedure {#FlyMove}Move;',
+  '  end;',
+  '  TRunHelper = class helper for TObject',
+  '    procedure {#Run}Run;',
+  '    procedure {#RunMove}Move;',
+  '    procedure {#RunBack}Back;',
+  '  end;',
+  '  TSwimHelper = class helper for TObject',
+  '    procedure {#Swim}Swim;',
+  '    procedure {#SwimBack}Back;',
+  '  end;',
+  'procedure TFlyHelper.Fly; begin end;',
+  'procedure TFlyHelper.Move; begin end;',
+  'procedure TRunHelper.Run; begin end;',
+  'procedure TRunHelper.Move; begin end;',
+  'procedure TRunHelper.Back; begin end;',
+  'procedure TSwimHelper.Swim; begin end;',
+  'procedure TSwimHelper.Back; begin end;',
+  'var o: TObject;',
+  'begin',
+  '  o.{@Fly}Fly;',
+  '  o.{@Run}Run;',
+  '  o.{@Swim}Swim;',
+  '  o.{@RunMove}Move;',
+  '  o.{@SwimBack}Back;',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestRecordHelper;
 begin
   StartProgram(false);
   Add([
@@ -16207,7 +16398,87 @@ begin
   ParseProgram;
 end;
 
-procedure TTestResolver.TypeHelper;
+procedure TTestResolver.TestRecordHelper_Constructor_NewInstance;
+var
+  aMarker: PSrcMarker;
+  Elements: TFPList;
+  ActualNewInstance: Boolean;
+  i: Integer;
+  El: TPasElement;
+  Ref: TResolvedReference;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch advancedrecords}',
+  '{$modeswitch typehelpers}',
+  'type',
+  '  TRec = record',
+  '    constructor Create(w: word);',
+  '    class function DoSome: TRec; static;',
+  '  end;',
+  'constructor TRec.Create(w: word);',
+  'begin',
+  '  {#a}Create(1); // normal call',
+  '  TRec.{#b}Create(2); // new instance',
+  'end;',
+  'class function TRec.DoSome: TRec;',
+  'begin',
+  '  Result:={#c}Create(3); // new instance',
+  'end;',
+  'var',
+  '  r: TRec;',
+  'begin',
+  '  TRec.{#p}Create(4); // new object',
+  '  r:=TRec.{#q}Create(5); // new object',
+  '  with TRec do begin',
+  '    {#r}Create(6); // new object',
+  '    r:={#s}Create(7); // new object',
+  '  end;',
+  '  r.{#t}Create(8); // normal call',
+  '  r:=r.{#u}Create(9); // normal call',
+  '  with r do begin',
+  '    {#v}Create(10); // normal call',
+  '    r:={#w}Create(11); // normal call',
+  '  end;',
+  '']);
+  ParseProgram;
+  aMarker:=FirstSrcMarker;
+  while aMarker<>nil do
+    begin
+    //writeln('TTestResolver.TestAdvRecord_Constructor_NewInstance ',aMarker^.Identifier,' ',aMarker^.StartCol,' ',aMarker^.EndCol);
+    Elements:=FindElementsAt(aMarker);
+    try
+      ActualNewInstance:=false;
+      for i:=0 to Elements.Count-1 do
+        begin
+        El:=TPasElement(Elements[i]);
+        //writeln('TTestResolver.TestAdvRecord_Constructor_NewInstance ',aMarker^.Identifier,' ',i,'/',Elements.Count,' El=',GetObjName(El),' ',GetObjName(El.CustomData));
+        if not (El.CustomData is TResolvedReference) then continue;
+        Ref:=TResolvedReference(El.CustomData);
+        if not (Ref.Declaration is TPasProcedure) then continue;
+        //writeln('TTestResolver.TestAdvRecord_Constructor_NewInstance ',GetObjName(Ref.Declaration),' rrfNewInstance=',rrfNewInstance in Ref.Flags);
+        if (Ref.Declaration is TPasConstructor) then
+          ActualNewInstance:=rrfNewInstance in Ref.Flags;
+        if rrfImplicitCallWithoutParams in Ref.Flags then
+          RaiseErrorAtSrcMarker('unexpected implicit call at "#'+aMarker^.Identifier+' ref"',aMarker);
+        break;
+        end;
+      case aMarker^.Identifier of
+      'a','t','u','v','w':// should be normal call
+        if ActualNewInstance then
+          RaiseErrorAtSrcMarker('expected normal call at "#'+aMarker^.Identifier+', but got newinstance"',aMarker);
+      else // should be newinstance
+        if not ActualNewInstance then
+          RaiseErrorAtSrcMarker('expected newinstance at "#'+aMarker^.Identifier+', but got normal call"',aMarker);
+      end;
+    finally
+      Elements.Free;
+    end;
+    aMarker:=aMarker^.Next;
+    end;
+end;
+
+procedure TTestResolver.TestTypeHelper;
 begin
   StartProgram(false);
   Add([
@@ -16223,7 +16494,7 @@ begin
   ParseProgram;
 end;
 
-procedure TTestResolver.TypeHelper_HelperForProcTypeFail;
+procedure TTestResolver.TestTypeHelper_HelperForProcTypeFail;
 begin
   StartProgram(false);
   Add([
@@ -16238,7 +16509,7 @@ begin
     nTypeXCannotBeExtendedByATypeHelper);
 end;
 
-procedure TTestResolver.TypeHelper_DefaultPropertyFail;
+procedure TTestResolver.TestTypeHelper_DefaultPropertyFail;
 begin
   StartProgram(false);
   Add([
@@ -16258,7 +16529,7 @@ begin
     nDefaultPropertyNotAllowedInHelperForX);
 end;
 
-procedure TTestResolver.TypeHelper_Enum;
+procedure TTestResolver.TestTypeHelper_Enum;
 begin
   StartProgram(false);
   Add([
@@ -16282,7 +16553,7 @@ begin
   ParseProgram;
 end;
 
-procedure TTestResolver.TypeHelper_Enumerator;
+procedure TTestResolver.TestTypeHelper_Enumerator;
 begin
   StartProgram(false);
   Add([
@@ -16316,6 +16587,86 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestTypeHelper_Constructor_NewInstance;
+var
+  aMarker: PSrcMarker;
+  Elements: TFPList;
+  ActualNewInstance: Boolean;
+  i: Integer;
+  El: TPasElement;
+  Ref: TResolvedReference;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch typehelpers}',
+  'type',
+  '  TInt = type word;',
+  '  THelper = type helper for TInt',
+  '    constructor Create(w: TInt);',
+  '    class function DoSome: TInt; static;',
+  '  end;',
+  'constructor THelper.Create(w: TInt);',
+  'begin',
+  '  {#a}Create(1); // normal call',
+  '  TInt.{#b}Create(2); // new instance',
+  'end;',
+  'class function THelper.DoSome: TInt;',
+  'begin',
+  '  Result:={#c}Create(3); // new instance',
+  'end;',
+  'var',
+  '  r: TInt;',
+  'begin',
+  '  TInt.{#p}Create(4); // new object',
+  '  r:=TInt.{#q}Create(5); // new object',
+  '  with TInt do begin',
+  '    {#r}Create(6); // new object',
+  '    r:={#s}Create(7); // new object',
+  '  end;',
+  '  r.{#t}Create(8); // normal call',
+  '  r:=r.{#u}Create(9); // normal call',
+  '  with r do begin',
+  '    {#v}Create(10); // normal call',
+  '    r:={#w}Create(11); // normal call',
+  '  end;',
+  '']);
+  ParseProgram;
+  aMarker:=FirstSrcMarker;
+  while aMarker<>nil do
+    begin
+    //writeln('TTestResolver.TestAdvRecord_Constructor_NewInstance ',aMarker^.Identifier,' ',aMarker^.StartCol,' ',aMarker^.EndCol);
+    Elements:=FindElementsAt(aMarker);
+    try
+      ActualNewInstance:=false;
+      for i:=0 to Elements.Count-1 do
+        begin
+        El:=TPasElement(Elements[i]);
+        //writeln('TTestResolver.TestAdvRecord_Constructor_NewInstance ',aMarker^.Identifier,' ',i,'/',Elements.Count,' El=',GetObjName(El),' ',GetObjName(El.CustomData));
+        if not (El.CustomData is TResolvedReference) then continue;
+        Ref:=TResolvedReference(El.CustomData);
+        if not (Ref.Declaration is TPasProcedure) then continue;
+        //writeln('TTestResolver.TestAdvRecord_Constructor_NewInstance ',GetObjName(Ref.Declaration),' rrfNewInstance=',rrfNewInstance in Ref.Flags);
+        if (Ref.Declaration is TPasConstructor) then
+          ActualNewInstance:=rrfNewInstance in Ref.Flags;
+        if rrfImplicitCallWithoutParams in Ref.Flags then
+          RaiseErrorAtSrcMarker('unexpected implicit call at "#'+aMarker^.Identifier+' ref"',aMarker);
+        break;
+        end;
+      case aMarker^.Identifier of
+      'a','t','u','v','w':// should be normal call
+        if ActualNewInstance then
+          RaiseErrorAtSrcMarker('expected normal call at "#'+aMarker^.Identifier+', but got newinstance"',aMarker);
+      else // should be newinstance
+        if not ActualNewInstance then
+          RaiseErrorAtSrcMarker('expected newinstance at "#'+aMarker^.Identifier+', but got normal call"',aMarker);
+      end;
+    finally
+      Elements.Free;
+    end;
+    aMarker:=aMarker^.Next;
+    end;
+end;
+
 procedure TTestResolver.TestAttributes_Ignore;
 begin
   StartProgram(false);

packages/pastojs/src/pas2jscompiler.pp

@@ -688,9 +688,6 @@ type
     property PostProcessorSupport: TPas2JSPostProcessorSupport Read FPostProcessorSupport Write FPostProcessorSupport;
   end;
 
-
-
-
 function GetCompiledDate: string;
 function GetCompiledVersion: string;
 function GetCompiledTargetOS: string;