--- Merging r34555 into '.':

U    packages/fcl-passrc/tests/tcexprparser.pas
U    packages/fcl-passrc/tests/tctypeparser.pas
U    packages/fcl-passrc/tests/tcresolver.pas
U    packages/fcl-passrc/src/pparser.pp
U    packages/fcl-passrc/src/pastree.pp
U    packages/fcl-passrc/src/pasresolver.pp
U    packages/fcl-passrc/src/pscanner.pp
U    packages/pastojs/tests/tcconverter.pp
--- Recording mergeinfo for merge of r34555 into '.':
 U   .
--- Merging r34569 into '.':
G    packages/pastojs/tests/tcconverter.pp
U    packages/fcl-passrc/tests/tcbaseparser.pas
U    packages/fcl-passrc/tests/tcclasstype.pas
U    packages/fcl-passrc/tests/tcstatements.pas
G    packages/fcl-passrc/tests/tcresolver.pas
G    packages/fcl-passrc/src/pastree.pp
G    packages/fcl-passrc/src/pasresolver.pp
G    packages/fcl-passrc/src/pscanner.pp
G    packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r34569 into '.':
 G   .
--- Merging r34631 into '.':
G    packages/fcl-passrc/src/pastree.pp
G    packages/fcl-passrc/src/pasresolver.pp
G    packages/fcl-passrc/src/pparser.pp
G    packages/fcl-passrc/tests/tcresolver.pas
--- Recording mergeinfo for merge of r34631 into '.':
 G   .
--- Merging r34668 into '.':
G    packages/fcl-passrc/src/pastree.pp
G    packages/fcl-passrc/src/pparser.pp
G    packages/fcl-passrc/tests/tctypeparser.pas
U    packages/fcl-passrc/tests/tcprocfunc.pas
U    packages/fcl-passrc/tests/testpassrc.lpi
G    packages/fcl-passrc/tests/tcclasstype.pas
--- Recording mergeinfo for merge of r34668 into '.':
 G   .
--- Merging r34671 into '.':
G    packages/fcl-passrc/src/pscanner.pp
G    packages/fcl-passrc/src/pparser.pp
G    packages/fcl-passrc/tests/tcclasstype.pas
U    packages/fcl-passrc/tests/tcscanner.pas
U    packages/fcl-passrc/tests/tcvarparser.pas
G    packages/fcl-passrc/tests/testpassrc.lpi
--- Recording mergeinfo for merge of r34671 into '.':
 G   .
--- Merging r34672 into '.':
G    packages/fcl-passrc/src/pparser.pp
G    packages/fcl-passrc/tests/testpassrc.lpi
G    packages/fcl-passrc/tests/tcstatements.pas
G    packages/fcl-passrc/tests/tctypeparser.pas
--- Recording mergeinfo for merge of r34672 into '.':
 G   .
--- Merging r34674 into '.':
G    packages/fcl-passrc/tests/testpassrc.lpi
G    packages/fcl-passrc/tests/tctypeparser.pas
G    packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r34674 into '.':
 G   .
--- Merging r34675 into '.':
G    packages/fcl-passrc/tests/tctypeparser.pas
G    packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r34675 into '.':
 G   .
--- Merging r34676 into '.':
U    utils/fpdoc/makeskel.pp
--- Recording mergeinfo for merge of r34676 into '.':
 G   .
--- Merging r34687 into '.':
G    packages/fcl-passrc/tests/tctypeparser.pas
G    packages/fcl-passrc/tests/tcstatements.pas
G    packages/fcl-passrc/src/pastree.pp
G    packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r34687 into '.':
 G   .
--- Merging r34688 into '.':
G    packages/fcl-passrc/src/pparser.pp
G    packages/fcl-passrc/tests/tctypeparser.pas
--- Recording mergeinfo for merge of r34688 into '.':
 G   .
--- Merging r34689 into '.':
G    packages/fcl-passrc/tests/tcprocfunc.pas
G    packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r34689 into '.':
 G   .
--- Merging r34690 into '.':
G    packages/fcl-passrc/src/pscanner.pp
--- Recording mergeinfo for merge of r34690 into '.':
 G   .
--- Merging r34691 into '.':
G    packages/fcl-passrc/src/pparser.pp
G    packages/fcl-passrc/tests/tcexprparser.pas
--- Recording mergeinfo for merge of r34691 into '.':
 G   .
--- Merging r34694 into '.':
G    utils/fpdoc/makeskel.pp
--- Recording mergeinfo for merge of r34694 into '.':
 G   .
--- Merging r34699 into '.':
G    packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r34699 into '.':
 G   .
--- Merging r34700 into '.':
G    packages/fcl-passrc/src/pastree.pp
--- Recording mergeinfo for merge of r34700 into '.':
 G   .
--- Merging r34709 into '.':
G    packages/fcl-passrc/tests/testpassrc.lpi
G    packages/fcl-passrc/tests/tcresolver.pas
G    packages/fcl-passrc/src/pastree.pp
G    packages/fcl-passrc/src/pasresolver.pp
G    packages/fcl-passrc/src/pscanner.pp
G    packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r34709 into '.':
 G   .
--- Merging r34716 into '.':
G    packages/fcl-passrc/tests/tcresolver.pas
G    packages/fcl-passrc/src/pparser.pp
G    packages/fcl-passrc/src/pastree.pp
G    packages/fcl-passrc/src/pasresolver.pp
--- Recording mergeinfo for merge of r34716 into '.':
 G   .
--- Merging r34739 into '.':
U    packages/fcl-passrc/src/readme.txt
--- Recording mergeinfo for merge of r34739 into '.':
 G   .
--- Merging r34749 into '.':
U    utils/fpdoc/fpdocxmlopts.pas
U    utils/fpdoc/mkfpdoc.pp
U    utils/fpdoc/dglobals.pp
U    utils/fpdoc/fpdoc.pp
--- Recording mergeinfo for merge of r34749 into '.':
 G   .
--- Merging r34750 into '.':
G    packages/fcl-passrc/tests/tcprocfunc.pas
G    packages/fcl-passrc/src/pastree.pp
--- Recording mergeinfo for merge of r34750 into '.':
 G   .
--- Merging r34751 into '.':
G    packages/fcl-passrc/src/pastree.pp
--- Recording mergeinfo for merge of r34751 into '.':
 G   .
--- Merging r34752 into '.':
U    utils/fpdoc/dwlinear.pp
U    utils/fpdoc/dw_ipflin.pas
--- Recording mergeinfo for merge of r34752 into '.':
 G   .
--- Merging r34753 into '.':
G    packages/fcl-passrc/tests/tcscanner.pas
G    packages/fcl-passrc/src/pscanner.pp
--- Recording mergeinfo for merge of r34753 into '.':
 G   .
--- Merging r34754 into '.':
G    packages/fcl-passrc/src/pscanner.pp
G    packages/fcl-passrc/src/pparser.pp
G    packages/fcl-passrc/src/pastree.pp
G    packages/fcl-passrc/tests/tcscanner.pas
G    packages/fcl-passrc/tests/tcbaseparser.pas
G    packages/fcl-passrc/tests/tcclasstype.pas
--- Recording mergeinfo for merge of r34754 into '.':
 G   .
--- Merging r34756 into '.':
G    packages/fcl-passrc/tests/tcscanner.pas
G    packages/fcl-passrc/src/pscanner.pp
--- Recording mergeinfo for merge of r34756 into '.':
 G   .
--- Merging r34759 into '.':
G    packages/fcl-passrc/src/pscanner.pp
--- Recording mergeinfo for merge of r34759 into '.':
 G   .

# revisions: 34555,34569,34631,34668,34671,34672,34674,34675,34676,34687,34688,34689,34690,34691,34694,34699,34700,34709,34716,34739,34749,34750,34751,34752,34753,34754,34756,34759

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

packages/fcl-passrc/src/pscanner.pp

@@ -124,6 +124,7 @@ type
     tkconstref,
     tkconstructor,
     tkdestructor,
+    tkdispinterface,
     tkdiv,
     tkdo,
     tkdownto,
@@ -139,7 +140,6 @@ type
     tkfunction,
     tkgeneric,
     tkgoto,
-    tkHelper,
     tkif,
     tkimplementation,
     tkin,
@@ -329,7 +329,10 @@ type
     po_delphi, // Delphi mode: forbid nested comments
     po_cassignments,  // allow C-operators += -= *= /=
     po_resolvestandardtypes, // search for 'longint', 'string', etc., do not use dummies, TPasResolver sets this to use its declarations
-    po_asmwhole  // store whole text between asm..end in TPasImplAsmStatement.Tokens
+    po_asmwhole,  // store whole text between asm..end in TPasImplAsmStatement.Tokens
+    po_nooverloadedprocs,  // do not create TPasOverloadedProc for procs with same name
+    po_keepclassforward,   // disabled: delete class fowards when there is a class declaration
+    po_arrayrangeexpr    // enable: create TPasArrayType.IndexRange, disable: create TPasArrayType.Ranges
     );
   TPOptions = set of TPOption;
 
@@ -386,9 +389,19 @@ type
     Procedure DoLog(MsgType: TMessageType; MsgNumber: integer; Const Fmt : String; Args : Array of const;SkipSourceInfo : Boolean = False);overload;
     procedure Error(MsgNumber: integer; const Msg: string);overload;
     procedure Error(MsgNumber: integer; const Fmt: string; Args: array of Const);overload;
+    procedure PushSkipMode;
+    function HandleDirective(const ADirectiveText: String): TToken; virtual;
+    procedure HandleIFDEF(const AParam: String);
+    procedure HandleIFNDEF(const AParam: String);
+    procedure HandleIFOPT(const AParam: String);
+    procedure HandleIF(const AParam: String);
+    procedure HandleELSE(const AParam: String);
+    procedure HandleENDIF(const AParam: String);
     procedure HandleDefine(Param: String); virtual;
     procedure HandleIncludeFile(Param: String); virtual;
     procedure HandleUnDefine(Param: String);virtual;
+    function HandleInclude(const Param: String): TToken;virtual;
+    procedure HandleMode(const Param: String);virtual;
     function HandleMacro(AIndex: integer): TToken;virtual;
     procedure PushStackItem; virtual;
     function DoFetchTextToken: TToken;
@@ -484,6 +497,7 @@ const
     'constref',
     'constructor',
     'destructor',
+    'dispinterface',
     'div',
     'do',
     'downto',
@@ -499,7 +513,6 @@ const
     'function',
     'generic',
     'goto',
-    'helper',
     'if',
     'implementation',
     'in',
@@ -848,7 +861,8 @@ Procedure TStreamLineReader.InitFromStream(AStream : TStream);
 
 begin
   SetLength(FContent,AStream.Size);
-  AStream.Read(FContent[1],AStream.Size);
+  if FContent<>'' then
+    AStream.Read(FContent[1],length(FContent));
   FPos:=0;
 end;
 
@@ -1415,12 +1429,217 @@ begin
     end;
 end;
 
