--- Merging r35822 into '.':

A    packages/fcl-web/examples/simpleserver
A    packages/fcl-web/examples/simpleserver/index.html
A    packages/fcl-web/examples/simpleserver/README.txt
A    packages/fcl-web/examples/simpleserver/index.css
A    packages/fcl-web/examples/simpleserver/simpleserver.pas
A    packages/fcl-web/examples/simpleserver/simpleserver.lpi
--- Recording mergeinfo for merge of r35822 into '.':
 U   .
--- Merging r35827 into '.':
U    packages/fcl-passrc/tests/tcresolver.pas
U    packages/fcl-passrc/src/pasresolver.pp
--- Recording mergeinfo for merge of r35827 into '.':
 G   .
--- Merging r35828 into '.':
U    packages/pastojs/tests/tcmodules.pas
U    packages/pastojs/src/fppas2js.pp
--- Recording mergeinfo for merge of r35828 into '.':
 G   .
--- Merging r35829 into '.':
U    packages/fcl-passrc/src/pparser.pp
U    packages/fcl-passrc/src/pastree.pp
U    packages/fcl-passrc/tests/tctypeparser.pas
--- Recording mergeinfo for merge of r35829 into '.':
 G   .
--- Merging r35839 into '.':
G    packages/fcl-passrc/tests/tcresolver.pas
G    packages/fcl-passrc/src/pasresolver.pp
--- Recording mergeinfo for merge of r35839 into '.':
 G   .
--- Merging r35840 into '.':
G    packages/pastojs/tests/tcmodules.pas
U    packages/pastojs/tests/tcoptimizations.pas
G    packages/pastojs/src/fppas2js.pp
--- Recording mergeinfo for merge of r35840 into '.':
 G   .
--- Merging r35842 into '.':
G    packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r35842 into '.':
 G   .
--- Merging r35843 into '.':
G    packages/pastojs/tests/tcmodules.pas
--- Recording mergeinfo for merge of r35843 into '.':
 G   .
--- Merging r35844 into '.':
G    packages/fcl-passrc/tests/tcresolver.pas
G    packages/fcl-passrc/src/pasresolver.pp
--- Recording mergeinfo for merge of r35844 into '.':
 G   .
--- Merging r35845 into '.':
G    packages/pastojs/tests/tcmodules.pas
G    packages/pastojs/src/fppas2js.pp
--- Recording mergeinfo for merge of r35845 into '.':
 G   .
--- Merging r35846 into '.':
G    packages/fcl-passrc/tests/tcresolver.pas
G    packages/fcl-passrc/src/pasresolver.pp
--- Recording mergeinfo for merge of r35846 into '.':
 G   .
--- Merging r35847 into '.':
G    packages/pastojs/tests/tcmodules.pas
G    packages/pastojs/src/fppas2js.pp
--- Recording mergeinfo for merge of r35847 into '.':
 G   .
--- Merging r35851 into '.':
G    packages/fcl-passrc/src/pastree.pp
G    packages/fcl-passrc/src/pasresolver.pp
G    packages/fcl-passrc/tests/tcresolver.pas
U    packages/fcl-passrc/tests/tcuseanalyzer.pas
--- Recording mergeinfo for merge of r35851 into '.':
 G   .
--- Merging r35852 into '.':
G    packages/pastojs/tests/tcmodules.pas
G    packages/pastojs/src/fppas2js.pp
--- Recording mergeinfo for merge of r35852 into '.':
 G   .
--- Merging r35853 into '.':
G    packages/fcl-passrc/src/pasresolver.pp
U    packages/fcl-passrc/src/pasuseanalyzer.pas
--- Recording mergeinfo for merge of r35853 into '.':
 G   .
--- Merging r35854 into '.':
G    packages/pastojs/src/fppas2js.pp
G    packages/pastojs/tests/tcmodules.pas
--- Recording mergeinfo for merge of r35854 into '.':
 G   .
--- Merging r35859 into '.':
G    packages/fcl-passrc/tests/tcresolver.pas
G    packages/fcl-passrc/src/pasresolver.pp
--- Recording mergeinfo for merge of r35859 into '.':
 G   .
--- Merging r35860 into '.':
G    packages/pastojs/src/fppas2js.pp
--- Recording mergeinfo for merge of r35860 into '.':
 G   .
--- Merging r35862 into '.':
G    packages/pastojs/tests/tcmodules.pas
G    packages/pastojs/src/fppas2js.pp
--- Recording mergeinfo for merge of r35862 into '.':
 G   .
--- Merging r35863 into '.':
G    packages/fcl-passrc/src/pasresolver.pp
G    packages/fcl-passrc/tests/tcresolver.pas
--- Recording mergeinfo for merge of r35863 into '.':
 G   .
--- Merging r35864 into '.':
G    packages/pastojs/src/fppas2js.pp
G    packages/pastojs/tests/tcmodules.pas
--- Recording mergeinfo for merge of r35864 into '.':
 G   .
--- Merging r35865 into '.':
G    packages/fcl-passrc/tests/tcuseanalyzer.pas
G    packages/fcl-passrc/src/pasuseanalyzer.pas
--- Recording mergeinfo for merge of r35865 into '.':
 G   .
--- Merging r35866 into '.':
G    packages/fcl-passrc/src/pasresolver.pp
--- Recording mergeinfo for merge of r35866 into '.':
 G   .
--- Merging r35867 into '.':
G    packages/pastojs/src/fppas2js.pp
G    packages/pastojs/tests/tcmodules.pas
--- Recording mergeinfo for merge of r35867 into '.':
 G   .
--- Merging r35868 into '.':
G    packages/fcl-passrc/tests/tcresolver.pas
G    packages/fcl-passrc/src/pasresolver.pp
--- Recording mergeinfo for merge of r35868 into '.':
 G   .
--- Merging r35869 into '.':
G    packages/pastojs/src/fppas2js.pp
--- Recording mergeinfo for merge of r35869 into '.':
 G   .
--- Merging r35870 into '.':
G    packages/fcl-passrc/tests/tcresolver.pas
G    packages/fcl-passrc/src/pasresolver.pp
--- Recording mergeinfo for merge of r35870 into '.':
 G   .
--- Merging r35871 into '.':
G    packages/pastojs/tests/tcmodules.pas
G    packages/pastojs/src/fppas2js.pp
--- Recording mergeinfo for merge of r35871 into '.':
 G   .
--- Merging r35872 into '.':
G    packages/fcl-passrc/src/pasresolver.pp
G    packages/fcl-passrc/tests/tcresolver.pas
--- Recording mergeinfo for merge of r35872 into '.':
 G   .
--- Merging r35873 into '.':
G    packages/pastojs/tests/tcmodules.pas
G    packages/pastojs/src/fppas2js.pp
--- Recording mergeinfo for merge of r35873 into '.':
 G   .
--- Merging r35874 into '.':
G    packages/fcl-passrc/tests/tcresolver.pas
G    packages/fcl-passrc/tests/tcuseanalyzer.pas
G    packages/fcl-passrc/src/pasresolver.pp
G    packages/fcl-passrc/src/pasuseanalyzer.pas
--- Recording mergeinfo for merge of r35874 into '.':
 G   .
--- Merging r35875 into '.':
G    packages/pastojs/src/fppas2js.pp
--- Recording mergeinfo for merge of r35875 into '.':
 G   .
--- Merging r35876 into '.':
G    packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r35876 into '.':
 G   .

# revisions: 35822,35827,35828,35829,35839,35840,35842,35843,35844,35845,35846,35847,35851,35852,35853,35854,35859,35860,35862,35863,35864,35865,35866,35867,35868,35869,35870,35871,35872,35873,35874,35875,35876

git-svn-id: branches/fixes_3_0@35988 -

.gitattributes

@@ -3112,6 +3112,11 @@ packages/fcl-web/examples/session/sessiondemo.lpi svneol=native#text/plain
 packages/fcl-web/examples/session/sessiondemo.lpr svneol=native#text/plain
 packages/fcl-web/examples/session/wmsession.lfm svneol=native#text/plain
 packages/fcl-web/examples/session/wmsession.pp svneol=native#text/plain
+packages/fcl-web/examples/simpleserver/README.txt svneol=native#text/plain
+packages/fcl-web/examples/simpleserver/index.css svneol=native#text/plain
+packages/fcl-web/examples/simpleserver/index.html svneol=native#text/plain
+packages/fcl-web/examples/simpleserver/simpleserver.lpi svneol=native#text/plain
+packages/fcl-web/examples/simpleserver/simpleserver.pas svneol=native#text/plain
 packages/fcl-web/examples/webdata/demo/createusers.lpi svneol=native#text/plain
 packages/fcl-web/examples/webdata/demo/createusers.lpr svneol=native#text/plain
 packages/fcl-web/examples/webdata/demo/extgrid-json.html svneol=native#text/plain

packages/fcl-passrc/src/pastree.pp

@@ -103,7 +103,7 @@ type
 
   TCallingConvention = (ccDefault,ccRegister,ccPascal,ccCDecl,ccStdCall,
                         ccOldFPCCall,ccSafeCall,ccSysCall);
-  TProcTypeModifier = (ptmOfObject,ptmIsNested,ptmStatic,ptmVarargs);
+  TProcTypeModifier = (ptmOfObject,ptmIsNested,ptmStatic,ptmVarargs,ptmReferenceTo);
   TProcTypeModifiers = set of TProcTypeModifier;
   TPackMode = (pmNone,pmPacked,pmBitPacked);
 
@@ -654,8 +654,10 @@ type
   private
     function GetIsNested: Boolean;
     function GetIsOfObject: Boolean;
+    function GetIsReference: Boolean;
     procedure SetIsNested(const AValue: Boolean);
     procedure SetIsOfObject(const AValue: Boolean);
+    procedure SetIsReference(AValue: Boolean);
   public
     constructor Create(const AName: string; AParent: TPasElement); override;
     destructor Destroy; override;
@@ -672,6 +674,7 @@ type
     Modifiers: TProcTypeModifiers;
     property IsOfObject: Boolean read GetIsOfObject write SetIsOfObject;
     property IsNested : Boolean read GetIsNested write SetIsNested;
+    property IsReferenceTo : Boolean Read GetIsReference write SetIsReference;
   end;
 
   { TPasResultElement }
@@ -718,7 +721,7 @@ type
     function ElementTypeName: string; override;
   end;
 
-  { TPasStringType }
+  { TPasStringType - e.g. string[len] }
 
   TPasStringType = class(TPasUnresolvedTypeRef)
   public
@@ -1420,7 +1423,7 @@ const
   cCallingConventions : Array[TCallingConvention] of string =
       ( '', 'Register','Pascal','CDecl','StdCall','OldFPCCall','SafeCall','SysCall');
   ProcTypeModifiers : Array[TProcTypeModifier] of string =
