fcl-passrc: fixed parsing type helper() for, fixed parsing record helper: atype end

git-svn-id: trunk@40869 -

packages/fcl-passrc/src/pastree.pp

@@ -733,7 +733,8 @@ type
   TPasGenericTemplateType = Class(TPasType);
 
   TPasObjKind = (
-    okObject, okClass, okInterface, okGeneric,
+    okObject, okClass, okInterface,
+    okGeneric, // MG: what is okGeneric?
     // okSpecialize removed in FPC 3.1.1
     okClassHelper,okRecordHelper,okTypeHelper,
     okDispInterface);
@@ -758,7 +759,7 @@ type
     ObjKind: TPasObjKind;
     AncestorType: TPasType;   // TPasClassType or TPasUnresolvedTypeRef or TPasAliasType or TPasTypeAliasType
                               // Note: AncestorType can be nil even though it has a default ancestor
-    HelperForType: TPasType;  // TPasClassType or TPasUnresolvedTypeRef
+    HelperForType: TPasType;  // any type, except helper
     IsForward: Boolean;
     IsExternal : Boolean;
     IsShortDefinition: Boolean;//class(anchestor); without end

packages/fcl-passrc/src/pparser.pp

@@ -72,7 +72,7 @@ const
   nParserNotAProcToken = 2026;
   nRangeExpressionExpected = 2027;
   nParserExpectCase = 2028;
-  nParserHelperNotAllowed = 2029;
+  // free 2029;
   nLogStartImplementation = 2030;
   nLogStartInterface = 2031;
   nParserNoConstructorAllowed = 2032;
@@ -132,7 +132,7 @@ resourcestring
   SParserNotAProcToken = 'Not a procedure or function token';
   SRangeExpressionExpected = 'Range expression expected';
   SParserExpectCase = 'Case label expression expected';
-  SParserHelperNotAllowed = 'Helper objects not allowed for "%s"';
+  // free for 2029
   SLogStartImplementation = 'Start parsing implementation section.';
   SLogStartInterface = 'Start parsing interface section';
   SParserNoConstructorAllowed = 'Constructors or Destructors are not allowed in Interfaces or Record helpers';
@@ -1735,12 +1735,40 @@ begin
       tkInterface:
         Result := ParseClassDecl(Parent, NamePos, TypeName, okInterface);
       tkSpecialize: Result:=ParseSpecializeType(Parent,TypeName);
-      tkClass: Result := ParseClassDecl(Parent, NamePos, TypeName, okClass, PM, GenericArgs);
+      tkClass:
+        begin
+        isHelper:=false;
+        NextToken;
+        if CurTokenIsIdentifier('Helper') then
+          begin
+          // class helper: atype end;
+          // class helper for atype end;
+          NextToken;
+          isHelper:=CurToken in [tkfor,tkBraceOpen];
+          UnGetToken;
+          end;
+        UngetToken;
+        if isHelper then
+          Result:=ParseClassDecl(Parent,NamePos,TypeName,okClassHelper,PM, GenericArgs)
+        else
+          Result:=ParseClassDecl(Parent, NamePos, TypeName, okClass, PM, GenericArgs);
+        end;
       tkType:
         begin
-        NextToken;
-        isHelper:=CurTokenIsIdentifier('helper');
-        UnGetToken;
+        isHelper:=false;
+        if msTypeHelpers in Scanner.CurrentModeSwitches then
+          begin
+          NextToken;
+          if CurTokenIsIdentifier('helper') then
+            begin
+            // atype = type helper;
+            // atype = type helper for atype end;
+            NextToken;
+            isHelper:=CurToken in [tkfor,tkBraceOpen];
+            UnGetToken;
+            end;
+          UnGetToken;
+          end;
         if isHelper then
           Result:=ParseClassDecl(Parent,NamePos,TypeName,okTypeHelper,PM)
         else
@@ -1769,16 +1797,20 @@ begin
       tkRecord:
         begin
         NextToken;
+        isHelper:=false;
         if CurTokenIsIdentifier('Helper') then
           begin
+          // record helper: atype end;
+          // record helper for atype end;
+          NextToken;
+          isHelper:=CurToken in [tkfor,tkBraceOpen];
           UnGetToken;
-          Result:=ParseClassDecl(Parent,NamePos,TypeName,okRecordHelper,PM);
-          end
-        else
-          begin
-          UnGetToken;
-          Result := ParseRecordDecl(Parent,NamePos,TypeName,PM);
           end;
+        UngetToken;
+        if isHelper then
+          Result:=ParseClassDecl(Parent,NamePos,TypeName,okRecordHelper,PM)
+        else
+          Result:=ParseRecordDecl(Parent,NamePos,TypeName,PM);
         end;
       tkNumber,tkMinus,tkChar:
         begin
@@ -6797,18 +6829,23 @@ begin
   if (CurToken=tkBraceOpen) then
     begin
     // read ancestor and interfaces
+    if (AType.ObjKind=okRecordHelper)
+        and ([msTypeHelpers,msDelphi]*Scanner.CurrentModeSwitches=[msDelphi]) then
+      // Delphi does not support ancestors in record helpers
+      CheckToken(tkend);
     NextToken;
     AType.AncestorType := ParseTypeReference(AType,false,Expr);