+Function TPascalScanner.HandleInclude(Const Param : String) : TToken;
+
+begin
+  Result:=tkComment;
+  if ((Param='') or (Param[1]<>'%')) then
+    HandleIncludeFile(param)
+  else if Param[1]='%' then
+    begin
+    fcurtokenstring:='{$i '+param+'}';
+    fcurtoken:=tkstring;
+    result:=fcurtoken;
+    end
+end;
+
+Procedure TPascalScanner.HandleMode(Const Param : String);
+
+Var
+  P : String;
+
+begin
+  P:=UpperCase(Param);
+  // Eventually, we'll need to make the distinction...
+  // For now, treat OBJFPC as Delphi mode.
+  if (P='DELPHI') or (P='OBJFPC') then
+    Options:=Options+[po_delphi]
+  else
+    Options:=Options-[po_delphi]
+end;
+
+Procedure TPascalScanner.PushSkipMode;
+
+begin
+  if PPSkipStackIndex = High(PPSkipModeStack) then
+    Error(nErrIfXXXNestingLimitReached,SErrIfXXXNestingLimitReached);
+  PPSkipModeStack[PPSkipStackIndex] := PPSkipMode;
+  PPIsSkippingStack[PPSkipStackIndex] := PPIsSkipping;
+  Inc(PPSkipStackIndex);
+end;
+
+Procedure TPascalScanner.HandleIFDEF(Const AParam : String);
+
+Var
+  ADefine : String;
+  Index : Integer;
+
+begin
+  PushSkipMode;
+  if PPIsSkipping then
+    PPSkipMode := ppSkipAll
+  else
+    begin
+    ADefine := UpperCase(AParam);
+    Index := Defines.IndexOf(ADefine);
+    if Index < 0 then
+      Index := Macros.IndexOf(ADefine);
+    if Index < 0 then
+      begin
+      PPSkipMode := ppSkipIfBranch;
+      PPIsSkipping := true;
+      end
+    else
+      PPSkipMode := ppSkipElseBranch;
+    If LogEvent(sleConditionals) then
+      if PPSkipMode=ppSkipElseBranch then
+        DoLog(mtInfo,nLogIFDefAccepted,sLogIFDefAccepted,[AParam])
+      else
+        DoLog(mtInfo,nLogIFDefRejected,sLogIFDefRejected,[AParam])
+    end;
+end;
+
+Procedure TPascalScanner.HandleIFNDEF(Const AParam : String);
+
+Var
+  ADefine : String;
+  Index : Integer;
+
+begin
+  PushSkipMode;
+  if PPIsSkipping then
+    PPSkipMode := ppSkipAll
+  else
+    begin
+    ADefine := UpperCase(AParam);
+    Index := Defines.IndexOf(ADefine);
+    // Not sure about this
+    if Index < 0 then
+      Index := Macros.IndexOf(ADefine);
+    if Index >= 0 then
+      begin
+      PPSkipMode := ppSkipIfBranch;
+      PPIsSkipping := true;
+      end
+    else
+      PPSkipMode := ppSkipElseBranch;
+    If LogEvent(sleConditionals) then
+      if PPSkipMode=ppSkipElseBranch then
+        DoLog(mtInfo,nLogIFNDefAccepted,sLogIFNDefAccepted,[AParam])
+      else
+        DoLog(mtInfo,nLogIFNDefRejected,sLogIFNDefRejected,[AParam])
+    end;
+end;
+
+Procedure TPascalScanner.HandleIFOPT(Const AParam : String);
+
+begin
+  PushSkipMode;
+  if PPIsSkipping then
+    PPSkipMode := ppSkipAll
+  else
+    begin
+    { !!!: Currently, options are not supported, so they are just
+      assumed as not being set. }
+    PPSkipMode := ppSkipIfBranch;
+    PPIsSkipping := true;
+    end;
+  If LogEvent(sleConditionals) then
+    DoLog(mtInfo,nLogIFOPTIgnored,sLogIFOPTIgnored,[Uppercase(AParam)])
+end;
+
+Procedure TPascalScanner.HandleIF(Const AParam : String);
+
+begin
+  PushSkipMode;
+  if PPIsSkipping then
+    PPSkipMode := ppSkipAll
+  else
+    begin
+    { !!!: Currently, expressions are not supported, so they are
+      just assumed as evaluating to false. }
+    PPSkipMode := ppSkipIfBranch;
+    PPIsSkipping := true;
+    If LogEvent(sleConditionals) then
+       DoLog(mtInfo,nLogIFIgnored,sLogIFIgnored,[Uppercase(AParam)])
+    end;
+end;
+
+Procedure TPascalScanner.HandleELSE(Const AParam : String);
+
+begin
+  if PPSkipStackIndex = 0 then
+     Error(nErrInvalidPPElse,sErrInvalidPPElse);
+  if PPSkipMode = ppSkipIfBranch then
+    PPIsSkipping := false
+  else if PPSkipMode = ppSkipElseBranch then
+    PPIsSkipping := true;
+end;
+
+
+Procedure TPascalScanner.HandleENDIF(Const AParam : String);
+
+begin
+  if PPSkipStackIndex = 0 then
+    Error(nErrInvalidPPEndif,sErrInvalidPPEndif);
+  Dec(PPSkipStackIndex);
+  PPSkipMode := PPSkipModeStack[PPSkipStackIndex];
+  PPIsSkipping := PPIsSkippingStack[PPSkipStackIndex];
+end;
+
+Function TPascalScanner.HandleDirective(Const ADirectiveText : String) : TToken;
+
+Var
+  Directive,Param : String;
+  P : Integer;
+
+begin
+  Result:=tkComment;
+  P:=Pos(' ',ADirectiveText);
+  If P=0 then
+    P:=Length(ADirectiveText)+1;
+  Directive:=Copy(ADirectiveText,2,P-2); // 1 is $
+  Param:=ADirectiveText;
+  Delete(Param,1,P);
+//  Writeln('Directive: "',Directive,'", Param : "',Param,'"');
+  Case UpperCase(Directive) of
+  'I':
+    if not PPIsSkipping then
+      Result:=HandleInclude(Param);
+  'INCLUDE':
+    if not PPIsSkipping then
+      Result:=HandleInclude(Param);
+  'MODE':
+     if not PPIsSkipping then
+      HandleMode(Param);
+  'DEFINE':
+     if not PPIsSkipping then
+       HandleDefine(Param);
+  'UNDEF':
+     if not PPIsSkipping then
+       HandleUnDefine(Param);
+  'IFDEF':
+     HandleIFDEF(Param);
+  'IFNDEF':
+     HandleIFNDEF(Param);
+  'IFOPT':
+     HandleIFOPT(Param);
+  'IF':
+     HandleIF(Param);
+  'ELSE':
+     HandleELSE(Param);
+  'ENDIF':
+    HandleENDIF(Param);
+  'IFEND':
+    HandleENDIF(Param);
+  end;
+end;
+
 function TPascalScanner.DoFetchToken: TToken;
 var
-  TokenStart, CurPos: PChar;
+  TokenStart: PChar;
   i: TToken;
   OldLength, SectionLength, NestingLevel, Index: Integer;
-  Directive, Param : string;
 begin
   if TokenStr = nil then
     if not FetchLine then
@@ -1429,9 +1648,7 @@ begin
       FCurToken := Result;
       exit;
     end;
-
   FCurTokenString := '';
-
   case TokenStr[0] of
     #0:         // Empty line
       begin
@@ -1505,27 +1722,45 @@ begin
     '(':
       begin
         Inc(TokenStr);
-        if TokenStr[0] = '*' then
-        begin
+        if TokenStr[0] <> '*' then
+          Result := tkBraceOpen
+        else
+          begin
           // Old-style multi-line comment
           Inc(TokenStr);
+          TokenStart := TokenStr;
+          FCurTokenString := '';
+          OldLength := 0;
           while (TokenStr[0] <> '*') or (TokenStr[1] <> ')') do
-          begin
-            if TokenStr[0] = #0 then
             begin
-              if not FetchLine then
+            if TokenStr[0] = #0 then
               begin
+              SectionLength:=TokenStr - TokenStart +1;
+              SetLength(FCurTokenString, OldLength + SectionLength);
+              if SectionLength > 1 then
+                Move(TokenStart^, FCurTokenString[OldLength + 1], SectionLength - 1);
+              Inc(OldLength, SectionLength);
+              FCurTokenString[OldLength] := #10;
+              if not FetchLine then
+                begin
                 Result := tkEOF;
                 FCurToken := Result;
                 exit;
-              end;
-            end else
+                end;
+              TokenStart:=TokenStr;
+              end
+            else
               Inc(TokenStr);
           end;
+          SectionLength := TokenStr - TokenStart;
+          SetLength(FCurTokenString, OldLength + SectionLength);
+          if SectionLength > 0 then
+            Move(TokenStart^, FCurTokenString[OldLength + 1], SectionLength);
           Inc(TokenStr, 2);
           Result := tkComment;
-        end else
-          Result := tkBraceOpen;
+          if Copy(CurTokenString,1,1)='$' then
+            Result := HandleDirective(CurTokenString);
+          end;
       end;
     ')':
       begin
@@ -1674,14 +1909,21 @@ begin
       begin
         Inc(TokenStr);
         if TokenStr[0] = '>' then
-        begin
+          begin
           Inc(TokenStr);
           Result := tkNotEqual;
-        end else if TokenStr[0] = '=' then
-        begin
+          end
+        else if TokenStr[0] = '=' then
+          begin
           Inc(TokenStr);
           Result := tkLessEqualThan;
-        end else
+          end
+        else if TokenStr[0] = '<' then
+          begin
+          Inc(TokenStr);
+          Result := tkshl;
+          end
+        else
           Result := tkLessThan;
       end;
     '=':
@@ -1693,14 +1935,20 @@ begin
       begin
         Inc(TokenStr);
         if TokenStr[0] = '=' then
-        begin
+          begin
           Inc(TokenStr);
           Result := tkGreaterEqualThan;
             end else if TokenStr[0] = '<' then
             begin
           Inc(TokenStr);
           Result := tkSymmetricalDifference;
-        end else
+          end
+        else if TokenStr[0] = '>' then
+          begin
+          Inc(TokenStr);
+          Result := tkshr;
+          end
+        else
           Result := tkGreaterThan;
       end;
     '@':
@@ -1769,164 +2017,8 @@ begin
         Inc(TokenStr);
         Result := tkComment;
         //WriteLn('Kommentar: "', CurTokenString, '"');
