Browse Source

missing patches from trunk

mattias 4 years ago
parent
commit
327e6aa0c9

+ 12 - 6
compiler/packages/fcl-passrc/src/pastree.pp

@@ -111,7 +111,8 @@ type
 
   TPasMemberVisibility = (visDefault, visPrivate, visProtected, visPublic,
     visPublished, visAutomated,
-    visStrictPrivate, visStrictProtected);
+    visStrictPrivate, visStrictProtected,
+    visRequired, visOptional);
 
   TCallingConvention = (ccDefault,ccRegister,ccPascal,ccCDecl,ccStdCall,
                         ccOldFPCCall,ccSafeCall,ccSysCall,ccMWPascal,
@@ -533,6 +534,7 @@ type
     procedure ClearTypeReferences(aType: TPasElement); override;
   public
     DestType: TPasType;
+    SubType: TPasType;
     Expr: TPasExpr;
   end;
 
@@ -1167,7 +1169,8 @@ type
     otBitwiseAnd, otbitwiseXor,
     otLogicalAnd, otLogicalNot, otLogicalXor,
     otRightShift,
-    otEnumerator, otIn
+    otEnumerator, otIn,
+    otInitialize // Management operator
     );
   TOperatorTypes = set of TOperatorType;
 
@@ -1700,7 +1703,7 @@ const
 
   VisibilityNames: array[TPasMemberVisibility] of string = (
     'default','private', 'protected', 'public', 'published', 'automated',
-    'strict private', 'strict protected');
+    'strict private', 'strict protected','required','optional');
 
   ObjKindNames: array[TPasObjKind] of string = (
     'object', 'class', 'interface',
@@ -1749,13 +1752,13 @@ const
            '>',':=','<>','<=','>=','**',
            '><','Inc','Dec','mod','-','+','Or','div',
            'shl','or','and','xor','and','not','xor',
-           'shr','enumerator','in');
+           'shr','enumerator','in','');
   OperatorNames : Array[TOperatorType] of string
        =  ('','implicit','explicit','multiply','add','subtract','divide','lessthan','equal',
            'greaterthan','assign','notequal','lessthanorequal','greaterthanorequal','power',
            'symmetricaldifference','inc','dec','modulus','negative','positive','bitwiseor','intdivide',
            'leftshift','logicalor','bitwiseand','bitwisexor','logicaland','logicalnot','logicalxor',
-           'rightshift','enumerator','in');
+           'rightshift','enumerator','in','initialize');
 
   AssignKindNames : Array[TAssignKind] of string = (':=','+=','-=','*=','/=' );
 
@@ -2834,7 +2837,9 @@ begin
         Result := Result + ', ';
       Result := Result + TPasArgument(ProcType.Args[i]).ArgType.Name;
       end;
-    Result := Result + '): ' + TPasFunctionType(ProcType).ResultEl.ResultType.Name;
+    Result := Result + ')';
+    if (OperatorType<>otInitialize) and Assigned(TPasFunctionType(ProcType).ResultEl.ResultType) then
+       Result:=Result+': ' + TPasFunctionType(ProcType).ResultEl.ResultType.Name;
     If WithPath then
       begin
       S:=Self.ParentPath;
@@ -3302,6 +3307,7 @@ end;
 
 destructor TPasAliasType.Destroy;
 begin
+  ReleaseAndNil(TPasElement(SubType){$IFDEF CheckPasTreeRefCount},'TPasAliasType.SubType'{$ENDIF});
   ReleaseAndNil(TPasElement(DestType){$IFDEF CheckPasTreeRefCount},'TPasAliasType.DestType'{$ENDIF});
   ReleaseAndNil(TPasElement(Expr){$IFDEF CheckPasTreeRefCount},'TPasAliasType.Expr'{$ENDIF});
   inherited Destroy;

+ 4 - 4
compiler/packages/fcl-passrc/src/paswrite.pp

@@ -1408,11 +1408,11 @@ end;
 
 procedure TPasWriter.WriteImplRaise(aRaise: TPasImplRaise);
 begin
-  if  assigned(aRaise.ExceptObject) then
+  if assigned(aRaise.ExceptObject) then
     begin
-      Add('raise %s',[GetExpr(aRaise.ExceptObject)]);
-      if aRaise.ExceptAddr<>Nil then
-        Add(' at %s',[GetExpr(aRaise.ExceptAddr)]);
+    Add('raise %s',[GetExpr(aRaise.ExceptObject)]);
+    if aRaise.ExceptAddr<>Nil then
+      Add(' at %s',[GetExpr(aRaise.ExceptAddr)]);
     end
   else
     Add('raise');

+ 139 - 50
compiler/packages/fcl-passrc/src/pparser.pp

@@ -311,7 +311,7 @@ type
     function CheckProcedureArgs(Parent: TPasElement;
       Args: TFPList; // list of TPasArgument
       ProcType: TProcType): boolean;
-    function CheckVisibility(S: String; var AVisibility: TPasMemberVisibility): Boolean;
+    function CheckVisibility(S: String; var AVisibility: TPasMemberVisibility; IsObjCProtocol : Boolean = False): Boolean;
     procedure ParseExc(MsgNumber: integer; const Msg: String);
     procedure ParseExc(MsgNumber: integer; const Fmt: String; Args : Array of {$ifdef pas2js}jsvalue{$else}const{$endif});
     procedure ParseExcExpectedIdentifier;
@@ -1192,29 +1192,40 @@ procedure TPasParser.ChangeToken(tk: TToken);
 var
   Cur, Last: PTokenRec;
   IsLast: Boolean;
+
+  Procedure DoChange(tk1,tk2 : TToken);
+
+    begin
+      // change last token '>>' into two '>'
+      Cur:=@FTokenRing[FTokenRingCur];
+      Cur^.Token:=tk2;
+      Cur^.AsString:=TokenInfos[tk2];
+      Last:=@FTokenRing[FTokenRingEnd];
+      Last^.Token:=tk2;
+      Last^.AsString:=TokenInfos[tk2];
+      if Last^.Comments<>nil then
+        Last^.Comments.Clear;
+      Last^.SourcePos:=Cur^.SourcePos;
+      dec(Cur^.SourcePos.Column);
+      Last^.TokenPos:=Cur^.TokenPos;
+      inc(Last^.TokenPos.Column);
+      FTokenRingEnd:=(FTokenRingEnd+1) mod FTokenRingSize;
+      if FTokenRingStart=FTokenRingEnd then
+        FTokenRingStart:=(FTokenRingStart+1) mod FTokenRingSize;
+      FCurToken:=tk1;
+      FCurTokenString:=TokenInfos[tk1];
+    end;
+
 begin
   //writeln('TPasParser.ChangeToken FTokenBufferSize=',FTokenRingStart,' FTokenBufferIndex=',FTokenRingCur);
   IsLast:=((FTokenRingCur+1) mod FTokenRingSize)=FTokenRingEnd;
-  if (CurToken=tkshr) and (tk=tkGreaterThan) and IsLast then
+  if (CurToken=tkGreaterEqualThan) and (tk=tkGreaterThan) and IsLast then
     begin
-    // change last token '>>' into two '>'
-    Cur:=@FTokenRing[FTokenRingCur];
-    Cur^.Token:=tkGreaterThan;
-    Cur^.AsString:='>';
-    Last:=@FTokenRing[FTokenRingEnd];
-    Last^.Token:=tkGreaterThan;
-    Last^.AsString:='>';
-    if Last^.Comments<>nil then
-      Last^.Comments.Clear;
-    Last^.SourcePos:=Cur^.SourcePos;
-    dec(Cur^.SourcePos.Column);
-    Last^.TokenPos:=Cur^.TokenPos;
-    inc(Last^.TokenPos.Column);
-    FTokenRingEnd:=(FTokenRingEnd+1) mod FTokenRingSize;
-    if FTokenRingStart=FTokenRingEnd then
-      FTokenRingStart:=(FTokenRingStart+1) mod FTokenRingSize;
-    FCurToken:=tkGreaterThan;
-    FCurTokenString:='>';
+    DoChange(tkGreaterThan,tkEqual);
+    end
+  else if (CurToken=tkshr) and (tk=tkGreaterThan) and IsLast then
+    begin
+    DoChange(tkGreaterThan,tkGreaterThan);
     end
   else
     CheckToken(tk);
@@ -1748,12 +1759,20 @@ begin
       end;
     // read nested specialize arguments
     ReadSpecializeArguments(ST,ST.Params);
-    // Important: resolve type reference AFTER args, because arg count is needed
-    ST.DestType:=ResolveTypeReference(GenName,ST,ST.Params.Count);
-
     if CurToken<>tkGreaterThan then
       ParseExcTokenError('[20190801113005]');