-    while CurToken=tkComma do
-      begin
-      NextToken;
-      AType.Interfaces.Add(ParseTypeReference(AType,false,Expr));
-      end;
+    if AType.ObjKind in [okClass,okGeneric] then
+      while CurToken=tkComma do
+        begin
+        NextToken;
+        AType.Interfaces.Add(ParseTypeReference(AType,false,Expr));
+        end;
     CheckToken(tkBraceClose);
     NextToken;
     AType.IsShortDefinition:=(CurToken=tkSemicolon);
     end;
-  if (AType.ObjKind in [okClassHelper,okRecordHelper]) then
+  if (AType.ObjKind in [okClassHelper,okRecordHelper,okTypeHelper]) then
     begin
     CheckToken(tkfor);
     NextToken;
@@ -6837,12 +6874,10 @@ function TPasParser.ParseClassDecl(Parent: TPasElement;
 
 Var
   ok: Boolean;
-  FT : TPasType;
   AExternalNameSpace,AExternalName : String;
   PCT:TPasClassType;
 begin
   NextToken;
-  FT:=Nil;
   if (AObjKind = okClass) and (CurToken = tkOf) then
     begin
     Result := TPasClassOfType(CreateElement(TPasClassOfType, AClassName,
@@ -6860,7 +6895,7 @@ begin
     end;
     exit;
     end;
-  if ((AObjKind in [okClass,OKInterface]) and (msExternalClass in CurrentModeswitches)
+  if ((AObjKind in [okClass,okInterface]) and (msExternalClass in CurrentModeswitches)
       and CurTokenIsIdentifier('external')) then
     begin
     NextToken;
@@ -6882,19 +6917,10 @@ begin
     AExternalNameSpace:='';
     AExternalName:='';
     end;
-  if (CurTokenIsIdentifier('Helper')) then
+  if AObjKind in [okClassHelper,okRecordHelper,okTypeHelper] then
     begin
-    if Not (AObjKind in [okClass,okTypeHelper,okRecordHelper]) then
-      ParseExc(nParserHelperNotAllowed,SParserHelperNotAllowed,[ObjKindNames[AObjKind]]);
-    Case AObjKind of
-     okClass:
-       AObjKind:=okClassHelper;
-     okTypeHelper:
-       begin
-       ExpectToken(tkFor);
-       FT:=ParseType(Parent,CurSourcePos,'',False);
-       end
-    end;
+    if not CurTokenIsIdentifier('Helper') then
+      ParseExcSyntaxError;
     NextToken;
     end;
   PCT := TPasClassType(CreateElement(TPasClassType, AClassName,
@@ -6902,7 +6928,7 @@ begin
   Result:=PCT;
   ok:=false;
   try
-    PCT.HelperForType:=FT;
+    PCT.HelperForType:=nil;
     PCT.IsExternal:=(AExternalName<>'');
     if AExternalName<>'' then
       PCT.ExternalName:={$ifdef pas2js}DeQuoteString{$else}AnsiDequotedStr{$endif}(AExternalName,'''');

packages/fcl-passrc/tests/tctypeparser.pas

@@ -165,6 +165,7 @@ type
     Procedure TestReferencePointer;
     Procedure TestInvalidColon;
     Procedure TestTypeHelper;
+    Procedure TestTypeHelperWithParent;
     procedure TestPointerReference;
     Procedure TestPointerKeyWord;
   end;
@@ -3562,9 +3563,16 @@ end;
 
 procedure TTestTypeParser.TestTypeHelper;
 begin
+  Scanner.CurrentModeSwitches:=Scanner.CurrentModeSwitches+[msTypeHelpers];
   ParseType('Type Helper for AnsiString end',TPasClassType,'');
 end;
 
+procedure TTestTypeParser.TestTypeHelperWithParent;
+begin
+  Scanner.CurrentModeSwitches:=Scanner.CurrentModeSwitches+[msTypeHelpers];
+  ParseType('Type Helper(TOtherHelper) for AnsiString end',TPasClassType,'');
+end;
+
 procedure TTestTypeParser.TestPointerReference;
 begin
   Add('Type');

packages/pastojs/src/fppas2js.pp

@@ -86,7 +86,7 @@ Works:
   - array of record-const
   - skip clone record of new record
   - use rtl.recNewT to create a record type
-  - use TRec.$new to instantiate records
+  - use TRec.$new to instantiate records, using Object.create to instantiate
   - advanced records:
     - public, private, strict private
     - class var
@@ -94,6 +94,8 @@ Works:
     - sub types
     - functions
     - properties
+    - class properties
+    - default property
     - rtti
     - constructor
 - assign: copy values, do not create new JS object, needed by ^record
@@ -376,16 +378,9 @@ Works:
 - move all local types to global
 
 ToDos:
+- class helpers, type helpers, record helpers, array helpers
 - cmd line param to set modeswitch
 - Result:=inherited;
-- move local types to unit scope
-- records:
-  - use Object.create to instantiate simple records
-  - advanced records:
-    - class properties
-    - default property
-    - constructor
-    - rtti
 - bug: DoIt(typeinfo(i))  where DoIt is in another unit and has TTypeInfo
 - $OPTIMIZATION ON|OFF
 - $optimization REMOVEEMPTYPROCS
@@ -445,7 +440,6 @@ ToDos:
   -O2 CSE
   -O3 DFA
 - objects
-- class helpers, type helpers, record helpers, array helpers
 - generics
 - operator overloading
   - operator enumerator