-        if (Length(CurTokenString) > 0) and (CurTokenString[1] = '$') then
-        begin
-          TokenStart := @CurTokenString[2];
-          CurPos := TokenStart;
-          while (CurPos[0] <> ' ') and (CurPos[0] <> #0) do
-            Inc(CurPos);
-          SectionLength := CurPos - TokenStart;
-          SetLength(Directive, SectionLength);
-          if SectionLength > 0 then
-          begin
-            Move(TokenStart^, Directive[1], SectionLength);
-            Directive := UpperCase(Directive);
-            if CurPos[0] <> #0 then
-            begin
-              TokenStart := CurPos + 1;
-              CurPos := TokenStart;
-              while CurPos[0] <> #0 do
-                Inc(CurPos);
-              SectionLength := CurPos - TokenStart;
-              SetLength(Param, SectionLength);
-              if SectionLength > 0 then
-                Move(TokenStart^, Param[1], SectionLength);
-            end else
-              Param := '';
-            if Not PPIsSkipping then
-              begin
-              if (Directive = 'I') or (Directive = 'INCLUDE') then
-                begin
-                if ((Param='') or (Param[1]<>'%')) then
-                  HandleIncludeFile(param)
-                else if Param[1]='%' then
-                  begin
-                  fcurtokenstring:='{$i '+param+'}';
-                  fcurtoken:=tkstring;
-                  result:=fcurtoken;
-                  exit;
-                  end
-                end
-              else if (Directive = 'DEFINE') then
-                HandleDefine(Param)
-              else if (Directive = 'UNDEF') then
-                HandleUnDefine(Param)
-              end;
-            if (Directive = 'IFDEF') then
-              begin
-              if PPSkipStackIndex = High(PPSkipModeStack) then
-                Error(nErrIfXXXNestingLimitReached,SErrIfXXXNestingLimitReached);
-              PPSkipModeStack[PPSkipStackIndex] := PPSkipMode;
-              PPIsSkippingStack[PPSkipStackIndex] := PPIsSkipping;
-              Inc(PPSkipStackIndex);
-              if PPIsSkipping then
-              begin
-                PPSkipMode := ppSkipAll;
-                PPIsSkipping := true;
-              end else
-              begin
-                Param := UpperCase(Param);
-                Index := Defines.IndexOf(Param);
-                if Index < 0 then
-                  Index := Macros.IndexOf(Param);
-                if Index < 0 then
-                begin
-                  PPSkipMode := ppSkipIfBranch;
-                  PPIsSkipping := true;
-                end else
-                  PPSkipMode := ppSkipElseBranch;
-                If LogEvent(sleConditionals) then
-                  if PPSkipMode=ppSkipElseBranch then
-                    DoLog(mtInfo,nLogIFDefAccepted,sLogIFDefAccepted,[Param])
-                  else
-                    DoLog(mtInfo,nLogIFDefRejected,sLogIFDefRejected,[Param])
-              end;
-            end else if Directive = 'IFNDEF' then
-            begin
-              if PPSkipStackIndex = High(PPSkipModeStack) then
-                Error(nErrIfXXXNestingLimitReached,sErrIfXXXNestingLimitReached);
-              PPSkipModeStack[PPSkipStackIndex] := PPSkipMode;
-              PPIsSkippingStack[PPSkipStackIndex] := PPIsSkipping;
-              Inc(PPSkipStackIndex);
-              if PPIsSkipping then
-              begin
-                PPSkipMode := ppSkipAll;
-                PPIsSkipping := true;
-              end else
-              begin
-                Param := UpperCase(Param);
-                Index := Defines.IndexOf(Param);
-                if Index >= 0 then
-                begin
-                  PPSkipMode := ppSkipIfBranch;
-                  PPIsSkipping := true;
-                end else
-                  PPSkipMode := ppSkipElseBranch;
-                If LogEvent(sleConditionals) then
-                  if PPSkipMode=ppSkipElseBranch then
-                    DoLog(mtInfo,nLogIFNDefAccepted,sLogIFNDefAccepted,[Param])
-                  else
-                    DoLog(mtInfo,nLogIFNDefRejected,sLogIFNDefRejected,[Param])
-              end;
-            end else if Directive = 'IFOPT' then
-            begin
-              if PPSkipStackIndex = High(PPSkipModeStack) then
-                Error(nErrIfXXXNestingLimitReached,sErrIfXXXNestingLimitReached);
-              PPSkipModeStack[PPSkipStackIndex] := PPSkipMode;
-              PPIsSkippingStack[PPSkipStackIndex] := PPIsSkipping;
-              Inc(PPSkipStackIndex);
-              if PPIsSkipping then
-              begin
-                PPSkipMode := ppSkipAll;
-                PPIsSkipping := true;
-              end else
-              begin
-                { !!!: Currently, options are not supported, so they are just
-                  assumed as not being set. }
-                PPSkipMode := ppSkipIfBranch;
-                PPIsSkipping := true;
-              end;
-              If LogEvent(sleConditionals) then
-                DoLog(mtInfo,nLogIFOPTIgnored,sLogIFOPTIgnored,[Uppercase(Param)])
-            end else if Directive = 'IF' then
-            begin
-              if PPSkipStackIndex = High(PPSkipModeStack) then
-                Error(nErrIfXXXNestingLimitReached,sErrIfXXXNestingLimitReached);
-              PPSkipModeStack[PPSkipStackIndex] := PPSkipMode;
-              PPIsSkippingStack[PPSkipStackIndex] := PPIsSkipping;
-              Inc(PPSkipStackIndex);
-              if PPIsSkipping then
-              begin
-                PPSkipMode := ppSkipAll;
-                PPIsSkipping := true;
-              end else
-              begin
-                { !!!: Currently, expressions are not supported, so they are
-                  just assumed as evaluating to false. }
-                PPSkipMode := ppSkipIfBranch;
-                PPIsSkipping := true;
-              If LogEvent(sleConditionals) then
-                 DoLog(mtInfo,nLogIFIgnored,sLogIFIgnored,[Uppercase(Param)])
-              end;
-            end else if Directive = 'ELSE' then
-            begin
-              if PPSkipStackIndex = 0 then
-                Error(nErrInvalidPPElse,sErrInvalidPPElse);
-              if PPSkipMode = ppSkipIfBranch then
-                PPIsSkipping := false
-              else if PPSkipMode = ppSkipElseBranch then
-                PPIsSkipping := true;
-            end else if ((Directive = 'ENDIF') or (Directive='IFEND')) then
-            begin
-              if PPSkipStackIndex = 0 then
-                Error(nErrInvalidPPEndif,sErrInvalidPPEndif);
-              Dec(PPSkipStackIndex);
-              PPSkipMode := PPSkipModeStack[PPSkipStackIndex];
-              PPIsSkipping := PPIsSkippingStack[PPSkipStackIndex];
-            end;
-          end else
-            Directive := '';
-        end;
+        if (Copy(CurTokenString,1,1)='$') then
+          Result:=HandleDirective(CurTokenString);
       end;
     'A'..'Z', 'a'..'z', '_':
       begin

packages/fcl-passrc/src/readme.txt

@@ -28,3 +28,18 @@ pparser.pp
 ----------
 Parser for Pascal source files. Reads files via the pscanner unit and stores
 all parsed data in a parse tree, as implemented in the pastree unit.
+
+pasresolver.pp
+--------------
+A symbol resolver: A TPasTreeContainer descendent that looks up symbols 
+(identifiers) in the parse tree, following the scope rules of Pascal
+
+passrcutil.pp
+-------------
+A small class to roughly analyse a pascal source unit. It gives some methods to get
+a list of interface/implementation units, whether a source file has resource
+strings, a complete list of identifiers etc.
+
+pastounittest.pp
+----------------
+A unit to create a FPC unit test source file from a pascal unit file.

packages/fcl-passrc/tests/tcbaseparser.pas

@@ -599,6 +599,8 @@ end;
 
 procedure TTestParser.StartParsing;
 
+var
+  i: Integer;
 begin
   If FIsUnit then
     StartImplementation;
@@ -608,7 +610,8 @@ begin
   FResolver.AddStream(FFileName,TStringStream.Create(FSource.Text));
   FScanner.OpenFile(FFileName);
   Writeln('// Test : ',Self.TestName);
-  Writeln(FSource.Text);
+  for i:=0 to FSource.Count-1 do
+    Writeln(Format('%:4d: ',[i+1]),FSource[i]);
 end;
 
 procedure TTestParser.ParseDeclarations;
@@ -707,8 +710,8 @@ end;
 procedure TTestParser.AssertEquals(const Msg: String; AExpected,
   AActual: TPasObjKind);
 begin
-  AssertEquals(Msg,GetEnumName(TypeInfo(TexprOpcode),Ord(AExpected)),
-                   GetEnumName(TypeInfo(TexprOpcode),Ord(AActual)));
+  AssertEquals(Msg,GetEnumName(TypeInfo(TPasObjKind),Ord(AExpected)),
+                   GetEnumName(TypeInfo(TPasObjKind),Ord(AActual)));
 end;
 
 procedure TTestParser.AssertEquals(const Msg: String; AExpected,

packages/fcl-passrc/tests/tcclasstype.pas

@@ -31,7 +31,7 @@ type
   protected
     Procedure StartClass (AParent : String = 'TObject'; InterfaceList : String = '');
     Procedure StartClassHelper (ForType : String = 'TOriginal'; AParent : String = 'TObject');
-    Procedure StartInterface (AParent : String = 'IInterface'; UUID : String = '');
+    Procedure StartInterface (AParent : String = 'IInterface'; UUID : String = ''; Disp : Boolean = False);
     Procedure StartRecordHelper (ForType : String = 'TOriginal'; AParent : String = 'TObject');
     Procedure StartVisibility(A : TPasMemberVisibility);
     Procedure EndClass(AEnd : String = 'end');
@@ -72,6 +72,8 @@ type
     procedure TestOneSpecializedClassInterface;
     Procedure TestOneField;
     Procedure TestOneFieldComment;
+    procedure TestOneFieldStatic;
+    Procedure TestOneHelperField;
     Procedure TestOneVarField;
     Procedure TestOneClassField;
     Procedure TestOneFieldVisibility;
@@ -144,8 +146,11 @@ type
     procedure TestClassHelperParentedEmpty;
     procedure TestClassHelperOneMethod;
     procedure TestInterfaceEmpty;
+    procedure TestInterfaceDisp;
     procedure TestInterfaceParentedEmpty;
     procedure TestInterfaceOneMethod;
+    procedure TestInterfaceProperty;
+    procedure TestInterfaceDispProperty;
     procedure TestInterfaceNoConstructor;
     procedure TestInterfaceNoDestructor;
     procedure TestInterfaceNoFields;
@@ -257,12 +262,16 @@ begin
   FParent:=AParent;
 end;
 
-procedure TTestClassType.StartInterface(AParent: String; UUID: String);
+procedure TTestClassType.StartInterface(AParent: String; UUID: String;
+  Disp: Boolean = False);
 Var
   S : String;
 begin
   FStarted:=True;
-  S:='TMyClass = Interface';
+  if Disp then
+    S:='TMyClass = DispInterface'
+  else
+    S:='TMyClass = Interface';
   if (AParent<>'') then
     S:=S+' ('+AParent+')';
   if (UUID<>'') then
@@ -513,6 +522,25 @@ begin
   AssertVisibility;
 end;
 
+procedure TTestClassType.TestOneFieldStatic;
+begin
+  AddMember('a : integer; static');
+  ParseClass;
+  AssertNotNull('Have 1 field',Field1);
+  AssertMemberName('a');
+  AssertVisibility;
+  AssertTrue('Have static field',vmStatic in TPasVariable(Field1).VarModifiers);
+end;
+
+procedure TTestClassType.TestOneHelperField;
+begin
+  AddMember('helper : integer');
+  ParseClass;
+  AssertNotNull('Have 1 field',Field1);
+  AssertMemberName('helper');
+  AssertVisibility;
+end;
+
 procedure TTestClassType.TestOneFieldComment;
 begin
   AddComment:=true;
@@ -763,28 +791,28 @@ procedure TTestClassType.TestConstructor;
 begin
   AddMember('Constructor Create');
   ParseClass;
-  AssertEquals('1 members',1,TheClass.members.Count);
-  AssertEquals('1 class procedure',TPasConstructor,members[0].ClassType);
+  AssertEquals('1 members',1,TheClass.Members.Count);
+  AssertEquals('1 class procedure',TPasConstructor,Members[0].ClassType);
   AssertEquals('Default visibility',visDefault,Members[0].Visibility);
   AssertMemberName('Create');
-  AssertEquals('No modifiers',[],TPasClassProcedure(Members[0]).Modifiers);
-  AssertEquals('Default calling convention',ccDefault, TPasClassProcedure(Members[0]).ProcType.CallingConvention);
-  AssertNotNull('Method proc type',TPasClassProcedure(Members[0]).ProcType);
-  AssertEquals('No arguments',0,TPasClassProcedure(Members[0]).ProcType.Args.Count)
+  AssertEquals('No modifiers',[],TPasConstructor(Members[0]).Modifiers);
+  AssertEquals('Default calling convention',ccDefault, TPasConstructor(Members[0]).ProcType.CallingConvention);
+  AssertNotNull('Method proc type',TPasConstructor(Members[0]).ProcType);
+  AssertEquals('No arguments',0,TPasConstructor(Members[0]).ProcType.Args.Count)
 end;
 
 procedure TTestClassType.TestClassConstructor;
 begin
   AddMember('Class Constructor Create');
   ParseClass;
-  AssertEquals('1 members',1,TheClass.members.Count);
-  AssertEquals('1 class procedure',TPasClassConstructor,members[0].ClassType);
+  AssertEquals('1 members',1,TheClass.Members.Count);
+  AssertEquals('1 class procedure',TPasClassConstructor,Members[0].ClassType);
   AssertEquals('Default visibility',visDefault,Members[0].Visibility);
   AssertMemberName('Create');
-  AssertEquals('No modifiers',[],TPasClassProcedure(Members[0]).Modifiers);
-  AssertEquals('Default calling convention',ccDefault, TPasClassProcedure(Members[0]).ProcType.CallingConvention);
-  AssertNotNull('Method proc type',TPasClassProcedure(Members[0]).ProcType);
-  AssertEquals('No arguments',0,TPasClassProcedure(Members[0]).ProcType.Args.Count)
+  AssertEquals('No modifiers',[],TPasClassConstructor(Members[0]).Modifiers);
+  AssertEquals('Default calling convention',ccDefault, TPasClassConstructor(Members[0]).ProcType.CallingConvention);
+  AssertNotNull('Method proc type',TPasClassConstructor(Members[0]).ProcType);
+  AssertEquals('No arguments',0,TPasClassConstructor(Members[0]).ProcType.Args.Count)
 end;
 
 procedure TTestClassType.TestDestructor;
@@ -795,24 +823,24 @@ begin
   AssertEquals('1 class procedure',TPasDestructor,members[0].ClassType);
   AssertEquals('Default visibility',visDefault,Members[0].Visibility);
   AssertMemberName('Destroy');
-  AssertEquals('No modifiers',[],TPasClassProcedure(Members[0]).Modifiers);
-  AssertEquals('Default calling convention',ccDefault, TPasClassProcedure(Members[0]).ProcType.CallingConvention);
-  AssertNotNull('Method proc type',TPasClassProcedure(Members[0]).ProcType);
-  AssertEquals('No arguments',0,TPasClassProcedure(Members[0]).ProcType.Args.Count)
+  AssertEquals('No modifiers',[],TPasDestructor(Members[0]).Modifiers);
+  AssertEquals('Default calling convention',ccDefault, TPasDestructor(Members[0]).ProcType.CallingConvention);
+  AssertNotNull('Method proc type',TPasDestructor(Members[0]).ProcType);
+  AssertEquals('No arguments',0,TPasDestructor(Members[0]).ProcType.Args.Count)
 end;
 
 procedure TTestClassType.TestClassDestructor;
 begin
   AddMember('Class Destructor Destroy');
   ParseClass;
-  AssertEquals('1 members',1,TheClass.members.Count);
-  AssertEquals('1 class procedure',TPasClassDestructor,members[0].ClassType);
+  AssertEquals('1 members',1,TheClass.Members.Count);
+  AssertEquals('1 class procedure',TPasClassDestructor,Members[0].ClassType);
   AssertEquals('Default visibility',visDefault,Members[0].Visibility);
   AssertMemberName('Destroy');
-  AssertEquals('No modifiers',[],TPasClassProcedure(Members[0]).Modifiers);
-  AssertEquals('Default calling convention',ccDefault, TPasClassProcedure(Members[0]).ProcType.CallingConvention);
-  AssertNotNull('Method proc type',TPasClassProcedure(Members[0]).ProcType);
-  AssertEquals('No arguments',0,TPasClassProcedure(Members[0]).ProcType.Args.Count)
+  AssertEquals('No modifiers',[],TPasClassDestructor(Members[0]).Modifiers);
+  AssertEquals('Default calling convention',ccDefault, TPasClassDestructor(Members[0]).ProcType.CallingConvention);
+  AssertNotNull('Method proc type',TPasClassDestructor(Members[0]).ProcType);
+  AssertEquals('No arguments',0,TPasClassDestructor(Members[0]).ProcType.Args.Count)
 end;
 
 procedure TTestClassType.TestFunctionMethodSimple;
@@ -1546,6 +1574,17 @@ begin
   AssertNull('No UUID',TheClass.GUIDExpr);
 end;
 
+procedure TTestClassType.TestInterfaceDisp;
+
+begin
+  StartInterface('','',true);
+  EndClass();
+  ParseClass;
+  AssertEquals('Is interface',okDispInterface,TheClass.ObjKind);
+  AssertEquals('No members',0,TheClass.Members.Count);
+  AssertNull('No UUID',TheClass.GUIDExpr);
+end;
+
 procedure TTestClassType.TestInterfaceParentedEmpty;
 begin
   StartInterface('IInterface','');
@@ -1570,6 +1609,44 @@ begin
   AssertNull('No UUID',TheClass.GUIDExpr);
 end;
 
+procedure TTestClassType.TestInterfaceProperty;
+begin
+  StartInterface('IInterface','');
+  AddMember('Function GetS : Integer');
+  AddMember('Property S : Integer Read GetS');
+  EndClass();
+  ParseClass;
+  AssertEquals('Is interface',okInterface,TheClass.ObjKind);
+  if TheClass.members.Count<1 then
+    Fail('No members for method');
+  AssertNotNull('Have method',FunctionMethod1);
+  AssertNotNull('Method proc type',FunctionMethod1.ProcType);
+  AssertMemberName('GetS');
+  AssertEquals('0 arguments',0,FunctionMethod1.ProcType.Args.Count) ;
+  AssertEquals('Default visibility',visDefault,FunctionMethod1.Visibility);
+  AssertEquals('No modifiers',[],FunctionMethod1.Modifiers);
+  AssertEquals('Default calling convention',ccDefault, FunctionMethod1.ProcType.CallingConvention);
+  AssertNull('No UUID',TheClass.GUIDExpr);
+  AssertNotNull('Have property',Property2);
+  AssertMemberName('S',Property2);
+end;
+
+procedure TTestClassType.TestInterfaceDispProperty;
+begin
+  StartInterface('IInterface','',True);
+  AddMember('Property S : Integer DispID 1');
+  EndClass();
+  ParseClass;
+  AssertEquals('Is interface',okDispInterface,TheClass.ObjKind);
+  if TheClass.members.Count<1 then
+    Fail('No members for method');
+  AssertNotNull('Have property',Property1);
+  AssertMemberName('S',Property1);
+  AssertNotNull('Have property dispID',Property1.DispIDExpr);
+  AssertEquals('Have number',pekNumber,Property1.DispIDExpr.Kind);
+  AssertEquals('Have number','1', (Property1.DispIDExpr as TPrimitiveExpr).Value);
+end;
+
 procedure TTestClassType.TestInterfaceNoConstructor;
 begin
   StartInterface('','');

packages/fcl-passrc/tests/tcexprparser.pas

@@ -62,6 +62,8 @@ type
     Procedure TestUnaryAddress;
     Procedure TestUnaryNot;
     Procedure TestUnaryDeref;
+    Procedure TestUnaryDoubleDeref;
+    Procedure TestUnaryDoubleDeref2;
     Procedure TestBinaryAdd;
     Procedure TestBinarySubtract;
     Procedure TestBinaryMultiply;
@@ -210,13 +212,14 @@ Var
 begin
   DeclareVar('record a : array[1..2] of integer; end ','b');
   ParseExpression('b.a[1]');
-  P:=TParamsExpr(AssertExpression('Simple identifier',theExpr,pekArrayParams,TParamsExpr));
-  B:=AssertExpression('Name of array',P.Value,pekBinary,TBInaryExpr) as TBinaryExpr;
-  AssertEquals('name is Subident',eopSubIdent,B.Opcode);
+  B:=AssertExpression('Binary of record',TheExpr,pekBinary,TBinaryExpr) as TBinaryExpr;
+  AssertEquals('Name is Subident',eopSubIdent,B.Opcode);
   AssertExpression('Name of array',B.Left,pekIdent,'b');
-  AssertExpression('Name of array',B.Right,pekIdent,'a');
-  AssertEquals('One dimension',1,Length(p.params));
-  AssertExpression('Simple identifier',p.params[0],pekNumber,'1');
+  P:=TParamsExpr(AssertExpression('Simple identifier',B.right,pekArrayParams,TParamsExpr));
+  AssertExpression('Name of array',P.Value,pekIdent,'a');
+  TAssert.AssertSame('P.value.parent=P',P,P.Value.Parent);
+  AssertEquals('One dimension',1,Length(P.params));
+  AssertExpression('Simple identifier',P.params[0],pekNumber,'1');
   TAssert.AssertSame('B.left.parent=B',B,B.left.Parent);
   TAssert.AssertSame('B.right.parent=B',B,B.right.Parent);
 end;
@@ -549,10 +552,30 @@ begin
   DeclareVar('integer','a');
   DeclareVar('pinteger','b');
   ParseExpression('b^');
-  AssertUnaryExpr('Simple address unary',eopDeref,FLeft);
+  AssertUnaryExpr('Simple deref unary',eopDeref,FLeft);
   AssertExpression('Simple identifier',theLeft,pekIdent,'b');
 end;
 
+procedure TTestExpressions.TestUnaryDoubleDeref;
+begin
+  DeclareVar('integer','a');
+  DeclareVar('ppinteger','b');
+  ParseExpression('(b)^^');
+  AssertExpression('Deref expression 1',TheExpr,pekUnary,TUnaryExpr);
+  AssertExpression('Deref expression 2',TUnaryExpr(TheExpr).Operand,pekUnary,TUnaryExpr);
+  AssertExpression('Deref expression 3',TUnaryExpr(TUnaryExpr(TheExpr).Operand).Operand,pekIdent,'b');
+end;
+
+procedure TTestExpressions.TestUnaryDoubleDeref2;
+begin
+  DeclareVar('integer','a');
+  DeclareVar('ppinteger','b');
+  ParseExpression('b^^');
+  AssertExpression('Deref expression 1',TheExpr,pekUnary,TUnaryExpr);
+  AssertExpression('Deref expression 2',TUnaryExpr(TheExpr).Operand,pekUnary,TUnaryExpr);
+  AssertExpression('Deref expression 3',TUnaryExpr(TUnaryExpr(TheExpr).Operand).Operand,pekIdent,'b');
+end;
+
 procedure TTestExpressions.TestBinaryAdd;
 begin
   ParseExpression('1+2');

packages/fcl-passrc/tests/tcprocfunc.pas

@@ -80,6 +80,7 @@ type
     Procedure TestFunctionOneArgDefaultExpr;
     procedure TestProcedureTwoArgsDefault;
     Procedure TestFunctionTwoArgsDefault;
+    procedure TestFunctionOneArgEnumeratedExplicit;
     procedure TestProcedureOneUntypedVarArg;
     Procedure TestFunctionOneUntypedVarArg;
     procedure TestProcedureTwoUntypedVarArgs;
@@ -160,6 +161,7 @@ type
     Procedure TestFunctionCdeclExternalName;
     Procedure TestOperatorTokens;
     procedure TestOperatorNames;
+    Procedure TestFunctionNoResult;
   end;
 
 implementation
@@ -562,6 +564,13 @@ begin
   AssertArg(FuncType,0,'B',argDefault,'Integer','1');
 end;
 
+procedure TTestProcedureFunction.TestFunctionOneArgEnumeratedExplicit;
+begin
+  ParseFunction('(B : TSomeEnum = TSomeEnum.False)');
+  AssertFunc([],ccDefault,1);
+  AssertArg(FuncType,0,'B',argDefault,'TSomeEnum','TSomeEnum.False');
+end;
+
 procedure TTestProcedureFunction.TestProcedureOneArgDefaultSet;
 begin
   ParseProcedure('(B : MySet = [1,2])');
@@ -1154,24 +1163,26 @@ procedure TTestProcedureFunction.TestOperatorTokens;
 
 Var
   t : TOperatorType;
+  s : string;
 
 begin
   For t:=otMul to High(TOperatorType) do
     // No way to distinguish between logical/bitwise or/and/Xor
     if not (t in [otBitwiseOr,otBitwiseAnd,otBitwiseXor]) then
       begin
+      S:=GetEnumName(TypeInfo(TOperatorType),Ord(T));
       ResetParser;
       if t in UnaryOperators then
         AddDeclaration(Format('operator %s (a: Integer) : te',[OperatorTokens[t]]))
       else
         AddDeclaration(Format('operator %s (a: Integer; b: integer) : te',[OperatorTokens[t]]));
       ParseOperator;
-      AssertEquals('Token based',Not (T in [otInc,otDec]),FOperator.TokenBased);
-      AssertEquals('Correct operator type',T,FOperator.OperatorType);
+      AssertEquals(S+': Token based ',Not (T in [otInc,otDec,otEnumerator]),FOperator.TokenBased);
+      AssertEquals(S+': Correct operator type',T,FOperator.OperatorType);
       if t in UnaryOperators then
-        AssertEquals('Correct operator name',format('%s(Integer):te',[OperatorNames[t]]),FOperator.Name)
+        AssertEquals(S+': Correct operator name',format('%s(Integer):te',[OperatorNames[t]]),FOperator.Name)
       else
-        AssertEquals('Correct operator name',format('%s(Integer,Integer):te',[OperatorNames[t]]),FOperator.Name);
+        AssertEquals(S+': Correct operator name',format('%s(Integer,Integer):te',[OperatorNames[t]]),FOperator.Name);
       end;
 end;
 
@@ -1198,6 +1209,21 @@ begin
       end;
 end;
 
+procedure TTestProcedureFunction.TestFunctionNoResult;
+begin
+  Add('unit afile;');
+  Add('{$mode delphi}');
+  Add('interface');
+  Add('function TestDelphiModeFuncs(d:double):string;');
+  Add('implementation');
+  Add('function TestDelphiModeFuncs;');
+  Add('begin');
+  Add('end;');
+  EndSource;
+  Parser.Options:=[po_delphi];
+  ParseModule;
+end;
+
 procedure TTestProcedureFunction.SetUp;
 begin
    Inherited;

packages/fcl-passrc/tests/tcscanner.pas

@@ -65,12 +65,15 @@ type
     Procedure TestToken(t : TToken; Const ASource : String; Const CheckEOF : Boolean = True);
     Procedure TestTokens(t : array of TToken; Const ASource : String; Const CheckEOF : Boolean = True;Const DoClear : Boolean = True);
     Property LastIDentifier : String Read FLI Write FLi;
+    Property Scanner : TPascalScanner Read FScanner;
   published
     procedure TestEOF;
     procedure TestWhitespace;
     procedure TestComment1;
     procedure TestComment2;
     procedure TestComment3;
+    procedure TestComment4;
+    procedure TestComment5;
     procedure TestNestedComment1;
     procedure TestNestedComment2;
     procedure TestNestedComment3;
@@ -120,6 +123,7 @@ type
     procedure TestConst;
     procedure TestConstructor;
     procedure TestDestructor;
+    procedure TestDispinterface;
     procedure TestDiv;
     procedure TestDo;
     procedure TestDownto;
@@ -166,6 +170,8 @@ type
     procedure TestSet;
     procedure TestShl;
     procedure TestShr;
+    procedure TestShlC;
+    procedure TestShrC;
     procedure TestSpecialize;
     procedure TestThen;
     procedure TestThreadvar;
@@ -187,8 +193,11 @@ type
     Procedure TestTokenSeriesComments;
     Procedure TestTokenSeriesNoComments;
     Procedure TestDefine0;
+    procedure TestDefine01;
     Procedure TestDefine1;
     Procedure TestDefine2;
+    Procedure TestDefine21;
+    procedure TestDefine22;
     Procedure TestDefine3;
     Procedure TestDefine4;
     Procedure TestDefine5;
@@ -199,6 +208,7 @@ type
     Procedure TestDefine10;
     Procedure TestDefine11;
     Procedure TestDefine12;
+    Procedure TestDefine13;
     Procedure TestInclude;
     Procedure TestInclude2;
     Procedure TestUnDefine1;
@@ -359,11 +369,13 @@ begin
   if DoClear then
     FResolver.Clear;
   FResolver.AddStream('afile.pp',TStringStream.Create(Source));
+  Writeln('// TestName');
+  Writeln(Source);
   FScanner.OpenFile('afile.pp');
 end;
 
 procedure TTestScanner.DoTestToken(t: TToken; const ASource: String;
-  Const CheckEOF: Boolean);
+  const CheckEOF: Boolean);
 
 Var
   tk : ttoken;
@@ -381,7 +393,8 @@ begin
     end;
 end;
 
-procedure TTestScanner.TestToken(t: TToken; const ASource: String; Const CheckEOF: Boolean);
+procedure TTestScanner.TestToken(t: TToken; const ASource: String;
+  const CheckEOF: Boolean);
 Var
   S : String;
 begin
@@ -397,7 +410,7 @@ begin
 end;
 
 procedure TTestScanner.TestTokens(t: array of TToken; const ASource: String;
-  const CheckEOF: Boolean;Const DoClear : Boolean = True);
+  const CheckEOF: Boolean; const DoClear: Boolean);
 Var
   tk : ttoken;
   i : integer;