-    // ToDo: cascaded specialize A<B>.C<D>
+
+    // Check for cascaded specialize A<B>.C or A<B>.C<D>
+    NextToken;
+    if CurToken<>tkDot then
+      UnGetToken
+    else
+      begin
+      NextToken;
+      ST.SubType:=ParseSimpleType(ST,CurSourcePos,GenName,False);
+      end;
+    // Important: resolve type reference AFTER args, because arg count is needed
+    ST.DestType:=ResolveTypeReference(GenName,ST,ST.Params.Count);
 
     Engine.FinishScope(stTypeDef,ST);
     Result:=ST;
@@ -1775,7 +1794,7 @@ begin
   Try
     // only allowed: ^dottedidentifer
     // forbidden: ^^identifier, ^array of word, ^A<B>
-    ExpectIdentifier;
+    ExpectTokens([tkIdentifier,tkFile]);
     Name:=CurTokenString;
     repeat
       NextToken;
@@ -1787,7 +1806,14 @@ begin
       else
         break;
     until false;
-    UngetToken;
+    if CurToken=tkLessThan then
+      begin
+      Repeat
+        NextToken; // We should do something with this.
+      Until CurToken=tkGreaterThan;
+      end
+    else
+      UngetToken;
     Result.DestType:=ResolveTypeReference(Name,Result);
     Engine.FinishScope(stTypeDef,Result);
     ok:=true;
@@ -3613,6 +3639,7 @@ begin
       pt:=GetProcTypeFromToken(CurToken,True);
       AddProcOrFunction(Declarations,ParseProcedureOrFunctionDecl(Declarations, pt, MustBeGeneric));
       end;
+    tkAbsolute,
     tkIdentifier:
       begin
       Scanner.UnSetTokenOption(toOperatorToken);
@@ -4204,8 +4231,12 @@ begin
       until CurToken<>tkComma;
     Engine.FinishScope(stTypeDef,T);
   until not (CurToken in [tkSemicolon,tkComma]);
-  if CurToken<>tkGreaterThan then
-    ParseExcExpectedAorB(TokenInfos[tkComma], TokenInfos[tkGreaterThan]);
+  if Not (CurToken in [tkGreaterThan,tkGreaterEqualThan]) then
+    ParseExcExpectedAorB(TokenInfos[tkComma], TokenInfos[tkGreaterThan])
+  else if CurToken=tkGreaterEqualThan then
+    begin
+    ChangeToken(tkGreaterThan);
+    end;
 end;
 {$warn 5043 on}
 
@@ -4557,8 +4588,16 @@ begin
     begin
     Result:=True;
     NextToken;
-    Location:=ReadDottedIdentifier(Parent,AbsoluteExpr,true);
-    UnGetToken;
+    if Curtoken=tkNumber then
+      begin
+      AbsoluteExpr:=CreatePrimitiveExpr(Parent,pekNumber,CurTokenString);
+      Location:=CurTokenString
+      end
+    else
+      begin
+      Location:=ReadDottedIdentifier(Parent,AbsoluteExpr,true);
+      UnGetToken;
+      end
     end
   else
     UngetToken;
@@ -4619,6 +4658,8 @@ begin
     Result := Result + ' ' + CurTokenText;
     LibName:=DoParseExpression(Parent);
     end;
+  if CurToken=tkSemiColon then
+    exit;
   if not CurTokenIsIdentifier('name') then
     ParseExcSyntaxError;
   NextToken;
@@ -5318,13 +5359,17 @@ begin
         begin
         ResultEl.Name := CurTokenName;
         ExpectToken(tkColon);
-        end
-      else
-        if (CurToken=tkColon) then
-          ResultEl.Name := 'Result'
-        else
-          ParseExc(nParserExpectedColonID,SParserExpectedColonID);
         ResultEl.ResultType := ParseType(ResultEl,CurSourcePos);
+        end
+      else if not ((Parent is TPasOperator) and (TPasOperator(Parent).OperatorType=otInitialize)) then
+        // Initialize operator has no result
+        begin
+         if (CurToken=tkColon) then
+            ResultEl.Name := 'Result'
+          else
+            ParseExc(nParserExpectedColonID,SParserExpectedColonID);
+         ResultEl.ResultType := ParseType(ResultEl,CurSourcePos);
+         end;
       end;
   else
     ResultEl:=Nil;
@@ -5381,9 +5426,9 @@ begin
         else
           // remove legacy or basesysv on MorphOS syscalls
           begin
-          if CurTokenIsIdentifier('legacy') or CurTokenIsIdentifier('BaseSysV') then
+          if CurTokenIsIdentifier('legacy') or CurTokenIsIdentifier('consoledevice')
+             or (Curtoken=tkIdentifier) and (Pos('base',LowerCase(CurtokenText))>0) then
             NextToken;
-          NextToken; // remove offset
           end;
       end;
       if IsProcType then
@@ -6816,6 +6861,24 @@ var
     Scanner.UnSetTokenOption(toOperatorToken);
   end;
 
+  Function CheckSection : Boolean;
+
+  begin
+    // Advanced records can have empty sections.
+    { Use Case:
+      Record
+      type
+      const
+      var
+      Case Integer of
+      end;
+    }
+    NextToken;
+    Result:=CurToken in [tkvar,tktype,tkConst,tkCase];
+    if Not Result then
+      UngetToken;
+  end;
+
 Var
   VariantName : String;
   v : TPasMemberVisibility;
@@ -6827,7 +6890,10 @@ Var
   CurEl: TPasElement;
   LastToken: TToken;
   AllowVisibility: Boolean;
+  IsGeneric : Boolean;
+
 begin
+  IsGeneric:=False;
   AllowVisibility:=msAdvancedRecords in CurrentModeswitches;
   if AllowVisibility then
     v:=visPublic
@@ -6844,6 +6910,8 @@ begin
         DisableIsClass;
         if Not AllowMethods then
           ParseExc(nErrRecordTypesNotAllowed,SErrRecordTypesNotAllowed);
+        if CheckSection then
+          continue;
         ExpectToken(tkIdentifier);
         ParseMembersLocalTypes(ARec,v);
         end;
@@ -6852,6 +6920,8 @@ begin
         DisableIsClass;
         if Not AllowMethods then
           ParseExc(nErrRecordConstantsNotAllowed,SErrRecordConstantsNotAllowed);
+        if CheckSection then
+          continue;
         ExpectToken(tkIdentifier);
         ParseMembersLocalConsts(ARec,v);
         end;
@@ -6859,6 +6929,8 @@ begin
         begin
         if Not AllowMethods then
           ParseExc(nErrRecordVariablesNotAllowed,SErrRecordVariablesNotAllowed);
+        if CheckSection then
+          continue;
         ExpectToken(tkIdentifier);
         OldCount:=ARec.Members.Count;
         ParseInlineVarDecl(ARec, ARec.Members, v, AEndToken=tkBraceClose);
@@ -6907,7 +6979,7 @@ begin
         if Not AllowMethods then
           ParseExc(nErrRecordMethodsNotAllowed,SErrRecordMethodsNotAllowed);
         ProcType:=GetProcTypeFromToken(CurToken,LastToken=tkclass);
-        Proc:=ParseProcedureOrFunctionDecl(ARec,ProcType,false,v);
+        Proc:=ParseProcedureOrFunctionDecl(ARec,ProcType,IsGeneric,v);
         if Proc.Parent is TPasOverloadedProc then
           TPasOverloadedProc(Proc.Parent).Overloads.Add(Proc)
         else
@@ -6916,9 +6988,21 @@ begin
         end;
       tkDestructor:
         ParseExc(nParserNoConstructorAllowed,SParserNoConstructorAllowed);
-      tkabsolute,tkGeneric,tkSelf, // Counts as field name
+      tkGeneric, // Can count as field name
+      tkabsolute,
+      tkSelf, // Count as field name
       tkIdentifier :
         begin
+        if (Curtoken=tkGeneric) and AllowVisibility then
+          begin
+          NextToken;
+          if CurToken in [tkClass,tkOperator,tkFunction,tkProcedure] then
+            begin
+            IsGeneric:=True;
+            Continue;
+            end;
+          UnGetToken;
+          end;
         If AllowVisibility and CheckVisibility(CurTokenString,v) then
           begin
           if not (v in [visPrivate,visPublic,visStrictPrivate]) then
@@ -6972,6 +7056,8 @@ begin
       break;
     LastToken:=CurToken;
     NextToken;
+    if not IsClass then
+      IsGeneric:=False;
     end;
 end;
 
@@ -7005,18 +7091,20 @@ begin
   end;
 end;
 
-Function IsVisibility(S : String;  var AVisibility :TPasMemberVisibility) : Boolean;
+Function IsVisibility(S : String;  var AVisibility :TPasMemberVisibility; IsObjCProtocol : Boolean) : Boolean;
 
 Const
   VNames : array[TPasMemberVisibility] of string =
-    ('', 'private', 'protected', 'public', 'published', 'automated', '', '');
+    ('', 'private', 'protected', 'public', 'published', 'automated', '', '','required','optional');
+  VLast : Array[Boolean] of TPasMemberVisibility = (visAutomated,visOptional);
+
 Var
   V : TPasMemberVisibility;
 
 begin
   Result:=False;
   S:=lowerCase(S);