-      ('of Object', 'is nested','static','varargs');
+      ('of Object', 'is nested','static','varargs','reference to');
 
   ModifierNames : Array[TProcedureModifier] of string
                 = ('virtual', 'dynamic','abstract', 'override',
@@ -2468,6 +2471,11 @@ begin
   Result:=ptmOfObject in Modifiers;
 end;
 
+function TPasProcedureType.GetIsReference: Boolean;
+begin
+  Result:=ptmReferenceTo in Modifiers;
+end;
+
 procedure TPasProcedureType.SetIsNested(const AValue: Boolean);
 begin
   if AValue then
@@ -2484,6 +2492,14 @@ begin
     Exclude(Modifiers,ptmOfObject);
 end;
 
+procedure TPasProcedureType.SetIsReference(AValue: Boolean);
+begin
+  if AValue then
+    Include(Modifiers,ptmReferenceTo)
+  else
+    Exclude(Modifiers,ptmReferenceTo);
+end;
+
 constructor TPasProcedureType.Create(const AName: string; AParent: TPasElement);
 begin
   inherited Create(AName, AParent);

packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -610,7 +610,12 @@ begin
   else if C.InheritsFrom(TPasExpr) then
     UseExpr(TPasExpr(El))
   else if C=TPasEnumValue then
-    MarkElementAsUsed(El)
+    begin
+    repeat
+      MarkElementAsUsed(El);
+      El:=El.Parent;
+    until not (El is TPasType);
+    end
   else if C.InheritsFrom(TPasModule) then
     // e.g. unitname.identifier -> the module is used by the identifier
   else
@@ -618,7 +623,7 @@ begin
 end;
 
 procedure TPasAnalyzer.UsePublished(El: TPasElement);
-// mark typeinfo, do not
+// mark typeinfo, do not mark code
 var
   C: TClass;
   Members: TFPList;
@@ -636,6 +641,8 @@ begin
   if C=TPasUnresolvedSymbolRef then
   else if (C=TPasVariable) or (C=TPasConst) then
     UsePublished(TPasVariable(El).VarType)
+  else if (C=TPasArgument) then
+    UsePublished(TPasArgument(El).ArgType)
   else if C=TPasProperty then
     begin
     // published property
@@ -1002,8 +1009,14 @@ begin
         if BuiltInProc.BuiltIn=bfTypeInfo then
           begin
           Params:=(El.Parent as TParamsExpr).Params;
-          Resolver.ComputeElement(Params[0],ParamResolved,[]);
-          UsePublished(ParamResolved.IdentEl);
+          Resolver.ComputeElement(Params[0],ParamResolved,[rcNoImplicitProc]);
+          {$IFDEF VerbosePasAnalyzer}
+          writeln('TPasAnalyzer.UseExpr typeinfo ',GetResolverResultDbg(ParamResolved));
+          {$ENDIF}
+          if ParamResolved.IdentEl is TPasFunction then
+            UsePublished(TPasFunction(ParamResolved.IdentEl).FuncType.ResultEl.ResultType)
+          else
+            UsePublished(ParamResolved.IdentEl);
           end;
         end;
       end;

packages/fcl-passrc/src/pparser.pp

@@ -336,6 +336,7 @@ type
     function ParseComplexType(Parent : TPasElement = Nil): TPasType;
     function ParseTypeDecl(Parent: TPasElement): TPasType;
     function ParseType(Parent: TPasElement; const NamePos: TPasSourcePos; const TypeName: String = ''; Full: Boolean = false; GenericArgs: TFPList = nil): TPasType;
+    function ParseReferenceToProcedureType(Parent: TPasElement; Const NamePos: TPasSourcePos; Const TypeName: String): TPasProcedureType;
     function ParseProcedureType(Parent: TPasElement; Const NamePos: TPasSourcePos; Const TypeName: String; const PT: TProcType): TPasProcedureType;
     function ParseStringType(Parent: TPasElement; Const NamePos: TPasSourcePos; Const TypeName: String): TPasAliasType;
     function ParseSimpleType(Parent: TPasElement; Const NamePos: TPasSourcePos; Const TypeName: String; IsFull : Boolean = False): TPasType;
@@ -594,7 +595,7 @@ begin
     // TargetCPU
     s := UpperCase(CPUTarget);
     Scanner.AddDefine('CPU'+s);
-    if (s='x86_64') then
+    if (s='X86_64') then
       Scanner.AddDefine('CPU64')
     else
       Scanner.AddDefine('CPU32');
@@ -886,7 +887,12 @@ end;
 procedure TPasParser.CheckToken(tk: TToken);
 begin
   if (CurToken<>tk) then
+    begin
+    {$IFDEF VerbosePasParser}
+    writeln('TPasParser.ParseExcTokenError String="',CurTokenString,'" Text="',CurTokenText,'" CurToken=',CurToken,' tk=',tk);
+    {$ENDIF}
     ParseExcTokenError(TokenInfos[tk]);
+    end;
 end;
 
 
@@ -1331,7 +1337,16 @@ begin
           Result:=ParseAliasType(Parent,NamePos,TypeName);
         end;
       // Always allowed
-      tkIdentifier: Result:=ParseSimpleType(Parent,NamePos,TypeName,Full);
+      tkIdentifier:
+        begin
+        if CurTokenIsIdentifier('reference') then
+          begin
+          CH:=False;
+          Result:=ParseReferencetoProcedureType(Parent,NamePos,TypeName)
+          end
+        else
+          Result:=ParseSimpleType(Parent,NamePos,TypeName,Full);
+        end;
       tkCaret: Result:=ParsePointerType(Parent,NamePos,TypeName);
       tkFile: Result:=ParseFileType(Parent,NamePos,TypeName);
       tkArray: Result:=ParseArrayType(Parent,NamePos,TypeName,pm);
@@ -1371,6 +1386,22 @@ begin
   end;
 end;
 
+function TPasParser.ParseReferenceToProcedureType(Parent: TPasElement; const NamePos: TPasSourcePos; const TypeName: String
+  ): TPasProcedureType;
+begin
+  if not CurTokenIsIdentifier('reference') then
+    ParseExcTokenError('reference');
+  ExpectToken(tkTo);
+  NextToken;
+  Case CurToken of
+   tkprocedure : Result:=ParseProcedureType(Parent,NamePos,TypeName,ptProcedure);
+   tkfunction : Result:=ParseProcedureType(Parent,NamePos,TypeName,ptFunction);
+  else
+    ParseExcTokenError('procedure or function');
+  end;
+  Result.IsReferenceTo:=True;
+end;
+
 function TPasParser.ParseComplexType(Parent : TPasElement = Nil): TPasType;
 begin
   NextToken;
@@ -3093,7 +3124,7 @@ begin
   if not CurTokenIsIdentifier('name') then
     ParseExcSyntaxError;
   NextToken;
-  if not (CurToken in [tkString,tkIdentifier]) then
+  if not (CurToken in [tkChar,tkString,tkIdentifier]) then
     ParseExcTokenError(TokenInfos[tkString]);
   Result := Result + ' ' + CurTokenText;
   ExportName:=DoParseExpression(Parent);
@@ -3485,7 +3516,7 @@ begin
         if ((CurToken=tkIdentifier) and (Tok='NAME')) then
           begin
           NextToken;
-          if not (CurToken in [tkString,tkIdentifier]) then
+          if not (CurToken in [tkChar,tkString,tkIdentifier]) then
             ParseExcTokenError(TokenInfos[tkString]);
           E:=DoParseExpression(Parent);
           if Assigned(P) then
@@ -5241,7 +5272,9 @@ begin
     ExpectIdentifier;
     If Not CurTokenIsIdentifier('Name')  then
       ParseExc(nParserExpectedExternalClassName,SParserExpectedExternalClassName);
-    ExpectToken(tkString);
+    NextToken;
+    if not (CurToken in [tkChar,tkString]) then
+      CheckToken(tkString);
     AExternalName:=CurTokenString;
     NextToken;
     end

packages/fcl-passrc/tests/tcresolver.pas

@@ -104,6 +104,7 @@ type
     FModules: TObjectList;// list of TTestEnginePasResolver
     FResolverEngine: TTestEnginePasResolver;
     FResolverMsgs: TObjectList; // list of TTestResolverMessage
+    FResolverGoodMsgs: TFPList; // list of TTestResolverMessage marked as expected
     function GetModuleCount: integer;
     function GetModules(Index: integer): TTestEnginePasResolver;
     function GetMsgCount: integer;
@@ -121,7 +122,8 @@ type
     procedure ParseProgram; virtual;
     procedure ParseUnit; virtual;
     procedure CheckReferenceDirectives; virtual;
-    procedure CheckResolverHint(MsgType: TMessageType; MsgNumber: integer; Msg: string; MustHave: boolean);
+    procedure CheckResolverHint(MsgType: TMessageType; MsgNumber: integer; Msg: string); virtual;
+    procedure CheckResolverUnexpectedHints; virtual;
     procedure CheckResolverException(Msg: string; MsgNumber: integer);
     procedure CheckParserException(Msg: string; MsgNumber: integer);
     procedure CheckAccessMarkers; virtual;
@@ -181,6 +183,7 @@ type
     Procedure TestArgWrongExprFail;
     Procedure TestVarExternal;
     Procedure TestVarNoSemicolonBeginFail;
+    Procedure TestIntegerRange;
 
     // strings
     Procedure TestChar_Ord;
@@ -191,11 +194,11 @@ type
     Procedure TestStringElement_IndexNonIntFail;
     Procedure TestStringElement_AsVarArgFail;
     Procedure TestString_DoubleQuotesFail;
+    Procedure TestString_ShortstringType;
 
     // enums
     Procedure TestEnums;
     Procedure TestSets;
-    Procedure TestSetConstRange;
     Procedure TestSetOperators;
     Procedure TestEnumParams;
     Procedure TestSetParams;
@@ -206,6 +209,7 @@ type
     Procedure TestEnum_EqualNilFail;
     Procedure TestEnum_CastIntegerToEnum;
     Procedure TestEnum_Str;
+    Procedure TestSetConstRange;
     Procedure TestSet_AnonymousEnumtype;
     Procedure TestSet_AnonymousEnumtypeName;
 
@@ -279,6 +283,10 @@ type
     Procedure TestProcedureResultFail;
     Procedure TestProcOverload;
     Procedure TestProcOverloadWithBaseTypes;
+    Procedure TestProcOverloadWithBaseTypes2;
+    Procedure TestProcOverloadNearestHigherPrecision;
+    Procedure TestProcCallLowPrecision;
+    Procedure TestProcOverloadMultiLowPrecisionFail;
     Procedure TestProcOverloadWithClassTypes;
     Procedure TestProcOverloadWithInhClassTypes;
     Procedure TestProcOverloadWithInhAliasClassTypes;
@@ -331,6 +339,7 @@ type
     Procedure TestClassForwardAsAncestorFail;
     Procedure TestClassForwardNotResolved;
     Procedure TestClass_Method;
+    Procedure TestClass_ConstructorMissingDotFail;
     Procedure TestClass_MethodWithoutClassFail;
     Procedure TestClass_MethodWithParams;
     Procedure TestClass_MethodUnresolvedPrg;
@@ -348,12 +357,14 @@ type
     Procedure TestClass_MethodOverrideSameResultType;
     Procedure TestClass_MethodOverrideDiffResultTypeFail;
     Procedure TestClass_MethodOverloadAncestor;
+    Procedure TestClass_MethodOverloadArrayOfTClass;
     Procedure TestClass_MethodScope;
     Procedure TestClass_IdentifierSelf;
     Procedure TestClassCallInherited;
     Procedure TestClassCallInheritedNoParamsAbstractFail;
     Procedure TestClassCallInheritedWithParamsAbstractFail;
     Procedure TestClassCallInheritedConstructor;
+    Procedure TestClassCallInheritedNested;
     Procedure TestClassAssignNil;
     Procedure TestClassAssign;
     Procedure TestClassNilAsParam;
@@ -525,12 +536,14 @@ type
     Procedure TestProcType_WhileListCompare;
     Procedure TestProcType_IsNested;
     Procedure TestProcType_IsNested_AssignProcFail;
+    Procedure TestProcType_ReferenceTo;
     Procedure TestProcType_AllowNested;
     Procedure TestProcType_AllowNestedOfObject;
     Procedure TestProcType_AsArgOtherUnit;
     Procedure TestProcType_Property;
     Procedure TestProcType_PropertyCallWrongArgFail;
     Procedure TestProcType_Typecast;
+    Procedure TestProcType_InsideFunction;
 
     // pointer
     Procedure TestPointer;
@@ -538,6 +551,10 @@ type
     Procedure TestPointer_TypecastToMethodTypeFail;
     Procedure TestPointer_TypecastFromMethodTypeFail;
     Procedure TestPointer_TypecastMethod_proMethodAddrAsPointer;
+    Procedure TestPointer_OverloadSignature;
+
+    // hints
+    Procedure TestHint_ElementHints;
   end;
 
 function LinesToStr(Args: array of const): string;
@@ -612,6 +629,7 @@ end;
 procedure TCustomTestResolver.TearDown;
 begin
   FResolverMsgs.Clear;
+  FResolverGoodMsgs.Clear;
   {$IFDEF VerbosePasResolverMem}
   writeln('TTestResolver.TearDown START FreeSrcMarkers');
   {$ENDIF}
@@ -1091,29 +1109,24 @@ begin
 end;
 
 procedure TCustomTestResolver.CheckResolverHint(MsgType: TMessageType;
-  MsgNumber: integer; Msg: string; MustHave: boolean);
+  MsgNumber: integer; Msg: string);
 var
   i: Integer;
   Item: TTestResolverMessage;
   Expected,Actual: string;
 begin