@@ -453,6 +466,20 @@ begin
   TestToken(tkComment,'//');
 end;
 
+procedure TTestScanner.TestComment4;
+
+begin
+  DoTestToken(tkComment,'(* abc *)',False);
+  AssertEquals('Correct comment',' abc ',Scanner.CurTokenString);
+end;
+
+procedure TTestScanner.TestComment5;
+
+begin
+  DoTestToken(tkComment,'(* abc'+LineEnding+'def *)',False);
+  AssertEquals('Correct comment',' abc'+LineEnding+'def ',Scanner.CurTokenString);
+end;
+
 procedure TTestScanner.TestNestedComment1;
 begin
   TestToken(tkComment,'// { comment } ');
@@ -788,6 +815,10 @@ begin
   TestToken(tkdestructor,'destructor');
 end;
 
+procedure TTestScanner.TestDispinterface;
+begin
+  TestToken(tkdispinterface,'dispinterface');
+end;
 
 procedure TTestScanner.TestDiv;
 
@@ -895,7 +926,7 @@ end;
 
 procedure TTestScanner.TestHelper;
 begin
-  TestToken(tkHelper,'helper');
+  TestToken(tkIdentifier,'helper');
 end;
 
 
@@ -1108,6 +1139,16 @@ begin
   TestToken(tkshr,'shr');
 end;
 
