* Patch from Mattias Gaertner:

pastree: changed TPasVariable.LibraryName and ExportName to TPasExpr. 
            It can be constants instead of string literals.
  pscanner: fixed parsing floats 1.2, 1.2E3, 1.E2, 1E2, 1.2E-3, 1E+2
  pparser:  var modifier external with optional lib and symbol
  pasresolver:
    - untyped parameter
    - added option proAllowPropertyAsVarParam allows to pass a property as a var/out argument
    - varargs

git-svn-id: trunk@35503 -

packages/fcl-passrc/src/pasresolver.pp

@@ -109,9 +109,11 @@ Works:
 - function without params: mark if call or address, rrfImplicitCallWithoutParams
 - procedure break, procedure continue
 - built-in functions pred, succ for range type and enums
+- untyped parameters
 
 ToDo:
 - fail to write a loop var inside the loop
+- Note: (5025) Local variable "i" not used
 - classes - TPasClassType
    - nested var, const
    - nested types
@@ -124,7 +126,6 @@ ToDo:
    - function default(record type): record
 - proc: check if forward and impl default values match
 - call array of proc without ()
-- untyped parameters
 - pointer type, ^type, @ operator, [] operator
 - object
 - interfaces
@@ -866,7 +867,8 @@ type
 
   TPasResolverOption = (
     proFixCaseOfOverrides,  // fix Name of overriding procs to the overriden proc
-    proClassPropertyNonStatic  // class property accessor must be non static
+    proClassPropertyNonStatic,  // class property accessor must be non static
+    proAllowPropertyAsVarParam // allows to pass a property as a var/out argument
     );
   TPasResolverOptions = set of TPasResolverOption;
 
@@ -1120,7 +1122,7 @@ type
     procedure ComputeElement(El: TPasElement; out ResolvedEl: TPasResolverResult;
       Flags: TPasResolverComputeFlags);
     // checking compatibilility
-    function CheckCallProcCompatibility(Proc: TPasProcedureType;
+    function CheckCallProcCompatibility(ProcType: TPasProcedureType;
       Params: TParamsExpr; RaiseOnError: boolean): integer;
     function CheckCallPropertyCompatibility(PropEl: TPasProperty;
       Params: TParamsExpr; RaiseOnError: boolean): integer;
@@ -1146,6 +1148,7 @@ type
     function CheckOverloadProcCompatibility(Proc1, Proc2: TPasProcedure): boolean;
     function CheckProcAssignCompatibility(Proc1, Proc2: TPasProcedureType): boolean;
     function CheckProcArgCompatibility(Arg1, Arg2: TPasArgument): boolean;
+    function CheckProcArgTypeCompatibility(Arg1, Arg2: TPasType): boolean;
     function CheckCanBeLHS(const ResolvedEl: TPasResolverResult;
       ErrorOnFalse: boolean; ErrorEl: TPasElement): boolean;
     function CheckAssignCompatibility(const LHS, RHS: TPasElement;
@@ -1173,6 +1176,7 @@ type
     function IsDynArray(TypeEl: TPasType): boolean;
     function IsClassMethod(El: TPasElement): boolean;
     function IsProcedureType(const ResolvedEl: TPasResolverResult): boolean;
+    function IsArrayType(const ResolvedEl: TPasResolverResult): boolean;
     function GetRangeLength(RangeResolved: TPasResolverResult): integer;
   public
     property BaseType[bt: TResolverBaseType]: TPasUnresolvedSymbolRef read GetBaseType;
@@ -2953,7 +2957,7 @@ begin
 
     if Proc.IsForward and Proc.IsExternal then
       RaiseMsg(20170216151616,nInvalidProcModifiers,
-        sInvalidProcModifiers,[Proc.ElementTypeName,'forward, external'],Proc);
+        sInvalidProcModifiers,[Proc.ElementTypeName,'external, forward'],Proc);
 
     if Proc.IsDynamic then
       // 'dynamic' is not supported
@@ -3697,8 +3701,8 @@ begin
     // check result type
     ImplResult:=TPasFunction(ImplProc).FuncType.ResultEl.ResultType;
     DeclResult:=TPasFunction(DeclProc).FuncType.ResultEl.ResultType;
-    if (ImplResult=nil)
+
-    or (ImplResult<>DeclResult) then
+    if not CheckProcArgTypeCompatibility(ImplResult,DeclResult) then
       RaiseMsg(20170216151734,nResultTypeMismatchExpectedButFound,
         sResultTypeMismatchExpectedButFound,[GetTypeDesc(DeclResult),GetTypeDesc(ImplResult)],
         ImplProc);
@@ -7275,15 +7279,16 @@ begin
     CurrentParser.OnLog(Self,Format(Fmt,Args));
 end;
 
-function TPasResolver.CheckCallProcCompatibility(Proc: TPasProcedureType;
+function TPasResolver.CheckCallProcCompatibility(ProcType: TPasProcedureType;
   Params: TParamsExpr; RaiseOnError: boolean): integer;
 var
   ProcArgs: TFPList;
   i, ParamCnt, ParamCompatibility: Integer;
   Param: TPasExpr;
+  Proc: TPasProcedure;
 begin
   Result:=cExact;
-  ProcArgs:=Proc.Args;
+  ProcArgs:=ProcType.Args;
   // check args
   ParamCnt:=length(Params.Params);
   i:=0;
@@ -7292,10 +7297,16 @@ begin
     Param:=Params.Params[i];
     if i>=ProcArgs.Count then
       begin
+      if ProcType.Parent is TPasProcedure then
+        begin
+        Proc:=TPasProcedure(ProcType.Parent);
+        if pmVarargs in Proc.Modifiers then
+          exit;
+        end;
       // too many arguments
       if RaiseOnError then
         RaiseMsg(20170216152408,nWrongNumberOfParametersForCallTo,
-          sWrongNumberOfParametersForCallTo,[GetProcDesc(Proc)],Param);
+          sWrongNumberOfParametersForCallTo,[GetProcDesc(ProcType)],Param);
       exit(cIncompatible);
       end;
     {$IFDEF VerbosePasResolver}
@@ -7313,7 +7324,7 @@ begin
     if RaiseOnError then
       // ToDo: position cursor on identifier
       RaiseMsg(20170216152410,nWrongNumberOfParametersForCallTo,
-        sWrongNumberOfParametersForCallTo,[GetProcDesc(Proc)],Params.Value);
+        sWrongNumberOfParametersForCallTo,[GetProcDesc(ProcType)],Params.Value);
     exit(cIncompatible);
     end;
 end;