-  writeln('TCustomTestResolver.CheckResolverHint MsgCount=',MsgCount);
+  //writeln('TCustomTestResolver.CheckResolverHint MsgCount=',MsgCount);
   for i:=0 to MsgCount-1 do
     begin
     Item:=Msgs[i];
     if (Item.MsgNumber<>MsgNumber) or (Item.Msg<>Msg) then continue;
     // found
+    FResolverGoodMsgs.Add(Item);
     str(Item.MsgType,Actual);
-    if not MustHave then
-      begin
-      WriteSources('',0,0);
-      Fail('Expected to *not* emit '+Actual+' ('+IntToStr(MsgNumber)+') {'+Msg+'}');
-      end;
     str(MsgType,Expected);
     AssertEquals('MsgType',Expected,Actual);
     exit;
     end;
-  if not MustHave then exit;
 
   // needed message missing -> show emitted messages
   WriteSources('',0,0);
@@ -1126,6 +1139,22 @@ begin
   Fail('Missing '+Expected+' ('+IntToStr(MsgNumber)+') '+Msg);
 end;
 
+procedure TCustomTestResolver.CheckResolverUnexpectedHints;
+var
+  i: Integer;
+  s: String;
+  Msg: TTestResolverMessage;
+begin
+  for i:=0 to MsgCount-1 do
+    begin
+    Msg:=Msgs[i];
+    if FResolverGoodMsgs.IndexOf(Msg)>=0 then continue;
+    s:='';
+    str(Msg.MsgType,s);
+    Fail('Unexpected resolver message found ['+IntToStr(Msg.Id)+'] '+s+': ('+IntToStr(Msg.MsgNumber)+') {'+Msg.Msg+'}');
+    end;
+end;
+
 procedure TCustomTestResolver.CheckResolverException(Msg: string; MsgNumber: integer);
 var
   ok: Boolean;
@@ -1357,11 +1386,13 @@ constructor TCustomTestResolver.Create;
 begin
   inherited Create;
   FResolverMsgs:=TObjectList.Create(true);
+  FResolverGoodMsgs:=TFPList.Create;
 end;
 
 destructor TCustomTestResolver.Destroy;
 begin
   FreeAndNil(FResolverMsgs);
+  FreeAndNil(FResolverGoodMsgs);
   inherited Destroy;
 end;
 
@@ -1604,7 +1635,7 @@ var
   var
     s: String;
   begin
-    s:='TTestResolver.OnCheckElementParent El='+GetTreeDesc(El)+' '+
+    s:='TTestResolver.OnCheckElementParent El='+GetTreeDbg(El)+' '+
       ResolverEngine.GetElementSourcePosStr(El)+' '+Msg;
     writeln('ERROR: ',s);
     Fail(s);
@@ -2041,6 +2072,16 @@ begin
     nParserExpectTokenError);
 end;
 
+procedure TTestResolver.TestIntegerRange;
+begin
+  StartProgram(false);
+  Add('const');
+  Add('  MinInt = -1;');
+  Add('  MaxInt = +1;');
+  Add('  {#TMyInt}TMyInt = MinInt..MaxInt;');
+  Add('begin');
+end;
+
 procedure TTestResolver.TestChar_Ord;
 begin
   StartProgram(false);
@@ -2107,7 +2148,7 @@ begin
   Add('var s: string;');
   Add('begin');
   Add('  if s[true]=s then ;');