-  For V :=Low(TPasMemberVisibility) to High(TPasMemberVisibility) do
+  For V :=Low(TPasMemberVisibility) to VLast[isObjCProtocol] do
     begin
     Result:=(VNames[V]<>'') and (S=VNames[V]);
     if Result then
@@ -7027,8 +7115,7 @@ begin
     end;
 end;
 
-function TPasParser.CheckVisibility(S: String;
-  var AVisibility: TPasMemberVisibility): Boolean;
+function TPasParser.CheckVisibility(S: String; var AVisibility: TPasMemberVisibility; IsObjCProtocol : Boolean = false): Boolean;
 
 Var
   B : Boolean;
@@ -7041,7 +7128,7 @@ begin
     NextToken;
     s:=LowerCase(CurTokenString);
     end;
-  Result:=isVisibility(S,AVisibility);
+  Result:=isVisibility(S,AVisibility,isObjCProtocol);
   if Result then
     begin
     if (AVisibility=visPublished) and (msOmitRTTI in Scanner.CurrentModeSwitches) then
@@ -7277,7 +7364,7 @@ begin
           CurSection:=stVar;
         end;
     tkIdentifier:
-      if CheckVisibility(CurTokenString,CurVisibility) then
+      if CheckVisibility(CurTokenString,CurVisibility,(AType.ObjKind=okObjcProtocol)) then
         CurSection:=stNone
       else
         begin
@@ -7295,6 +7382,8 @@ begin
           if not (AType.ObjKind in okWithFields) then
             ParseExc(nParserNoFieldsAllowed,SParserNoFieldsAllowedInX,[ObjKindNames[AType.ObjKind]]);
           ParseClassFields(AType,CurVisibility,CurSection=stClassVar);
+          if Curtoken=tkEnd then // case Ta = Class x : String end;
+            UngetToken;
           HaveClass:=False;
           end;
         stClassVar:
@@ -7446,7 +7535,7 @@ begin
       CheckToken(tkend);
     NextToken;
     AType.AncestorType := ParseTypeReference(AType,false,Expr);
-    if AType.ObjKind in [okClass,okObjCClass] then
+    if AType.ObjKind in [okClass,okObjCClass,okObjcProtocol] then
       while CurToken=tkComma do
         begin
         NextToken;
@@ -7482,7 +7571,7 @@ end;
 function TPasParser.DoParseClassExternalHeader(AObjKind: TPasObjKind; out AExternalNameSpace, AExternalName: string): Boolean;
 begin
   Result:=False;
-  if ((aObjKind in [okObjcCategory,okObjcClass]) or
+  if ((aObjKind in [okObjcCategory,okObjcClass,okObjcProtocol]) or
       ((AObjKind in [okClass,okInterface]) and (msExternalClass in CurrentModeswitches)))
       and CurTokenIsIdentifier('external') then
     begin
@@ -7494,7 +7583,7 @@ begin
       AExternalNameSpace:=CurTokenString;
     if (aObjKind in [okObjcCategory,okObjcClass]) then
       begin
-      // Name is optional in objcclass/category
+      // Name is optional in objcclass/category/protocol
       NextToken;
       if CurToken=tkBraceOpen then
         exit;

+ 3 - 4
compiler/packages/fcl-passrc/src/pscanner.pp

@@ -1643,6 +1643,7 @@ begin
   '$':
     begin
     FToken:=tkNumber;
+    inc(FTokenEnd);
     {$ifdef UsePChar}
     while FTokenEnd^ in HexDigits do inc(FTokenEnd);
     {$else}
@@ -3010,8 +3011,6 @@ Procedure TPascalScanner.PopStackItem;
 
 var
   IncludeStackItem: TIncludeStackItem;
-  aFileName : String;
-
 begin
   IncludeStackItem :=
     TIncludeStackItem(FIncludeStack[FIncludeStack.Count - 1]);
@@ -3798,8 +3797,8 @@ begin
     SetMode(msMac,MacModeSwitches,false,bsMacPasMode);
   'ISO':
     SetMode(msIso,ISOModeSwitches,false,[],[],false);
-  'EXTENDED':
-    SetMode(msExtpas,ExtPasModeSwitches,false,[],[],false);
+  'EXTENDEDPASCAL':
+    SetMode(msExtpas,ExtPasModeSwitches,false);
   'GPC':
     SetMode(msGPC,GPCModeSwitches,false);
   else

+ 70 - 3
compiler/packages/fcl-passrc/tests/tcclasstype.pas

@@ -33,7 +33,7 @@ type
     Procedure StartClass (AncestorName : String = 'TObject'; InterfaceList : String = ''; aClassType : TClassDeclType = cdtClass);
     Procedure StartExternalClass (AParent : String; AExternalName,AExternalNameSpace : String );
     Procedure StartClassHelper (ForType : String = 'TOriginal'; AParent : String = 'TObject');
-    Procedure StartInterface (AParent : String = 'IInterface'; UUID : String = ''; Disp : Boolean = False; UseObjcClass : Boolean = False);
+    Procedure StartInterface (AParent : String = 'IInterface'; UUID : String = ''; Disp : Boolean = False; UseObjcClass : Boolean = False; UseExternal : Boolean = False);
     Procedure StartRecordHelper (ForType : String = 'TOriginal'; AParent : String = 'TObject');
     Procedure StartVisibility(A : TPasMemberVisibility);
     Procedure EndClass(AEnd : String = 'end');
@@ -105,6 +105,7 @@ type
     Procedure TestMethodWithDotFails;
     Procedure TestMethodWithDotOK;
     Procedure TestMethodFunctionWithDotOK;
+    Procedure TestNoSemicolon;
     Procedure TestClassMethodSimple;
     Procedure TestClassMethodSimpleComment;
     Procedure TestConstructor;
@@ -170,6 +171,10 @@ type
     procedure TestClassHelperOneMethod;
     procedure TestInterfaceEmpty;
     procedure TestObjcProtocolEmpty;
+    procedure TestObjcProtocolEmptyExternal;
+    procedure TestObjcProtocolMultiParent;
+    procedure TestObjcProtocolOptional;
+    procedure TestObjcProtocolRequired;
     procedure TestInterfaceDisp;
     procedure TestInterfaceParentedEmpty;
     procedure TestInterfaceOneMethod;
@@ -320,7 +325,7 @@ begin
 end;
 
 procedure TTestClassType.StartInterface(AParent: String; UUID: String;
-  Disp: Boolean = False; UseObjcClass : Boolean = False);
+  Disp: Boolean = False; UseObjcClass : Boolean = False; UseExternal : Boolean = False);
 Var
   S : String;
 begin
@@ -328,7 +333,9 @@ begin
   if UseObjCClass then
     begin
     FDecl.Add('{$modeswitch objectivec1}');
-    S:='TMyClass = objcprotocol'
+    S:='TMyClass = objcprotocol';
+    if UseExternal then
+      S:=S+' external name ''abc'' ';
     end
   else if Disp then
     S:='TMyClass = DispInterface'
@@ -971,6 +978,13 @@ begin
   AssertNotNull('1 method resolution procedure',TPasMethodResolution(members[0]).ImplementationProc);
 end;
 
+procedure TTestClassType.TestNoSemicolon;
+begin
+  StartClass;
+  fDecl.Add('Y : String');
+  ParseClass;
+end;
+
 procedure TTestClassType.TestClassMethodSimple;
 
 begin
@@ -1929,6 +1943,59 @@ begin
   AssertNull('No UUID',TheClass.GUIDExpr);
 end;
 