+procedure TTestScanner.TestShlC;
+begin
+  TestToken(tkshl,'<<');
+end;
+
+procedure TTestScanner.TestShrC;
+begin
+  TestToken(tkshr,'>>');
+end;
+
 
 procedure TTestScanner.TestSpecialize;
 
@@ -1249,6 +1290,13 @@ begin
     Fail('Define not defined');
 end;
 
+procedure TTestScanner.TestDefine01;
+begin
+  TestTokens([tkComment],'(*$DEFINE NEVER*)');
+  If FSCanner.Defines.IndexOf('NEVER')=-1 then
+    Fail('Define not defined');
+end;
+
 procedure TTestScanner.TestDefine1;
 begin
   TestTokens([tkComment],'{$IFDEF NEVER} of {$ENDIF}');
@@ -1261,6 +1309,19 @@ begin
   TestTokens([tkComment,tkWhitespace,tkOf,tkWhitespace,tkcomment],'{$IFDEF ALWAYS} of {$ENDIF}');
 end;
 
+procedure TTestScanner.TestDefine21;
+begin
+  FSCanner.Defines.Add('ALWAYS');
+  TestTokens([tkComment,tkWhitespace,tkOf,tkWhitespace,tkcomment],'(*$IFDEF ALWAYS*) of (*$ENDIF*)');
+end;
+
+procedure TTestScanner.TestDefine22;
+begin
+  FSCanner.Defines.Add('ALWAYS');
+  // No whitespace. Test border of *)
+  TestTokens([tkComment,tkOf,tkWhitespace,tkcomment],'(*$IFDEF ALWAYS*)of (*$ENDIF*)');
+end;
+
 procedure TTestScanner.TestDefine3;
 begin
   FSCanner.Defines.Add('ALWAYS');
@@ -1328,6 +1389,13 @@ begin
   TestTokens([tkin],'{$IFDEF ALWAYS} of {$ELSE} in {$ENDIF}');
 end;
 
+procedure TTestScanner.TestDefine13;
+begin
+  FScanner.SkipComments:=True;
+  FScanner.SkipWhiteSpace:=True;
+  TestTokens([tkin],'{$IFDEF ALWAYS} }; ą è {$ELSE} in {$ENDIF}');
+end;
+
 procedure TTestScanner.TestInclude;
 begin
   FResolver.AddStream('myinclude.inc',TStringStream.Create('if true then'));

packages/fcl-passrc/tests/tcstatements.pas

@@ -19,6 +19,8 @@ Type
   private
     FStatement: TPasImplBlock;
     FVariables : TStrings;
+    procedure DoTestCallOtherFormat;
+    procedure TestCallFormat(FN: String; Two: Boolean);
   Protected
     Procedure SetUp; override;
     Procedure TearDown; override;
@@ -48,6 +50,13 @@ Type
     Procedure TestCallQualified2;
     Procedure TestCallNoArgs;
     Procedure TestCallOneArg;
+    procedure TestCallWriteFormat1;
+    procedure TestCallWriteFormat2;
+    procedure TestCallWritelnFormat1;
+    procedure TestCallWritelnFormat2;
+    procedure TestCallStrFormat1;
+    procedure TestCallStrFormat2;
+    procedure TestCallOtherFormat;
     Procedure TestIf;
     Procedure TestIfBlock;
     Procedure TestIfAssignment;
@@ -97,6 +106,7 @@ Type
     Procedure TestTryExceptOn2;
     Procedure TestTryExceptOnElse;
     Procedure TestTryExceptOnIfElse;
+    procedure TestTryExceptRaise;
     Procedure TestAsm;
   end;
 
@@ -412,6 +422,7 @@ begin
 end;
 
 procedure TTestStatementParser.TestCallOneArg;
+
 Var
   S : TPasImplSimple;
   P : TParamsExpr;
@@ -428,6 +439,76 @@ begin
   AssertExpression('Parameter is constant',P.Params[0],pekNumber,'1');
 end;
 
+procedure TTestStatementParser.TestCallFormat(FN : String; Two : Boolean);
+
+Var
+  S : TPasImplSimple;
+  P : TParamsExpr;
+  N : String;
+begin
+  N:=fn+'(a:3';
+  if Two then
+    N:=N+':2';
+  N:=N+');';
+  TestStatement(N);
+  AssertEquals('1 statement',1,PasProgram.InitializationSection.Elements.Count);
+  AssertEquals('Simple statement',TPasImplSimple,Statement.ClassType);
+  S:=Statement as TPasImplSimple;
+  AssertExpression('Doit call',S.Expr,pekFuncParams,TParamsExpr);
+  P:=S.Expr as TParamsExpr;
+  AssertExpression('Correct function call name',P.Value,pekIdent,FN);
+  AssertEquals('One param',1,Length(P.Params));
+  AssertExpression('Parameter is identifier',P.Params[0],pekIdent,'a');
+  AssertExpression('Parameter has formatting constant 1' ,P.Params[0].format1,pekNumber,'3');
+  if Two then
+    AssertExpression('Parameter has formatting constant 2',P.Params[0].format2,pekNumber,'2');
+end;
+
+procedure TTestStatementParser.TestCallWriteFormat1;
+
+begin
+  TestCalLFormat('write',False);
+end;
+
+procedure TTestStatementParser.TestCallWriteFormat2;
+
+begin
+  TestCalLFormat('write',True);
+end;
+
+procedure TTestStatementParser.TestCallWritelnFormat1;
+begin
+  TestCalLFormat('writeln',False);
+
+end;
+
+procedure TTestStatementParser.TestCallWritelnFormat2;
+begin
+  TestCalLFormat('writeln',True);
+end;
+
+procedure TTestStatementParser.TestCallStrFormat1;
+begin
+  TestCalLFormat('str',False);
+end;
+
+procedure TTestStatementParser.TestCallStrFormat2;
+begin
+  TestCalLFormat('str',True);
+end;
+
+procedure TTestStatementParser.DoTestCallOtherFormat;
+
+begin
+  TestCalLFormat('nono',False);
+end;
+
+procedure TTestStatementParser.TestCallOtherFormat;
+
+begin
+  AssertException('Only Write(ln) and str allow format',EParserError,@DoTestCallOtherFormat);
+end;
+
 procedure TTestStatementParser.TestIf;
 
 Var
@@ -1326,8 +1407,8 @@ begin
   O:=TPasImplExceptOn(E.Elements[0]);
   AssertEquals(1,O.Elements.Count);
   AssertEquals('Simple statement',TPasImplSimple,TPasElement(O.Elements[0]).ClassType);
-  AssertExpression('Exception Variable name',O.VarExpr,pekIdent,'E');
-  AssertExpression('Exception Type name',O.TypeExpr,pekIdent,'Exception');
+  AssertEquals('Exception Variable name','E',O.VariableName);
+  AssertEquals('Exception Type name','Exception',O.TypeName);
   S:=TPasImplSimple(O.Elements[0]);
   AssertExpression('DoSomethingElse call',S.Expr,pekIdent,'DoSomethingElse');
 //  AssertEquals('Variable name',
@@ -1364,8 +1445,8 @@ begin
   O:=TPasImplExceptOn(E.Elements[0]);
   AssertEquals(1,O.Elements.Count);
   AssertEquals('Simple statement',TPasImplSimple,TPasElement(O.Elements[0]).ClassType);
-  AssertExpression('Exception Variable name',O.VarExpr,pekIdent,'E');
-  AssertExpression('Exception Type name',O.TypeExpr,pekIdent,'Exception');
+  AssertEquals('Exception Variable name','E',O.VariableName);
+  AssertEquals('Exception Type name','Exception',O.TypeName);
   S:=TPasImplSimple(O.Elements[0]);
   AssertExpression('DoSomethingElse call',S.Expr,pekIdent,'DoSomethingElse');
   // Exception handler 2
@@ -1373,8 +1454,8 @@ begin
   O:=TPasImplExceptOn(E.Elements[1]);
   AssertEquals(1,O.Elements.Count);
   AssertEquals('Simple statement',TPasImplSimple,TPasElement(O.Elements[0]).ClassType);
-  AssertExpression('Exception Variable name',O.VarExpr,pekIdent,'Y');
-  AssertExpression('Exception Type name',O.TypeExpr,pekIdent,'Exception2');
+  AssertEquals('Exception Variable name','Y',O.VariableName);
+  AssertEquals('Exception Type name','Exception2',O.TypeName);
   S:=TPasImplSimple(O.Elements[0]);
   AssertExpression('DoSomethingElse call',S.Expr,pekIdent,'DoSomethingElse2');
 end;
@@ -1407,8 +1488,8 @@ begin
   AssertEquals(1,E.Elements.Count);
   AssertEquals('Except on handler',TPasImplExceptOn,TPasElement(E.Elements[0]).ClassType);
   O:=TPasImplExceptOn(E.Elements[0]);
-  AssertExpression('Exception Variable name',O.VarExpr,pekIdent,'E');
-  AssertExpression('Exception Type name',O.TypeExpr,pekIdent,'Exception');
+  AssertEquals('Exception Variable name','E',O.VariableName);
+  AssertEquals('Exception Type name','Exception',O.TypeName);
   AssertEquals(1,O.Elements.Count);
   AssertEquals('Simple statement',TPasImplIfElse,TPasElement(O.Elements[0]).ClassType);
   I:=TPasImplIfElse(O.Elements[0]);
@@ -1450,8 +1531,8 @@ begin
   AssertEquals(1,E.Elements.Count);
   AssertEquals('Except on handler',TPasImplExceptOn,TPasElement(E.Elements[0]).ClassType);
   O:=TPasImplExceptOn(E.Elements[0]);
-  AssertExpression('Exception Variable name',O.VarExpr,pekIdent,'E');
-  AssertExpression('Exception Type name',O.TypeExpr,pekIdent,'Exception');
+  AssertEquals('Exception Variable name','E',O.VariableName);
+  AssertEquals('Exception Type name','Exception',O.TypeName);
   AssertEquals(1,O.Elements.Count);
   AssertEquals('Simple statement',TPasImplSimple,TPasElement(O.Elements[0]).ClassType);
   S:=TPasImplSimple(O.Elements[0]);
@@ -1465,6 +1546,29 @@ begin
   AssertExpression('DoSomething call',S.Expr,pekIdent,'DoSomethingMore');
 end;
 