-  CheckResolverException('Incompatible types: got "Boolean" expected "Char"',
+  CheckResolverException('Incompatible types: got "Boolean" expected "integer"',
     PasResolver.nIncompatibleTypesGotExpected);
 end;
 
@@ -2133,6 +2174,19 @@ begin
   CheckParserException('Invalid character ''"''',PScanner.nErrInvalidCharacter);
 end;
 
+procedure TTestResolver.TestString_ShortstringType;
+begin
+  StartProgram(false);
+  Add([
+  'type t = string[12];',
+  'var',
+  '  s: t;',
+  'begin',
+  '  s:=''abc'';',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestEnums;
 begin
   StartProgram(false);
@@ -2193,16 +2247,6 @@ begin
   ParseProgram;
 end;
 
-procedure TTestResolver.TestSetConstRange;
-begin
-  StartProgram(false);
-  Add('const');
-  Add('  MinInt = -1;');
-  Add('  MaxInt = +1;');
-  Add('  {#TMyInt}TMyInt = MinInt..MaxInt;');
-  Add('begin');
-end;
-
 procedure TTestResolver.TestSetOperators;
 begin
   StartProgram(false);
@@ -2418,6 +2462,32 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestSetConstRange;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TEnum = (red,blue,green);',
+  '  TEnums = set of TEnum;',
+  'const',
+  '  teAny = [low(TEnum)..high(TEnum)];',
+  '  teRedBlue = [low(TEnum)..pred(high(TEnum))];',
+  'var',
+  '  e: TEnum;',
+  '  s: TEnums;',
+  'begin',
+  '  if blue in teAny then;',
+  '  if blue in teAny+[e] then;',
+  '  if blue in teAny+teRedBlue then;',
+  '  s:=teAny;',
+  '  s:=teAny+[e];',
+  '  s:=[e]+teAny;',
+  '  s:=teAny+teRedBlue;',
+  '  s:=teAny+teRedBlue+[e];',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestSet_AnonymousEnumtype;
 begin
   StartProgram(false);
@@ -2596,8 +2666,9 @@ begin
   Add('  {#vshortint}vshortint:shortint;');
   Add('  {#vword}vword:word;');
   Add('  {#vsmallint}vsmallint:smallint;');
-  Add('  {#vcardinal}vcardinal:cardinal;');
+  Add('  {#vlongword}vlongword:longword;');
   Add('  {#vlongint}vlongint:longint;');
+  Add('  {#vqword}vqword:qword;');
   Add('  {#vint64}vint64:int64;');
   Add('  {#vcomp}vcomp:comp;');
   Add('begin');
@@ -2611,8 +2682,8 @@ begin
   Add('  {@vsmallint}vsmallint:=0;');
   Add('  {@vsmallint}vsmallint:=-$8000;');
   Add('  {@vsmallint}vsmallint:= $7fff;');
-  Add('  {@vcardinal}vcardinal:=0;');
-  Add('  {@vcardinal}vcardinal:=$ffffffff;');
+  Add('  {@vlongword}vlongword:=0;');
+  Add('  {@vlongword}vlongword:=$ffffffff;');
   Add('  {@vlongint}vlongint:=0;');
   Add('  {@vlongint}vlongint:=-$80000000;');
   Add('  {@vlongint}vlongint:= $7fffffff;');
@@ -2621,11 +2692,14 @@ begin
   Add('  {@vlongint}vlongint:={@vword}vword;');
   Add('  {@vlongint}vlongint:={@vsmallint}vsmallint;');
   Add('  {@vlongint}vlongint:={@vlongint}vlongint;');
-  Add('  {@vcomp}vcomp:=0;');
-  Add('  {@vcomp}vcomp:=$ffffffffffffffff;');
   Add('  {@vint64}vint64:=0;');
   Add('  {@vint64}vint64:=-$8000000000000000;');
   Add('  {@vint64}vint64:= $7fffffffffffffff;');
+  Add('  {@vqword}vqword:=0;');
+  Add('  {@vqword}vqword:=$ffffffffffffffff;');
+  Add('  {@vcomp}vcomp:=0;');
+  Add('  {@vcomp}vcomp:=-$8000000000000000;');
+  Add('  {@vcomp}vcomp:= $7fffffffffffffff;');
   ParseProgram;
 end;
 
@@ -2683,8 +2757,11 @@ begin
   Add('  i:=-j+k;');
   Add('  i:=j*k;');
   Add('  i:=j**k;');
+  Add('  i:=10**3;');
   Add('  i:=j div k;');
+  Add('  i:=10 div 3;');
   Add('  i:=j mod k;');
+  Add('  i:=10 mod 3;');
   Add('  i:=j shl k;');
   Add('  i:=j shr k;');
   Add('  i:=j and k;');
@@ -2743,6 +2820,7 @@ begin
   StartProgram(false);
   Add('var');
   Add('  i,j,k:double;');
+  Add('  o,p:longint;');
   Add('begin');
   Add('  i:=1;');
   Add('  i:=1+2;');
@@ -2754,8 +2832,18 @@ begin
   Add('  i:=j+k;');
   Add('  i:=-j+k;');
   Add('  i:=j*k;');
+  Add('  i:=10/3;');
+  Add('  i:=10.0/3;');
+  Add('  i:=10/3.0;');
+  Add('  i:=10.0/3.0;');
   Add('  i:=j/k;');
+  Add('  i:=o/p;');
+  Add('  i:=10**3;');
+  Add('  i:=10.0**3;');
+  Add('  i:=10.0**3.0;');
+  Add('  i:=10**3.0;');
   Add('  i:=j**k;');
+  Add('  i:=o**p;');
   Add('  i:=(j+k)/3;');
   ParseProgram;
 end;
@@ -3071,23 +3159,36 @@ end;
 procedure TTestResolver.TestTypeInfo;
 begin
   StartProgram(false);
-  Add('type');
-  Add('  integer = longint;');
-  Add('  TRec = record');
-  Add('    v: integer;');
-  Add('  end;');
-  Add('var');
-  Add('  i: integer;');
-  Add('  s: string;');
-  Add('  p: pointer;');
-  Add('  r: TRec;');
-  Add('begin');
-  Add('  p:=typeinfo(integer);');
-  Add('  p:=typeinfo(longint);');
-  Add('  p:=typeinfo(i);');
-  Add('  p:=typeinfo(s);');
-  Add('  p:=typeinfo(p);');
-  Add('  p:=typeinfo(r.v);');
+  Add([
+  'type',
+  '  integer = longint;',
+  '  TRec = record',
+  '    v: integer;',
+  '  end;',
+  '  TClass = class of TObject;',
+  '  TObject = class',
+  '    class function ClassType: TClass; virtual; abstract;',
+  '  end;',
+  'var',
+  '  i: integer;',
+  '  s: string;',
+  '  p: pointer;',
+  '  r: TRec;',
+  '  o: TObject;',
+  '  c: TClass;',
+  'begin',
+  '  p:=typeinfo(integer);',
+  '  p:=typeinfo(longint);',
+  '  p:=typeinfo(i);',
+  '  p:=typeinfo(s);',
+  '  p:=typeinfo(p);',
+  '  p:=typeinfo(r.v);',
+  '  p:=typeinfo(TObject.ClassType);',
+  '  p:=typeinfo(o.ClassType);',
+  '  p:=typeinfo(o);',
+  '  p:=typeinfo(c);',
+  '  p:=typeinfo(c.ClassType);',
+  '']);
   ParseProgram;
 end;
 
@@ -3688,6 +3789,86 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestProcOverloadWithBaseTypes2;
+begin
+  StartProgram(false);
+  Add('procedure {#byte}DoIt(p: byte); external;  var by: byte;');
+  Add('procedure {#shortint}DoIt(p: shortint); external;  var shi: shortint;');
+  Add('procedure {#word}DoIt(p: word); external;  var w: word;');
+  Add('procedure {#smallint}DoIt(p: smallint); external;  var smi: smallint;');
+  Add('procedure {#longword}DoIt(p: longword); external;  var lw: longword;');
+  Add('procedure {#longint}DoIt(p: longint); external;  var li: longint;');
+  Add('procedure {#qword}DoIt(p: qword); external;  var qw: qword;');
+  Add('procedure {#int64}DoIt(p: int64); external;  var i6: int64;');
+  Add('procedure {#comp}DoIt(p: comp); external;  var co: comp;');
+  Add('procedure {#boolean}DoIt(p: boolean); external;  var bo: boolean;');
+  Add('procedure {#char}DoIt(p: char); external;  var ch: char;');
+  Add('procedure {#widechar}DoIt(p: widechar); external;  var wc: widechar;');
+  Add('procedure {#string}DoIt(p: string); external;  var st: string;');
+  Add('procedure {#widestring}DoIt(p: widestring); external;  var ws: widestring;');
+  Add('procedure {#shortstring}DoIt(p: shortstring); external;  var ss: shortstring;');
+  Add('procedure {#unicodestring}DoIt(p: unicodestring); external;  var us: unicodestring;');
+  Add('procedure {#rawbytestring}DoIt(p: rawbytestring); external;  var rs: rawbytestring;');
+  Add('begin');
+  Add('  {@byte}DoIt(by);');
+  Add('  {@shortint}DoIt(shi);');
+  Add('  {@word}DoIt(w);');
+  Add('  {@smallint}DoIt(smi);');
+  Add('  {@longword}DoIt(lw);');
+  Add('  {@longint}DoIt(li);');
+  Add('  {@qword}DoIt(qw);');
+  Add('  {@int64}DoIt(i6);');
+  Add('  {@comp}DoIt(co);');
+  Add('  {@boolean}DoIt(bo);');
+  Add('  {@char}DoIt(ch);');
+  Add('  {@widechar}DoIt(wc);');
+  Add('  {@string}DoIt(st);');
+  Add('  {@widestring}DoIt(ws);');
+  Add('  {@shortstring}DoIt(ss);');
+  Add('  {@unicodestring}DoIt(us);');
+  Add('  {@rawbytestring}DoIt(rs);');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestProcOverloadNearestHigherPrecision;
+begin
+  StartProgram(false);
+  Add([
+  'procedure {#longint}DoIt(i: longint); external;',
+  'procedure DoIt(i: int64); external;',
+  'var w: word;',
+  'begin',
+  '  {@longint}DoIt(w);',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestProcCallLowPrecision;
+begin
+  StartProgram(false);
+  Add([
+  'procedure {#longint}DoIt(i: longint); external;',
+  'var i: int64;',
+  'begin',
+  '  {@longint}DoIt(i);',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestProcOverloadMultiLowPrecisionFail;
+begin
+  StartProgram(false);
+  Add([
+  'procedure DoIt(i: longint); external;',
+  'procedure DoIt(w: longword); external;',
+  'var i: int64;',
+  'begin',
+  '  DoIt(i);',
+  '']);
+  CheckResolverException('Can''t determine which overloaded function to call, afile.pp(3,15), afile.pp(2,15)',
+    nCantDetermineWhichOverloadedFunctionToCall);
+end;
+
 procedure TTestResolver.TestProcOverloadWithClassTypes;
 begin
   StartProgram(false);
@@ -4530,6 +4711,21 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestClass_ConstructorMissingDotFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '    constructor Create;',
+  '  end;',
+  'constructor Create; begin end;',
+  'begin',
+  '']);
+  CheckResolverException('full method name expected, but short name found',
+    nXExpectedButYFound);
+end;
+
 procedure TTestResolver.TestClass_MethodWithoutClassFail;
 begin
   StartProgram(false);
@@ -4862,6 +5058,59 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestClass_MethodOverloadArrayOfTClass;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TClass = class of TObject;',
+  '  TObject = class',
+  '    constructor {#A}Builder(AClass: TClass; AName: string); reintroduce; overload; virtual;',
+  '    constructor {#B}Builder(AClass: TClass); reintroduce; overload; virtual;',
+  '    constructor {#C}Builder(AClassArray: Array of TClass); reintroduce; overload; virtual;',
+  '    constructor {#D}Builder(AName: string); reintroduce; overload; virtual;',
+  '    constructor {#E}Builder; reintroduce; overload; virtual;',
+  '    class var ClassName: string;',
+  '  end;',
+  '  TTestCase = class end;',
+  'constructor TObject.Builder(AClass: TClass; AName: string);',
+  'begin',
+  '  Builder(AClass);',
+  'end;',
+  'constructor TObject.Builder(AClass: TClass);',
+  'begin',
+  '  Builder(AClass.ClassName);',
+  'end;',
+  'constructor TObject.Builder(AClassArray: Array of TClass);',
+  'var',
+  '  i: longint;',
+  'begin',
+  '  Builder;',
+  '  for i := Low(AClassArray) to High(AClassArray) do',
+  '    if Assigned(AClassArray[i]) then ;',
+  'end;',
+  'constructor TObject.Builder(AName: string);',
+  'begin',
+  '  Builder();',
+  'end;',
+  'constructor TObject.Builder;',
+  'begin',
+  'end;',
+  'var',
+  '  o: TObject;',
+  'begin',
+  '  o.{@A}Builder(TTestCase,''first'');',
+  '  o.{@B}Builder(TTestCase);',
+  '  o.{@C}Builder([]);',
+  '  o.{@C}Builder([TTestCase]);',
+  '  o.{@C}Builder([TObject,TTestCase]);',
+  '  o.{@D}Builder(''fourth'');',
+  '  o.{@E}Builder();',
+  '  o.{@E}Builder;',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestClass_MethodScope;
 begin
   StartProgram(false);
@@ -5002,6 +5251,38 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestClassCallInheritedNested;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '    function DoIt: longint; virtual;',
+  '  end;',
+  '  TBird = class',
+  '    function DoIt: longint; override;',
+  '  end;',
+  'function tobject.doit: longint;',
+  'begin',
+  'end;',
+  'function tbird.doit: longint;',
+  '  procedure Sub;',
+  '  begin',
+  '    inherited;',
+  '    inherited DoIt;',
+  '    if inherited DoIt=4 then ;',
+  '  end;',
+  'begin',
+  '  Sub;',
+  '  inherited;',
+  '  inherited DoIt;',
+  '  if inherited DoIt=14 then ;',
+  'end;',
+  'begin',
+   '']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestClassAssignNil;
 begin
   StartProgram(false);
@@ -6016,13 +6297,14 @@ begin
   Add('begin');
   ParseProgram;
   CheckResolverHint(mtNote,nVirtualMethodXHasLowerVisibility,
-    'Virtual method "DoStrictProtected" has a lower visibility (private) than parent class TObject (strict protected)',true);
+    'Virtual method "DoStrictProtected" has a lower visibility (private) than parent class TObject (strict protected)');
   CheckResolverHint(mtNote,nVirtualMethodXHasLowerVisibility,
-    'Virtual method "DoProtected" has a lower visibility (private) than parent class TObject (protected)',true);
+    'Virtual method "DoProtected" has a lower visibility (private) than parent class TObject (protected)');
   CheckResolverHint(mtNote,nVirtualMethodXHasLowerVisibility,
-    'Virtual method "DoPublic" has a lower visibility (protected) than parent class TObject (public)',true);
+    'Virtual method "DoPublic" has a lower visibility (protected) than parent class TObject (public)');
   CheckResolverHint(mtNote,nVirtualMethodXHasLowerVisibility,
-    'Virtual method "DoPublished" has a lower visibility (protected) than parent class TObject (published)',true);
+    'Virtual method "DoPublished" has a lower visibility (protected) than parent class TObject (published)');
+  CheckResolverUnexpectedHints;
 end;
 
 procedure TTestResolver.TestClass_Const;