+procedure TTestClassType.TestObjcProtocolEmptyExternal;
+begin
+  StartInterface('','',False,True,true);
+  EndClass();
+  ParseClass;
+  AssertEquals('Is interface',okObjcProtocol,TheClass.ObjKind);
+  AssertTrue('Is objectivec',TheClass.IsObjCClass);
+  AssertEquals('No members',0,TheClass.Members.Count);
+  AssertNull('No UUID',TheClass.GUIDExpr);
+end;
+
+procedure TTestClassType.TestObjcProtocolMultiParent;
+begin
+  StartInterface('A, B','',False,True,true);
+  FParent:='A';
+  EndClass();
+  ParseClass;
+  AssertEquals('Is interface',okObjcProtocol,TheClass.ObjKind);
+  AssertTrue('Is objectivec',TheClass.IsObjCClass);
+  AssertEquals('No members',0,TheClass.Members.Count);
+  AssertNull('No UUID',TheClass.GUIDExpr);
+  AssertEquals('Have 1 interface',1,TheClass.Interfaces.Count);
+  AssertNotNull('Correct class',TheClass.Interfaces[0]);
+  AssertEquals('Correct class',TPasUnresolvedTypeRef,TObject(TheClass.Interfaces[0]).ClassType);
+  AssertEquals('Interface name','B',TPasUnresolvedTypeRef(TheClass.Interfaces[0]).Name);
+end;
+
+procedure TTestClassType.TestObjcProtocolOptional;
+begin
+  StartInterface('','',False,True);
+  FDecl.Add('    optional');
+  AddMember('Procedure DoSomething(A : Integer)');
+  EndClass();
+  ParseClass;
+  AssertEquals('Is interface',okObjcProtocol,TheClass.ObjKind);
+  AssertTrue('Is objectivec',TheClass.IsObjCClass);
+  AssertEquals('No members',1,TheClass.Members.Count);
+  AssertNull('No UUID',TheClass.GUIDExpr);
+end;
+
+procedure TTestClassType.TestObjcProtocolRequired;
+begin
+  StartInterface('','',False,True);
+  FDecl.Add('    required');
+  AddMember('Procedure DoSomething(A : Integer)');
+  EndClass();
+  ParseClass;
+  AssertEquals('Is interface',okObjcProtocol,TheClass.ObjKind);
+  AssertTrue('Is objectivec',TheClass.IsObjCClass);
+  AssertEquals('No members',1,TheClass.Members.Count);
+  AssertNull('No UUID',TheClass.GUIDExpr);
+end;
+
 procedure TTestClassType.TestInterfaceDisp;
 
 begin

+ 25 - 0
compiler/packages/fcl-passrc/tests/tcgenerics.pp

@@ -21,6 +21,7 @@ Type
     Procedure TestProcTypeGenerics;
     Procedure TestDeclarationDelphi;
     Procedure TestDeclarationFPC;
+    Procedure TestDeclarationFPCNoSpaces;
     Procedure TestMethodImplementation;
 
     // generic constraints
@@ -108,6 +109,9 @@ begin
   Source.Add('  TSomeClass<T,T2> = Class(TObject)');
   Source.Add('    b : T;');
   Source.Add('    b2 : T2;');
+  Source.Add('    FItems: ^TArray<T>;');
+  Source.Add('  type');
+  Source.Add('    TDictionaryEnumerator = TDictionary<T, TEmptyRecord>.TKeyEnumerator;');
   Source.Add('  end;');
   ParseDeclarations;
   AssertNotNull('have generic definition',Declarations.Classes);
@@ -141,6 +145,27 @@ begin
   AssertSame('Parent 1 is class',T,TPasElement(T.GenericTemplateTypes[1]).Parent);
 end;
 
+procedure TTestGenerics.TestDeclarationFPCNoSpaces;
+Var
+  T : TPasClassType;
+begin
+  Scanner.CurrentModeSwitches:=[msDelphi]+Scanner.CurrentModeSwitches;
+  Source.Add('Type');
+  Source.Add('  TSomeClass<T;T2>=Class(TObject)');
+  Source.Add('    b : T;');
+  Source.Add('    b2 : T2;');
+  Source.Add('  end;');
+  ParseDeclarations;
+  AssertNotNull('have generic definition',Declarations.Classes);
+  AssertEquals('have generic definition',1,Declarations.Classes.Count);
+  AssertEquals('Pascal class',TPasClassType,TObject(Declarations.Classes[0]).ClassType);
+  T:=TPasClassType(Declarations.Classes[0]);
+  AssertNotNull('have generic templates',T.GenericTemplateTypes);
+  AssertEquals('2 template types',2,T.GenericTemplateTypes.Count);
+  AssertSame('Parent 0 is class',T,TPasElement(T.GenericTemplateTypes[0]).Parent);
+  AssertSame('Parent 1 is class',T,TPasElement(T.GenericTemplateTypes[1]).Parent);
+end;
+
 procedure TTestGenerics.TestMethodImplementation;
 begin
   With source do

+ 14 - 0
compiler/packages/fcl-passrc/tests/tconstparser.pas

@@ -43,6 +43,7 @@ Type
     Procedure TestSimpleIdentifierConst;
     Procedure TestSimpleSetConst;
     Procedure TestSimpleExprConst;
+    Procedure TestSimpleAbsoluteConst;
     Procedure TestSimpleIntConstDeprecatedMsg;
     Procedure TestSimpleIntConstDeprecated;
     Procedure TestSimpleFloatConstDeprecated;
@@ -255,6 +256,19 @@ begin
   DoTestSimpleExprConst;
 end;
 
+procedure TTestConstParser.TestSimpleAbsoluteConst;
+
+// Found in xi.pp
+
+begin
+  Add('Const');
+  Add('  Absolute = 1;');
+  ParseDeclarations;
+  AssertEquals('One constant definition',1,Declarations.Consts.Count);
+  AssertEquals('First declaration is constant definition.',TPasConst,TObject(Declarations.Consts[0]).ClassType);
+
+end;
+
 procedure TTestConstParser.TestSimpleIntConstDeprecatedMsg;
 begin
   Hint:='deprecated ''this is old''' ;

+ 75 - 33
compiler/packages/fcl-passrc/tests/tcprocfunc.pas

@@ -122,6 +122,10 @@ type
     procedure TestCallingConventionSysV_ABI_CDec;
     procedure TestCallingConventionSysV_ABI_Default;
     procedure TestCallingConventionVectorCall;
+    procedure TestCallingConventionSysCall;
+    procedure TestCallingConventionSysCallExecbase;
+    procedure TestCallingConventionSysCallUtilitybase;
+    procedure TestCallingConventionSysCallConsoleDevice;
     Procedure TestProcedurePublic;
     Procedure TestProcedurePublicIdent;
     Procedure TestFunctionPublic;
@@ -174,6 +178,7 @@ type
     Procedure TestProcedureCdeclExternalName;
     Procedure TestFunctionCdeclExternalName;
     Procedure TestFunctionAlias;
+    Procedure TestOperatorNamedResult;
     Procedure TestOperatorTokens;
     procedure TestOperatorNames;
     Procedure TestAssignOperatorAfterObject;
@@ -812,6 +817,30 @@ begin
   AssertProc([],[],ccVectorCall,0);
 end;
 
+procedure TTestProcedureFunction.TestCallingConventionSysCall;
+begin
+  ParseProcedure('; syscall abc');
+  AssertProc([],[],ccSysCall,0);
+end;
+
+procedure TTestProcedureFunction.TestCallingConventionSysCallExecbase;
+begin
+  ParseProcedure('; syscall _execBase 123');
+  AssertProc([],[],ccSysCall,0);
+end;
+
+procedure TTestProcedureFunction.TestCallingConventionSysCallUtilitybase;
+begin
+  ParseProcedure('; syscall _utilityBase 123');
+  AssertProc([],[],ccSysCall,0);
+end;
+
+procedure TTestProcedureFunction.TestCallingConventionSysCallConsoleDevice;
+begin
+  ParseProcedure('; syscall ConsoleDevice 123');
+  AssertProc([],[],ccSysCall,0);
+end;
+
 procedure TTestProcedureFunction.TestCallingConventionHardFloat;
 begin
   ParseProcedure('; HardFloat');
@@ -1005,14 +1034,14 @@ procedure TTestProcedureFunction.TestProcedureFar;
 begin
   AddDeclaration('procedure A; far;');
   ParseProcedure;
-  AssertProc([pmfar],[],ccDefault,0);
+  AssertProc([pmfar],[ptmfar],ccDefault,0);
 end;
 
 procedure TTestProcedureFunction.TestFunctionFar;
 begin
   AddDeclaration('function A : integer; far;');
   ParseFunction;
-  AssertFunc([pmfar],[],ccDefault,0);
+  AssertFunc([pmfar],[ptmfar],ccDefault,0);
 end;
 
 procedure TTestProcedureFunction.TestProcedureCdeclForward;
@@ -1284,6 +1313,13 @@ begin
   AssertEquals('Alias name','''myalias''',Func.AliasName);
 end;
 
+procedure TTestProcedureFunction.TestOperatorNamedResult;
+begin
+  AddDeclaration('operator = (a,b : T) z : Integer;');
+  ParseOperator;
+  AssertEquals('Correct operator type',otEqual,FOperator.OperatorType);
+end;
+
 procedure TTestProcedureFunction.TestProcedureAlias;
 begin
   AddDeclaration('Procedure A; Alias : ''myalias''');
@@ -1300,23 +1336,25 @@ Var
 
 begin
   For t:=otMul to High(TOperatorType) do
+    begin
+    if OperatorTokens[t]='' then continue;
     // No way to distinguish between logical/bitwise or/and/Xor