+procedure TTestStatementParser.TestTryExceptRaise;
+Var
+  T : TPasImplTry;
+  S : TPasImplSimple;
+  E : TPasImplTryExcept;
+
+begin
+  TestStatement(['Try','  DoSomething;','except','  raise','end']);
+  T:=AssertStatement('Try statement',TPasImplTry) as TPasImplTry;
+  AssertEquals(1,T.Elements.Count);
+  AssertNotNull(T.FinallyExcept);
+  AssertNull(T.ElseBranch);
+  AssertNotNull(T.Elements[0]);
+  AssertEquals('Simple statement',TPasImplSimple,TPasElement(T.Elements[0]).ClassType);
+  S:=TPasImplSimple(T.Elements[0]);
+  AssertExpression('DoSomething call',S.Expr,pekIdent,'DoSomething');
+  AssertEquals('Simple statement',TPasImplSimple,TPasElement(T.Elements[0]).ClassType);
+  AssertEquals('Except statement',TPasImplTryExcept,T.FinallyExcept.ClassType);
+  E:=TPasImplTryExcept(T.FinallyExcept);
+  AssertEquals(1,E.Elements.Count);
+  AssertEquals('Raise statement',TPasImplRaise,TPasElement(E.Elements[0]).ClassType);
+end;
+
 procedure TTestStatementParser.TestAsm;
 
 Var

packages/fcl-passrc/tests/tctypeparser.pas

@@ -33,6 +33,7 @@ type
   TTestTypeParser = Class(TBaseTestTypeParser)
   private
   Protected
+    procedure StartTypeHelper(ForType: String; AParent: String);
     Procedure DoTestAliasType(Const AnAliasType : String; Const AHint : String);
     procedure DoTestStringType(const AnAliasType: String; const AHint: String);
     procedure DoTypeError(Const AMsg,ASource : string);
@@ -127,6 +128,7 @@ type
     Procedure TestFileTypeDeprecated;
     Procedure TestFileTypePlatform;
     Procedure TestRangeType;
+    Procedure TestCharRangeType;
     Procedure TestRangeTypeDeprecated;
     Procedure TestRangeTypePlatform;
     Procedure TestIdentifierRangeType;
@@ -139,6 +141,7 @@ type
     Procedure TestComplexSet;
     Procedure TestComplexSetDeprecated;
     Procedure TestComplexSetPlatform;
+    procedure TestRangeLowHigh;
     Procedure TestRangeSet;
     Procedure TestSubRangeSet;
     Procedure TestRangeSetDeprecated;
@@ -154,6 +157,9 @@ type
     Procedure TestReferenceFile;
     Procedure TestReferenceArray;
     Procedure TestReferencePointer;
+    Procedure TestInvalidColon;
+    Procedure TestTypeHelper;
+    Procedure TestSpecializationDelphi;
   end;
 
   { TTestRecordTypeParser }
@@ -174,6 +180,7 @@ type
     procedure AssertField1(Hints: TPasMemberHints);
     procedure AssertField2(Hints: TPasMemberHints);
     procedure AssertMethod2(Hints: TPasMemberHints; isClass : Boolean = False);
+    procedure AssertConstructor2(Hints: TPasMemberHints; isClass : Boolean = False);
     procedure AssertOperatorMethod2(Hints: TPasMemberHints; isClass : Boolean = False);
     procedure AssertVariant1(Hints: TPasMemberHints);
     procedure AssertVariant1(Hints: TPasMemberHints; VariantLabels : Array of string);
@@ -182,6 +189,7 @@ type
     procedure AssertOneIntegerField(Hints: TPasMemberHints);
     procedure AssertTwoIntegerFields(Hints1, Hints2: TPasMemberHints);
     procedure AssertIntegerFieldAndMethod(Hints1, Hints2: TPasMemberHints);
+    procedure AssertIntegerFieldAndConstructor(Hints1, Hints2: TPasMemberHints);
     procedure AssertRecordField(AIndex: Integer;Hints: TPasMemberHints);
     procedure AssertRecordVariant(AIndex: Integer;Hints: TPasMemberHints; VariantLabels : Array of string);
     Procedure AssertRecordVariantVariant(AIndex: Integer;Const AFieldName,ATypeName: string;Hints: TPasMemberHints; VariantLabels : Array of string);
@@ -248,6 +256,7 @@ type
     Procedure TestTwoDeprecatedFieldsCombined;
     Procedure TestTwoDeprecatedFieldsCombinedDeprecated;
     Procedure TestTwoDeprecatedFieldsCombinedPlatform;
+    procedure TestFieldAndConstructor;
     Procedure TestFieldAndMethod;
     Procedure TestFieldAnd2Methods;
     Procedure TestFieldAndProperty;
@@ -1518,6 +1527,21 @@ begin
   AssertTrue('Method hints match',P.Hints=Hints)
 end;
 
+procedure TTestRecordTypeParser.AssertConstructor2(Hints: TPasMemberHints;
+  isClass: Boolean);
+Var
+  P : TPasProcedure;
+
+begin
+  if IsClass then
+    AssertEquals('Member 2 type',TPasClassConstructor,TObject(TheRecord.Members[1]).ClassType)
+  else
+    AssertEquals('Member 2 type',TPasConstructor,TObject(TheRecord.Members[1]).ClassType);
+  P:=TPasProcedure(TheRecord.Members[1]);
+  AssertEquals('Constructor name','create',P.Name);
+  AssertTrue('Constructor hints match',P.Hints=Hints)
+end;
+
 procedure TTestRecordTypeParser.AssertOperatorMethod2(Hints: TPasMemberHints;
   isClass: Boolean);
 Var
@@ -1557,6 +1581,14 @@ begin
   AssertMethod2(Hints2);
 end;
 
+procedure TTestRecordTypeParser.AssertIntegerFieldAndConstructor(Hints1,
+  Hints2: TPasMemberHints);
+begin
+  AssertEquals('Two members',2,TheRecord.Members.Count);
+  AssertField1(Hints1);
+  AssertConstructor2(Hints2);
+end;
+
 procedure TTestRecordTypeParser.AssertRecordField(AIndex: Integer;
   Hints: TPasMemberHints);
 
@@ -1904,6 +1936,14 @@ begin
   AssertTwoIntegerFields([hdeprecated],[hdeprecated]);
 end;
 
+procedure TTestRecordTypeParser.TestFieldAndConstructor;
+
+begin
+  Parser.Options:=[po_delphi];
+  TestFields(['x : integer;','constructor create;'],'',False);
+  AssertIntegerFieldAndConstructor([],[]);
+end;
+
 procedure TTestRecordTypeParser.TestFieldAndMethod;
 begin
   Parser.Options:=[po_delphi];