@@ -6466,8 +6748,8 @@ begin
   Add('  if TObject(Self)=nil then ;');
   Add('end;');
   Add('begin');
-  CheckResolverException('Cannot type cast a type',
-    PasResolver.nCannotTypecastAType);
+  CheckResolverException('Illegal type conversion: "Self" to "class TObject"',
+    PasResolver.nIllegalTypeConversionTo);
 end;
 
 procedure TTestResolver.TestClass_ClassMembers;
@@ -8424,6 +8706,63 @@ begin
   CheckResolverException('procedure type modifier "is nested" mismatch',nXModifierMismatchY);
 end;
 
+procedure TTestResolver.TestProcType_ReferenceTo;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TProcRef = reference to procedure(i: longint = 0);',
+  '  TFuncRef = reference to function(i: longint = 0): longint;',
+  '  TObject = class',
+  '    function Grow(s: longint): longint;',
+  '  end;',
+  'var',
+  '  p: TProcRef;',
+  '  f: TFuncRef;',
+  'function tobject.Grow(s: longint): longint;',
+  '  function GrowSub(i: longint): longint;',
+  '  begin',
+  '    f:=@Grow;',
+  '    f:=@GrowSub;',
+  '    f;',
+  '    f();',
+  '    f(1);',
+  '  end;',
+  'begin',
+  '  f:=@Grow;',
+  '  f:=@GrowSub;',
+  '  f;',
+  '  f();',
+  '  f(1);',
+  'end;',
+  'procedure DoIt(i: longint);',
+  'begin',
+  'end;',
+  'function GetIt(i: longint): longint;',
+  '  function Sub(i: longint): longint;',
+  '  begin',
+  '    p:=@DoIt;',
+  '    f:=@GetIt;',
+  '    f:=@Sub;',
+  '  end;',
+  'begin',
+  '  p:=@DoIt;',
+  '  f:=@GetIt;',
+  '  f;',
+  '  f();',
+  '  f(1);',
+  'end;',
+  'begin',
+  '  p:=@DoIt;',
+  '  f:=@GetIt;',
+  '  f;',
+  '  f();',
+  '  f(1);',
+  '  p:=TProcRef(f);',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestProcType_AllowNested;
 begin
   ResolverEngine.Options:=ResolverEngine.Options+[proProcTypeWithoutIsNested];
@@ -8596,6 +8935,22 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestProcType_InsideFunction;
+begin
+  StartProgram(false);
+  Add([
+  'function GetIt: longint;',
+  'type TGetter = function: longint;',
+  'var',
+  '  p: Pointer;',
+  'begin',
+  '  Result:=TGetter(p)();',
+  'end;',
+  'begin',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestPointer;
 begin
   StartProgram(false);
@@ -8686,6 +9041,59 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestPointer_OverloadSignature;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class end;');
+  Add('  TClass = class of TObject;');
+  Add('  TBird = class(TObject) end;');
+  Add('  TBirds = class of TBird;');
+  Add('procedure {#pointer}DoIt(p: Pointer); begin end;');
+  Add('procedure {#tobject}DoIt(o: TObject); begin end;');
+  Add('procedure {#tclass}DoIt(c: TClass); begin end;');
+  Add('var');
+  Add('  p: pointer;');
+  Add('  o: TObject;');
+  Add('  c: TClass;');
+  Add('  b: TBird;');
+  Add('  bc: TBirds;');
+  Add('begin');
+  Add('  {@pointer}DoIt(p);');
+  Add('  {@tobject}DoIt(o);');
+  Add('  {@tclass}DoIt(c);');
+  Add('  {@tobject}DoIt(b);');
+  Add('  {@tclass}DoIt(bc);');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestHint_ElementHints;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TDeprecated = longint deprecated;',
+  '  TLibrary = longint library;',
+  '  TPlatform = longint platform;',
+  '  TExperimental = longint experimental;',
+  '  TUnimplemented = longint unimplemented;',
+  'var',
+  '  vDeprecated: TDeprecated;',
+  '  vLibrary: TLibrary;',
+  '  vPlatform: TPlatform;',
+  '  vExperimental: TExperimental;',
+  '  vUnimplemented: TUnimplemented;',
+  'begin',
+  '']);
+  ParseProgram;
+  CheckResolverHint(mtWarning,nSymbolXIsDeprecated,'Symbol "TDeprecated" is deprecated');
+  CheckResolverHint(mtWarning,nSymbolXBelongsToALibrary,'Symbol "TLibrary" belongs to a library');
+  CheckResolverHint(mtWarning,nSymbolXIsNotPortable,'Symbol "TPlatform" is not portable');
+  CheckResolverHint(mtWarning,nSymbolXIsExperimental,'Symbol "TExperimental" is experimental');
+  CheckResolverHint(mtWarning,nSymbolXIsNotImplemented,'Symbol "TUnimplemented" is implemented');
+  CheckResolverUnexpectedHints;
+end;
+
 initialization
   RegisterTests([TTestResolver]);
 

packages/fcl-passrc/tests/tctypeparser.pas

@@ -410,6 +410,7 @@ type
     Procedure TestProcedureOutOpenArray;
     Procedure TestProcedureVarOpenArray;
     Procedure TestProcedureArrayOfConst;
+    Procedure TestProcedureReference;
     Procedure TestProcedureOfObject;
     Procedure TestProcedureOfObjectOneArg;
     Procedure TestProcedureIsNested;
@@ -1086,6 +1087,13 @@ begin
   TestCallingConventions(@DoTestProcedureArrayOfConst);
 end;
 
+procedure TTestProcedureTypeParser.TestProcedureReference;
+begin
+  ParseType('reference to procedure',ccDefault,TPasProcedureType);
+  AssertEquals('Argument count',0,Proc.Args.Count);
+  AssertEquals('Is Reference to',True,Proc.IsReferenceTo);
+end;
+
 Procedure TTestProcedureTypeParser.TestProcedureOfObject;
 begin
   TestCallingConventions(@DoTestProcedureOfObject);

packages/fcl-passrc/tests/tcuseanalyzer.pas

@@ -32,9 +32,9 @@ type
     procedure AnalyzeUnit; virtual;
     procedure AnalyzeWholeProgram; virtual;
     procedure CheckUsedMarkers; virtual;