-    if not (t in [otBitwiseOr,otBitwiseAnd,otBitwiseXor]) then
-      begin
-      S:=GetEnumName(TypeInfo(TOperatorType),Ord(T));
-      ResetParser;
-      if t in UnaryOperators then
-        AddDeclaration(Format('operator %s (a: Integer) : te',[OperatorTokens[t]]))
-      else
-        AddDeclaration(Format('operator %s (a: Integer; b: integer) : te',[OperatorTokens[t]]));
-      ParseOperator;
-      AssertEquals(S+': Token based ',Not (T in [otInc,otDec,otEnumerator]),FOperator.TokenBased);
-      AssertEquals(S+': Correct operator type',T,FOperator.OperatorType);
-      if t in UnaryOperators then
-        AssertEquals(S+': Correct operator name',format('%s(Integer):te',[OperatorNames[t]]),FOperator.Name)
-      else
-        AssertEquals(S+': Correct operator name',format('%s(Integer,Integer):te',[OperatorNames[t]]),FOperator.Name);
-      end;
+    if t in [otBitWiseOr,otBitwiseAnd,otbitwiseXor] then continue;
+
+    S:=GetEnumName(TypeInfo(TOperatorType),Ord(T));
+    ResetParser;
+    if t in UnaryOperators then
+      AddDeclaration(Format('operator %s (a: Integer) : te',[OperatorTokens[t]]))
+    else
+      AddDeclaration(Format('operator %s (a: Integer; b: integer) : te',[OperatorTokens[t]]));
+    ParseOperator;
+    AssertEquals(S+': Token based ',Not (T in [otInc,otDec,otEnumerator]),FOperator.TokenBased);
+    AssertEquals(S+': Correct operator type',T,FOperator.OperatorType);
+    if t in UnaryOperators then
+      AssertEquals(S+': Correct operator name',format('%s(Integer):te',[OperatorNames[t]]),FOperator.Name)
+    else
+      AssertEquals(S+': Correct operator name',format('%s(Integer,Integer):te',[OperatorNames[t]]),FOperator.Name);
+    end;
 end;
 
 procedure TTestProcedureFunction.TestOperatorNames;
@@ -1327,21 +1365,25 @@ Var
 
 begin
   For t:=Succ(otUnknown) to High(TOperatorType) do
-      begin
-      S:=GetEnumName(TypeInfo(TOperatorType),Ord(T));
-      ResetParser;
-      if t in UnaryOperators then
-        AddDeclaration(Format('operator %s (a: Integer) : te',[OperatorNames[t]]))
-      else
-        AddDeclaration(Format('operator %s (a: Integer; b: integer) : te',[OperatorNames[t]]));
-      ParseOperator;
-      AssertEquals(S+': Token based',t in [otIn],FOperator.TokenBased);
-      AssertEquals(S+': Correct operator type',T,FOperator.OperatorType);
-      if t in UnaryOperators then
-        AssertEquals('Correct operator name',format('%s(Integer):te',[OperatorNames[t]]),FOperator.Name)
-      else
-        AssertEquals('Correct operator name',format('%s(Integer,Integer):te',[OperatorNames[t]]),FOperator.Name);
-      end;
+    begin
+    if OperatorNames[t]='' then continue;
+    // otInitialize has no result
+    if t=otInitialize then continue;
+    writeln('TTestProcedureFunction.TestOperatorTokens ',t);
+    S:=GetEnumName(TypeInfo(TOperatorType),Ord(T));
+    ResetParser;
+    if t in UnaryOperators then
+      AddDeclaration(Format('operator %s (a: Integer) : te',[OperatorNames[t]]))
+    else
+      AddDeclaration(Format('operator %s (a: Integer; b: integer) : te',[OperatorNames[t]]));
+    ParseOperator;
+    AssertEquals(S+': Token based',t in [otIn],FOperator.TokenBased);
+    AssertEquals(S+': Correct operator type',T,FOperator.OperatorType);
+    if t in UnaryOperators then
+      AssertEquals('Correct operator name',format('%s(Integer):te',[OperatorNames[t]]),FOperator.Name)
+    else
+      AssertEquals('Correct operator name',format('%s(Integer,Integer):te',[OperatorNames[t]]),FOperator.Name);
+    end;
 end;
 
 procedure TTestProcedureFunction.TestAssignOperatorAfterObject;

+ 93 - 0
compiler/packages/fcl-passrc/tests/tctypeparser.pas

@@ -50,6 +50,7 @@ type
     Procedure DoTestClassOf(Const AHint : string);
   Published
     Procedure TestAliasType;
+    procedure TestAbsoluteAliasType;
     Procedure TestCrossUnitAliasType;
     Procedure TestAliasTypeDeprecated;
     Procedure TestAliasTypePlatform;
@@ -168,6 +169,7 @@ type
     Procedure TestTypeHelperWithParent;
     procedure TestPointerReference;
     Procedure TestPointerKeyWord;
+    Procedure TestPointerFile;
   end;
 
   { TTestRecordTypeParser }
@@ -361,9 +363,13 @@ type
     Procedure TestAdvRec_ProcOverrideFail;
     Procedure TestAdvRec_ProcMessageFail;
     Procedure TestAdvRec_DestructorFail;
+    Procedure TestAdvRec_CaseInVar;
+    Procedure TestAdvRec_EmptySections;
     Procedure TestAdvRecordInFunction;
     Procedure TestAdvRecordInAnonFunction;
     Procedure TestAdvRecordClassOperator;
+    Procedure TestAdvRecordInitOperator;
+    Procedure TestAdvRecordGenericFunction;
   end;
 
   { TTestProcedureTypeParser }
@@ -2610,6 +2616,29 @@ begin
   ParseRecordFail(SParserNoConstructorAllowed,nParserNoConstructorAllowed);
 end;
 
+procedure TTestRecordTypeParser.TestAdvRec_CaseInVar;
+
+// Found in System.UITypes.pas
+
+begin
+  StartRecord(true);
+  AddMember('var');
+  AddMember('Case Integer of');
+  AddMember('  1 : (x: integer);');
+  AddMember('  2 : (y,z: integer)');
+  ParseRecord;
+end;
+
+procedure TTestRecordTypeParser.TestAdvRec_EmptySections;
+begin
+  StartRecord(true);
+  AddMember('const');
+  AddMember('type');
+  AddMember('var');
+  AddMember('  x: integer;');
+  ParseRecord;
+end;
+
 procedure TTestRecordTypeParser.TestAdvRecordInFunction;
 
 // Src from bug report 36179
@@ -2688,6 +2717,51 @@ begin
   ParseModule;   // We're just interested in that it parses.
 end;
 