@@ -7444,6 +7455,8 @@ end;
 
 function TPasResolver.CheckOverloadProcCompatibility(Proc1, Proc2: TPasProcedure
   ): boolean;
+// returns if number and type of arguments fit
+// does not check calling convention
 var
   ProcArgs1, ProcArgs2: TFPList;
   i: Integer;
@@ -7504,8 +7517,6 @@ begin
 end;
 
 function TPasResolver.CheckProcArgCompatibility(Arg1, Arg2: TPasArgument): boolean;
-var
-  Arg1Resolved, Arg2Resolved: TPasResolverResult;
 begin
   Result:=false;
 
@@ -7517,15 +7528,28 @@ begin
     exit(Arg2.ArgType=nil);
   if Arg2.ArgType=nil then exit;
 
-  ComputeElement(Arg1,Arg1Resolved,[]);
+  Result:=CheckProcArgTypeCompatibility(Arg1.ArgType,Arg2.ArgType);
-  ComputeElement(Arg2,Arg2Resolved,[]);
+end;
+
+function TPasResolver.CheckProcArgTypeCompatibility(Arg1, Arg2: TPasType
+  ): boolean;
+var
+  Arg1Resolved, Arg2Resolved: TPasResolverResult;
+begin
+  ComputeElement(Arg1,Arg1Resolved,[rcType]);
+  ComputeElement(Arg2,Arg2Resolved,[rcType]);
 
   if (Arg1Resolved.BaseType<>Arg2Resolved.BaseType)
       or (Arg1Resolved.TypeEl=nil)
-      or (Arg1Resolved.TypeEl<>Arg2Resolved.TypeEl) then
+      or (Arg2Resolved.TypeEl=nil) then
-    exit;
+    exit(false);
+  if Arg1Resolved.TypeEl=Arg2Resolved.TypeEl then
+    exit(true);
+  if (Arg1Resolved.TypeEl.ClassType=TPasUnresolvedSymbolRef)
+      and (IsBaseType(Arg2Resolved.TypeEl,Arg1Resolved.BaseType)) then
+    exit(true);
 