-    procedure CheckHasHint(MsgType: TMessageType; MsgNumber: integer;
+    procedure CheckUseAnalyzerHint(MsgType: TMessageType; MsgNumber: integer;
       const MsgText: string); virtual;
-    procedure CheckUnexpectedMessages; virtual;
+    procedure CheckUseAnalyzerUnexpectedHints; virtual;
     procedure CheckUnitUsed(const aFilename: string; Used: boolean); virtual;
   public
     property Analyzer: TPasAnalyzer read FAnalyzer;
@@ -100,6 +100,7 @@ type
     procedure TestM_Hint_FunctionResultRecord;
     procedure TestM_Hint_FunctionResultPassRecordElement;
     procedure TestM_Hint_OutParam_No_AssignedButNeverUsed;
+    procedure TestM_Hint_ArgPassed_No_ParameterNotUsed;
 
     // whole program optimization
     procedure TestWP_LocalVar;
@@ -117,6 +118,8 @@ type
     procedure TestWP_PublishedRecordType;
     procedure TestWP_PublishedProcType;
     procedure TestWP_PublishedProperty;
+    procedure TestWP_BuiltInFunctions;
+    procedure TestWP_TypeInfo;
   end;
 
 implementation
@@ -239,7 +242,7 @@ begin
 
 end;
 
-procedure TCustomTestUseAnalyzer.CheckHasHint(MsgType: TMessageType;
+procedure TCustomTestUseAnalyzer.CheckUseAnalyzerHint(MsgType: TMessageType;
   MsgNumber: integer; const MsgText: string);
 var
   i: Integer;
@@ -272,7 +275,7 @@ begin
   Fail('Analyzer Message not found: '+s+': ('+IntToStr(MsgNumber)+') {'+MsgText+'}');
 end;
 
-procedure TCustomTestUseAnalyzer.CheckUnexpectedMessages;
+procedure TCustomTestUseAnalyzer.CheckUseAnalyzerUnexpectedHints;
 var
   i: Integer;
   Msg: TPAMessage;
@@ -284,7 +287,7 @@ begin
     if FPAGoodMessages.IndexOf(Msg)>=0 then continue;
     s:='';
     str(Msg.MsgType,s);
-    Fail('Analyzer Message found ['+IntToStr(Msg.Id)+'] '+s+': ('+IntToStr(Msg.MsgNumber)+') {'+Msg.MsgText+'}');
+    Fail('Unexpected analyzer message found ['+IntToStr(Msg.Id)+'] '+s+': ('+IntToStr(Msg.MsgNumber)+') {'+Msg.MsgText+'}');
     end;
 end;
 
@@ -851,8 +854,8 @@ begin
   Add('uses unit2;');
   Add('begin');
   AnalyzeProgram;
-  CheckHasHint(mtHint,nPAUnitNotUsed,'Unit "unit2" not used in afile');
-  CheckUnexpectedMessages;
+  CheckUseAnalyzerHint(mtHint,nPAUnitNotUsed,'Unit "unit2" not used in afile');
+  CheckUseAnalyzerUnexpectedHints;
 end;
 
 procedure TTestUseAnalyzer.TestM_Hint_UnitNotUsed_No_OnlyExternal;
@@ -873,7 +876,7 @@ begin
   AnalyzeProgram;
 
   // unit hints: no hint, even though no code is actually used
-  CheckUnexpectedMessages;
+  CheckUseAnalyzerUnexpectedHints;
 end;
 
 procedure TTestUseAnalyzer.TestM_Hint_ParameterNotUsed;
@@ -884,8 +887,8 @@ begin
   Add('begin');
   Add('  DoIt(1);');
   AnalyzeProgram;
-  CheckHasHint(mtHint,nPAParameterNotUsed,'Parameter "i" not used');
-  CheckUnexpectedMessages;
+  CheckUseAnalyzerHint(mtHint,nPAParameterNotUsed,'Parameter "i" not used');
+  CheckUseAnalyzerUnexpectedHints;
 end;
 
 procedure TTestUseAnalyzer.TestM_Hint_ParameterNotUsed_Abstract;
@@ -898,7 +901,7 @@ begin
   Add('begin');
   Add('  TObject.DoIt(3);');
   AnalyzeProgram;
-  CheckUnexpectedMessages;
+  CheckUseAnalyzerUnexpectedHints;
 end;
 
 procedure TTestUseAnalyzer.TestM_Hint_ParameterNotUsedTypecast;
@@ -919,7 +922,7 @@ begin
   Add('begin');
   Add('  DoIt(nil);');
   AnalyzeProgram;
-  CheckUnexpectedMessages;
+  CheckUseAnalyzerUnexpectedHints;
 end;
 
 procedure TTestUseAnalyzer.TestM_Hint_LocalVariableNotUsed;
@@ -936,11 +939,11 @@ begin
   Add('begin');
   Add('  DoIt;');
   AnalyzeProgram;
-  CheckHasHint(mtHint,nPALocalXYNotUsed,'Local constant "a" not used');
-  CheckHasHint(mtHint,nPALocalXYNotUsed,'Local constant "b" not used');
-  CheckHasHint(mtHint,nPALocalVariableNotUsed,'Local variable "c" not used');
-  CheckHasHint(mtHint,nPALocalVariableNotUsed,'Local variable "d" not used');
-  CheckUnexpectedMessages;
+  CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local constant "a" not used');
+  CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local constant "b" not used');
+  CheckUseAnalyzerHint(mtHint,nPALocalVariableNotUsed,'Local variable "c" not used');
+  CheckUseAnalyzerHint(mtHint,nPALocalVariableNotUsed,'Local variable "d" not used');
+  CheckUseAnalyzerUnexpectedHints;
 end;
 
 procedure TTestUseAnalyzer.TestM_Hint_InterfaceUnitVariableUsed;
@@ -965,14 +968,14 @@ begin
   Add('  {#ImpTFlags_notused}ImpTFlags = set of TFlag;');
   Add('  {#ImpTArrInt_notused}ImpTArrInt = array of integer;');
   AnalyzeUnit;
-  CheckHasHint(mtHint,nPALocalXYNotUsed,'Local constant "d" not used');
-  CheckHasHint(mtHint,nPALocalXYNotUsed,'Local constant "e" not used');
-  CheckHasHint(mtHint,nPALocalVariableNotUsed,'Local variable "f" not used');
-  CheckHasHint(mtHint,nPALocalXYNotUsed,'Local alias type "ImpTColor" not used');
-  CheckHasHint(mtHint,nPALocalXYNotUsed,'Local enumeration type "ImpTFlag" not used');
-  CheckHasHint(mtHint,nPALocalXYNotUsed,'Local set type "ImpTFlags" not used');
-  CheckHasHint(mtHint,nPALocalXYNotUsed,'Local array type "ImpTArrInt" not used');
-  CheckUnexpectedMessages;
+  CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local constant "d" not used');
+  CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local constant "e" not used');
+  CheckUseAnalyzerHint(mtHint,nPALocalVariableNotUsed,'Local variable "f" not used');
+  CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local alias type "ImpTColor" not used');
+  CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local enumeration type "ImpTFlag" not used');
+  CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local set type "ImpTFlags" not used');
+  CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local array type "ImpTArrInt" not used');
+  CheckUseAnalyzerUnexpectedHints;
 end;
 
 procedure TTestUseAnalyzer.TestM_Hint_ValueParameterIsAssignedButNeverUsed;
@@ -985,9 +988,9 @@ begin
   Add('begin');
   Add('  DoIt(1);');
   AnalyzeProgram;
-  CheckHasHint(mtHint,nPAValueParameterIsAssignedButNeverUsed,
+  CheckUseAnalyzerHint(mtHint,nPAValueParameterIsAssignedButNeverUsed,
     'Value parameter "i" is assigned but never used');
-  CheckUnexpectedMessages;
+  CheckUseAnalyzerUnexpectedHints;
 end;
 
 procedure TTestUseAnalyzer.TestM_Hint_LocalVariableIsAssignedButNeverUsed;
@@ -1007,13 +1010,13 @@ begin
   Add('begin');
   Add('  DoIt;');
   AnalyzeProgram;
-  CheckHasHint(mtHint,nPALocalVariableIsAssignedButNeverUsed,
+  CheckUseAnalyzerHint(mtHint,nPALocalVariableIsAssignedButNeverUsed,
     'Local variable "a" is assigned but never used');
-  CheckHasHint(mtHint,nPALocalVariableIsAssignedButNeverUsed,
+  CheckUseAnalyzerHint(mtHint,nPALocalVariableIsAssignedButNeverUsed,
     'Local variable "b" is assigned but never used');
-  CheckHasHint(mtHint,nPALocalVariableIsAssignedButNeverUsed,
+  CheckUseAnalyzerHint(mtHint,nPALocalVariableIsAssignedButNeverUsed,
     'Local variable "c" is assigned but never used');
-  CheckUnexpectedMessages;
+  CheckUseAnalyzerUnexpectedHints;
 end;
 
 procedure TTestUseAnalyzer.TestM_Hint_LocalXYNotUsed;
@@ -1031,12 +1034,12 @@ begin
   Add('begin');
   Add('  DoIt;');
   AnalyzeProgram;
-  CheckHasHint(mtHint,nPALocalXYNotUsed,'Local alias type "TColor" not used');
-  CheckHasHint(mtHint,nPALocalXYNotUsed,'Local enumeration type "TFlag" not used');
-  CheckHasHint(mtHint,nPALocalXYNotUsed,'Local set type "TFlags" not used');
-  CheckHasHint(mtHint,nPALocalXYNotUsed,'Local array type "TArrInt" not used');
-  CheckHasHint(mtHint,nPALocalXYNotUsed,'Local procedure "Sub" not used');
-  CheckUnexpectedMessages;
+  CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local alias type "TColor" not used');
+  CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local enumeration type "TFlag" not used');
+  CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local set type "TFlags" not used');
+  CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local array type "TArrInt" not used');
+  CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local procedure "Sub" not used');
+  CheckUseAnalyzerUnexpectedHints;
 end;
 
 procedure TTestUseAnalyzer.TestM_Hint_PrivateFieldIsNeverUsed;
@@ -1051,11 +1054,11 @@ begin
   Add('begin');
   Add('  m:=nil;');
   AnalyzeProgram;
-  CheckHasHint(mtHint,nPAPrivateFieldIsNeverUsed,
+  CheckUseAnalyzerHint(mtHint,nPAPrivateFieldIsNeverUsed,
     'Private field "TMobile.a" is never used');
-  CheckHasHint(mtHint,nPALocalVariableIsAssignedButNeverUsed,
+  CheckUseAnalyzerHint(mtHint,nPALocalVariableIsAssignedButNeverUsed,
     'Local variable "m" is assigned but never used');
-  CheckUnexpectedMessages;
+  CheckUseAnalyzerUnexpectedHints;
 end;
 
 procedure TTestUseAnalyzer.TestM_Hint_PrivateFieldIsAssignedButNeverUsed;
@@ -1075,9 +1078,9 @@ begin
   Add('begin');
   Add('  TMobile.Create;');
   AnalyzeProgram;
-  CheckHasHint(mtHint,nPAPrivateFieldIsAssignedButNeverUsed,
+  CheckUseAnalyzerHint(mtHint,nPAPrivateFieldIsAssignedButNeverUsed,
     'Private field "TMobile.a" is assigned but never used');
-  CheckUnexpectedMessages;
+  CheckUseAnalyzerUnexpectedHints;
 end;
 
 procedure TTestUseAnalyzer.TestM_Hint_PrivateMethodIsNeverUsed;
@@ -1096,9 +1099,9 @@ begin
   Add('begin');
   Add('  TMobile.Create;');
   AnalyzeProgram;
-  CheckHasHint(mtHint,nPAPrivateMethodIsNeverUsed,
+  CheckUseAnalyzerHint(mtHint,nPAPrivateMethodIsNeverUsed,
     'Private method "TMobile.DoSome" is never used');
-  CheckUnexpectedMessages;
+  CheckUseAnalyzerUnexpectedHints;
 end;
 
 procedure TTestUseAnalyzer.TestM_Hint_LocalDestructor_No_IsNeverUsed;
@@ -1125,7 +1128,7 @@ begin
   Add('  o:=TMobile.Create;');
   Add('  o.Destroy;');
   AnalyzeProgram;
-  CheckUnexpectedMessages;
+  CheckUseAnalyzerUnexpectedHints;
 end;
 
 procedure TTestUseAnalyzer.TestM_Hint_PrivateTypeNeverUsed;
@@ -1144,9 +1147,9 @@ begin
   Add('begin');
   Add('  TMobile.Create;');
   AnalyzeProgram;
-  CheckHasHint(mtHint,nPAPrivateTypeXNeverUsed,
+  CheckUseAnalyzerHint(mtHint,nPAPrivateTypeXNeverUsed,
     'Private type "TMobile.t" never used');
-  CheckUnexpectedMessages;
+  CheckUseAnalyzerUnexpectedHints;
 end;
 
 procedure TTestUseAnalyzer.TestM_Hint_PrivateConstNeverUsed;
@@ -1165,9 +1168,9 @@ begin
   Add('begin');
   Add('  TMobile.Create;');
   AnalyzeProgram;
-  CheckHasHint(mtHint,nPAPrivateConstXNeverUsed,
+  CheckUseAnalyzerHint(mtHint,nPAPrivateConstXNeverUsed,
     'Private const "TMobile.c" never used');
-  CheckUnexpectedMessages;
+  CheckUseAnalyzerUnexpectedHints;
 end;
 
 procedure TTestUseAnalyzer.TestM_Hint_PrivatePropertyNeverUsed;
@@ -1187,11 +1190,11 @@ begin
   Add('begin');
   Add('  TMobile.Create;');
   AnalyzeProgram;
-  CheckHasHint(mtHint,nPAPrivatePropertyXNeverUsed,
+  CheckUseAnalyzerHint(mtHint,nPAPrivatePropertyXNeverUsed,
     'Private property "TMobile.A" never used');
-  CheckHasHint(mtHint,nPAPrivateFieldIsNeverUsed,
+  CheckUseAnalyzerHint(mtHint,nPAPrivateFieldIsNeverUsed,
     'Private field "TMobile.FA" is never used');
-  CheckUnexpectedMessages;
+  CheckUseAnalyzerUnexpectedHints;
 end;
 
 procedure TTestUseAnalyzer.TestM_Hint_LocalClassInProgramNotUsed;
@@ -1209,9 +1212,9 @@ begin
   Add('  m: TMobile;');
   Add('begin');
   AnalyzeProgram;
-  CheckHasHint(mtHint,nPALocalXYNotUsed,'Local class "TMobile" not used');
-  CheckHasHint(mtHint,nPALocalVariableNotUsed,'Local variable "m" not used');
-  CheckUnexpectedMessages;
+  CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local class "TMobile" not used');
+  CheckUseAnalyzerHint(mtHint,nPALocalVariableNotUsed,'Local variable "m" not used');
+  CheckUseAnalyzerUnexpectedHints;
 end;
 
 procedure TTestUseAnalyzer.TestM_Hint_LocalMethodInProgramNotUsed;
@@ -1230,8 +1233,8 @@ begin
   Add('begin');
   Add('  if m=nil then ;');
   AnalyzeProgram;
-  CheckHasHint(mtHint,nPALocalXYNotUsed,'Local constructor "Create" not used');
-  CheckUnexpectedMessages;
+  CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local constructor "Create" not used');
+  CheckUseAnalyzerUnexpectedHints;
 end;
 
 procedure TTestUseAnalyzer.TestM_Hint_AssemblerParameterIgnored;
@@ -1254,7 +1257,7 @@ begin
   Add('begin');
   Add('  DoIt(1);');
   AnalyzeProgram;
-  CheckUnexpectedMessages;
+  CheckUseAnalyzerUnexpectedHints;
 end;
 
 procedure TTestUseAnalyzer.TestM_Hint_FunctionResultDoesNotSeemToBeSet;
@@ -1265,9 +1268,9 @@ begin
   Add('begin');
   Add('  DoIt();');
   AnalyzeProgram;
-  CheckHasHint(mtHint,nPAFunctionResultDoesNotSeemToBeSet,
+  CheckUseAnalyzerHint(mtHint,nPAFunctionResultDoesNotSeemToBeSet,
     sPAFunctionResultDoesNotSeemToBeSet);
-  CheckUnexpectedMessages;
+  CheckUseAnalyzerUnexpectedHints;
 end;
 
 procedure TTestUseAnalyzer.TestM_Hint_FunctionResultDoesNotSeemToBeSet_Abstract;
@@ -1280,7 +1283,7 @@ begin
   Add('begin');
   Add('  TObject.DoIt;');
   AnalyzeProgram;
-  CheckUnexpectedMessages;
+  CheckUseAnalyzerUnexpectedHints;
 end;
 
 procedure TTestUseAnalyzer.TestM_Hint_FunctionResultRecord;
@@ -1295,10 +1298,10 @@ begin
   Add('begin');
   Add('  Point(1);');
   AnalyzeProgram;
-  CheckHasHint(mtHint,nPALocalVariableIsAssignedButNeverUsed,
+  CheckUseAnalyzerHint(mtHint,nPALocalVariableIsAssignedButNeverUsed,
     'Local variable "X" is assigned but never used');
-  CheckHasHint(mtHint,nPALocalVariableNotUsed,'Local variable "Y" not used');
-  CheckUnexpectedMessages;
+  CheckUseAnalyzerHint(mtHint,nPALocalVariableNotUsed,'Local variable "Y" not used');
+  CheckUseAnalyzerUnexpectedHints;
 end;
 
 procedure TTestUseAnalyzer.TestM_Hint_FunctionResultPassRecordElement;
@@ -1317,8 +1320,8 @@ begin
   Add('begin');
   Add('  Point();');
   AnalyzeProgram;
-  CheckHasHint(mtHint,nPALocalVariableNotUsed,'Local variable "Y" not used');
-  CheckUnexpectedMessages;
+  CheckUseAnalyzerHint(mtHint,nPALocalVariableNotUsed,'Local variable "Y" not used');
+  CheckUseAnalyzerUnexpectedHints;
 end;
 
 procedure TTestUseAnalyzer.TestM_Hint_OutParam_No_AssignedButNeverUsed;
@@ -1332,7 +1335,26 @@ begin
   Add('begin');
   Add('  DoIt(i);');
   AnalyzeProgram;
-  CheckUnexpectedMessages;
+  CheckUseAnalyzerUnexpectedHints;
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_ArgPassed_No_ParameterNotUsed;
+begin
+  StartProgram(false);
+  Add([
+  'procedure AssertTrue(b: boolean);',
+  'begin',
+  '  if b then ;',
+  'end;',
+  'procedure AssertFalse(b: boolean);',
+  'begin',
+  '  AssertTrue(not b);',
+  'end;',
+  'begin',
+  '  AssertFalse(true);',
+  '']);
+  AnalyzeProgram;
+  CheckUseAnalyzerUnexpectedHints;
 end;
 
 procedure TTestUseAnalyzer.TestWP_LocalVar;
@@ -1634,6 +1656,62 @@ begin
   AnalyzeWholeProgram;
 end;
 
+procedure TTestUseAnalyzer.TestWP_BuiltInFunctions;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  {#tordenum_used}TOrdEnum = (ordenum1,ordenum2);',
+  'begin',
+  '  if ord(ordenum1)=1 then ;',
+  '']);
+  AnalyzeWholeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestWP_TypeInfo;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  {#integer_used}integer = longint;',
+  '  {#trec_used}TRec = record',
+  '    {#trecv_used}v: integer;',
+  '  end;',
+  '  {#tclass_used}TClass = class of TObject;',
+  '  {#tobject_used}TObject = class',
+  '    class function {#tobject_classtype_used}ClassType: TClass; virtual; abstract;',
+  '  end;',
+  '  {#tbirds_used}TBirds = class of TBird;',
+  '  {#tbird_used}TBird = class',
+  '  end;',
+  'function {#getbirdclass_used}GetBirdClass: TBirds;',
+  'begin',
+  '  Result:=nil;',
+  'end;',
+  'var',
+  '  {#i_used}i: integer;',
+  '  {#s_used}s: string;',
+  '  {#p_used}p: pointer;',
+  '  {#r_used}r: TRec;',
+  '  {#o_used}o: TObject;',
+  '  {#c_used}c: TClass;',
+  'begin',
+  '  p:=typeinfo(integer);',
+  '  p:=typeinfo(longint);',
+  '  p:=typeinfo(i);',
+  '  p:=typeinfo(s);',
+  '  p:=typeinfo(p);',
+  '  p:=typeinfo(r.v);',
+  '  p:=typeinfo(TObject.ClassType);',
+  '  p:=typeinfo(o.ClassType);',
+  '  p:=typeinfo(o);',
+  '  p:=typeinfo(c);',
+  '  p:=typeinfo(c.ClassType);',
+  '  p:=typeinfo(GetBirdClass);',
+  '']);
+  AnalyzeWholeProgram;
+end;
+
 initialization
   RegisterTests([TTestUseAnalyzer]);
 

packages/fcl-web/examples/simpleserver/README.txt

@@ -0,0 +1,10 @@
+
+Small demo for simple file module. The server will listen on a specified
+port (default 3000) and will serve files starting from the current working
+directory.
+
+Just start the server, no options, and point your browser at
+http://localhost:3000/
+
+running simpleserver -h will provide some help.
+

packages/fcl-web/examples/simpleserver/index.css

@@ -0,0 +1,3 @@
+.important {
+  color: red
+}

packages/fcl-web/examples/simpleserver/index.html

@@ -0,0 +1,10 @@
+<http>
+<link rel="stylesheet" href="index.css">
+<body>
+<H1>Simple server demo</H1>
+If you see this page, it demonstrates that the simple server demo serves the
+<span class="important">index.html</span> page. <p>
+If it shows index.html in a
+different style, it means the css is loaded as well.
+</body>
+</http>

packages/fcl-web/examples/simpleserver/simpleserver.lpi

@@ -0,0 +1,60 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="10"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="simpleserver"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <VersionInfo>
+      <StringTable ProductVersion=""/>
+    </VersionInfo>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+      </local>
+    </RunParams>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="simpleserver.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="simpleserver"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

packages/fcl-web/examples/simpleserver/simpleserver.pas

@@ -0,0 +1,89 @@
+program simpleserver;
+
+uses sysutils,custhttpapp, fpwebfile;
+
+Type
+
+  { THTTPApplication }
+
+  THTTPApplication = Class(TCustomHTTPApplication)
+  private
+    FQuiet: Boolean;
+    procedure Usage(Msg: String);
+  published
+    procedure DoLog(EventType: TEventType; const Msg: String); override;
+    Procedure DoRun; override;
+    property Quiet : Boolean read FQuiet Write FQuiet;
+  end;
+
+Var
+  Application : THTTPApplication;
+
+{ THTTPApplication }
+
+procedure THTTPApplication.DoLog(EventType: TEventType; const Msg: String);
+begin
+  if Quiet then
+    exit;
+  if IsConsole then
+    Writeln(FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz',Now),' [',EventType,'] ',Msg)
+  else
+    inherited DoLog(EventType, Msg);
+end;
+
+procedure THTTPApplication.Usage(Msg : String);
+
+begin
+  if (Msg<>'') then
+    Writeln('Error: ',Msg);
+  Writeln('Usage ',ExtractFileName(ParamStr(0)),' [options] ');
+  Writeln('Where options is one or more of : ');
+  Writeln('-d --directory=dir  Base directory from which to serve files.');
+  Writeln('                    Default is current working directory: ',GetCurrentDir);
+  Writeln('-h --help           This help text');
+  Writeln('-i --indexpage=name Directory index page to use (default: index.html)');
+  Writeln('-n --noindexpage    Do not allow index page.');
+  Writeln('-p --port=NNNN      TCP/IP port to listen on (default is 3000)');
+  Writeln('-q --quiet          Do not write diagnostic messages');
+  Halt(Ord(Msg<>''));
+end;
+
+procedure THTTPApplication.DoRun;
+
+Var
+  S,IndexPage,D : String;
+
+begin
+  S:=Checkoptions('hqd:ni:p:',['help','quiet','noindexpage','directory:','port:','indexpage:']);
+  if (S<>'') or HasOption('h','help') then
+    usage(S);
+  Quiet:=HasOption('q','quiet');
+  Port:=StrToIntDef(GetOptionValue('p','port'),3000);
+  D:=GetOptionValue('d','directory');
+  if D='' then
+    D:=GetCurrentDir;
+  Log(etInfo,'Listening on port %d, serving files from directory: %s',[Port,D]);
+{$ifdef unix}
+  MimeTypesFile:='/etc/mime.types';
+{$endif}
+  TSimpleFileModule.BaseDir:=IncludeTrailingPathDelimiter(D);
+  TSimpleFileModule.OnLog:=@Log;
+  If not HasOption('n','noindexpage') then
+    begin
+    IndexPage:=GetOptionValue('i','indexpage');
+    if IndexPage='' then
+      IndexPage:='index.html';
+    Log(etInfo,'Using index page %s',[IndexPage]);
+    TSimpleFileModule.IndexPageName:=IndexPage;
+    end;
+  inherited;
+end;
+
+begin
+  TSimpleFileModule.RegisterDefaultRoute;
+  Application:=THTTPApplication.Create(Nil);
+  Application.Initialize;
+  Application.Run;
+  Application.Free;
+end.
+

packages/pastojs/tests/tcoptimizations.pas

@@ -173,7 +173,7 @@ begin
   ConvertProgram;
   CheckSource('TestWPO_OmitLocalVar',
     'this.b = 0;',
-    'this.b = 3;');
+    '$mod.b = 3;');
 end;
 
 procedure TTestOptimizations.TestWPO_OmitLocalProc;
@@ -190,7 +190,7 @@ begin
     '};',
     '']),
     LinesToStr([
-    'this.DoIt();',
+    '$mod.DoIt();',
     '']));
 end;
 
@@ -210,7 +210,7 @@ begin
     '};',
     '']),
     LinesToStr([
-    'this.DoIt();',
+    '$mod.DoIt();',
     '']));
 end;
 
@@ -239,7 +239,7 @@ begin
     '};',
     '']),
     LinesToStr([
-    'this.DoIt();',
+    '$mod.DoIt();',
     '']));
 end;
 
@@ -269,7 +269,7 @@ begin
     '};',
     '']),
     LinesToStr([
-    'this.DoIt();',
+    '$mod.DoIt();',
     '']));
 end;
 
@@ -295,7 +295,7 @@ begin
     '};',
     '']),
     LinesToStr([
-    'this.DoIt();',
+    '$mod.DoIt();',
     '']));
 end;
 