+procedure TTestRecordTypeParser.TestAdvRecordInitOperator;
+// Source from bug id 36180
+
+Const
+   SRC =
+    '{$mode objfpc}'+sLineBreak+
+    '{$modeswitch advancedrecords}'+sLineBreak+
+    'program afile;'+sLineBreak+
+    'type'+sLineBreak+
+    '  TMyRecord = record'+sLineBreak+
+    '    class operator initialize (var self: TMyRecord);'+sLineBreak+
+    '  end;'+sLineBreak+
+    'class operator TMyRecord.initialize (a, b: TMyRecord);'+sLineBreak+
+    'begin'+sLineBreak+
+    '  result := (@a = @b);'+sLineBreak+
+    'end;'+sLineBreak+
+    'begin'+sLineBreak+
+    'end.';
+
+begin
+  Source.Text:=Src;
+  ParseModule;   // We're just interested in that it parses.
+end;
+
+procedure TTestRecordTypeParser.TestAdvRecordGenericFunction;
+
+Const
+   SRC =
+    '{$mode objfpc}'+sLineBreak+
+    '{$modeswitch advancedrecords}'+sLineBreak+
+    'program afile;'+sLineBreak+
+    'type'+sLineBreak+
+    '  TMyRecord = record'+sLineBreak+
+    '    generic class procedure doit<T> (a: T);'+sLineBreak+
+    '  end;'+sLineBreak+
+    'generic class procedure TMyRecord.DoIt<T>(a: T);'+sLineBreak+
+    'begin'+sLineBreak+
+    'end;'+sLineBreak+
+    'begin'+sLineBreak+
+    'end.';
+begin
+  Source.Text:=Src;
+  ParseModule;   // We're just interested in that it parses.
+end;
+
 { TBaseTestTypeParser }
 
 Function TBaseTestTypeParser.ParseType(ASource: String; ATypeClass: TClass;
@@ -2893,11 +2967,21 @@ begin
 end;
 
 procedure TTestTypeParser.TestAliasType;
+
 begin
   DoTestAliasType('othertype','');
   AssertEquals('Unresolved type name ','othertype',TPasUnresolvedTypeRef(TPasAliasType(TheType).DestType).name);
 end;
 
+procedure TTestTypeParser.TestAbsoluteAliasType;
+begin
+  Add('Type');
+  Add('  Absolute = Integer;');
+  ParseDeclarations;
+  AssertEquals('First declaration is type definition.',TPasAliasType,TPasElement(Declarations.Types[0]).ClassType);
+  AssertEquals('First declaration has correct name.','Absolute',TPasElement(Declarations.Types[0]).Name);
+end;
+
 procedure TTestTypeParser.TestCrossUnitAliasType;
 begin
   DoTestAliasType('otherunit.othertype','');
@@ -3674,6 +3758,15 @@ begin
   AssertEquals('object definition count',1,Declarations.Classes.Count);
 end;
 
+procedure TTestTypeParser.TestPointerFile;
+begin
+  Add('type');
+  Add('  pfile = ^file;');
+  ParseDeclarations;
+  AssertEquals('object definition count',1,Declarations.Types.Count);
+end;
+
+
 
 initialization
   RegisterTests([TTestTypeParser,TTestRecordTypeParser,TTestProcedureTypeParser]);

+ 36 - 0
compiler/packages/fcl-passrc/tests/tcvarparser.pas

@@ -26,6 +26,7 @@ Type
     Procedure TearDown; override;
   Published
     Procedure TestSimpleVar;
+    Procedure TestSimpleVarAbsoluteName;
     Procedure TestSimpleVarHelperName;
     procedure TestSimpleVarHelperType;
     Procedure TestSimpleVarDeprecated;
@@ -34,6 +35,7 @@ Type
     procedure TestSimpleVarInitializedDeprecated;
     procedure TestSimpleVarInitializedPlatform;
     Procedure TestSimpleVarAbsolute;
+    Procedure TestSimpleVarAbsoluteAddress;
     Procedure TestSimpleVarAbsoluteDot;
     Procedure TestSimpleVarAbsolute2Dots;
     Procedure TestVarProcedure;
@@ -51,6 +53,7 @@ Type
     Procedure TestVarExternalLib;
     Procedure TestVarExternalLibName;
     procedure TestVarExternalNoSemiColon;
+    procedure TestVarExternalLibNoName;
     Procedure TestVarCVar;
     Procedure TestVarCVarExternal;
     Procedure TestVarPublic;
@@ -129,6 +132,21 @@ begin
   AssertVariableType('b');
 end;
 
+procedure TTestVarParser.TestSimpleVarAbsoluteName;
+Var
+  R : TPasVariable;
+
+begin
+  Add('Var');
+  Add('  Absolute : integer;');
+//  Writeln(source.text);
+  ParseDeclarations;
+  AssertEquals('One variable definition',1,Declarations.Variables.Count);
+  AssertEquals('First declaration is type definition.',TPasVariable,TObject(Declarations.Variables[0]).ClassType);
+  R:=TPasVariable(Declarations.Variables[0]);
+  AssertEquals('First declaration has correct name.','Absolute',R.Name);
+end;
+
 procedure TTestVarParser.TestSimpleVarHelperName;
 
 Var
@@ -194,6 +212,13 @@ begin
   AssertExpression('correct absolute location',TheVar.AbsoluteExpr,pekIdent,'v');
 end;
 
+procedure TTestVarParser.TestSimpleVarAbsoluteAddress;
+begin
+  ParseVar('q absolute $123','');
+  AssertVariableType('q');
+  AssertExpression('correct absolute location',TheVar.AbsoluteExpr,pekNumber,'$123');
+end;
+
 procedure TTestVarParser.TestSimpleVarAbsoluteDot;
 var
   B: TBinaryExpr;
@@ -339,6 +364,17 @@ begin
   AssertNotNull('Library symbol',TheVar.ExportName);
 end;
 
+
+procedure TTestVarParser.TestVarExternalLibNoName;
+begin
+  // Found in e.g.apache headers
+  ParseVar('integer; external ''mylib''','');
+  AssertEquals('Variable modifiers',[vmexternal],TheVar.VarModifiers);
+  AssertNotNull('Library name',TheVar.LibraryName);
+
+end;
+
+
 procedure TTestVarParser.TestVarExternalLibName;
 begin
   ParseVar('integer; external ''mylib'' name ''de''','');

+ 8 - 2
compiler/packages/fcl-passrc/tests/testpassrc.lpi

@@ -4,7 +4,9 @@
     <Version Value="12"/>
     <General>
       <Flags>
-        <SaveOnlyProjectUnits Value="True"/>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
         <SaveJumpHistory Value="False"/>
         <SaveFoldState Value="False"/>
         <CompatibilityMode Value="True"/>
@@ -40,7 +42,7 @@
         <PackageName Value="FCL"/>
       </Item1>
     </RequiredPackages>
-    <Units Count="15">
+    <Units Count="16">
       <Unit0>
         <Filename Value="testpassrc.lpr"/>
         <IsPartOfProject Value="True"/>
@@ -101,6 +103,10 @@
         <Filename Value="tcuseanalyzer.pas"/>
         <IsPartOfProject Value="True"/>
       </Unit14>
+      <Unit15>
+        <Filename Value="tcresolvegenerics.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit15>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

+ 34 - 23
compiler/packages/pastojs/src/fppas2js.pp

@@ -4575,19 +4575,24 @@ var
   ClassScope: TPas2JSClassScope;
   ptm: TProcTypeModifier;
   TypeEl, ElTypeEl, HelperForType: TPasType;
+  FuncType: TPasFunctionType;
 begin
   inherited FinishProcedureType(El);
 
   if El is TPasFunctionType then
     begin
-    TypeEl:=ResolveAliasType(TPasFunctionType(El).ResultEl.ResultType);
-    if TypeEl.ClassType=TPasPointerType then
+    FuncType:=TPasFunctionType(El);
+    if FuncType.ResultEl<>nil then
       begin
-      ElTypeEl:=ResolveAliasType(TPasPointerType(TypeEl).DestType);
-      if ElTypeEl.ClassType=TPasRecordType then
-        // ^record
-      else
-        RaiseMsg(20180423110824,nNotSupportedX,sNotSupportedX,['pointer'],El);
+      TypeEl:=ResolveAliasType(FuncType.ResultEl.ResultType);
+      if TypeEl.ClassType=TPasPointerType then
+        begin
+        ElTypeEl:=ResolveAliasType(TPasPointerType(TypeEl).DestType);
+        if ElTypeEl.ClassType=TPasRecordType then
+          // ^record
+        else
+          RaiseMsg(20180423110824,nNotSupportedX,sNotSupportedX,['pointer'],El);
+        end;
       end;
     end;
 
@@ -6278,10 +6283,12 @@ begin
     AddBaseType(Pas2JSBuiltInNames[pbitnUIntDouble],btUIntDouble);
   if btIntDouble in TheBaseTypes then
     AddBaseType(Pas2JSBuiltInNames[pbitnIntDouble],btIntDouble);
-  FJSBuiltInProcs[pbpDebugger]:=AddBuiltInProc('Debugger','procedure Debugger',
+  FJSBuiltInProcs[pbpDebugger]:=AddBuiltInProc(Pas2jsBuiltInProcNames[pbpDebugger],
+      'procedure Debugger',
       @BI_Debugger_OnGetCallCompatibility,nil,
       nil,nil,bfCustom,[bipfCanBeStatement]);
-  FJSBuiltInProcs[pbpAWait]:=AddBuiltInProc('AWait','function await(const Expr: T): T',
+  FJSBuiltInProcs[pbpAWait]:=AddBuiltInProc(Pas2jsBuiltInProcNames[pbpAWait],
+      'function await(const Expr: T): T',
       @BI_AWait_OnGetCallCompatibility,@BI_AWait_OnGetCallResult,
       @BI_AWait_OnEval,@BI_AWait_OnFinishParamsExpr,bfCustom,[bipfCanBeStatement]);
 end;
@@ -6485,6 +6492,7 @@ end;
 function TPas2JSResolver.FindLocalBuiltInSymbol(El: TPasElement): TPasElement;
 var
   Data: TObject;
+  pbp: TPas2jsBuiltInProc;
 begin
   Result:=inherited FindLocalBuiltInSymbol(El);
   if Result<>nil then exit;
@@ -6493,10 +6501,9 @@ begin
     Result:=JSBaseTypes[TResElDataPas2JSBaseType(Data).JSBaseType]
   else if (Data.ClassType=TResElDataBuiltInProc)
       and (TResElDataBuiltInProc(Data).BuiltIn=bfCustom) then
-    case El.Name of
-    'Debugger': Result:=FJSBuiltInProcs[pbpDebugger].Element;
-    'AWait': Result:=FJSBuiltInProcs[pbpAWait].Element;
-    end;
+    for pbp in TPas2jsBuiltInProc do
+      if El.Name=Pas2jsBuiltInProcNames[pbp] then
+        Result:=FJSBuiltInProcs[pbp].Element;
 end;
 
 function TPas2JSResolver.ExtractPasStringLiteral(El: TPasElement;
@@ -12451,9 +12458,9 @@ begin
         end;
       end;
     end
-  else if to_bt=btChar then
+  else if to_bt in [btChar,btWideChar] then
     begin
-    if from_bt=btChar then
+    if from_bt in [btChar,btWideChar] then
       begin
       // char to char
       Result:=ConvertExpression(Param,AContext);
@@ -13214,7 +13221,7 @@ begin
   bt:=ParamResolved.BaseType;
   if bt=btRange then
     bt:=ParamResolved.SubType;
-  if bt=btChar then
+  if bt in [btChar,btWideChar] then
     begin
     if Param is TParamsExpr then
       begin
@@ -15023,22 +15030,26 @@ Var
     Proc: TPasProcedure;
     FunType: TPasFunctionType;
     VarSt: TJSVariableStatement;
-    SrcEl: TPasElement;
-    Scope: TPas2JSProcedureScope;
+    ImplScope: TPas2JSProcedureScope;
   begin
     Proc:=El.Parent as TPasProcedure;
     FunType:=Proc.ProcType as TPasFunctionType;
     ResultEl:=FunType.ResultEl;
-    Scope:=Proc.CustomData as TPas2JSProcedureScope;
-    if Scope.ResultVarName<>'' then
-      ResultVarName:=Scope.ResultVarName
+    ImplScope:=Proc.CustomData as TPas2JSProcedureScope;
+    if (ResultEl=nil) or (ResultEl.ResultType=nil) then
+      begin
+      Proc:=ImplScope.DeclarationProc;
+      FunType:=Proc.ProcType as TPasFunctionType;
+      ResultEl:=FunType.ResultEl;
+      end;
+    if ImplScope.ResultVarName<>'' then
+      ResultVarName:=ImplScope.ResultVarName
     else
       ResultVarName:=ResolverResultVar;
 
     // add 'var result=initvalue'
-    SrcEl:=ResultEl;
     VarSt:=CreateVarStatement(ResultVarName,
-      CreateValInit(ResultEl.ResultType,nil,SrcEl,aContext),ResultEl);
+      CreateValInit(ResultEl.ResultType,nil,ResultEl,aContext),ResultEl);
     Add(VarSt,ResultEl);
     Result:=SLFirst;
   end;

+ 3 - 3
compiler/packages/pastojs/src/pas2jscompiler.pp

@@ -44,9 +44,9 @@ uses
 
 const
   VersionMajor = 2;
-  VersionMinor = 0;
-  VersionRelease = 0;
-  VersionExtra = 'RC5';
+  VersionMinor = 1;
+  VersionRelease = 1;
+  VersionExtra = '';
   DefaultConfigFile = 'pas2js.cfg';
 
 //------------------------------------------------------------------------------

+ 39 - 12
compiler/packages/pastojs/src/pas2jsfilecache.pp

@@ -259,7 +259,7 @@ type
     function FindUnitJSFileName(const aUnitFilename: string): String; override;
     function FindUnitFileName(const aUnitname, InFilename, ModuleDir: string; out IsForeign: boolean): String; override;
     function FindResourceFileName(const aFilename, ModuleDir: string): String; override;
-    function FindIncludeFileName(const aFilename, ModuleDir: string): String; override;
+    function FindIncludeFileName(const aFilename, SrcDir, ModuleDir: string; Mode: TModeSwitch): String; override;
     function AddIncludePaths(const Paths: string; FromCmdLine: boolean; out ErrorMsg: string): boolean;
     function AddUnitPaths(const Paths: string; FromCmdLine: boolean; out ErrorMsg: string): boolean;
     function AddSrcUnitPaths(const Paths: string; FromCmdLine: boolean; out ErrorMsg: string): boolean;
@@ -1832,25 +1832,52 @@ begin
     UsePointDirectory, AlwaysRequireSharedBaseFolder, RelPath);
 end;
 
-function TPas2jsFilesCache.FindIncludeFileName(const aFilename,
-  ModuleDir: string): String;
+function TPas2jsFilesCache.FindIncludeFileName(const aFilename, SrcDir,
+  ModuleDir: string; Mode: TModeSwitch): String;
 
   function SearchCasedInIncPath(const Filename: string): string;
+  var
+    SearchedDir: array of string;
+
+    function SearchDir(Dir: string): boolean;
+    var
+      i: Integer;
+      CurFile: String;
+    begin
+      Dir:=IncludeTrailingPathDelimiter(Dir);
+      for i:=0 to length(SearchedDir)-1 do
+        if SearchedDir[i]=Dir then exit;
+      CurFile:=Dir+Filename;
+      //writeln('SearchDir aFilename=',aFilename,' SrcDir=',SrcDir,' ModDir=',ModuleDir,' Mode=',Mode,' CurFile=',CurFile);
+      Result:=SearchLowUpCase(CurFile);
+      if Result then
+        SearchCasedInIncPath:=CurFile
+      else begin
+        i:=length(SearchedDir);
+        SetLength(SearchedDir,i+1);
+        SearchedDir[i]:=Dir;
+      end;
+    end;
+
   var
     i: Integer;
   begin
     // file name is relative
-    // first search in the same directory as the unit
+    SearchedDir:=nil;
+
+    // first search in the same directory as the include file
+    if not (Mode in [msDelphi,msDelphiUnicode])
+        and (SrcDir<>'') then
+      if SearchDir(SrcDir) then exit;
+
+    // then search in the same directory as the unit
     if ModuleDir<>'' then
-      begin
-      Result:=IncludeTrailingPathDelimiter(ModuleDir)+Filename;
-      if SearchLowUpCase(Result) then exit;
-      end;
+      if SearchDir(ModuleDir) then exit;
+
     // then search in include path
-    for i:=0 to IncludePaths.Count-1 do begin
-      Result:=IncludeTrailingPathDelimiter(IncludePaths[i])+Filename;
-      if SearchLowUpCase(Result) then exit;
-    end;
+    for i:=0 to IncludePaths.Count-1 do
+      if SearchDir(IncludePaths[i]) then exit;
+
     Result:='';
   end;
 

+ 40 - 7
compiler/packages/pastojs/src/pas2jsfiler.pp

@@ -1005,6 +1005,7 @@ type
     FElementRefsArray: TPCUFilerElementRefArray; // TPCUFilerElementRef by Id
     FJSON: TJSONObject;
     FPendingIdentifierScopes: TObjectList; // list of TPCUReaderPendingIdentifierScope
+    FPendingForwardProcs: TFPList; // list of TPasElement waiting for implementation of methods
     procedure Set_Variable_VarType(RefEl: TPasElement; Data: TObject);
     procedure Set_AliasType_DestType(RefEl: TPasElement; Data: TObject);
     procedure Set_PointerType_DestType(RefEl: TPasElement; Data: TObject);
@@ -6217,6 +6218,7 @@ var
   BuiltInProc: TResElDataBuiltInProc;
   bp: TResolverBuiltInProc;
   pbt: TPas2jsBaseType;
+  pbp: TPas2jsBuiltInProc;
 begin
   if not ReadArray(Obj,BuiltInNodeName,Arr,ErrorEl) then exit;
   for i:=0 to Arr.Count-1 do
@@ -6275,6 +6277,21 @@ begin
           end;
         end;
       end;
+    if not Found then
+      begin
+      for pbp in TPas2jsBuiltInProc do
+        begin
+        BuiltInProc:=Resolver.JSBuiltInProcs[pbp];
+        if BuiltInProc=nil then continue;
+        El:=BuiltInProc.Element;
+        if (CompareText(El.Name,aName)=0) then
+          begin
+          Found:=true;
+          AddElReference(Id,ErrorEl,El);
+          break;
+          end;
+        end;
+      end;
     if not Found then
       RaiseMsg(20180216231551,ErrorEl,aName);
     end;
@@ -7034,6 +7051,8 @@ procedure TPCUReader.ReadSection(Obj: TJSONObject; Section: TPasSection;
 // Note: can be called twice for each section if there are pending used interfaces
 var
   Scope: TPas2JSSectionScope;
+  i: Integer;
+  El: TPasElement;
 begin
   {$IFDEF VerbosePCUFiler}
   writeln('TPCUReader.ReadSection ',GetObjName(Section));
@@ -7068,10 +7087,19 @@ begin
   end;
 
   Scope.Finished:=true;
-  if Section is TInterfaceSection then
+  if Section.ClassType=TInterfaceSection then
     begin
     ResolvePending(false);
     Resolver.NotifyPendingUsedInterfaces;
+    end
+  else if Section.ClassType=TImplementationSection then
+    begin
+    for i:=0 to FPendingForwardProcs.Count-1 do
+      begin
+      El:=TPasElement(FPendingForwardProcs[i]);
+      Resolver.CheckPendingForwardProcs(El);
+      end;
+    FPendingForwardProcs.Clear;
     end;
 end;
 
@@ -8657,7 +8685,7 @@ begin
     Resolver.PopScope;
   end;
   ReadRecordScope(Obj,Scope,aContext);
-  Resolver.FinishSpecializedClassOrRecIntf(Scope);
+  Resolver.FinishGenericClassOrRecIntf(Scope);
   Resolver.FinishSpecializations(Scope);
 
   ReadSpecializations(Obj,El);
@@ -9028,8 +9056,9 @@ begin
     finally
       Resolver.PopScope;
     end;
-    Resolver.FinishSpecializedClassOrRecIntf(Scope);
-    Resolver.FinishSpecializations(Scope);
+    Resolver.FinishGenericClassOrRecIntf(Scope);
+    if (El.GenericTemplateTypes<>nil) and (El.GenericTemplateTypes.Count>0) then
+      FPendingForwardProcs.Add(El);
     ReadSpecializations(Obj,El);
     end;
 end;
@@ -9563,7 +9592,7 @@ var
   DefProcMods: TProcedureModifiers;
   t: TProcedureMessageType;
   s: string;
-  Found: Boolean;
+  Found, HasBody: Boolean;
   Scope: TPas2JSProcedureScope;
   DeclProcId: integer;
   Ref: TPCUFilerElementRef;
@@ -9587,6 +9616,7 @@ begin
 
   ReadPasElement(Obj,El,aContext);
 
+  HasBody:=Obj.Find('Body')<>nil;
   if ReadInteger(Obj,'DeclarationProc',DeclProcId,El) then
     begin
     // ImplProc
@@ -9598,7 +9628,7 @@ begin
     DeclProc:=TPasProcedure(Ref.Element);
     Scope.DeclarationProc:=DeclProc; // no AddRef
 
-    El.ProcType:=TPasProcedureType(CreateElement(TPasProcedureTypeClass(DeclProc.ProcType.ClassType),'',DeclProc));
+    El.ProcType:=TPasProcedureType(CreateElement(TPasProcedureTypeClass(DeclProc.ProcType.ClassType),'',El));
     El.Modifiers:=ReadProcedureModifiers(Obj,El,'PMods',DeclProc.Modifiers*PCUProcedureModifiersImplProc);
     end
   else
@@ -9644,7 +9674,7 @@ begin
   if (Scope<>nil) and (Obj.Find('ImplProc')=nil) then
     ReadProcScopeReferences(Obj,Scope);
 
-  if Obj.Find('Body')<>nil then
+  if HasBody then
     ReadProcedureBody(Obj,El,aContext);
 end;
 
@@ -9931,12 +9961,14 @@ begin
   inherited Create;
   FInitialFlags:=TPCUInitialFlags.Create;
   FPendingIdentifierScopes:=TObjectList.Create(true);
+  FPendingForwardProcs:=TFPList.Create;
 end;
 
 destructor TPCUReader.Destroy;
 begin
   FreeAndNil(FJSON);
   inherited Destroy;
+  FreeAndNil(FPendingForwardProcs);
   FreeAndNil(FPendingIdentifierScopes);
   FreeAndNil(FInitialFlags);
 end;
@@ -9952,6 +9984,7 @@ begin
   FPendingIdentifierScopes.Clear;
   while FPendingSpecialize<>nil do
     DeletePendingSpecialize(FPendingSpecialize);
+  FPendingForwardProcs.Clear;
 
   inherited Clear;
   FInitialFlags.Clear;

+ 3 - 3
compiler/packages/pastojs/src/pas2jsfs.pp

@@ -98,7 +98,7 @@ Type
   Public
     // Public Abstract. Must be overridden
     function FindResourceFileName(const aFilename, ModuleDir: string): String; virtual; abstract;
-    function FindIncludeFileName(const aFilename, ModuleDir: string): String; virtual; abstract;
+    function FindIncludeFileName(const aFilename, SrcDir, ModuleDir: string; Mode: TModeSwitch): String; virtual; abstract;
     function LoadFile(Filename: string; Binary: boolean = false): TPas2jsFile; virtual; abstract;
     Function FileExists(Const aFileName: String): Boolean; virtual; abstract;
     function FindUnitJSFileName(const aUnitFilename: string): String; virtual; abstract;
@@ -421,7 +421,7 @@ var
   Filename: String;
 begin
   Result:=nil;
-  Filename:=FS.FindIncludeFileName(aFilename,BaseDirectory);
+  Filename:=FS.FindIncludeFileName(aFilename,BaseDirectory,ModuleDirectory,Mode);
   if Filename='' then exit;
   try
     Result:=FindSourceFile(Filename);
@@ -444,7 +444,7 @@ end;
 function TPas2jsFSResolver.FindIncludeFileName(const aFilename: string): String;
 
 begin
-  Result:=FS.FindIncludeFileName(aFilename,BaseDirectory);
+  Result:=FS.FindIncludeFileName(aFilename,BaseDirectory,ModuleDirectory,Mode);
 end;
 
 

+ 9 - 3
compiler/packages/pastojs/tests/tcmodules.pas

@@ -233,7 +233,7 @@ type
   Published
     Procedure TestReservedWords;
 
-    // program/units
+    // program, units, includes
     Procedure TestEmptyProgram;
     Procedure TestEmptyProgramUseStrict;
     Procedure TestEmptyUnit;
@@ -294,7 +294,7 @@ type
     Procedure TestBaseType_RawByteStringFail;
     Procedure TestTypeShortstring_Fail;
     Procedure TestCharSet_Custom;
-    Procedure TestWideChar_VarArg;
+    Procedure TestWideChar;
     Procedure TestForCharDo;
     Procedure TestForCharInDo;
 
@@ -7927,7 +7927,7 @@ begin
     '']));
 end;
 