-  Result:=true;
+  Result:=false;
 end;
 
 function TPasResolver.CheckCanBeLHS(const ResolvedEl: TPasResolverResult;
@@ -7591,7 +7615,11 @@ begin
   {$ENDIF}
   if LHS.TypeEl=nil then
     begin
-    // ToDo: untyped parameter
+    if LHS.BaseType=btUntyped then
+      begin
+      // untyped parameter
+      exit(cExact+1);
+      end;
     RaiseNotYetImplemented(20160922163631,LHS.IdentEl);
     end
   else if LHS.BaseType=RHS.BaseType then
@@ -7631,18 +7659,18 @@ begin
     end
   else if RHS.BaseType=btNil then
     begin
-      if LHS.BaseType=btPointer then
+    if LHS.BaseType=btPointer then
-        exit(cExact)
+      exit(cExact)
-      else if LHS.BaseType=btContext then
+    else if LHS.BaseType=btContext then
-        begin
+      begin
-        TypeEl:=LHS.TypeEl;
+      TypeEl:=LHS.TypeEl;
-        if (TypeEl.ClassType=TPasClassType)
+      if (TypeEl.ClassType=TPasClassType)
-            or (TypeEl.ClassType=TPasClassOfType)
+          or (TypeEl.ClassType=TPasClassOfType)
-            or (TypeEl.ClassType=TPasPointerType)
+          or (TypeEl.ClassType=TPasPointerType)
-            or (TypeEl is TPasProcedureType)
+          or (TypeEl is TPasProcedureType)
-            or IsDynArray(TypeEl) then
+          or IsDynArray(TypeEl) then
-          exit(cExact);
+        exit(cExact);
-        end;
+      end;
     end
   else if RHS.BaseType=btSet then
     begin
@@ -7685,15 +7713,27 @@ begin
   Actual:=GetResolverResultDescription(RHS);
   if LHS.BaseType<>RHS.BaseType then
     begin
-    if (LHS.BaseType=btContext) and (LHS.TypeEl<>nil) and (LHS.TypeEl.Name<>'') then
+    Expected:=BaseTypeNames[LHS.BaseType];
-      Expected:=LHS.TypeEl.Name
+    if (LHS.BaseType=btContext) then
-    else
+      begin
-      Expected:=BaseTypeNames[LHS.BaseType];
+      if (LHS.TypeEl<>nil) then
-    if (RHS.BaseType=btContext)
+        begin
-    and (RHS.TypeEl<>nil) then
+        if (LHS.TypeEl.Name<>'') then
-      Actual:=RHS.TypeEl.ElementTypeName
+          Expected:=LHS.TypeEl.Name
-    else
+        else
-      Actual:=BaseTypeNames[RHS.BaseType];
+          Expected:=LHS.TypeEl.ElementTypeName;
+        end;
+      end;
+    if (RHS.BaseType=btContext) then
+      begin
+      if (RHS.TypeEl<>nil) then
+        begin
+        if (RHS.TypeEl.Name<>'') then
+          Actual:=RHS.TypeEl.Name
+        else
+          Actual:=RHS.TypeEl.ElementTypeName;
+        end;
+      end;
    end
   else if (LHS.TypeEl<>nil) and (RHS.TypeEl<>nil) then
     begin
@@ -7875,6 +7915,9 @@ begin
     Result:=(TPasConst(ResolvedEl.IdentEl).VarType<>nil);
     exit;
     end;
+  if (proAllowPropertyAsVarParam in Options)
+      and (ResolvedEl.IdentEl.ClassType=TPasProperty) then
+    exit(true);
 end;
 
 function TPasResolver.ResolvedElIsClassInstance(
@@ -7992,6 +8035,8 @@ begin
       if (ParamResolved.TypeEl<>nil) and (ParamResolved.TypeEl=ExprResolved.TypeEl) then
         exit(cExact);
       end;
+    if (Param.ArgType=nil) then
+      exit(cExact); // untyped argument
     if RaiseOnError then
       RaiseMsg(20170216152452,nIncompatibleTypeArgNoVarParamMustMatchExactly,
         sIncompatibleTypeArgNoVarParamMustMatchExactly,
@@ -8374,7 +8419,12 @@ begin
   if (ResTypeEl<>nil)
       and (rrfReadable in ParamResolved.Flags) then
     begin
-    if ResTypeEl.ClassType=TPasUnresolvedSymbolRef then
+    if ParamResolved.BaseType=btUntyped then
+      begin
+      // typecast an untyped parameter
+      Result:=cExact+1;
+      end
+    else if ResTypeEl.ClassType=TPasUnresolvedSymbolRef then
       begin
       if ResTypeEl.CustomData.ClassType=TResElDataBaseType then
         begin
@@ -8955,6 +9005,12 @@ begin
   Result:=(ResolvedEl.BaseType=btContext) and (ResolvedEl.TypeEl is TPasProcedureType);
 end;
 
+function TPasResolver.IsArrayType(const ResolvedEl: TPasResolverResult
+  ): boolean;
+begin
+  Result:=(ResolvedEl.BaseType=btContext) and (ResolvedEl.TypeEl is TPasArrayType);
+end;
+
 function TPasResolver.GetRangeLength(RangeResolved: TPasResolverResult
   ): integer;
 begin

packages/fcl-passrc/src/passrcutil.pp

@@ -74,6 +74,7 @@ end;
 
 function TSrcContainer.FindElement(const AName: String): TPasElement;
 begin
+  if AName='' then ;
   Result:=Nil;
 end;
 

packages/fcl-passrc/src/pastree.pp

@@ -632,7 +632,7 @@ type
       const Arg: Pointer); override;
   public
     Access: TArgumentAccess;
-    ArgType: TPasType;
+    ArgType: TPasType; // can be nil, when Access<>argDefault
     ValueExpr: TPasExpr; // the default value
     Function Value : String;
   end;
@@ -733,7 +733,8 @@ type
   public
     VarType: TPasType;
     VarModifiers : TVariableModifiers;
-    LibraryName,ExportName : string;
+    LibraryName : TPasExpr; // libname of modifier external
+    ExportName : TPasExpr; // symbol name of modifier external, export and public
     Modifiers : string;
     AbsoluteLocation : String;
     Expr: TPasExpr;
@@ -820,7 +821,7 @@ type
   TProcedureModifier = (pmVirtual, pmDynamic, pmAbstract, pmOverride,
                         pmExport, pmOverload, pmMessage, pmReintroduce,
                         pmStatic,pmInline,pmAssembler,pmVarargs, pmPublic,
-                        pmCompilerProc,pmExternal,pmForward, pmdispid, pmnoreturn);
+                        pmCompilerProc,pmExternal,pmForward, pmDispId, pmNoReturn);
   TProcedureModifiers = Set of TProcedureModifier;
   TProcedureMessageType = (pmtNone,pmtInteger,pmtString);
                         
@@ -2474,6 +2475,8 @@ begin
     (e.g. in Constants) }
   ReleaseAndNil(TPasElement(VarType));
   ReleaseAndNil(TPasElement(Expr));