@@ -320,7 +320,7 @@ begin
     '};',
     '']),
     LinesToStr([
-    'this.DoIt();',
+    '$mod.DoIt();',
     '']));
 end;
 
@@ -347,7 +347,7 @@ begin
     '};',
     '']),
     LinesToStr([
-    'this.DoIt();',
+    '$mod.DoIt();',
     '']));
 end;
 
@@ -375,10 +375,10 @@ begin
     '    return this.a == b.a;',
     '  };',
     '};',
-    'this.r = new this.TRec();',
+    'this.r = new $mod.TRec();',
     '']),
     LinesToStr([
-    'this.r.a = 3;',
+    '$mod.r.a = 3;',
     '']));
 end;
 
@@ -413,7 +413,7 @@ begin
   ConvertProgram;
   CheckSource('TestWPO_TObject',
     LinesToStr([
-    'rtl.createClass(this, "TObject", null, function () {',
+    'rtl.createClass($mod, "TObject", null, function () {',
     '  this.$init = function () {',
     '  };',
     '  this.$final = function () {',
@@ -426,7 +426,7 @@ begin
     'this.o = null;',
     '']),
     LinesToStr([
-    'this.o = null;']));
+    '$mod.o = null;']));
 end;
 
 procedure TTestOptimizations.TestWPO_OmitClassField;