-procedure TTestModule.TestWideChar_VarArg;
+procedure TTestModule.TestWideChar;
 begin
   StartProgram(false);
   Add([
@@ -7940,9 +7940,12 @@ begin
   'var',
   '  c: char;',
   '  wc: widechar;',
+  '  w: word;',
   'begin',
   '  Fly(wc);',
   '  Run(c);',
+  '  wc:=WideChar(w);',
+  '  w:=ord(wc);',
   '']);
   ConvertProgram;
   CheckSource('TestWideChar_VarArg',
@@ -7953,6 +7956,7 @@ begin
     '};',
     'this.c = "";',
     'this.wc = "";',
+    'this.w = 0;',
     '']),
     LinesToStr([ // this.$main
     '$mod.Fly({',
@@ -7973,6 +7977,8 @@ begin
     '      this.p.c = v;',
     '    }',
     '});',
+    '$mod.wc = String.fromCharCode($mod.w);',
+    '$mod.w = $mod.wc.charCodeAt();',
     '',
     '']));
 end;

+ 0 - 1
compiler/packages/pastojs/tests/tcprecompile.pas

@@ -130,7 +130,6 @@ begin
       Params.AddStrings(SharedParams);
     if SecondRunParams<>nil then
       Params.AddStrings(SecondRunParams);