@@ -2325,6 +2365,7 @@ Function TBaseTestTypeParser.ParseType(ASource: String; ATypeClass: TClass;
 
 Var
   D : String;
+
 begin
   Hint:=AHint;
   Add('Type');
@@ -2339,11 +2380,19 @@ begin
   Add('  '+D+';');
 //  Writeln(source.text);
   ParseDeclarations;
-  AssertEquals('One type definition',1,Declarations.Types.Count);
+  if ATypeClass.InHeritsFrom(TPasClassType) then
+    AssertEquals('One type definition',1,Declarations.Classes.Count)
+  else
+    AssertEquals('One type definition',1,Declarations.Types.Count);
   If (AtypeClass<>Nil) then
-    AssertEquals('First declaration is type definition.',ATypeClass,TObject(Declarations.Types[0]).ClassType);
-  AssertEquals('First declaration has correct name.','A',TPasType(Declarations.Types[0]).Name);
-  Result:=TPasType(Declarations.Types[0]);
+    begin
+    if ATypeClass.InHeritsFrom(TPasClassType) then
+      Result:=TPasType(Declarations.Classes[0])
+    else
+      Result:=TPasType(Declarations.Types[0]);
+    AssertEquals('First declaration is type definition.',ATypeClass,Result.ClassType);
+    end;
+  AssertEquals('First declaration has correct name.','A',Result.Name);
   FType:=Result;
   Definition:=Result;
   if (Hint<>'') then
@@ -2975,6 +3024,11 @@ begin
   DoTestRangeType('1','4','');
 end;
 
+procedure TTestTypeParser.TestCharRangeType;
+begin
+  DoTestRangeType('#1','#4','');
+end;
+
 procedure TTestTypeParser.TestRangeTypeDeprecated;
 begin
   DoTestRangeType('1','4','deprecated');
@@ -3043,6 +3097,13 @@ begin
   DoTestComplexSet;
 end;
 
+procedure TTestTypeParser.TestRangeLowHigh;
+
+begin
+  DoParseRangeSet('low(TRange)..high(TRange)','');
+end;
+
+
 procedure TTestTypeParser.TestRangeSet;
 begin
   // TRange = (rLow, rMiddle, rHigh);
@@ -3183,6 +3244,46 @@ begin
   AssertSame('Second declaration references first.',Declarations.Types[0],TPasPointerType(Declarations.Types[1]).DestType);
 end;
 
+procedure TTestTypeParser.TestInvalidColon;
+var
+  ok: Boolean;
+begin
+  ok:=false;
+  try
+    ParseType(':1..2',TPasSetType);
+  except
+    on E: EParserError do
+      ok:=true;
+  end;
+  AssertEquals('wrong colon in type raised an error',true,ok);
+end;
+
+
+procedure TTestTypeParser.StartTypeHelper(ForType: String; AParent: String);
+Var
+  S : String;
+begin
+
+  S:='TMyClass = Type Helper';
+  if (AParent<>'') then
+    begin
+    S:=S+'('+AParent;
+    S:=S+')';
+    end;
+  S:=S+' for '+ForType;
+  Add(S);
+
+end;
+
+procedure TTestTypeParser.TestTypeHelper;
+begin
+  ParseType('Type Helper for AnsiString end',TPasClassType,'');
+end;
+
+procedure TTestTypeParser.TestSpecializationDelphi;
+begin
+  ParseType('TFPGList<integer>',TPasClassType,'');
+end;
 
 initialization
   RegisterTests([TTestTypeParser,TTestRecordTypeParser,TTestProcedureTypeParser]);

packages/fcl-passrc/tests/tcvarparser.pas

@@ -26,6 +26,8 @@ Type
     Procedure TearDown; override;
   Published
     Procedure TestSimpleVar;
+    Procedure TestSimpleVarHelperName;
+    procedure TestSimpleVarHelperType;
     Procedure TestSimpleVarDeprecated;
     Procedure TestSimpleVarPlatform;
     Procedure TestSimpleVarInitialized;
@@ -120,6 +122,28 @@ begin
   AssertVariableType('b');
 end;
 
+procedure TTestVarParser.TestSimpleVarHelperName;
+
+Var
+  R : TPasVariable;
+
+begin
+  Add('Var');
+  Add('  Helper : integer;');
+//  Writeln(source.text);
+  ParseDeclarations;
+  AssertEquals('One variable definition',1,Declarations.Variables.Count);
+  AssertEquals('First declaration is type definition.',TPasVariable,TObject(Declarations.Variables[0]).ClassType);
+  R:=TPasVariable(Declarations.Variables[0]);
+  AssertEquals('First declaration has correct name.','Helper',R.Name);
+end;
+
+procedure TTestVarParser.TestSimpleVarHelperType;
+begin
+  ParseVar('helper','');
+  AssertVariableType('helper');
+end;
+
 procedure TTestVarParser.TestSimpleVarDeprecated;
 begin
   ParseVar('b','deprecated');

packages/fcl-passrc/tests/testpassrc.lpi

@@ -30,7 +30,7 @@
     <RunParams>
       <local>
         <FormatVersion Value="1"/>
-        <CommandLineParams Value="--suite=TTestTypeParser.TestGenericArray"/>
+        <CommandLineParams Value="--suite=TTestExpressions.TestUnaryDoubleDeref"/>
       </local>
     </RunParams>
     <RequiredPackages Count="1">

packages/pastojs/tests/tcconverter.pp

@@ -333,11 +333,6 @@ begin
   AssertEquals('Correct condition class',TJSUnaryNotExpression,E.Cond.ClassType);
   AssertIdentifier('Conditional expression',TJSUnaryNotExpression(E.Cond).A,'a');
   L:=AssertListStatement('Multiple statements',E.Body);
-  //  writeln('TTestStatementConverter.TestRepeatUntilStatementTwo L.A=',L.A.ClassName);
-  // writeln('  L.B=',L.B.ClassName);
-  // writeln('  L.B.A=',TJSStatementList(L.B).A.ClassName);
-  // writeln('  L.B.B=',TJSStatementList(L.B).B.ClassName);
-
   AssertAssignStatement('First List statement is assignment',L.A,'b','c');
   AssertAssignStatement('Second List statement is assignment',L.B,'d','e');
 end;
@@ -649,7 +644,7 @@ begin
   T:=TPasImplTry.Create('',Nil);
   T.AddElement(CreateAssignStatement('a','b'));
   F:=T.AddExcept;
-  O:=F.AddExceptOn(CreateIdent('E'),CreateIdent('Exception'));
+  O:=F.AddExceptOn('E','Exception');
   O.Body:=CreateAssignStatement('b','c');
   // Convert
   El:=TJSTryFinallyStatement(Convert(T,TJSTryCatchStatement));
@@ -697,7 +692,7 @@ begin
   T:=TPasImplTry.Create('',Nil);
   T.AddElement(CreateAssignStatement('a','b'));
   F:=T.AddExcept;
-  O:=F.AddExceptOn(CreateIdent('E'),CreateIdent('Exception'));
+  O:=F.AddExceptOn('E','Exception');
   O.Body:=TPasImplRaise.Create('',Nil);
   // Convert
   El:=TJSTryFinallyStatement(Convert(T,TJSTryCatchStatement));

utils/fpdoc/dglobals.pp

@@ -161,6 +161,7 @@ resourcestring
   SUsageOption120  = '                  At least one input option is required.';
   SUsageOption130  = '--input-dir=Dir   Add All *.pp and *.pas files in Dir to list of input files';
   SUsageOption140  = '--lang=lng        Select output language.';
+  SUsageOption145  = '--macro=name=value Define a macro to preprocess the project file with.';
   SUsageOption150  = '--ostarget=value  Set the target OS for the scanner.';
   SUsageOption160  = '--output=name     use name as the output name.';
   SUsageOption170  = '                  Each backend interprets this as needed.';
@@ -183,6 +184,7 @@ resourcestring
   SUsageFormats        = 'The following output formats are supported by this fpdoc:';
   SUsageBackendHelp    = 'Specify an output format, combined with --help to get more help for this backend.';
   SUsageFormatSpecific = 'Output format "%s" supports the following options:';
+  SCmdLineErrInvalidMacro     = 'Macro needs to be in the form name=value';
 
   SCmdLineInvalidOption       = 'Ignoring unknown option "%s"';
   SCmdLineInvalidFormat       = 'Invalid format "%s" specified';

utils/fpdoc/dw_ipflin.pas

@@ -72,8 +72,8 @@ type
     Procedure StartAccess; override;
     Procedure StartErrors; override;
     Procedure StartVersion; override;
-    Procedure StartSeealso; override;
-    Procedure EndSeealso; override;
+    Procedure StartSeeAlso; override;
+    Procedure EndSeeAlso; override;
     procedure StartUnitOverview(AModuleName,AModuleLabel : String);override;
     procedure WriteUnitEntry(UnitRef : TPasType); override;
     Procedure EndUnitOverview; override;
@@ -1068,7 +1068,7 @@ begin
   WriteLn(Format(':pd. %s', [ADescr]));
 end;
 
-procedure TIPFNewWriter.StartSeealso;
+procedure TIPFNewWriter.StartSeeAlso;
 begin
   writeln('');
   writeln(':p.');
@@ -1078,7 +1078,7 @@ begin
   writeln('.br');
 end;
 
-procedure TIPFNewWriter.EndSeealso;
+procedure TIPFNewWriter.EndSeeAlso;
 begin
   writeln('');
 end;

utils/fpdoc/dwlinear.pp

@@ -396,10 +396,12 @@ var
   Member: TPasElement;
   i: Integer;
 begin
+  DocNode := Engine.FindDocNode(ClassDecl);
+  if Assigned(DocNode) and DocNode.IsSkipped then
+    Exit;
   StartSection(ClassDecl.Name);
   WriteLabel(ClassDecl);
   WriteIndex(ClassDecl);
-  DocNode := Engine.FindDocNode(ClassDecl);
   if Assigned(DocNode) and ((not IsDescrNodeEmpty(DocNode.Descr)) or
     (not IsDescrNodeEmpty(DocNode.ShortDescr))) then
   begin
@@ -482,6 +484,8 @@ begin
         L:=StripText(GetLabel(Member));
         N:=EscapeText(Member.Name);
         DocNode := Engine.FindDocNode(Member);
+        if Assigned(DocNode) and DocNode.IsSkipped then
+          Continue;
         if Assigned(DocNode) then
         begin
           if FDupLinkedDoc and (DocNode.Link <> '') then
@@ -544,6 +548,8 @@ begin
         L := StripText(GetLabel(lInterface));
         N := EscapeText(lInterface.Name);
         DocNode := Engine.FindDocNode(lInterface);
+        if Assigned(DocNode) and DocNode.IsSkipped then
+          Continue;
         if Assigned(DocNode) then
         begin
           if FDupLinkedDoc and (DocNode.Link <> '') then
@@ -595,7 +601,7 @@ begin
   If (Engine.OutPut='') then
     Engine.Output:=PackageName+FileNameExtension
   else if (ExtractFileExt(Engine.output)='') and (FileNameExtension<>'') then
-    Engine.Output:=ChangeFileExt(Engine.output,FileNameExtension);  
+    Engine.Output:=ChangeFileExt(Engine.output,FileNameExtension);
   FStream:=TFileStream.Create(Engine.Output,fmCreate);
   try
     WriteBeginDocument;
@@ -875,12 +881,14 @@ begin
     for i := 0 to ASection.Types.Count - 1 do
       begin
       TypeDecl := TPasType(ASection.Types[i]);
+      DocNode := Engine.FindDocNode(TypeDecl);
+      if Assigned(DocNode) and DocNode.IsSkipped then
+        Continue;
       if not ((TypeDecl is TPasRecordType) and TPasRecordType(TypeDecl).IsAdvancedRecord) then
         begin
         DescrBeginParagraph;
         WriteTypeDecl(TypeDecl);
         StartListing(False,'');
-        DocNode := Engine.FindDocNode(TypeDecl);
         If Assigned(DocNode) and
            Assigned(DocNode.Node) and
            (Docnode.Node['opaque']='1') then
@@ -953,6 +961,9 @@ var
 begin
   With ProcDecl do
     begin
+    DocNode := Engine.FindDocNode(ProcDecl);
+    if Assigned(DocNode) and DocNode.IsSkipped then
+      Exit;
     if Not (Assigned(Parent) and ((Parent.InheritsFrom(TPasClassType)) or Parent.InheritsFrom(TPasRecordType))) then
       begin
       StartSubSection(Name);
@@ -966,7 +977,6 @@ begin
       WriteIndex(Parent.Name+'.'+Name);
       end;
     StartProcedure;
-    DocNode := Engine.FindDocNode(ProcDecl);
     if Assigned(DocNode) and Assigned(DocNode.ShortDescr) then
       begin
       StartSynopsis;
@@ -1065,11 +1075,13 @@ var
 begin
   With PropDecl do
     begin
+    DocNode := Engine.FindDocNode(PropDecl);
+    if Assigned(DocNode) and DocNode.IsSkipped then
+      Exit;
     StartSubSection(Parent.Name+'.'+Name);
     WriteLabel(PropDecl);
     WriteIndex(Parent.Name+'.'+Name);
     StartProperty;
-    DocNode := Engine.FindDocNode(PropDecl);
     if Assigned(DocNode) then
     begin
       if FDupLinkedDoc and (DocNode.Link <> '') then
@@ -1288,6 +1300,8 @@ begin
         L:=StripText(GetLabel(Member));
         N:=EscapeText(Member.Name);
         DocNode := Engine.FindDocNode(Member);
+        if Assigned(DocNode) and DocNode.IsSkipped then
+          Continue;
         If Assigned(DocNode) then
           S:=GetDescrString(Member, DocNode.ShortDescr)
         else

utils/fpdoc/fpdoc.pp

@@ -90,6 +90,7 @@ begin
   Writeln(SUsageOption120);
   Writeln(SUsageOption130);
   Writeln(SUsageOption140);
+  Writeln(SUsageOption145);
   Writeln(SUsageOption150);
   Writeln(SUsageOption160);
   Writeln(SUsageOption170);
@@ -181,11 +182,12 @@ procedure TFPDocApplication.ParseCommandLine;
 Const
   SOptProject = '--project=';
   SOptPackage = '--package=';
-  
+  SOptMacro = '--macro=';
+
   Function ProjectOpt(Const s : string) : boolean;
 
   begin
-    Result:=(Copy(s,1,3)='-p=') or (Copy(s,1,Length(SOptProject))=SOptProject);
+    Result:=(Copy(s,1,3)='-p=') or (Copy(s,1,Length(SOptProject))=SOptProject) or (Copy(s,1,Length(SOptMacro))=SOptMacro);
   end;
 
   Function PackageOpt(Const s : string) : boolean;
@@ -286,7 +288,7 @@ procedure TFPDocApplication.ParseOption(Const S : String);
 
 var
   i: Integer;
-  Cmd, Arg: String;
+  ProjectFileName,Cmd, Arg: String;
 
 begin
   if (s = '-h') or (s = '--help') then
@@ -325,6 +327,12 @@ begin
       AddDirToFileList(SelectedPackage.Descriptions, Arg, '*.xml')
     else if (Cmd = '--base-descr-dir') then
       FCreator.BaseDescrDir:=Arg
+    else if (Cmd = '--macro') then
+      begin
+      If Pos('=',Arg)=0 then
+        WriteLn(StdErr, Format(SCmdLineErrInvalidMacro, [Arg]));
+      FCreator.ProjectMacros.Add(Arg);
+      end
     else if (Cmd = '-f') or (Cmd = '--format') then
       begin
       Arg:=UpperCase(Arg);
@@ -384,23 +392,28 @@ end;
 Procedure TFPDocApplication.DoRun;
 
 begin
-{$IFDEF Unix}
-  gettext.TranslateResourceStrings('/usr/local/share/locale/%s/LC_MESSAGES/fpdoc.mo');
-{$ELSE}
-  gettext.TranslateResourceStrings('intl/fpdoc.%s.mo');
-{$ENDIF}
-  WriteLn(STitle);
-  WriteLn(Format(SVersion, [DefFPCVersion, DefFPCDate]));
-  WriteLn(SCopyright1);
-  WriteLn(SCopyright2);
-  WriteLn;
-  ParseCommandLine;
-  if (FWriteProjectFile<>'') then
-    FCreator.CreateProjectFile(FWriteProjectFile)
-  else
-    FCreator.CreateDocumentation(FPackage,FDryRun);
-  WriteLn(SDone);
-  Terminate;
+  try
+  {$IFDEF Unix}
+    gettext.TranslateResourceStrings('/usr/local/share/locale/%s/LC_MESSAGES/fpdoc.mo');
+  {$ELSE}
+    gettext.TranslateResourceStrings('intl/fpdoc.%s.mo');
+  {$ENDIF}
+    WriteLn(STitle);
+    WriteLn(Format(SVersion, [DefFPCVersion, DefFPCDate]));
+    WriteLn(SCopyright1);
+    WriteLn(SCopyright2);
+    WriteLn;
+    ParseCommandLine;
+    if (FWriteProjectFile<>'') then
+      FCreator.CreateProjectFile(FWriteProjectFile)
+    else
+      FCreator.CreateDocumentation(FPackage,FDryRun);
+    WriteLn(SDone);
+    Terminate;
+  except
+    ExitCode:=1;
+    Raise;
+  end;
 end;
 
 constructor TFPDocApplication.Create(AOwner: TComponent);

utils/fpdoc/fpdocxmlopts.pas

@@ -13,6 +13,7 @@ Type
   TXMLFPDocOptions = Class(TComponent)
   private
   Protected
+    Function PreProcessFile(const AFileName: String; Macros: TStrings): TStream; virtual;
     Procedure Error(Const Msg : String);
     Procedure Error(Const Fmt : String; Args : Array of Const);
     Procedure LoadPackage(APackage : TFPDocPackage; E : TDOMElement); virtual;
@@ -24,7 +25,7 @@ Type
     procedure SaveInputFile(const AInputFile: String; XML: TXMLDocument; AParent: TDOMElement);virtual;
     Procedure SavePackage(APackage : TFPDocPackage; XML : TXMLDocument; AParent : TDOMElement); virtual;
   Public
-    Procedure LoadOptionsFromFile(AProject : TFPDocProject; Const AFileName : String);
+    Procedure LoadOptionsFromFile(AProject : TFPDocProject; Const AFileName : String; Macros : TStrings = Nil);
     Procedure LoadFromXML(AProject : TFPDocProject; XML : TXMLDocument); virtual;
     Procedure SaveOptionsToFile(AProject : TFPDocProject; Const AFileName : String);
     procedure SaveToXML(AProject : TFPDocProject; ADoc: TXMLDocument); virtual;
@@ -65,7 +66,7 @@ begin
 end;
 
 
-procedure TXMLFPDocOptions.Error(Const Msg: String);
+procedure TXMLFPDocOptions.Error(const Msg: String);
 begin
   Raise EXMLFPDoc.Create(Msg);
 end;
@@ -248,7 +249,8 @@ begin
     end;
 end;
 
-Procedure TXMLFPDocOptions.SaveEngineOptions(Options : TEngineOptions; XML : TXMLDocument; AParent : TDOMElement);
+procedure TXMLFPDocOptions.SaveEngineOptions(Options: TEngineOptions;
+  XML: TXMLDocument; AParent: TDOMElement);
 
   procedure AddStr(const n, v: string);
   var
@@ -288,7 +290,8 @@ begin
 end;
 
 
-Procedure TXMLFPDocOptions.SaveInputFile(Const AInputFile : String; XML : TXMLDocument; AParent: TDOMElement);
+procedure TXMLFPDocOptions.SaveInputFile(const AInputFile: String;
+  XML: TXMLDocument; AParent: TDOMElement);
 
 Var
   F,O : String;
@@ -299,7 +302,8 @@ begin
   AParent['options']:=O;
 end;
 
-Procedure TXMLFPDocOptions.SaveDescription(Const ADescription : String; XML : TXMLDocument; AParent: TDOMElement);
+procedure TXMLFPDocOptions.SaveDescription(const ADescription: String;
+  XML: TXMLDocument; AParent: TDOMElement);
 
 begin
   AParent['file']:=ADescription;
@@ -317,7 +321,8 @@ begin
   AParent['prefix']:=Copy(AImportFile,i+1,Length(AImportFile));
 end;
 
-Procedure TXMLFPDocOptions.SavePackage(APackage: TFPDocPackage; XML : TXMLDocument; AParent: TDOMElement);
+procedure TXMLFPDocOptions.SavePackage(APackage: TFPDocPackage;
+  XML: TXMLDocument; AParent: TDOMElement);
 
 
 var
@@ -358,17 +363,55 @@ begin
 end;
 
 
+Function TXMLFPDocOptions.PreprocessFile(const AFileName: String; Macros : TStrings) : TStream;
+
+Var
+  F : TFileStream;
+  P : TTemplateParser;
+  I : Integer;
+  N,V : String;
+
+begin
+  Result:=Nil;
+  P:=Nil;
+  F:=TFileStream.Create(AFileName,fmOpenRead or fmShareDenyWrite);
+  try
+    P:=TTemplateParser.Create;
+    P.AllowTagParams:=False;
+    P.StartDelimiter:='{{';
+    P.EndDelimiter:='}}';
+    For I:=0 to Macros.Count-1 do
+      begin
+      Macros.GetNameValue(I,N,V);
+      P.Values[N]:=V;
+      end;
+    Result:=TMemoryStream.Create;
+    P.ParseStream(F,Result);
+    Result.Position:=0;
+  finally
+    FreeAndNil(F);
+    FreeAndNil(P);
+  end;
+end;
 
-procedure TXMLFPDocOptions.LoadOptionsFromFile(AProject: TFPDocProject; const AFileName: String);
+procedure TXMLFPDocOptions.LoadOptionsFromFile(AProject: TFPDocProject;
+  const AFileName: String; Macros: TStrings = Nil);
 
 Var
   XML : TXMLDocument;
+  S : TStream;
 
 begin
-  ReadXMLFile(XML,AFileName);
+  XML:=Nil;
+  if Macros=Nil then
+    S:=TFileStream.Create(AFileName,fmOpenRead or fmShareDenyWrite)
+  else
+    S:=PreProcessFile(AFileName,Macros);
   try
+    ReadXMLFile(XML,S);
     LoadFromXML(AProject,XML);
   finally
+    FreeAndNil(S);
     FreeAndNil(XML);
   end;
 end;
@@ -393,7 +436,8 @@ begin
     LoadEngineOptions(AProject.Options,N as TDOMElement);
 end;
 
-Procedure TXMLFPDocOptions.SaveOptionsToFile(AProject: TFPDocProject; const AFileName: String);
+procedure TXMLFPDocOptions.SaveOptionsToFile(AProject: TFPDocProject;
+  const AFileName: String);
 
 Var
   XML : TXMLDocument;

utils/fpdoc/makeskel.pp

@@ -50,12 +50,15 @@ type
     Property DocNode : TDocNode Read FNode;
   end;
 
+  { TSkelEngine }
+
   TSkelEngine = class(TFPDocEngine)
   Private
     FEmittedList, 
     FNodeList,
     FModules : TStringList;
     Procedure  DoWriteUnReferencedNodes(N : TDocNode; NodePath : String);
+    function EffectiveVisibility(El: TPasElement): TPasMemberVisibility;
   public
     Destructor Destroy; override;
     Function MustWriteElement(El : TPasElement; Full : Boolean) : Boolean;
@@ -132,43 +135,56 @@ Var
 begin
   If Assigned(FModules) then 
     begin
-    For I:=0 to FModules.Count-1 do
-      FModules.Objects[i].Free;
+   { For I:=0 to FModules.Count-1 do
+      FModules.Objects[i].Release;}
     FreeAndNil(FModules);    
     end;
 end;
 
-Function TSkelEngine.MustWriteElement(El : TPasElement; Full : Boolean) : Boolean;
+Function TSkelEngine.EffectiveVisibility (El : TPasElement) :  TPasMemberVisibility;
 
 Var
-  ParentVisible:Boolean;
-  PT,PP : TPasElement;
+  V : TPasMemberVisibility;
+
 begin
-  ParentVisible:=True;
-  If (El is TPasArgument) or (El is TPasResultElement) then
+  Result:=EL.Visibility;
+  El:=el.Parent;
+  While Assigned(El) do
     begin
-    PT:=El.Parent;
-    // Skip ProcedureType or PasFunctionType
-    If (PT<>Nil) then
-      begin
-      if (PT is TPasProcedureType) or (PT is TPasFunctionType) then
-        PT:=PT.Parent;
-      If (PT<>Nil) and ((PT is TPasProcedure) or (PT is TPasProcedure))   then
-        PP:=PT.Parent
-      else
-        PP:=Nil;
-      If (PP<>Nil) and (PP is TPasClassType) then
-        begin
-        ParentVisible:=((not DisablePrivate or (PT.Visibility<>visPrivate)) and
-                       (not DisableProtected or (PT.Visibility<>visProtected)));
-        end;
-      end;
+    V:=EL.Visibility;
+    if V=visStrictPrivate then
+      V:=visPrivate
+    else if V=visStrictProtected then
+      V:=visProtected;
+    if (V<>visDefault) and ((V<Result) or (Result=visDefault)) then
+      Result:=V;
+    EL:=el.Parent;
     end;
-  Result:=Assigned(El.Parent) and (Length(El.Name) > 0) and
-          (ParentVisible and (not DisableArguments or (El.ClassType <> TPasArgument))) and
-          (ParentVisible and (not DisableFunctionResults or (El.ClassType <> TPasResultElement))) and
-          (not DisablePrivate or (el.Visibility<>visPrivate)) and
-          (not DisableProtected or (el.Visibility<>visProtected));
+end;
+
+Function TSkelEngine.MustWriteElement(El : TPasElement; Full : Boolean) : Boolean;
+
+Var
+  VisibilityOK : Boolean;
+  V : TPasMemberVisibility;
+
+
+begin
+  V:=EffectiveVisibility(El);
+  Case V of
+    visPrivate,visStrictPrivate:
+      VisibilityOK:= not DisablePrivate;
+    visProtected,visStrictProtected:
+      VisibilityOK:= not DisableProtected;
+  else
+    VisibilityOK:=True;
+  end;
+  Result:= Assigned(el.Parent)
+           and (Length(El.Name) > 0)
+           and VisibilityOK
+           and (Not (El is TPasExpr))
+           and (not DisableArguments or (El.ClassType <> TPasArgument))
+           and (not DisableFunctionResults or (El.ClassType <> TPasResultElement));
   If Result and Full then
     begin
     Result:=(Not Assigned(FEmittedList) or (FEmittedList.IndexOf(El.FullName)=-1));

utils/fpdoc/mkfpdoc.pp

@@ -26,12 +26,14 @@ Type
     FOnLog: TPasParserLogHandler;
     FPParserLogEvents: TPParserLogEvents;
     FProject : TFPDocProject;
+    FProjectMacros: TStrings;
     FScannerLogEvents: TPScannerLogEvents;
     FVerbose: Boolean;
     function GetOptions: TEngineOptions;
     function GetPackages: TFPDocPackages;
     procedure SetBaseDescrDir(AValue: String);
     procedure SetBaseInputDir(AValue: String);
+    procedure SetProjectMacros(AValue: TStrings);
   Protected
     Function FixInputFile(Const AFileName : String) : String;
     Function FixDescrFile(Const AFileName : String) : String;
@@ -58,6 +60,8 @@ Type
     // When set, they will be prepended to non-absolute filenames.
     Property BaseInputDir : String Read FBaseInputDir Write SetBaseInputDir;
     Property BaseDescrDir : String Read FBaseDescrDir Write SetBaseDescrDir;
+    // Macros used when loading the project file
+    Property ProjectMacros : TStrings Read FProjectMacros Write SetProjectMacros;
   end;
 
 implementation
@@ -81,13 +85,13 @@ begin
     end;
 end;
 
-Procedure TFPDocCreator.DoLog(Const Msg: String);
+procedure TFPDocCreator.DoLog(const Msg: String);
 begin
   If Assigned(OnLog) then
     OnLog(Self,Msg);
 end;
 
-procedure TFPDocCreator.DoLog(Const Fmt: String; Args: Array of Const);
+procedure TFPDocCreator.DoLog(const Fmt: String; Args: array of const);
 begin
   DoLog(Format(Fmt,Args));
 end;
@@ -132,7 +136,7 @@ begin
   Result:=FProject.Packages;
 end;
 
-Function TFPDocCreator.FixInputFile(Const AFileName: String): String;
+function TFPDocCreator.FixInputFile(const AFileName: String): String;
 begin
   Result:=AFileName;
   If Result='' then exit;
@@ -140,7 +144,7 @@ begin
     Result:=BaseInputDir+Result;
 end;
 
-Function TFPDocCreator.FixDescrFile(Const AFileName: String): String;
+function TFPDocCreator.FixDescrFile(const AFileName: String): String;
 begin
   Result:=AFileName;
   If Result='' then exit;
@@ -164,13 +168,19 @@ begin
     FBaseInputDir:=IncludeTrailingPathDelimiter(FBaseInputDir);
 end;
 
-Procedure TFPDocCreator.DoBeforeEmitNote(Sender: TObject; Note: TDomElement;
-  Var EmitNote: Boolean);
+procedure TFPDocCreator.SetProjectMacros(AValue: TStrings);
+begin
+  if FProjectMacros=AValue then Exit;
+  FProjectMacros.Assign(AValue);
+end;
+
+procedure TFPDocCreator.DoBeforeEmitNote(Sender: TObject; Note: TDomElement;
+  var EmitNote: Boolean);
 begin
   EmitNote:=True;
 end;
 
-Constructor TFPDocCreator.Create(AOwner: TComponent);
+constructor TFPDocCreator.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
   FProject:=TFPDocProject.Create(Self);
@@ -178,12 +188,14 @@ begin
   FProject.Options.CPUTarget:=DefCPUTarget;
   FProject.Options.OSTarget:=DefOSTarget;
   FProcessedUnits:=TStringList.Create;
+  FProjectMacros:=TStringList.Create;
 end;
 
-Destructor TFPDocCreator.Destroy;
+destructor TFPDocCreator.Destroy;
 begin
   FreeAndNil(FProcessedUnits);
   FreeAndNil(FProject);
+  FreeAndNil(FProjectMacros);
   inherited Destroy;
 end;
 
@@ -221,7 +233,7 @@ begin
     Engine.WriteContentFile(APackage.ContentFile);
 end;
 
-Procedure TFPDocCreator.CreateDocumentation(APackage: TFPDocPackage;
+procedure TFPDocCreator.CreateDocumentation(APackage: TFPDocPackage;
   ParseOnly: Boolean);
 
 var
@@ -282,7 +294,7 @@ begin
   end;
 end;
 
-Procedure TFPDocCreator.CreateProjectFile(Const AFileName: string);
+procedure TFPDocCreator.CreateProjectFile(const AFileName: string);
 begin
   With TXMLFPDocOptions.Create(Self) do
   try
@@ -292,11 +304,14 @@ begin
   end;
 end;
 
-Procedure TFPDocCreator.LoadProjectFile(Const AFileName: string);
+procedure TFPDocCreator.LoadProjectFile(const AFileName: string);
 begin
   With TXMLFPDocOptions.Create(self) do
     try
-      LoadOptionsFromFile(FProject,AFileName);
+      if (ProjectMacros.Count>0) then
+        LoadOptionsFromFile(FProject,AFileName,ProjectMacros)
+      else
+        LoadOptionsFromFile(FProject,AFileName,Nil);
     finally
       Free;
     end;