@@ -443,7 +443,7 @@ begin
   ConvertProgram;
   CheckSource('TestWPO_OmitClassField',
     LinesToStr([
-    'rtl.createClass(this, "TObject", null, function () {',
+    'rtl.createClass($mod, "TObject", null, function () {',
     '  this.$init = function () {',
     '    this.a = 0;',
     '  };',
@@ -453,7 +453,7 @@ begin
     'this.o = null;',
     '']),
     LinesToStr([
-    'this.o.a = 3;']));
+    '$mod.o.a = 3;']));
 end;
 
 procedure TTestOptimizations.TestWPO_OmitClassMethod;
@@ -472,7 +472,7 @@ begin
   ConvertProgram;
   CheckSource('TestWPO_OmitClassMethod',
     LinesToStr([
-    'rtl.createClass(this, "TObject", null, function () {',
+    'rtl.createClass($mod, "TObject", null, function () {',
     '  this.$init = function () {',
     '  };',
     '  this.$final = function () {',
@@ -483,7 +483,7 @@ begin
     'this.o = null;',
     '']),
     LinesToStr([
-    'this.o.ProcB();']));
+    '$mod.o.ProcB();']));
 end;
 
 procedure TTestOptimizations.TestWPO_OmitClassClassMethod;
@@ -502,7 +502,7 @@ begin
   ConvertProgram;
   CheckSource('TestWPO_OmitClassMethod',
     LinesToStr([
-    'rtl.createClass(this, "TObject", null, function () {',
+    'rtl.createClass($mod, "TObject", null, function () {',
     '  this.$init = function () {',
     '  };',
     '  this.$final = function () {',
@@ -513,7 +513,7 @@ begin
     'this.o = null;',
     '']),
     LinesToStr([
-    'this.o.$class.ProcB();']));
+    '$mod.o.$class.ProcB();']));
 end;
 
 procedure TTestOptimizations.TestWPO_OmitPropertyGetter1;
@@ -538,7 +538,7 @@ begin
   ConvertProgram;
   CheckSource('TestWPO_OmitClassPropertyGetter1',
     LinesToStr([
-    'rtl.createClass(this, "TObject", null, function () {',
+    'rtl.createClass($mod, "TObject", null, function () {',
     '  this.$init = function () {',
     '    this.FFoo = false;',
     '  };',
@@ -548,7 +548,7 @@ begin
     'this.o = null;',
     '']),
     LinesToStr([
-    'if (this.o.FFoo);',
+    'if ($mod.o.FFoo);',
     '']));
 end;
 
@@ -569,7 +569,7 @@ begin
   ConvertProgram;
   CheckSource('TestWPO_OmitClassPropertyGetter2',
     LinesToStr([
-    'rtl.createClass(this, "TObject", null, function () {',
+    'rtl.createClass($mod, "TObject", null, function () {',
     '  this.$init = function () {',
     '    this.FFoo = false;',
     '  };',
@@ -584,7 +584,7 @@ begin
     'this.o = null;',
     '']),
     LinesToStr([
-    'if (this.o.GetFoo()) ;',
+    'if ($mod.o.GetFoo()) ;',
     '']));
 end;
 
@@ -610,7 +610,7 @@ begin
   ConvertProgram;
   CheckSource('TestWPO_OmitClassPropertySetter1',
     LinesToStr([
-    'rtl.createClass(this, "TObject", null, function () {',
+    'rtl.createClass($mod, "TObject", null, function () {',
     '  this.$init = function () {',
     '    this.FFoo = false;',
     '  };',
@@ -620,7 +620,7 @@ begin
     'this.o = null;',
     '']),
     LinesToStr([
-    'this.o.FFoo = true;',
+    '$mod.o.FFoo = true;',
     '']));
 end;
 
@@ -641,7 +641,7 @@ begin
   ConvertProgram;
   CheckSource('TestWPO_OmitClassPropertySetter2',
     LinesToStr([
-    'rtl.createClass(this, "TObject", null, function () {',
+    'rtl.createClass($mod, "TObject", null, function () {',
     '  this.$init = function () {',
     '    this.FFoo = false;',
     '  };',
@@ -654,7 +654,7 @@ begin
     'this.o = null;',
     '']),
     LinesToStr([
-    'this.o.SetFoo(true);',
+    '$mod.o.SetFoo(true);',
     '']));
 end;
 
@@ -687,7 +687,7 @@ begin
   ConvertProgram;
   CheckSource('TestWPO_CallInherited',
     LinesToStr([
-    'rtl.createClass(this, "TObject", null, function () {',
+    'rtl.createClass($mod, "TObject", null, function () {',
     '  this.$init = function () {',
     '  };',
     '  this.$final = function () {',
@@ -697,19 +697,19 @@ begin
     '  this.DoB = function () {',
     '  };',
     '});',
-    ' rtl.createClass(this, "TMobile", this.TObject, function () {',
+    ' rtl.createClass($mod, "TMobile", $mod.TObject, function () {',
     '  this.DoA$1 = function () {',
-    '    pas.program.TObject.DoA.apply(this, arguments);',
+    '    $mod.TObject.DoA.apply(this, arguments);',
     '  };',
     '  this.DoC = function () {',
-    '    pas.program.TObject.DoB.call(this);',
+    '    $mod.TObject.DoB.call(this);',
     '  };',
     '});',
     'this.o = null;',
     '']),
     LinesToStr([
-    'this.o.DoA$1();',
-    'this.o.DoC();',
+    '$mod.o.DoA$1();',
+    '$mod.o.DoC();',
     '']));
 end;
 
@@ -741,7 +741,8 @@ begin
   ActualSrc:=JSToStr(JSModule);
   ExpectedSrc:=LinesToStr([
     'rtl.module("program", ["system", "unit2"], function () {',
-    '  this.$main = function () {',
+    '  var $mod = this;',
+    '  $mod.$main = function () {',
     '    pas.unit2.j = 3;',
     '  };',
     '});',
@@ -764,10 +765,11 @@ begin
   ActualSrc:=JSToStr(JSModule);
   ExpectedSrc:=LinesToStr([
     'rtl.module("program", ["system"], function () {',
+    '  var $mod = this;',
     '  this.vPublic = 0;',
     '  this.DoPublic =function(){',
     '  };',
-    '  this.$main = function () {',
+    '  $mod.$main = function () {',
     '  };',
     '});',
     '']);
@@ -797,10 +799,11 @@ begin
   ActualSrc:=JSToStr(JSModule);
   ExpectedSrc:=LinesToStr([
     'rtl.module("program", ["system"], function () {',
-    'this.$rtti.$DynArray("TArrB", {',
-    '  eltype: rtl.string',
-    '});',
-    '  rtl.createClass(this, "TObject", null, function () {',
+    '  var $mod = this;',
+    '  $mod.$rtti.$DynArray("TArrB", {',
+    '    eltype: rtl.string',
+    '  });',
+    '  rtl.createClass($mod, "TObject", null, function () {',
     '    this.$init = function () {',
     '      this.PublicA = [];',
     '      this.PublishedB = [];',
@@ -810,11 +813,11 @@ begin
     '      this.PublishedB = undefined;',
     '    };',
     '    var $r = this.$rtti;',
-    '    $r.addField("PublishedB", pas.program.$rtti["TArrB"]);',
+    '    $r.addField("PublishedB", $mod.$rtti["TArrB"]);',
     '  });',
     '  this.C = null;',
-    '  this.$main = function () {',
-    '    this.C.PublicA = [];',
+    '  $mod.$main = function () {',
+    '    $mod.C.PublicA = [];',
     '  };',
     '});',
     '']);
@@ -841,15 +844,16 @@ begin
   ActualSrc:=JSToStr(JSModule);
   ExpectedSrc:=LinesToStr([
     'rtl.module("program", ["system"], function () {',
-    'this.$rtti.$DynArray("TArrB", {',
-    '  eltype: rtl.string',
-    '});',
+    '  var $mod = this;',
+    '  $mod.$rtti.$DynArray("TArrB", {',
+    '    eltype: rtl.string',
+    '  });',
     '  this.A = [];',
     '  this.B = [];',
     '  this.p = null;',
-    '  this.$main = function () {',
-    '    this.A = [];',
-    '    this.p = this.$rtti["TArrB"];',
+    '  $mod.$main = function () {',
+    '    $mod.A = [];',
+    '    $mod.p = $mod.$rtti["TArrB"];',
     '  };',
     '});',
     '']);