diff --git a/packages/fcl-passrc/src/pastree.pp b/packages/fcl-passrc/src/pastree.pp index 1e56b1d7f7..4dc1c0f19b 100644 --- a/packages/fcl-passrc/src/pastree.pp +++ b/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 diff --git a/packages/fcl-passrc/src/pparser.pp b/packages/fcl-passrc/src/pparser.pp index e4f57441ea..7f9bce0187 100644 --- a/packages/fcl-passrc/src/pparser.pp +++ b/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,''''); diff --git a/packages/fcl-passrc/tests/tctypeparser.pas b/packages/fcl-passrc/tests/tctypeparser.pas index 1c1fa874db..7f124994bd 100644 --- a/packages/fcl-passrc/tests/tctypeparser.pas +++ b/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'); diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp index 6e8645c819..1ba4464fbf 100644 --- a/packages/pastojs/src/fppas2js.pp +++ b/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