+  ReleaseAndNil(TPasElement(LibraryName));
+  ReleaseAndNil(TPasElement(ExportName));
   inherited Destroy;
 end;
 

packages/fcl-passrc/src/pparser.pp

@@ -239,7 +239,7 @@ type
     function CheckOverloadList(AList: TFPList; AName: String; out OldMember: TPasElement): TPasOverloadedProc;
     procedure DumpCurToken(Const Msg : String; IndentAction : TIndentAction = iaNone);
     function GetCurrentModeSwitches: TModeSwitches;
-    function GetVariableModifiers(Out VarMods : TVariableModifiers; Out Libname,ExportName : string): string;
+    function GetVariableModifiers(Parent: TPasElement; Out VarMods: TVariableModifiers; Out LibName, ExportName: TPasExpr): string;
     function GetVariableValueAndLocation(Parent : TPasElement; Out Value : TPasExpr; Out Location: String): Boolean;
     procedure HandleProcedureModifier(Parent: TPasElement; pm : TProcedureModifier);
     procedure ParseClassLocalConsts(AType: TPasClassType; AVisibility: TPasMemberVisibility);
@@ -886,7 +886,7 @@ end;
 
 function TPasParser.CurTokenIsIdentifier(const S: String): Boolean;
 begin
-  Result:=(Curtoken=tkidentifier) and (CompareText(S,CurtokenText)=0);
+  Result:=(Curtoken=tkIdentifier) and (CompareText(S,CurtokenText)=0);
 end;
 
 
@@ -2976,13 +2976,16 @@ begin
     UngetToken;
 end;
 
-function TPasParser.GetVariableModifiers(out VarMods: TVariableModifiers; out
+function TPasParser.GetVariableModifiers(Parent: TPasElement; out
-  Libname, ExportName: string): string;
+  VarMods: TVariableModifiers; out LibName, ExportName: TPasExpr): string;
 
 Var
   S : String;
+  ExtMod: TVariableModifier;
 begin
   Result := '';
+  LibName := nil;
+  ExportName := nil;
   VarMods := [];
   NextToken;
   If CurTokenIsIdentifier('cvar') then
@@ -2993,46 +2996,47 @@ begin
     NextToken;
     end;
   s:=LowerCase(CurTokenText);
-  if Not ((s='external') or (s='public') or (s='export')) then
+  if s='external' then
-    UngetToken
+    ExtMod:=vmExternal
+  else if (s='public') then
+    ExtMod:=vmPublic
+  else if (s='export') then
+    ExtMod:=vmExport
   else
     begin
-    if s='external' then
+    UngetToken;
-      Include(VarMods,vmexternal)
+    exit;
-    else if (s='public') then
-      Include(varMods,vmpublic)
-    else if (s='export') then
-      Include(varMods,vmexport);
-    Result:=Result+';'+CurTokenText;
-    NextToken;
-    if (Curtoken<>tksemicolon) then
-      begin
-      if (s='external') then
-        begin
-        Include(VarMods,vmexternal);
-        if (CurToken in [tkString,tkIdentifier])
-            and Not (CurTokenIsIdentifier('name')) then
-          begin
-          Result := Result + ' ' + CurTokenText;
-          LibName:=CurTokenText;
-          NextToken;
-          end;
-        end;
-      if CurTokenIsIdentifier('name') then
-        begin
-        Result := Result + ' name ';
-        NextToken;
-        if (CurToken in [tkString,tkIdentifier]) then
-          Result := Result + CurTokenText
-        else
-          ParseExcSyntaxError;
-        ExportName:=CurTokenText;
-        NextToken;
-        end
-      else
-        ParseExcSyntaxError;
-      end;
     end;