-    writeln('BBB1 TCustomTestCLI_Precompile.CheckPrecompile ',Params.Text);
     Compile([MainFile,'-FU'+UnitOutputDir],ExpExitCode);
     if ExpExitCode=0 then
       begin

+ 52 - 0
compiler/packages/pastojs/tests/tcunitsearch.pas

@@ -143,7 +143,11 @@ type
     procedure TestUS_Program_FU;
     procedure TestUS_Program_FU_o;
     procedure TestUS_Program_FE_o;
+
+    // include files
     procedure TestUS_IncludeSameDir;
+    Procedure TestUS_Include_NestedDelphi;
+    Procedure TestUS_Include_NestedObjFPC;
 
     // uses 'in' modifier
     procedure TestUS_UsesInFile;
@@ -729,6 +733,54 @@ begin
   Compile(['test1.pas','-Fusub','-FElib','-ofoo.js']);
 end;
 
+procedure TTestCLI_UnitSearch.TestUS_Include_NestedDelphi;
+begin
+  AddUnit('system.pp',[''],['']);
+  AddFile('sub/inc1.inc',[
+    'type number = longint;',
+    '{$I sub/deep/inc2.inc}',
+    '']);
+  AddFile('sub/deep/inc2.inc',[
+    'type numero = number;',
+    '{$I sub/inc3.inc}',
+    '']);
+  AddFile('sub/inc3.inc',[
+    'type nummer = numero;',
+    '']);
+  AddFile('test1.pas',[
+  '{$mode delphi}',
+  '{$i sub/inc1.inc}',
+  'var',
+  '  n: nummer;',
+  'begin',
+  'end.']);
+  Compile(['test1.pas','-Jc']);
+end;
+
+procedure TTestCLI_UnitSearch.TestUS_Include_NestedObjFPC;
+begin
+  AddUnit('system.pp',[''],['']);
+  AddFile('sub/inc1.inc',[
+    'type number = longint;',
+    '{$I deep/inc2.inc}',
+    '']);
+  AddFile('sub/deep/inc2.inc',[
+    'type numero = number;',
+    '{$I ../inc3.inc}',
+    '']);
+  AddFile('sub/inc3.inc',[
+    'type nummer = numero;',
+    '']);
+  AddFile('test1.pas',[
+  '{$mode objfpc}',
+  '{$i sub/inc1.inc}',
+  'var',
+  '  n: nummer;',
+  'begin',
+  'end.']);
+  Compile(['test1.pas','-Jc']);
+end;
+
 procedure TTestCLI_UnitSearch.TestUS_UsesInFile;
 begin
   AddUnit('system.pp',[''],['']);