+  Include(varMods,ExtMod);
+  Result:=Result+';'+CurTokenText;
+
+  NextToken;
+  if not (CurToken in [tkString,tkIdentifier]) then
+    begin
+    if (CurToken=tkSemicolon) and (ExtMod in [vmExternal,vmPublic]) then
+      exit;
+    ParseExcSyntaxError;
+    end;
+  // export name exportname;
+  // public;
+  // public name exportname;
+  // external;
+  // external libname;
+  // external libname name exportname;
+  // external name exportname;
+  if (ExtMod=vmExternal) and (CurToken in [tkString,tkIdentifier])
+      and Not (CurTokenIsIdentifier('name')) then
+    begin
+    Result := Result + ' ' + CurTokenText;
+    LibName:=DoParseExpression(Parent);
+    end;
+  if not CurTokenIsIdentifier('name') then
+    ParseExcSyntaxError;
+  NextToken;
+  if not (CurToken in [tkString,tkIdentifier]) then
+    ParseExcTokenError(TokenInfos[tkString]);
+  Result := Result + ' ' + CurTokenText;
+  ExportName:=DoParseExpression(Parent);
 end;
 
 
@@ -3042,15 +3046,18 @@ procedure TPasParser.ParseVarList(Parent: TPasElement; VarList: TFPList; AVisibi
 
 var
   i, OldListCount: Integer;
-  Value : TPasExpr;
+  Value , aLibName, aExpName: TPasExpr;
   VarType: TPasType;
   VarEl: TPasVariable;
   H : TPasMemberHints;
   VarMods: TVariableModifiers;
-  D,Mods,Loc,aLibName,aExpName : string;
+  D,Mods,Loc: string;
   OldForceCaret,ok: Boolean;
 
 begin
+  Value:=Nil;
+  aLibName:=nil;
+  aExpName:=nil;
   OldListCount:=VarList.Count;
   ok:=false;
   try
@@ -3083,20 +3090,17 @@ begin
         VarType.AddRef;
       end;
 
-    Value:=Nil;
     H:=CheckHint(Nil,False);
     If Full then
       GetVariableValueAndLocation(Parent,Value,Loc);
     if (Value<>nil) and (VarList.Count>OldListCount+1) then
-      begin
-      Value.Release;
       ParseExc(nParserOnlyOneVariableCanBeInitialized,SParserOnlyOneVariableCanBeInitialized);
-      end;
     TPasVariable(VarList[OldListCount]).Expr:=Value;
+    Value:=nil;
 
     H:=H+CheckHint(Nil,Full);
     if Full then
-      Mods:=GetVariableModifiers(VarMods,aLibName,aExpName)
+      Mods:=GetVariableModifiers(Parent,VarMods,aLibName,aExpName)
     else
       begin
       NextToken;
@@ -3117,15 +3121,26 @@ begin
       VarEl.Modifiers:=Mods;
       VarEl.VarModifiers:=VarMods;
       VarEl.AbsoluteLocation:=Loc;
-      VarEl.LibraryName:=aLibName;
+      if aLibName<>nil then
-      VarEl.ExportName:=aExpName;
+        begin
+        VarEl.LibraryName:=aLibName;
+        aLibName.AddRef;
+        end;
+      if aExpName<>nil then
+        begin
+        VarEl.ExportName:=aExpName;
+        aExpName.AddRef;
+        end;
       end;
     for i := OldListCount to VarList.Count - 1 do
       Engine.FinishScope(stDeclaration,TPasVariable(VarList[i]));
     ok:=true;
   finally
+    if aLibName<>nil then aLibName.Release;
+    if aExpName<>nil then aExpName.Release;
     if not ok then
       begin
+        if Value<>nil then Value.Release;
         for i:=OldListCount to VarList.Count-1 do
           TPasElement(VarList[i]).Release;
         VarList.Count:=OldListCount;

packages/fcl-passrc/src/pscanner.pp

@@ -2074,35 +2074,25 @@ begin
       end;
     '0'..'9':
       begin
+        // 1, 12, 1.2, 1.2E3, 1.E2, 1E2, 1.2E-3, 1E+2
+        // beware of 1..2
         TokenStart := TokenStr;
-        while true do
+        repeat
+          Inc(TokenStr);
+        until not (TokenStr[0] in ['0'..'9']);
+        if (TokenStr[0]='.') and (TokenStr[1]<>'.') then
+          begin
+          inc(TokenStr);
+          while TokenStr[0] in ['0'..'9'] do
+            Inc(TokenStr);
+          end;
+        if TokenStr[0] in ['e', 'E'] then
         begin
           Inc(TokenStr);
-          case TokenStr[0] of
+          if TokenStr[0] in ['-','+'] then
-            '.':
+            inc(TokenStr);
-              begin
+          while TokenStr[0] in ['0'..'9'] do
-                if TokenStr[1] in ['0'..'9', 'e', 'E'] then
+            Inc(TokenStr);
-                begin
-                  Inc(TokenStr);
-                  repeat
-                    Inc(TokenStr);
-                  until not (TokenStr[0] in ['0'..'9', 'e', 'E']);
-                end;
-                break;
-              end;
-            '0'..'9': ;
-            'e', 'E':
-              begin
-                Inc(TokenStr);
-                if TokenStr[0] = '-'  then
-                  Inc(TokenStr);
-                while TokenStr[0] in ['0'..'9'] do
-                  Inc(TokenStr);
-                break;
-              end;
-            else
-              break;
-          end;
         end;
         SectionLength := TokenStr - TokenStart;
         SetLength(FCurTokenString, SectionLength);

packages/fcl-passrc/tests/tcexprparser.pas

@@ -45,6 +45,16 @@ type
     procedure TestPrimitiveIntegerOctal;
     procedure TestPrimitiveIntegerBinary;
     procedure TestPrimitiveDouble;
+    procedure TestPrimitiveDouble2;
+    procedure TestPrimitiveDouble3;
+    procedure TestPrimitiveDouble4;
+    procedure TestPrimitiveDouble5;
+    procedure TestPrimitiveDouble6;
+    procedure TestPrimitiveDouble7;
+    procedure TestPrimitiveDouble8;
+    procedure TestPrimitiveDouble9;
+    procedure TestPrimitiveDouble10;
+    procedure TestPrimitiveDouble11;
     procedure TestPrimitiveString;
     procedure TestPrimitiveIdent;
     procedure TestPrimitiveBooleanFalse;
@@ -164,6 +174,66 @@ begin
   AssertExpression('Simple double',theExpr,pekNumber,'1.2');
 end;
 
+procedure TTestExpressions.TestPrimitiveDouble2;
+begin
+  ParseExpression('1.200');
+  AssertExpression('Simple double',theExpr,pekNumber,'1.200');
+end;
+
+procedure TTestExpressions.TestPrimitiveDouble3;
+begin
+  ParseExpression('01.2');
+  AssertExpression('Simple double',theExpr,pekNumber,'01.2');
+end;
+
+procedure TTestExpressions.TestPrimitiveDouble4;
+begin
+  ParseExpression('1.2e10');
+  AssertExpression('Simple double',theExpr,pekNumber,'1.2e10');
+end;
+
+procedure TTestExpressions.TestPrimitiveDouble5;
+begin
+  ParseExpression('1.2e-10');
+  AssertExpression('Simple double',theExpr,pekNumber,'1.2e-10');
+end;
+
+procedure TTestExpressions.TestPrimitiveDouble6;
+begin
+  ParseExpression('12e10');
+  AssertExpression('Simple double',theExpr,pekNumber,'12e10');
+end;
+
+procedure TTestExpressions.TestPrimitiveDouble7;
+begin
+  ParseExpression('12e-10');
+  AssertExpression('Simple double',theExpr,pekNumber,'12e-10');
+end;
+
+procedure TTestExpressions.TestPrimitiveDouble8;
+begin
+  ParseExpression('8.5');
+  AssertExpression('Simple double',theExpr,pekNumber,'8.5');
+end;
+
+procedure TTestExpressions.TestPrimitiveDouble9;
+begin
+  ParseExpression('8.E5');
+  AssertExpression('Simple double',theExpr,pekNumber,'8.E5');
+end;
+
+procedure TTestExpressions.TestPrimitiveDouble10;
+begin
+  ParseExpression('8.E-5');
+  AssertExpression('Simple double',theExpr,pekNumber,'8.E-5');
+end;
+
+procedure TTestExpressions.TestPrimitiveDouble11;
+begin
+  ParseExpression('8E+5');
+  AssertExpression('Simple double',theExpr,pekNumber,'8E+5');
+end;
+
 procedure TTestExpressions.TestPrimitiveString;
 begin
   DeclareVar('string');

packages/fcl-passrc/tests/tcresolver.pas

@@ -150,6 +150,7 @@ type
     Procedure TestArgWrongExprFail;
     Procedure TestIncDec;
     Procedure TestIncStringFail;
+    Procedure TestVarExternal;
 
     // strings
     Procedure TestString_SetLength;
@@ -249,6 +250,8 @@ type
     Procedure TestBreak;
     Procedure TestContinue;
     Procedure TestProcedureExternal;
+    Procedure TestProc_UntypedParam_Forward;
+    Procedure TestProc_Varargs;
     // ToDo: fail builtin functions in constant with non const param
 
     // record
@@ -275,6 +278,8 @@ type
     Procedure TestClass_MethodOverride;
     Procedure TestClass_MethodOverride2;
     Procedure TestClass_MethodOverrideFixCase;
+    Procedure TestClass_MethodOverrideSameResultType;
+    Procedure TestClass_MethodOverrideDiffResultTypeFail;
     Procedure TestClass_MethodOverloadAncestor;
     Procedure TestClass_MethodScope;
     Procedure TestClass_IdentifierSelf;
@@ -315,6 +320,7 @@ type
     Procedure TestClass_ReintroducePublicVarFail;
     Procedure TestClass_ReintroducePrivateVar;
     Procedure TestClass_ReintroduceProc;
+    Procedure TestClass_UntypedParam_TypeCast;
     // Todo: Fail to use class.method in constant or type, e.g. const p = @o.doit;
     // ToDo: typecast multiple params fail
     // ToDo: use Self in non method as local var, requires changes in pparser
@@ -392,6 +398,9 @@ type
     Procedure TestArrayEnumTypeConstWrongTypeFail;
     Procedure TestArrayEnumTypeConstNonConstFail;
     Procedure TestArrayEnumTypeSetLengthFail;
+    Procedure TestArray_AssignNilToStaticArrayFail1;
+    Procedure TestArray_SetLengthProperty;
+    Procedure TestArray_PassArrayElementToVarParam;
 
     // procedure types
     Procedure TestProcTypesAssignObjFPC;
@@ -1627,6 +1636,15 @@ begin
   CheckResolverException('Incompatible type arg no. 1: Got "String", expected "Longint"',PasResolver.nIncompatibleTypeArgNo);
 end;
 
+procedure TTestResolver.TestVarExternal;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  NaN: double; external name ''Global.Nan'';');
+  Add('begin');
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestString_SetLength;
 begin
   StartProgram(false);
@@ -3257,6 +3275,59 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestProc_UntypedParam_Forward;
+begin
+  StartProgram(false);
+  Add('procedure {#ProcA}ProcA(var {#A}A); forward;');
+  Add('procedure {#ProcB}ProcB(const {#B}B); forward;');
+  Add('procedure {#ProcC}ProcC(out {#C}C); forward;');
+  Add('procedure {#ProcD}ProcD(constref {#D}D); forward;');
+  Add('procedure ProcA(var A);');
+  Add('begin');
+  Add('end;');
+  Add('procedure ProcB(const B);');
+  Add('begin');
+  Add('end;');
+  Add('procedure ProcC(out C);');
+  Add('begin');
+  Add('end;');
+  Add('procedure ProcD(constref D);');
+  Add('begin');
+  Add('end;');
+  Add('var i: longint;');
+  Add('begin');
+  Add('  {@ProcA}ProcA(i);');
+  Add('  {@ProcB}ProcB(i);');
+  Add('  {@ProcC}ProcC(i);');
+  Add('  {@ProcD}ProcD(i);');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestProc_Varargs;
+begin
+  StartProgram(false);
+  Add('procedure ProcA(i:longint); varargs; external;');
+  Add('procedure ProcB; varargs; external;');
+  Add('procedure ProcC(i: longint = 17); varargs; external;');
+  Add('begin');
+  Add('  ProcA(1);');
+  Add('  ProcA(1,2);');
+  Add('  ProcA(1,2.0);');
+  Add('  ProcA(1,2,3);');
+  Add('  ProcA(1,''2'');');
+  Add('  ProcA(2,'''');');
+  Add('  ProcA(3,false);');
+  Add('  ProcB;');
+  Add('  ProcB();');
+  Add('  ProcB(4);');
+  Add('  ProcB(''foo'');');
+  Add('  ProcC;');
+  Add('  ProcC();');
+  Add('  ProcC(4);');
+  Add('  ProcC(5,''foo'');');
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestRecord;
 begin
   StartProgram(false);
@@ -3672,6 +3743,50 @@ begin
   CheckOverrideName('B_ProcA');
 end;
 
+procedure TTestResolver.TestClass_MethodOverrideSameResultType;
+begin
+  AddModuleWithIntfImplSrc('unit2.pp',
+    LinesToStr([
+    'type',
+    '  TObject = class',
+    '  public',
+    '    function ProcA(const s: string): string; virtual; abstract;',
+    '  end;',
+    '']),
+    LinesToStr([
+    ''])
+    );
+
+  StartProgram(true);
+  Add('uses unit2;');
+  Add('type');
+  Add('  TCar = class');
+  Add('  public');
+  Add('    function ProcA(const s: string): string; override;');
+  Add('  end;');
+  Add('function TCar.ProcA(const s: string): string; begin end;');
+  Add('begin');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClass_MethodOverrideDiffResultTypeFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  public');
+  Add('    function ProcA(const s: string): string; virtual; abstract;');
+  Add('  end;');
+  Add('  TCar = class');
+  Add('  public');
+  Add('    function ProcA(const s: string): longint; override;');
+  Add('  end;');
+  Add('function TCar.ProcA(const s: string): longint; begin end;');
+  Add('begin');
+  CheckResolverException('Result type mismatch, expected String, but found Longint',
+    nResultTypeMismatchExpectedButFound);
+end;
+
 procedure TTestResolver.TestClass_MethodOverloadAncestor;
 begin
   StartProgram(false);
@@ -4729,6 +4844,29 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestClass_UntypedParam_TypeCast;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class end;');
+  Add('procedure {#ProcA}ProcA(var {#A}A);');
+  Add('begin');
+  Add('  TObject({@A}A):=TObject({@A}A);');
+  Add('  if TObject({@A}A)=nil then ;');
+  Add('  if nil=TObject({@A}A) then ;');
+  Add('end;');
+  Add('procedure {#ProcB}ProcB(const {#B}B);');
+  Add('begin');
+  Add('  if TObject({@B}B)=nil then ;');
+  Add('  if nil=TObject({@B}B) then ;');
+  Add('end;');
+  Add('var o: TObject;');
+  Add('begin');
+  Add('  {@ProcA}ProcA(o);');
+  Add('  {@ProcB}ProcB(o);');
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestClassOf;
 begin
   StartProgram(false);
@@ -6040,10 +6178,54 @@ begin
   Add('  a: array[TEnum] of longint;');
   Add('begin');
   Add('  SetLength(a,1);');
-  CheckResolverException(' Incompatible type arg no. 1: Got "array[] of Longint", expected "string or dynamic array variable',
+  CheckResolverException('Incompatible type arg no. 1: Got "array[] of Longint", expected "string or dynamic array variable',
     nIncompatibleTypeArgNo);
 end;
 
+procedure TTestResolver.TestArray_AssignNilToStaticArrayFail1;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TEnum = (red,blue);');
+  Add('var');
+  Add('  a: array[TEnum] of longint;');
+  Add('begin');
+  Add('  a:=nil;');
+  CheckResolverException('Incompatible types: got "nil" expected "array type"',
+    nIncompatibleTypesGotExpected);
+end;
+
+procedure TTestResolver.TestArray_SetLengthProperty;
+begin
+  ResolverEngine.Options:=ResolverEngine.Options+[proAllowPropertyAsVarParam];
+  StartProgram(false);
+  Add('type');
+  Add('  TArrInt = array of longint;');
+  Add('  TObject = class');
+  Add('    function GetColors: TArrInt; external name ''GetColors'';');
+  Add('    procedure SetColors(const Value: TArrInt); external name ''SetColors'';');
+  Add('    property Colors: TArrInt read GetColors write SetColors;');
+  Add('  end;');
+  Add('procedure DoIt(var i: longint; out j: longint; const k: longint); begin end;');
+  Add('var Obj: TObject;');
+  Add('begin');
+  Add('  SetLength(Obj.Colors,2);');
+  Add('  DoIt(Obj.Colors[1],Obj.Colors[2],Obj.Colors[3]);');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestArray_PassArrayElementToVarParam;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TArrInt = array of longint;');
+  Add('procedure DoIt(var i: longint; out j: longint; const k: longint); begin end;');
+  Add('var a: TArrInt;');
+  Add('begin');
+  Add('  DoIt(a[1],a[2],a[3]);');
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestProcTypesAssignObjFPC;
 begin
   StartProgram(false);

packages/fcl-passrc/tests/tcvarparser.pas

@@ -273,16 +273,16 @@ procedure TTestVarParser.TestVarExternalLib;
 begin
   ParseVar('integer; external name ''mylib''','');
   AssertEquals('Variable modifiers',[vmexternal],TheVar.VarModifiers);
-  AssertEquals('Library name','',TheVar.LibraryName);
+  AssertNull('Library name',TheVar.LibraryName);
-  AssertEquals('Library name','''mylib''',TheVar.ExportName);
+  AssertNotNull('Library symbol',TheVar.ExportName);
 end;
 
 procedure TTestVarParser.TestVarExternalLibName;
 begin
   ParseVar('integer; external ''mylib'' name ''de''','');
   AssertEquals('Variable modifiers',[vmexternal],TheVar.VarModifiers);
-  AssertEquals('Library name','''mylib''',TheVar.LibraryName);
+  AssertNotNull('Library name',TheVar.LibraryName);
-  AssertEquals('Library name','''de''',TheVar.ExportName);
+  AssertNotNull('Library symbol',TheVar.ExportName);
 end;
 
 procedure TTestVarParser.TestVarCVar;
@@ -307,7 +307,7 @@ procedure TTestVarParser.TestVarPublicName;
 begin
   ParseVar('integer; public name ''ce''','');
   AssertEquals('Variable modifiers',[vmpublic],TheVar.VarModifiers);
-  AssertEquals('Public export name','''ce''',TheVar.ExportName);
+  AssertNotNull('Public export name',TheVar.ExportName);
 end;
 
 procedure TTestVarParser.TestVarDeprecatedExternalName;
@@ -315,7 +315,8 @@ begin
   ParseVar('integer deprecated; external name ''me''','');
   CheckHint(TPasMemberHint(Getenumvalue(typeinfo(TPasMemberHint),'hdeprecated')));
   AssertEquals('Variable modifiers',[vmexternal],TheVar.VarModifiers);
-  AssertEquals('Library name','''me''',TheVar.ExportName);
+  AssertNull('Library name',TheVar.LibraryName);
+  AssertNotNull('Library symbol',TheVar.ExportName);
 end;
 
 procedure TTestVarParser.TestVarHintPriorToInit;