--- Merging r34878 into '.':

U    packages/fcl-passrc/src/pparser.pp
U    packages/fcl-passrc/src/pastree.pp
U    packages/fcl-passrc/tests/tcclasstype.pas
--- Recording mergeinfo for merge of r34878 into '.':
 U   .
--- Merging r34879 into '.':
U    packages/fcl-passrc/tests/tcscanner.pas
U    packages/fcl-passrc/src/pscanner.pp
--- Recording mergeinfo for merge of r34879 into '.':
 G   .
--- Merging r34880 into '.':
U    packages/fcl-passrc/tests/tctypeparser.pas
G    packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r34880 into '.':
 G   .
--- Merging r34881 into '.':
G    packages/fcl-passrc/src/pparser.pp
G    packages/fcl-passrc/src/pastree.pp
G    packages/fcl-passrc/tests/tcclasstype.pas
--- Recording mergeinfo for merge of r34881 into '.':
 G   .
--- Merging r34882 into '.':
U    packages/fcl-passrc/tests/tcstatements.pas
G    packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r34882 into '.':
 G   .
--- Merging r34883 into '.':
G    packages/fcl-passrc/tests/tcscanner.pas
G    packages/fcl-passrc/tests/tctypeparser.pas
U    packages/fcl-passrc/tests/tcvarparser.pas
G    packages/fcl-passrc/src/pscanner.pp
--- Recording mergeinfo for merge of r34883 into '.':
 G   .
--- Merging r35120 into '.':
U    compiler/powerpc/cgcpu.pas
U    compiler/powerpc/agppcmpw.pas
U    compiler/assemble.pas
U    compiler/script.pas
U    compiler/powerpc64/cgcpu.pas
U    utils/fpdoc/intl/dwriter.de.po
--- Recording mergeinfo for merge of r35120 into '.':
 G   .
--- Merging r35346 into '.':
U    packages/fcl-passrc/tests/tcprocfunc.pas
G    packages/fcl-passrc/src/pparser.pp
G    packages/fcl-passrc/src/pastree.pp
--- Recording mergeinfo for merge of r35346 into '.':
 G   .
--- Merging r35353 into '.':
U    packages/fcl-passrc/tests/tconstparser.pas
G    packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r35353 into '.':
 G   .
--- Merging r35357 into '.':
G    packages/fcl-passrc/src/pparser.pp
G    packages/fcl-passrc/src/pscanner.pp
G    packages/fcl-passrc/tests/tcscanner.pas
--- Recording mergeinfo for merge of r35357 into '.':
 G   .
--- Merging r35358 into '.':
A    packages/fcl-passrc/examples/parsepp.pp
--- Recording mergeinfo for merge of r35358 into '.':
 G   .
--- Merging r35359 into '.':
U    packages/fcl-passrc/examples/test_parser.pp
--- Recording mergeinfo for merge of r35359 into '.':
 G   .
--- Merging r35360 into '.':
G    packages/fcl-passrc/src/pparser.pp
G    packages/fcl-passrc/src/pastree.pp
G    packages/fcl-passrc/tests/tctypeparser.pas
--- Recording mergeinfo for merge of r35360 into '.':
 G   .
--- Merging r35361 into '.':
G    packages/fcl-passrc/tests/tcprocfunc.pas
G    packages/fcl-passrc/src/pastree.pp
--- Recording mergeinfo for merge of r35361 into '.':
 G   .
--- Merging r35362 into '.':
G    packages/fcl-passrc/src/pparser.pp
G    packages/fcl-passrc/tests/tcstatements.pas
--- Recording mergeinfo for merge of r35362 into '.':
 G   .
--- Merging r35383 into '.':
U    packages/fcl-js/src/jswriter.pp
U    packages/pastojs/tests/tcconverter.pp
U    packages/pastojs/tests/tcmodules.pas
U    packages/pastojs/src/fppas2js.pp
U    packages/fcl-passrc/tests/testpassrc.lpi
G    packages/fcl-passrc/tests/tcclasstype.pas
G    packages/fcl-passrc/tests/tcstatements.pas
U    packages/fcl-passrc/tests/tcresolver.pas
G    packages/fcl-passrc/src/pscanner.pp
G    packages/fcl-passrc/src/pparser.pp
U    packages/fcl-passrc/src/pasresolver.pp
--- Recording mergeinfo for merge of r35383 into '.':
 G   .
--- Merging r35391 into '.':
G    packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r35391 into '.':
 G   .
--- Merging r35402 into '.':
G    packages/pastojs/src/fppas2js.pp
G    packages/pastojs/tests/tcconverter.pp
G    packages/pastojs/tests/tcmodules.pas
G    packages/fcl-passrc/src/pasresolver.pp
G    packages/fcl-passrc/src/pscanner.pp
G    packages/fcl-passrc/src/pparser.pp
U    packages/fcl-passrc/examples/parsepp.pp
G    packages/fcl-passrc/tests/tcresolver.pas
G    packages/fcl-js/src/jswriter.pp
--- Recording mergeinfo for merge of r35402 into '.':
 G   .
--- Merging r35415 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
G    packages/fcl-passrc/src/pscanner.pp
--- Recording mergeinfo for merge of r35415 into '.':
 G   .
--- Merging r35420 into '.':
U    utils/fpdoc/dw_man.pp
--- Recording mergeinfo for merge of r35420 into '.':
 G   .

# revisions: 34878,34879,34880,34881,34882,34883,35120,35346,35353,35357,35358,35359,35360,35361,35362,35383,35391,35402,35415,35420

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

.gitattributes

@@ -2520,6 +2520,7 @@ packages/fcl-net/src/win/resolve.inc svneol=native#text/plain
 packages/fcl-passrc/Makefile svneol=native#text/plain
 packages/fcl-passrc/Makefile.fpc svneol=native#text/plain
 packages/fcl-passrc/Makefile.fpc.fpcmake svneol=native#text/plain
+packages/fcl-passrc/examples/parsepp.pp svneol=native#text/plain
 packages/fcl-passrc/examples/test_parser.pp svneol=native#text/plain
 packages/fcl-passrc/examples/testunit1.pp svneol=native#text/plain
 packages/fcl-passrc/fpmake.pp svneol=native#text/plain

compiler/assemble.pas

@@ -1569,7 +1569,7 @@ Implementation
            MaybeNextList(hp);
          end;
         ObjData.afteralloc;
-        { leave if errors have occured }
+        { leave if errors have occurred }
         if errorcount>0 then
          goto doexit;
 
@@ -1590,7 +1590,7 @@ Implementation
         ObjData.createsection(sec_code);
         ObjData.afteralloc;
 
-        { leave if errors have occured }
+        { leave if errors have occurred }
         if errorcount>0 then
          goto doexit;
 
@@ -1611,7 +1611,7 @@ Implementation
         ObjData.createsection(sec_code);
         ObjData.afterwrite;
 
-        { don't write the .o file if errors have occured }
+        { don't write the .o file if errors have occurred }
         if errorcount=0 then
          begin
            { write objectfile }
@@ -1658,7 +1658,7 @@ Implementation
            ObjData.createsection(startsectype);
            TreePass0(hp);
            ObjData.afteralloc;
-           { leave if errors have occured }
+           { leave if errors have occurred }
            if errorcount>0 then
              break;
 
@@ -1670,7 +1670,7 @@ Implementation
            TreePass1(hp);
            ObjData.afteralloc;
 
-           { leave if errors have occured }
+           { leave if errors have occurred }
            if errorcount>0 then
              break;
 
@@ -1683,7 +1683,7 @@ Implementation
            hp:=TreePass2(hp);
            ObjData.afterwrite;
 
-           { leave if errors have occured }
+           { leave if errors have occurred }
            if errorcount>0 then
              break;
 

compiler/powerpc/agppcmpw.pas

@@ -125,7 +125,7 @@ interface
       t32bitarray = array[0..3] of byte;
 
     function ReplaceForbiddenChars(var s: string):Boolean;
-         {Returns wheater a replacement has occured.}
+         {Returns wheater a replacement has occurred.}
 
         var
           i:Integer;

compiler/powerpc/cgcpu.pas

@@ -771,7 +771,7 @@ const
      { one.                                                                     }
      { This procedure may be called before, as well as after g_return_from_proc }
      { is called. NOTE registers are not to be allocated through the register   }
-     { allocator here, because the register colouring has already occured !!    }
+     { allocator here, because the register colouring has already occurred !!    }
 
 
      var regcounter,firstregfpu,firstregint: TSuperRegister;
@@ -920,7 +920,7 @@ const
     procedure tcgppc.g_proc_exit(list : TAsmList;parasize : longint;nostackframe:boolean);
      { This procedure may be called before, as well as after g_stackframe_entry }
      { is called. NOTE registers are not to be allocated through the register   }
-     { allocator here, because the register colouring has already occured !!    }
+     { allocator here, because the register colouring has already occurred !!    }
 
       var
          regcounter,firstregfpu,firstregint: TsuperRegister;

compiler/powerpc64/cgcpu.pas

@@ -1099,7 +1099,7 @@ end;
  called by the current one
 
  IMPORTANT: registers are not to be allocated through the register
- allocator here, because the register colouring has already occured !!
+ allocator here, because the register colouring has already occurred !!
 }
 procedure tcgppc.g_proc_entry(list: TAsmList; localsize: longint;
   nostackframe: boolean);
@@ -1239,7 +1239,7 @@ end;
  is called.
 
  IMPORTANT: registers are not to be allocated through the register
- allocator here, because the register colouring has already occured !!
+ allocator here, because the register colouring has already occurred !!
 }
 procedure tcgppc.g_proc_exit(list: TAsmList; parasize: longint; nostackframe:
   boolean);

compiler/script.pas

@@ -269,10 +269,10 @@ Begin
   AddStart('@echo off');
   Add('goto end');
   Add(':asmend');
-  Add('echo An error occured while assembling %THEFILE%');
+  Add('echo An error occurred while assembling %THEFILE%');
   Add('goto end');
   Add(':linkend');
-  Add('echo An error occured while linking %THEFILE%');
+  Add('echo An error occurred while linking %THEFILE%');
   Add(':end');
   inherited WriteToDisk;
 end;
@@ -336,11 +336,11 @@ Begin
   Add('skip end');
   Add('lab asmend');
   Add('why');
-  Add('echo An error occured while assembling $THEFILE');
+  Add('echo An error occurred while assembling $THEFILE');
   Add('skip end');
   Add('lab linkend');
   Add('why');
-  Add('echo An error occured while linking $THEFILE');
+  Add('echo An error occurred while linking $THEFILE');
   Add('lab end');
   inherited WriteToDisk;
 end;

packages/fcl-js/src/jswriter.pp

@@ -104,7 +104,8 @@ Type
     FOptions: TWriteOptions;
     FWriter: TTextWriter;
     FFreeWriter : Boolean;
-    FSkipBrackets : Boolean;
+    FSkipCurlyBrackets : Boolean;
+    FSkipRoundBrackets : Boolean;
     function GetUseUTF8: Boolean;
     procedure SetOptions(AValue: TWriteOptions);
   Protected
@@ -125,7 +126,7 @@ Type
     Procedure WriteLiteral(El: TJSLiteral);virtual;
     Procedure WriteArrayLiteral(El: TJSArrayLiteral);virtual;
     Procedure WriteObjectLiteral(El: TJSObjectLiteral);virtual;
-    Procedure WriteMemberExpression(el: TJSMemberExpression);virtual;
+    Procedure WriteMemberExpression(El: TJSMemberExpression);virtual;
     Procedure WriteCallExpression(El: TJSCallExpression);virtual;
     Procedure WriteSwitchStatement(El: TJSSwitchStatement);virtual;
     Procedure WriteUnary(El: TJSUnary);virtual;
@@ -497,7 +498,7 @@ begin
     end;
   if Assigned(FD.Body) then
     begin
-    FSkipBrackets:=True;
+    FSkipCurlyBrackets:=True;
     //writeln('TJSWriter.WriteFuncDef '+FD.Body.ClassName);
     WriteJS(FD.Body);
     If (Assigned(FD.Body.A))
@@ -551,7 +552,7 @@ end;
 
 procedure TJSWriter.WriteLiteral(El: TJSLiteral);
 begin
-  WriteValue(el.Value);
+  WriteValue(El.Value);
 end;
 
 procedure TJSWriter.WritePrimaryExpression(El: TJSPrimaryExpression);
@@ -595,6 +596,7 @@ begin
     Write(Copy(BC,1,1));
   For I:=0 to C do
     begin
+    FSkipRoundBrackets:=true;
     WriteJS(El.Elements[i].Expr);
     if I<C then
       if WC then
@@ -622,7 +624,7 @@ Var
   S : TJSString;
 
 begin
-  C:=EL.Elements.Count-1;
+  C:=El.Elements.Count-1;
   QE:=(woQuoteElementNames in Options);
   if C=-1 then
     begin
@@ -639,16 +641,18 @@ begin
     end;
   For I:=0 to C do
    begin
-   S:=EL.Elements[i].Name;
+   S:=El.Elements[i].Name;
    if QE then
      S:='"'+S+'"';
    Write(S+': ');
    Indent;
-   WriteJS(EL.Elements[i].Expr);
+   FSkipRoundBrackets:=true;
+   WriteJS(El.Elements[i].Expr);
    if I<C then
      if WC then Write(', ') else Writeln(',');
    Undent;
    end;
+  FSkipRoundBrackets:=false;
   if not WC then
     begin
     Writeln('');
@@ -657,27 +661,29 @@ begin
   Write('}');
 end;
 
-procedure TJSWriter.WriteMemberExpression(el: TJSMemberExpression);
+procedure TJSWriter.WriteMemberExpression(El: TJSMemberExpression);
 
 begin
-  if el is TJSNewMemberExpression then
+  if El is TJSNewMemberExpression then
     Write('new ');
-  WriteJS(el.MExpr);
-  if el is TJSDotMemberExpression then
+  WriteJS(El.MExpr);
+  if El is TJSDotMemberExpression then
     begin
     write('.');
-    Write(TJSDotMemberExpression(el).Name);
+    Write(TJSDotMemberExpression(El).Name);
     end
-  else if el is TJSBracketMemberExpression then
+  else if El is TJSBracketMemberExpression then
     begin
     write('[');
-    WriteJS(TJSBracketMemberExpression(el).Name);
+    FSkipRoundBrackets:=true;
+    WriteJS(TJSBracketMemberExpression(El).Name);
+    FSkipRoundBrackets:=false;
     write(']');
     end
-  else if (el is TJSNewMemberExpression) then
+  else if (El is TJSNewMemberExpression) then
     begin
-    if (Assigned(TJSNewMemberExpression(el).Args)) then
-      WriteArrayLiteral(TJSNewMemberExpression(el).Args)
+    if (Assigned(TJSNewMemberExpression(El).Args)) then
+      WriteArrayLiteral(TJSNewMemberExpression(El).Args)
     else
       Write('()');
     end;
@@ -699,6 +705,7 @@ Var
   S : String;
 
 begin
+  FSkipRoundBrackets:=false;
   S:=El.PreFixOperator;
   if (S<>'') then
     Write(S);
@@ -719,13 +726,13 @@ Var
   LastEl: TJSElement;
 
 begin
-  //write('TJSWriter.WriteStatementList '+BoolToStr(FSkipBrackets,true));
+  //write('TJSWriter.WriteStatementList '+BoolToStr(FSkipCurlyBrackets,true));
   //if El.A<>nil then write(' El.A='+El.A.ClassName) else write(' El.A=nil');
   //if El.B<>nil then write(' El.B='+El.B.ClassName) else write(' El.B=nil');
   //writeln(' ');
 
   C:=(woCompact in Options);
-  B:= Not FSkipBrackets;
+  B:= Not FSkipCurlyBrackets;
   if B then
     begin
     Write('{');
@@ -745,7 +752,7 @@ begin
         else
           Writeln(';');
         end;
-      FSkipBrackets:=True;
+      FSkipCurlyBrackets:=True;
       WriteJS(El.B);
       LastEl:=El.B;
       end;
@@ -762,24 +769,26 @@ end;
 procedure TJSWriter.WriteWithStatement(El: TJSWithStatement);
 begin
    Write('with (');
-   WriteJS(EL.A);
+   FSkipRoundBrackets:=true;
+   WriteJS(El.A);
+   FSkipRoundBrackets:=false;
    if (woCompact in Options) then
      Write(') ')
    else
      WriteLn(')');
    Indent;
-   WriteJS(EL.B);
+   WriteJS(El.B);
    Undent;
 end;
 
 procedure TJSWriter.WriteVarDeclarationList(El: TJSVariableDeclarationList);
 
 begin
-  WriteJS(EL.A);
-  If Assigned(EL.B) then
+  WriteJS(El.A);
+  If Assigned(El.B) then
     begin
     Write(', ');
-    WriteJS(EL.B);
+    WriteJS(El.B);
     end;
 end;
 
@@ -787,12 +796,15 @@ procedure TJSWriter.WriteBinary(El: TJSBinary);
 
 Var
   S : AnsiString;
-  AllowCompact : Boolean;
+  AllowCompact, WithBrackets: Boolean;
 begin
-  Write('(');
-  WriteJS(EL.A);
+  WithBrackets:=not FSkipRoundBrackets;
+  if WithBrackets then
+    Write('(');
+  FSkipRoundBrackets:=false;
+  WriteJS(El.A);
   AllowCompact:=False;
-  if (el is TJSBinaryExpression) then
+  if (El is TJSBinaryExpression) then
     begin
     S:=TJSBinaryExpression(El).OperatorString;
     AllowCompact:=TJSBinaryExpression(El).AllowCompact;
@@ -800,19 +812,20 @@ begin
   If Not (AllowCompact and (woCompact in Options)) then
     S:=' '+S+' ';
   Write(S);
-  WriteJS(EL.B);
-  Write(')');
+  WriteJS(El.B);
+  if WithBrackets then
+    Write(')');
 end;
 
 procedure TJSWriter.WriteConditionalExpression(El: TJSConditionalExpression);
 
 begin
   write('(');
-  WriteJS(EL.A);
+  WriteJS(El.A);
   write(' ? ');
-  WriteJS(EL.B);
+  WriteJS(El.B);
   write(' : ');
-  WriteJS(EL.C);
+  WriteJS(El.C);
   write(')');
 end;
 
@@ -821,22 +834,26 @@ procedure TJSWriter.WriteAssignStatement(El: TJSAssignStatement);
 Var
   S : AnsiString;
 begin
-  WriteJS(EL.LHS);
+  WriteJS(El.LHS);
   S:=El.OperatorString;
   If Not (woCompact in Options) then
     S:=' '+S+' ';
   Write(s);
-  WriteJS(EL.Expr);
+  FSkipRoundBrackets:=true;
+  WriteJS(El.Expr);
+  FSkipRoundBrackets:=false;
 end;
 
 procedure TJSWriter.WriteVarDeclaration(El: TJSVarDeclaration);
 
 begin
-  Write(EL.Name);
-  if Assigned(EL.Init) then
+  Write(El.Name);
+  if Assigned(El.Init) then
     begin
     Write(' = ');
-    WriteJS(EL.Init);
+    FSkipRoundBrackets:=true;
+    WriteJS(El.Init);
+    FSkipRoundBrackets:=false;
     end;
 end;
 
@@ -844,17 +861,25 @@ procedure TJSWriter.WriteIfStatement(El: TJSIfStatement);
 
 begin
   Write('if (');
+  FSkipRoundBrackets:=true;
   WriteJS(El.Cond);
+  FSkipRoundBrackets:=false;
   Write(')');
   If Not (woCompact in Options) then
     Write(' ');
   if (El.BTrue<>nil) and (not (El.BTrue is TJSEmptyStatement)) then
+    begin
     WriteJS(El.BTrue);
+    end;
   if Assigned(El.BFalse) then
     begin
     if (El.BTrue=nil) or (El.BTrue is TJSEmptyStatement) then
-      Write('{}');
-    Write(' else ');
+      Writeln('{}')
+    else if not (El.BTrue is TJSStatementList) then
+      Writeln('')
+    else
+      Write(' ');
+    Write('else ');
     WriteJS(El.BFalse)
     end;
 end;
@@ -881,7 +906,11 @@ begin
     WriteJS(El.Init);
   Write('; ');
   if Assigned(El.Cond) then
+    begin
+    FSkipRoundBrackets:=true;
     WriteJS(El.Cond);
+    FSkipRoundBrackets:=false;
+    end;
   Write('; ');
   if Assigned(El.Incr) then
     WriteJS(El.Incr);
@@ -899,19 +928,27 @@ begin
     Write('do ');
     if Assigned(El.Body) then
       begin
-      FSkipBrackets:=false;
+      FSkipCurlyBrackets:=false;
       WriteJS(El.Body);
       end;
     Write(' while (');
     If Assigned(El.Cond) then
+      begin
+      FSkipRoundBrackets:=true;
       WriteJS(EL.Cond);
+      FSkipRoundBrackets:=false;
+      end;
     Write(')');
     end
   else
     begin
     Write('while (');
     If Assigned(El.Cond) then
+      begin
+      FSkipRoundBrackets:=true;
       WriteJS(EL.Cond);
+      FSkipRoundBrackets:=false;
+      end;
     Write(') ');
     if Assigned(El.Body) then
       WriteJS(El.Body);
@@ -937,7 +974,11 @@ begin
   C:=(woCompact in Options);
   Write('switch (');
   If Assigned(El.Cond) then
+    begin
+    FSkipRoundBrackets:=true;
     WriteJS(El.Cond);
+    FSkipRoundBrackets:=false;
+    end;
   if C then
     Write(') {')
   else
@@ -950,7 +991,9 @@ begin
     else
       begin
       Write('case ');
+      FSkipRoundBrackets:=true;
       WriteJS(EC.Expr);
+      FSkipRoundBrackets:=false;
       end;
     If C then
       Write(': ')
@@ -958,7 +1001,7 @@ begin
       Writeln(':');
     if Assigned(EC.Body) then
       begin
-      FSkipBrackets:=true;
+      FSkipCurlyBrackets:=true;
       Indent;
       WriteJS(EC.Body);
       Undent;
@@ -1020,22 +1063,24 @@ begin
   else
     begin
     Write('return ');
+    FSkipRoundBrackets:=true;
     WriteJS(El.Expr);
+    FSkipRoundBrackets:=false;
     end;
 end;
 
 procedure TJSWriter.WriteLabeledStatement(El: TJSLabeledStatement);
 begin
-  if Assigned(EL.TheLabel) then
+  if Assigned(El.TheLabel) then
     begin
-    Write(EL.TheLabel.Name);
+    Write(El.TheLabel.Name);
     if woCompact in Options then
       Write(': ')
     else
       Writeln(':');
     end;
   // Target ??
-  WriteJS(EL.A);
+  WriteJS(El.A);
 end;
 
 procedure TJSWriter.WriteTryStatement(El: TJSTryStatement);
@@ -1047,45 +1092,33 @@ begin
   C:=woCompact in Options;
   Write('try {');
   if Not C then writeln('');
-  FSkipBrackets:=True;
+  FSkipCurlyBrackets:=True;
   Indent;
   WriteJS(El.Block);
   Undent;
-  If C then
-    Write('} ')
-  else
-    begin
-    Writeln('}');
-    end;
+  Write('}');
   If (El is TJSTryCatchFinallyStatement) or (El is TJSTryCatchStatement) then
     begin
-    Write('catch ('+El.Ident);
+    Write(' catch');
+    if El.Ident<>'' then Write(' ('+El.Ident+')');
     If C then
-      Write(') {')
+      Write(' {')
     else
-      Writeln(') {');
+      Writeln(' {');
+    FSkipCurlyBrackets:=True;
     Indent;
     WriteJS(El.BCatch);
     Undent;
-    If C then
-      if (El is TJSTryCatchFinallyStatement) then
-        Write('} ')
-      else
-        Write('}')
-    else
-      begin
-      Writeln('');
-      Writeln('}');
-      end;
+    Write('}');
     end;
   If (El is TJSTryCatchFinallyStatement) or (El is TJSTryFinallyStatement) then
     begin
     If C then
-      Write('finally {')
+      Write(' finally {')
     else
-      Writeln('finally {');
+      Writeln(' finally {');
     Indent;
-    FSkipBrackets:=True;
+    FSkipCurlyBrackets:=True;
     WriteJS(El.BFinally);
     Undent;
     Write('}');
@@ -1095,7 +1128,7 @@ end;
 procedure TJSWriter.WriteFunctionBody(El: TJSFunctionBody);
 
 begin
-  //writeln('TJSWriter.WriteFunctionBody '+El.A.ClassName+' FSkipBrackets='+BoolToStr(FSkipBrackets,'true','false'));
+  //writeln('TJSWriter.WriteFunctionBody '+El.A.ClassName+' FSkipBrackets='+BoolToStr(FSkipCurlyBrackets,'true','false'));
   if Assigned(El.A) and (not (El.A is TJSEmptyBlockStatement)) then
     WriteJS(El.A);
 end;
@@ -1104,8 +1137,8 @@ procedure TJSWriter.WriteFunctionDeclarationStatement(
   El: TJSFunctionDeclarationStatement);
 
 begin
-  if Assigned(EL.AFunction) then
-    WriteFuncDef(EL.AFunction);
+  if Assigned(El.AFunction) then
+    WriteFuncDef(El.AFunction);
 end;
 
 procedure TJSWriter.WriteSourceElements(El: TJSSourceElements);
@@ -1212,7 +1245,7 @@ begin
   else
     Error(SErrUnknownJSClass,[El.ClassName]);
 //  Write('/* '+El.ClassName+' */');
-  FSkipBrackets:=False;
+  FSkipCurlyBrackets:=False;
 end;
 
 { TFileWriter }

packages/fcl-passrc/examples/parsepp.pp

@@ -0,0 +1,89 @@
+{ ---------------------------------------------------------------------
+  This is a simple program to check whether fcl-passrc
+
+  ---------------------------------------------------------------------}
+
+program parsepp;
+
+{$mode objfpc}{$H+}
+ 
+uses SysUtils, Classes, PParser, PasTree;
+ 
+type
+  { We have to override abstract TPasTreeContainer methods.
+    See utils/fpdoc/dglobals.pp for an implementation of TFPDocEngine,
+    a "real" engine. }
+  TSimpleEngine = class(TPasTreeContainer)
+  public
+    function CreateElement(AClass: TPTreeElement; const AName: String;
+      AParent: TPasElement; AVisibility: TPasMemberVisibility;
+      const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
+      override;
+    function FindElement(const AName: String): TPasElement; override;
+  end;
+ 
+function TSimpleEngine.CreateElement(AClass: TPTreeElement; const AName: String;
+  AParent: TPasElement; AVisibility: TPasMemberVisibility;
+  const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
+begin
+  Writeln(AName,' : ',AClass.ClassName,' at ',ASourceFilename,':',ASourceLinenumber);
+  Result := AClass.Create(AName, AParent);
+  Result.Visibility := AVisibility;
+  Result.SourceFilename := ASourceFilename;
+  Result.SourceLinenumber := ASourceLinenumber;
+end;
+ 
+function TSimpleEngine.FindElement(const AName: String): TPasElement;
+begin
+  { dummy implementation, see TFPDocEngine.FindElement for a real example }
+  Result := nil;
+end;
+ 
+Procedure Usage;
+
+begin
+  Writeln('Usage : ',ExtractFileName(Paramstr(0)),' [-h|--help] options ');
+  Writeln('-h or --help shows this help');
+  Writeln('All other options are passed as-is to the parser');
+  Halt(0);
+end;
+ 
+var
+  M: TPasModule;
+  E: TPasTreeContainer;
+  I: Integer;
+  Decls: TFPList;
+  cmdline : String;
+  
+begin
+  cmdline:='';
+  if (ParamCount=0) or (Paramstr(1)='-h') or (Paramstr(1)='--help') then
+    Usage;
+  For I:=1 to ParamCount do
+    CmdLine:=CmdLine+' '+Paramstr(i);
+  E := TSimpleEngine.Create;
+  try
+    M := ParseSource(E, cmdline, 'linux', 'i386');
+ 
+    { Cool, we successfully parsed the module.
+      Now output some info about it. }
+    if M.InterfaceSection <> nil then
+    begin
+      Decls := M.InterfaceSection.Declarations;
+      for I := 0 to Decls.Count - 1 do
+        Writeln('Interface item ', I, ': ' +
+          (TObject(Decls[I]) as TPasElement).Name);
+    end else
+      Writeln('No interface section --- this is not a unit, this is a ', M.ClassName);
+ 
+    if M.ImplementationSection <> nil then // may be nil in case of a simple program
+    begin
+      Decls := M.ImplementationSection.Declarations;
+      for I := 0 to Decls.Count - 1 do
+        Writeln('Implementation item ', I, ': ' +
+          (TObject(Decls[I]) as TPasElement).Name);
+    end;
+ 
+    FreeAndNil(M);
+  finally FreeAndNil(E) end;
+end.

packages/fcl-passrc/examples/test_parser.pp

@@ -544,9 +544,9 @@ begin
     begin
      lifl:=TPasImplForLoop(lsmt);
      //TODO variable
-     write(s1,'for ',lifl.VariableName,':= ',lifl.StartValue,' ');
+     write(s1,'for ',lifl.Variable.Name,':= ',lifl.StartExpr.GetDeclaration(True),' ');
      if lifl.Down then write('down');
-     writeln('to ',lifl.EndValue,' do');
+     writeln('to ',lifl.EndExpr.GetDeclaration(True),' do');
      GetTPasImplBlock(TPasImplBlock(lifl),lindent+1,0,false,false);
      DoSem:=false;
     end
@@ -1147,8 +1147,8 @@ procedure GetTypes(pe:TPasElement; lindent:integer);
       Result:=true;
       writeln(';');
       write(s,'case ');
-      if prct.VariantName <>'' then write(prct.VariantName,'=');
-      write(TPasType(prct.VariantType).Name);
+      if prct.VariantEl.GetDeclaration(True) <>'' then write(prct.VariantEl.GetDeclaration(True),'=');
+      write(TPasType(prct.VariantEl).Name);
       writeln(' of');
       if assigned(prct.Variants)then
        if prct.Variants.Count >0 then
@@ -1235,8 +1235,8 @@ procedure GetTypes(pe:TPasElement; lindent:integer);
     if assigned(prct.Variants) then
      begin
       write(s1,'case ');
-      if prct.VariantName <>'' then write(prct.VariantName,'=');
-        write(TPasType(prct.VariantType).Name);
+      if prct.VariantEl.Name <>'' then write(prct.VariantEl.Name,'=');
+        write(TPasType(prct.VariantEl).Name);
       writeln(' of');
       if assigned(prct.Variants)then
        if prct.Variants.Count >0 then

packages/fcl-passrc/src/pastree.pp

@@ -535,6 +535,7 @@ type
       const Arg: Pointer); override;
   public
     EnumType: TPasType;
+    IsPacked : Boolean;
   end;
 
   TPasRecordType = class;
@@ -709,7 +710,7 @@ type
   end;
 
   { TPasVariable }
-  TVariableModifier = (vmCVar, vmExternal, vmPublic, vmExport, vmClass,vmStatic);
+  TVariableModifier = (vmCVar, vmExternal, vmPublic, vmExport, vmClass, vmStatic);
   TVariableModifiers = set of TVariableModifier;
 
   TPasVariable = class(TPasElement)
@@ -775,6 +776,7 @@ type
     Args: TFPList;        // List of TPasArgument objects
     ReadAccessorName, WriteAccessorName, ImplementsName,
       StoredAccessorName: string;
+    DispIDReadOnly,
     IsDefault, IsNodefault: Boolean;
     property IsClass: boolean read GetIsClass write SetIsClass;
     Function ResolvedType : TPasType;
@@ -808,7 +810,7 @@ type
   TProcedureModifier = (pmVirtual, pmDynamic, pmAbstract, pmOverride,
                         pmExport, pmOverload, pmMessage, pmReintroduce,
                         pmStatic,pmInline,pmAssembler,pmVarargs, pmPublic,
-                        pmCompilerProc,pmExternal,pmForward);
+                        pmCompilerProc,pmExternal,pmForward, pmdispid, pmnoreturn);
   TProcedureModifiers = Set of TProcedureModifier;
   TProcedureMessageType = (pmtNone,pmtInteger,pmtString);
                         
@@ -835,6 +837,8 @@ type
     PublicName,
     LibrarySymbolName,
     LibraryExpr : TPasExpr;
+    DispIDExpr :  TPasExpr;
+    AliasName : String;
     Procedure AddModifier(AModifier : TProcedureModifier);
     Function IsVirtual : Boolean;
     Function IsDynamic : Boolean;
@@ -1386,7 +1390,10 @@ const
                 = ('virtual', 'dynamic','abstract', 'override',
                    'export', 'overload', 'message', 'reintroduce',
                    'static','inline','assembler','varargs', 'public',
-                   'compilerproc','external','forward');
+                   'compilerproc','external','forward','dispid','noreturn');
+
+  VariableModifierNames : Array[TVariableModifier] of string
+     = ('cvar', 'external', 'public', 'export', 'class', 'static');
 
 procedure ReleaseAndNil(var El: TPasElement); overload;
 

packages/fcl-passrc/src/pparser.pp

@@ -238,6 +238,7 @@ type
     FDumpIndent : String;
     function CheckOverloadList(AList: TFPList; AName: String; out OldMember: TPasElement): TPasOverloadedProc;
     procedure DumpCurToken(Const Msg : String; IndentAction : TIndentAction = iaNone);
+    function GetCurrentModeSwitches: TModeSwitches;
     function GetVariableModifiers(Out VarMods : TVariableModifiers; Out Libname,ExportName : string): string;
     function GetVariableValueAndLocation(Parent : TPasElement; Out Value : TPasExpr; Out Location: String): Boolean;
     procedure HandleProcedureModifier(Parent: TPasElement; pm : TProcedureModifier);
@@ -282,6 +283,9 @@ type
       Element: TPasExpr; AOpCode: TExprOpCode);
     procedure AddParamsToBinaryExprChain(var ChainFirst, ChainLast: TPasExpr;
       Params: TParamsExpr);
+    {$IFDEF VerbosePasParser}
+    procedure WriteBinaryExprChain(Prefix: string; First, Last: TPasExpr);
+    {$ENDIF}
     function CreateUnaryExpr(AParent : TPasElement; AOperand: TPasExpr; AOpCode: TExprOpCode): TUnaryExpr;
     function CreateArrayValues(AParent : TPasElement): TArrayValues;
     function CreateFunctionType(const AName, AResultName: String; AParent: TPasElement;
@@ -298,7 +302,7 @@ type
     function ParseParams(AParent : TPasElement;paramskind: TPasExprKind; AllowFormatting : Boolean = False): TParamsExpr;
     function ParseExpIdent(AParent : TPasElement): TPasExpr;
     procedure DoParseClassType(AType: TPasClassType);
-    function DoParseExpression(AParent: TPaselement;InitExpr: TPasExpr=nil): TPasExpr;
+    function DoParseExpression(AParent: TPaselement;InitExpr: TPasExpr=nil; AllowEqual : Boolean = True): TPasExpr;
     function DoParseConstValueExpression(AParent: TPasElement): TPasExpr;
     function CheckPackMode: TPackMode;
     function CheckUseUnit(ASection: TPasSection; AUnitName : string): TPasElement;
@@ -322,7 +326,7 @@ type
     function ExpectIdentifier: String;
     Function CurTokenIsIdentifier(Const S : String) : Boolean;
     // Expression parsing
-    function isEndOfExp: Boolean;
+    function isEndOfExp(AllowEqual : Boolean = False): Boolean;
     // Type declarations
     function ParseComplexType(Parent : TPasElement = Nil): TPasType;
     function ParseTypeDecl(Parent: TPasElement): TPasType;
@@ -336,7 +340,7 @@ type
     Function ParseFileType(Parent : TPasElement; Const NamePos: TPasSourcePos; Const TypeName  : String) : TPasFileType;
     Function ParseRecordDecl(Parent: TPasElement; Const NamePos: TPasSourcePos; Const TypeName : string; const Packmode : TPackMode = pmNone) : TPasRecordType;
     function ParseEnumType(Parent: TPasElement; Const NamePos: TPasSourcePos; const TypeName: String): TPasEnumType;
-    function ParseSetType(Parent: TPasElement; Const NamePos: TPasSourcePos; const TypeName: String ): TPasSetType;
+    function ParseSetType(Parent: TPasElement; Const NamePos: TPasSourcePos; const TypeName: String; AIsPacked : Boolean = False): TPasSetType;
     function ParseSpecializeType(Parent: TPasElement; Const TypeName: String): TPasClassType;
     Function ParseClassDecl(Parent: TPasElement; Const NamePos: TPasSourcePos; Const AClassName: String; AObjKind: TPasObjKind; PackMode : TPackMode= pmNone): TPasType;
     Function ParseProperty(Parent : TPasElement; Const AName : String; AVisibility : TPasMemberVisibility; IsClassField: boolean) : TPasProperty;
@@ -377,6 +381,7 @@ type
     property CurToken: TToken read FCurToken;
     property CurTokenString: String read FCurTokenString;
     Property Options : TPOptions Read FOptions Write SetOptions;
+    Property CurrentModeswitches : TModeSwitches Read GetCurrentModeSwitches;
     Property CurModule : TPasModule Read FCurModule;
     Property LogEvents : TPParserLogEvents Read FLogEvents Write FLogEvents;
     Property OnLog : TPasParserLogHandler Read FOnLog Write FOnLog;
@@ -520,8 +525,14 @@ var
           if  (length(s)>2) then
             case S[3] of
               'c' : Scanner.Options:=Scanner.Options+[po_cassignments];
-              'd','2' : Parser.Options:=Parser.Options+[po_delphi];
+              'd' : Scanner.SetCompilerMode('DELPHI');
+              '2' : Scanner.SetCompilerMode('OBJFPC');
             end;
+        'M' :
+           begin
+           delete(S,1,2);
+           Scanner.SetCompilerMode(S);
+           end;
       end;
     end else
       if Filename <> '' then
@@ -933,7 +944,7 @@ begin
         NextToken;
         if (Curtoken<>tkString) then
           UnGetToken
-        else
+        else if assigned(Element) then
           Element.HintMessage:=CurTokenString;
         end;
       end;
@@ -958,8 +969,8 @@ begin
   if (Result<>pmNone) then
      begin
      NextToken;
-     if Not (CurToken in [tkArray, tkRecord, tkObject, tkClass]) then
-       ParseExcTokenError('ARRAY, RECORD, OBJECT or CLASS');
+     if Not (CurToken in [tkArray, tkRecord, tkObject, tkClass, tkSet]) then
+       ParseExcTokenError('SET, ARRAY, RECORD, OBJECT or CLASS');
      end;
 end;
 
@@ -1214,12 +1225,13 @@ begin
 end;
 
 function TPasParser.ParseSetType(Parent: TPasElement;
-  const NamePos: TPasSourcePos; const TypeName: String): TPasSetType;
+  const NamePos: TPasSourcePos; const TypeName: String; AIsPacked : Boolean = False): TPasSetType;
 
 var
   ok: Boolean;
 begin
   Result := TPasSetType(CreateElement(TPasSetType, TypeName, Parent, NamePos));
+  Result.IsPacked:=AIsPacked;
   ok:=false;
   try
     ExpectToken(tkOf);
@@ -1283,7 +1295,7 @@ begin
       tkFile: Result:=ParseFileType(Parent,NamePos,TypeName);
       tkArray: Result:=ParseArrayType(Parent,NamePos,TypeName,pm);
       tkBraceOpen: Result:=ParseEnumType(Parent,NamePos,TypeName);
-      tkSet: Result:=ParseSetType(Parent,NamePos,TypeName);
+      tkSet: Result:=ParseSetType(Parent,NamePos,TypeName,pm=pmPacked);
       tkProcedure: Result:=ParseProcedureType(Parent,NamePos,TypeName,ptProcedure);
       tkFunction: Result:=ParseProcedureType(Parent,NamePos,TypeName,ptFunction);
       tkRecord:
@@ -1413,7 +1425,7 @@ begin
    ungettoken;
 end;
 
-function TPasParser.isEndOfExp:Boolean;
+function TPasParser.isEndOfExp(AllowEqual : Boolean = False):Boolean;
 const
   EndExprToken = [
     tkEOF, tkBraceClose, tkSquaredBraceClose, tkSemicolon, tkComma, tkColon,
@@ -1421,6 +1433,8 @@ const
   ];
 begin
   Result:=(CurToken in EndExprToken) or IsCurTokenHint;
+  if Not (Result or AllowEqual) then
+    Result:=(Curtoken=tkEqual);
 end;
 
 function TPasParser.ParseParams(AParent: TPasElement; paramskind: TPasExprKind;
@@ -1693,7 +1707,7 @@ begin
   end;
 end;
 
-function TPasParser.DoParseExpression(AParent : TPaselement;InitExpr: TPasExpr): TPasExpr;
+function TPasParser.DoParseExpression(AParent : TPaselement;InitExpr: TPasExpr; AllowEqual : Boolean = True): TPasExpr;
 var
   expstack  : TFPList;
   opstack   : array of TToken;
@@ -1761,7 +1775,13 @@ const
     expstack.Add(bin);
   end;
 
+Var
+  AllowedBinaryOps : Set of TToken;
+
 begin
+  AllowedBinaryOps:=BinaryOP;
+  if Not AllowEqual then
+    Exclude(AllowedBinaryOps,tkEqual);
   //DumpCurToken('Entry',iaIndent);
   Result:=nil;
   expstack := TFPList.Create;
@@ -1842,7 +1862,7 @@ begin
         expstack.Add(InitExpr);
         InitExpr:=nil;
         end;
-      if (CurToken in BinaryOP) then
+      if (CurToken in AllowedBinaryOPs) then
         begin
         // Adjusting order of the operations
         NotBinary:=False;
@@ -1855,7 +1875,7 @@ begin
         NextToken;
         end;
       // Writeln('Bin ',NotBinary ,' or EOE ',isEndOfExp, ' Ex ',Assigned(x),' stack ',ExpStack.Count);
-    until NotBinary or isEndOfExp;
+    until NotBinary or isEndOfExp(AllowEqual);
 
     if not NotBinary then ParseExcExpectedIdentifier;
 
@@ -2435,8 +2455,10 @@ begin
               end;
             declType:
               begin
-                TypeEl := ParseTypeDecl(Declarations);
-                if Assigned(TypeEl) then        // !!!
+              Scanner.SetForceCaret(True);
+              TypeEl := ParseTypeDecl(Declarations);
+              // Scanner.SetForceCaret(OldForceCaret); // It may have been switched off
+              if Assigned(TypeEl) then        // !!!
                 begin
                   Declarations.Declarations.Add(TypeEl);
                   if (TypeEl.ClassType = TPasClassType)
@@ -2674,8 +2696,10 @@ end;
 
 // Starts after the variable name
 function TPasParser.ParseConstDecl(Parent: TPasElement): TPasConst;
+
 var
-  ok: Boolean;
+  OldForceCaret,ok: Boolean;
+
 begin
   SaveComments;
   Result := TPasConst(CreateElement(TPasConst, CurTokenString, Parent));
@@ -2683,7 +2707,16 @@ begin
   try
     NextToken;
     if CurToken = tkColon then
-      Result.VarType := ParseType(Result,Scanner.CurSourcePos)
+      begin
+      OldForceCaret:=Scanner.SetForceCaret(True);
+      try
+        Result.VarType := ParseType(Result,Scanner.CurSourcePos);
+      finally
+        Scanner.SetForceCaret(OldForceCaret);
+      end;
+{      if Result.VarType is TPasRangeType then
+        Ungettoken; // Range type stops on token after last range token}
+      end
     else
       UngetToken;
     ExpectToken(tkEqual);
@@ -2756,7 +2789,7 @@ begin
         ParseExcTokenError(TokenInfos[tkEqual]);
       end;
     NextToken;
-    PE:=DoParseExpression(Result,Nil);
+    PE:=DoParseExpression(Result,Nil,False);
     if not ((PE is TBinaryExpr) and (TBinaryExpr(PE).Kind=pekRange)) then
       begin
       PE.Release;
@@ -2845,11 +2878,18 @@ function TPasParser.ParseTypeDecl(Parent: TPasElement): TPasType;
 var
   TypeName: String;
   NamePos: TPasSourcePos;
+  OldForceCaret : Boolean;
+  
 begin
   TypeName := CurTokenString;
   NamePos:=Scanner.CurSourcePos;
   ExpectToken(tkEqual);
-  Result:=ParseType(Parent,NamePos,TypeName,True);
+  OldForceCaret:=Scanner.SetForceCaret(True);
+  try
+    Result:=ParseType(Parent,NamePos,TypeName,True);
+  finally
+    Scanner.SetForceCaret(OldForceCaret);
+  end;
 end;
 
 function TPasParser.GetVariableValueAndLocation(Parent: TPasElement; out
@@ -2955,7 +2995,7 @@ var
   H : TPasMemberHints;
   VarMods: TVariableModifiers;
   D,Mods,Loc,aLibName,aExpName : string;
-  ok: Boolean;
+  OldForceCaret,ok: Boolean;
 
 begin
   OldListCount:=VarList.Count;
@@ -2973,9 +3013,13 @@ begin
       if CurToken=tkComma then
         ExpectIdentifier;
     Until (CurToken=tkColon);
-
+    OldForceCaret:=Scanner.SetForceCaret(True);
+    try
+      VarType := ParseComplexType(VarEl);
+    finally
+      Scanner.SetForceCaret(OldForceCaret);
+    end;
     // read type
-    VarType := ParseComplexType(VarEl);
     for i := OldListCount to VarList.Count - 1 do
       begin
       VarEl:=TPasVariable(VarList[i]);
@@ -3233,16 +3277,10 @@ function TPasParser.CheckProcedureArgs(Parent: TPasElement; Args: TFPList;
 
 begin
   NextToken;
-  Result:=(Curtoken=tkbraceOpen);
-  if not Result then
-    begin
-    if Mandatory then
-      ParseExc(nParserExpectedLBracketColon,SParserExpectedLBracketColon)
-    else
-      UngetToken;
-    end
-  else
+  case CurToken of
+  tkBraceOpen:
     begin
+    Result:=true;
     NextToken;
     if (CurToken<>tkBraceClose) then
       begin
@@ -3250,6 +3288,17 @@ begin
       ParseArgList(Parent, Args, tkBraceClose);
       end;
     end;
+  tkSemicolon,tkColon,tkof,tkis,tkIdentifier:
+    begin
+    Result:=false;
+    if Mandatory then
+      ParseExc(nParserExpectedLBracketColon,SParserExpectedLBracketColon)
+    else
+      UngetToken;
+    end
+  else
+    ParseExcTokenError(';');
+  end;
 end;
 
 procedure TPasParser.HandleProcedureModifier(Parent: TPasElement; pm: TProcedureModifier);
@@ -3264,7 +3313,8 @@ begin
     P:=TPasProcedure(Parent);
   if Assigned(P) then
     P.AddModifier(pm);
-  if (pm=pmExternal) then
+  Case pm of
+  pmExternal:
     begin
     NextToken;
     if CurToken in [tkString,tkIdentifier] then
@@ -3297,8 +3347,8 @@ begin
       end
     else
       UngetToken;
-    end
-  else if (pm = pmPublic) then
+    end;
+  pmPublic:
     begin
     NextToken;
     { Should be token Name,
@@ -3320,16 +3370,16 @@ begin
       if (CurToken <> tkSemicolon) then
         ParseExcTokenError(TokenInfos[tkSemicolon]);
       end;
-    end
-  else if (pm=pmForward) then
+    end;
+  pmForward:
     begin
     if (Parent.Parent is TInterfaceSection) then
        begin
        ParseExc(nParserForwardNotInterface,SParserForwardNotInterface);
        UngetToken;
        end;
-    end
-  else if (pm=pmMessage) then
+    end;
+  pmMessage:
     begin
     Repeat
       NextToken;
@@ -3343,6 +3393,13 @@ begin
     until CurToken = tkSemicolon;
     UngetToken;
     end;
+  pmDispID:
+    begin
+    TPasProcedure(Parent).DispIDExpr:=DoParseExpression(Parent,Nil);
+    if CurToken = tkSemicolon then
+      UngetToken;
+    end;
+  end; // Case
 end;
 
 // Next token is expected to be a "(", ";" or for a function ":". The caller
@@ -3400,7 +3457,7 @@ begin
         end
       // In Delphi mode, the implementation in the implementation section can be without result as it was declared
       // We actually check if the function exists in the interface section.
-      else if (po_delphi in Options) and Assigned(CurModule.ImplementationSection) then
+      else if (msDelphi in CurrentModeswitches) and Assigned(CurModule.ImplementationSection) then
         begin
         I:=-1;
         if Assigned(CurModule.InterfaceSection) then
@@ -3505,6 +3562,14 @@ begin
       end
     else if DoCheckHint then
       ConsumeSemi
+    else if (CurToken=tkIdentifier) and (CompareText(CurTokenText,'alias')=0) then
+      begin
+      ExpectToken(tkColon);
+      ExpectToken(tkString);
+      if (Parent is TPasProcedure) then
+        (Parent as TPasProcedure).AliasName:=CurTokenText;
+      ExpectToken(tkSemicolon);
+      end
     else if (CurToken = tkSquaredBraceOpen) then
       begin
       repeat
@@ -3516,7 +3581,11 @@ begin
     if Done then
       begin
       NextToken;
-      Done:=Not ((Curtoken=tkSquaredBraceOpen) or TokenIsProcedureModifier(Parent,CurtokenString,Pm) or IscurtokenHint() or TokenisCallingConvention(CurTokenString,cc));
+      Done:=Not ((Curtoken=tkSquaredBraceOpen) or
+                  TokenIsProcedureModifier(Parent,CurtokenString,Pm) or
+                  IscurtokenHint() or
+                  TokenisCallingConvention(CurTokenString,cc) or
+                  (CurToken=tkIdentifier) and (CompareText(CurTokenText,'alias')=0));
 //      DumpCurToken('Done '+IntToStr(Ord(Done)));
       UngetToken;
       end;
@@ -3636,6 +3705,11 @@ begin
       Result.WriteAccessorName := GetAccessorName(Result,Result.WriteAccessor);
       NextToken;
       end;
+    if CurTokenIsIdentifier('READONLY') then
+      begin
+      Result.DispIDReadOnly:=True;
+      NextToken;
+      end;
     if CurTokenIsIdentifier('DISPID') then
       begin
       NextToken;
@@ -3743,7 +3817,7 @@ begin
     FTokenBufferSize:=1;
     FCommentsBuffer[0].Clear;
     repeat
-      Scanner.ReadNonPascalTilEndToken(true);
+      Scanner.ReadNonPascalTillEndToken(true);
       case Scanner.CurToken of
       tkLineEnding:
         AsmBlock.Tokens.Add(Scanner.CurTokenString);
@@ -3892,9 +3966,24 @@ begin
           CloseBlock;
           CloseStatement(false);
         end;
+        // Case ... else without semicolon in front.
+      end else if (CurBlock is TPasImplCaseStatement) then
+      begin
+        UngetToken;
+        CloseStatement(False);
+        exit;
       end else if (CurBlock is TPasImplWhileDo) then
       begin
-        //if .. then while .. do smt else ..
+        CloseBlock;
+        UngetToken;
+      end else if (CurBlock is TPasImplForLoop) then
+      begin
+        //if .. then for .. do smt else ..
+        CloseBlock;
+        UngetToken;
+      end else if (CurBlock is TPasImplWithDo) then
+      begin
+        //if .. then with .. do smt else ..
         CloseBlock;
         UngetToken;
       end else if (CurBlock is TPasImplRaise) then
@@ -4160,7 +4249,7 @@ begin
       El:=TPasImplRaise(CreateElement(TPasImplRaise,'',CurBlock));
       CreateBlock(TPasImplRaise(El));
       NextToken;
-      If Curtoken in [tkEnd,tkSemicolon] then
+      If Curtoken in [tkElse,tkEnd,tkSemicolon] then
         UnGetToken
       else
         begin
@@ -4431,6 +4520,14 @@ begin
   Flush(output);
 end;
 
+function TPasParser.GetCurrentModeSwitches: TModeSwitches;
+begin
+  if Assigned(FScanner) then
+    Result:=FScanner.CurrentModeSwitches
+  else
+    Result:=[msNone];
+end;
+
 // Starts on first token after Record or (. Ends on AEndToken
 procedure TPasParser.ParseRecordFieldList(ARec: TPasRecordType;
   AEndToken: TToken; AllowMethods: Boolean);
@@ -4490,12 +4587,12 @@ begin
         else
           ARec.Members.Add(Proc);
         end;
+      tkGeneric, // Counts as field name
       tkIdentifier :
         begin
-//        If (po_delphi in Scanner.Options) then
           if CheckVisibility(CurtokenString,v) then
             begin
-            If not (po_delphi in Scanner.Options) then
+            If not (msAdvancedRecords in Scanner.CurrentModeSwitches) then
               ParseExc(nErrRecordVisibilityNotAllowed,SErrRecordVisibilityNotAllowed);
             if not (v in [visPrivate,visPublic,visStrictPrivate]) then
               ParseExc(nParserInvalidRecordVisibility,SParserInvalidRecordVisibility);
@@ -4970,7 +5067,7 @@ begin
       // chain not yet full => inconsistency
       RaiseInternal;
     Last.right:=CreateBinaryExpr(Last,Last.right,Element,AOpCode);
-    ChainLast:=Last;
+    ChainLast:=Last.right;
     end
   else
     begin
@@ -5016,6 +5113,68 @@ begin
     end;
 end;
 
+{$IFDEF VerbosePasParser}
+procedure TPasParser.WriteBinaryExprChain(Prefix: string; First, Last: TPasExpr
+  );
+var
+  i: Integer;
+begin
+  if First=nil then
+    begin
+    write(Prefix,'First=nil');
+    if Last=nil then
+      writeln('=Last')
+    else
+      begin
+      writeln(', ERROR Last=',Last.ClassName);
+      ParseExcSyntaxError;
+      end;
+    end
+  else if Last=nil then
+    begin
+    writeln(Prefix,'ERROR Last=nil First=',First.ClassName);
+    ParseExcSyntaxError;
+    end
+  else if First is TBinaryExpr then
+    begin
+    i:=0;
+    while First is TBinaryExpr do
+      begin
+      writeln(Prefix,Space(i*2),'bin.left=',TBinaryExpr(First).left.ClassName);
+      if First=Last then break;
+      First:=TBinaryExpr(First).right;
+      inc(i);
+      end;
+    if First<>Last then
+      begin
+      writeln(Prefix,Space(i*2),'ERROR Last is not last in chain');
+      ParseExcSyntaxError;
+      end;
+    if not (Last is TBinaryExpr) then
+      begin
+      writeln(Prefix,Space(i*2),'ERROR Last is not TBinaryExpr: ',Last.ClassName);
+      ParseExcSyntaxError;
+      end;
+    if TBinaryExpr(Last).right=nil then
+      begin
+      writeln(Prefix,Space(i*2),'ERROR Last.right=nil');
+      ParseExcSyntaxError;
+      end;
+    writeln(Prefix,Space(i*2),'last.right=',TBinaryExpr(Last).right.ClassName);
+    end
+  else if First=Last then
+    writeln(Prefix,'First=Last=',First.ClassName)
+  else
+    begin
+    write(Prefix,'ERROR First=',First.ClassName);
+    if Last<>nil then
+      writeln(' Last=',Last.ClassName)
+    else
+      writeln(' Last=nil');
+    end;
+end;
+{$ENDIF}
+
 function TPasParser.CreateUnaryExpr(AParent: TPasElement; AOperand: TPasExpr;
   AOpCode: TExprOpCode): TUnaryExpr;
 begin

packages/fcl-passrc/src/pscanner.pp

@@ -39,6 +39,8 @@ const
   nLogIFNDefRejected = 1012;
   nLogIFOPTIgnored = 1013;
   nLogIFIgnored = 1014;
+  nErrInvalidMode = 1015;
+  nErrInvalidModeSwitch = 1016;
 
 // resourcestring patterns of messages
 resourcestring
@@ -56,6 +58,8 @@ resourcestring
   SLogIFNDefRejected = 'IFNDEF %s found, rejecting.';
   SLogIFOPTIgnored = 'IFOPT %s found, ignoring (rejected).';
   SLogIFIgnored = 'IF %s found, ignoring (rejected).';
+  SErrInvalidMode = 'Invalid mode: "%s"';
+  SErrInvalidModeSwitch = 'Invalid mode switch: "%s"';
 
 type
   TMessageType = (
@@ -190,6 +194,53 @@ type
     );
   TTokens = set of TToken;
 
+  TModeSwitch = (
+    msNone,
+    { generic }
+    msFpc, msObjfpc, msDelphi, msTP7, msMac, msIso, msExtpas, msGPC,
+    { more specific }
+    msClass,               { delphi class model }
+    msObjpas,              { load objpas unit }
+    msResult,              { result in functions }
+    msStringPchar,         { pchar 2 string conversion }
+    msCVarSupport,         { cvar variable directive }
+    msNestedComment,       { nested comments }
+    msTPProcVar,           { tp style procvars (no @ needed) }
+    msMacProcVar,          { macpas style procvars }
+    msRepeatForward,       { repeating forward declarations is needed }
+    msPointer2Procedure,   { allows the assignement of pointers to
+                             procedure variables                     }
+    msAutoDeref,           { does auto dereferencing of struct. vars }
+    msInitFinal,           { initialization/finalization for units }
+    msDefaultAnsistring,   { ansistring turned on by default }
+    msOut,                 { support the calling convention OUT }
+    msDefaultPara,         { support default parameters }
+    msHintDirective,       { support hint directives }
+    msDuplicateNames,      { allow locals/paras to have duplicate names of globals }
+    msProperty,            { allow properties }
+    msDefaultInline,       { allow inline proc directive }
+    msExcept,              { allow exception-related keywords }
+    msObjectiveC1,         { support interfacing with Objective-C (1.0) }
+    msObjectiveC2,         { support interfacing with Objective-C (2.0) }
+    msNestedProcVars,      { support nested procedural variables }
+    msNonLocalGoto,        { support non local gotos (like iso pascal) }
+    msAdvancedRecords,     { advanced record syntax with visibility sections, methods and properties }
+    msISOLikeUnaryMinus,   { unary minus like in iso pascal: same precedence level as binary minus/plus }
+    msSystemCodePage,      { use system codepage as compiler codepage by default, emit ansistrings with system codepage }
+    msFinalFields,         { allows declaring fields as "final", which means they must be initialised
+                             in the (class) constructor and are constant from then on (same as final
+                             fields in Java) }
+    msDefaultUnicodestring, { makes the default string type in $h+ mode unicodestring rather than
+                               ansistring; similarly, char becomes unicodechar rather than ansichar }
+    msTypeHelpers,         { allows the declaration of "type helper" (non-Delphi) or "record helper"
+                             (Delphi) for primitive types }
+    msBlocks,              { support for http://en.wikipedia.org/wiki/Blocks_(C_language_extension) }
+    msISOLikeIO,           { I/O as it required by an ISO compatible compiler }
+    msISOLikeProgramsPara, { program parameters as it required by an ISO compatible compiler }
+    msISOLikeMod           { mod operation as it is required by an iso compatible compiler }
+  );
+  TModeSwitches = Set of TModeSwitch;
+
   { TMacroDef }
 
   TMacroDef = Class(TObject)
@@ -326,13 +377,13 @@ type
   TPascalScannerPPSkipMode = (ppSkipNone, ppSkipIfBranch, ppSkipElseBranch, ppSkipAll);
 
   TPOption = (
-    po_delphi, // Delphi mode: forbid nested comments
-    po_cassignments,  // allow C-operators += -= *= /=
+    po_delphi,               // DEPRECATED 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_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
+    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;
 
@@ -351,6 +402,8 @@ type
 
   TPascalScanner = class
   private
+    FCurrentModeSwitches: TModeSwitches;
+    FForceCaret: Boolean;
     FLastMsg: string;
     FLastMsgArgs: TMessageArgs;
     FLastMsgNumber: integer;
@@ -368,6 +421,7 @@ type
     FOptions: TPOptions;
     FLogEvents: TPScannerLogEvents;
     FOnLog: TPScannerLogHandler;
+    FPreviousToken: TToken;
     FSkipComments: Boolean;
     FSkipWhiteSpace: Boolean;
     TokenStr: PChar;
@@ -379,7 +433,6 @@ type
     PPSkipStackIndex: Integer;
     PPSkipModeStack: array[0..255] of TPascalScannerPPSkipMode;
     PPIsSkippingStack: array[0..255] of Boolean;
-
     function GetCurColumn: Integer;
     procedure SetOptions(AValue: TPOptions);
   protected
@@ -402,6 +455,7 @@ type
     procedure HandleUnDefine(Param: String);virtual;
     function HandleInclude(const Param: String): TToken;virtual;
     procedure HandleMode(const Param: String);virtual;
+    procedure HandleModeSwitch(const Param: String);virtual;
     function HandleMacro(AIndex: integer): TToken;virtual;
     procedure PushStackItem; virtual;
     function DoFetchTextToken: TToken;
@@ -415,10 +469,12 @@ type
     destructor Destroy; override;
     procedure OpenFile(const AFilename: string);
     function FetchToken: TToken;
-    function ReadNonPascalTilEndToken(StopAtLineEnd: boolean): TToken;
+    function ReadNonPascalTillEndToken(StopAtLineEnd: boolean): TToken;
     Procedure AddDefine(S : String);
     Procedure RemoveDefine(S : String);
+    Procedure SetCompilerMode(S : String);
     function CurSourcePos: TPasSourcePos;
+    Function SetForceCaret(AValue : Boolean) : Boolean;
 
     property FileResolver: TBaseFileResolver read FFileResolver;
     property CurSourceFile: TLineReader read FCurSourceFile;
@@ -431,6 +487,7 @@ type
 
     property CurToken: TToken read FCurToken;
     property CurTokenString: string read FCurTokenString;
+    Property PreviousToken : TToken Read FPreviousToken;
 
     property Defines: TStrings read FDefines;
     property Macros: TStrings read FMacros;
@@ -443,6 +500,8 @@ type
     property LastMsgType: TMessageType read FLastMsgType write FLastMsgType;
     property LastMsgPattern: string read FLastMsgPattern write FLastMsgPattern;
     property LastMsgArgs: TMessageArgs read FLastMsgArgs write FLastMsgArgs;
+    Property CurrentModeSwitches : TModeSwitches Read FCurrentModeSwitches Write FCurrentModeSwitches;
+    Property ForceCaret : Boolean Read FForceCaret;
   end;
 
 const
@@ -562,6 +621,77 @@ const
     'Tab'
   );
 
+  SModeSwitchNames : array[TModeSwitch] of string[18] =
+  ( '', '','','','','','','', '',
+    { more specific }
+    'CLASS',
+    'OBJPAS',
+    'RESULT',
+    'PCHARTOSTRING',
+    'CVAR',
+    'NESTEDCOMMENTS',
+    'CLASSICPROCVARS',
+    'MACPROCVARS',
+    'REPEATFORWARD',
+    'POINTERTOPROCVAR',
+    'AUTODEREF',
+    'INITFINAL',
+    'ANSISTRINGS',
+    'OUT',
+    'DEFAULTPARAMETERS',
+    'HINTDIRECTIVE',
+    'DUPLICATELOCALS',
+    'PROPERTIES',
+    'ALLOWINLINE',
+    'EXCEPTIONS',
+    'OBJECTIVEC1',
+    'OBJECTIVEC2',
+    'NESTEDPROCVARS',
+    'NONLOCALGOTO',
+    'ADVANCEDRECORDS',
+    'ISOUNARYMINUS',
+    'SYSTEMCODEPAGE',
+    'FINALFIELDS',
+    'UNICODESTRINGS',
+    'TYPEHELPERS',
+    'CBLOCKS',
+    'ISOIO',
+    'ISOPROGRAMPARAS',
+    'ISOMOD'
+    );
+
+const
+  AllLanguageModes = [msFPC,msObjFPC,msDelphi,msTP7,msMac,msISO,msExtPas];
+
+const
+
+  DelphiModeSwitches = [msDelphi,msClass,msObjpas,msresult,msstringpchar,
+     mspointer2procedure,msautoderef,msTPprocvar,msinitfinal,msdefaultansistring,
+     msout,msdefaultpara,msduplicatenames,mshintdirective,
+     msproperty,msdefaultinline,msexcept,msadvancedrecords,mstypehelpers];
+
+  DelphiUnicodeModeSwitches = delphimodeswitches + [mssystemcodepage,msdefaultunicodestring];
+
+  FPCModeSwitches = [msfpc,msstringpchar,msnestedcomment,msrepeatforward,
+    mscvarsupport,msinitfinal,mshintdirective, msproperty,msdefaultinline];
+
+  OBJFPCModeSwitches =  [msobjfpc,msfpc,msclass,msobjpas,msresult,msstringpchar,msnestedcomment,
+    msrepeatforward,mscvarsupport,msinitfinal,msout,msdefaultpara,mshintdirective,
+    msproperty,msdefaultinline,msexcept];
+
+  TPModeSwitches = [mstp7,mstpprocvar,msduplicatenames];
+
+  GPCModeSwitches = [msgpc,mstpprocvar];
+
+  MacModeSwitches = [msmac,mscvarsupport,msmacprocvar,msnestedprocvars,msnonlocalgoto,
+    msisolikeunaryminus,msdefaultinline];
+
+  ISOModeSwitches =  [msiso,mstpprocvar,msduplicatenames,msnestedprocvars,msnonlocalgoto,msisolikeunaryminus,msisolikeio,
+    msisolikeprogramspara, msisolikemod];
+
+  ExtPasModeSwitches = [msextpas,mstpprocvar,msduplicatenames,msnestedprocvars,msnonlocalgoto,msisolikeunaryminus,msisolikeio,
+    msisolikeprogramspara, msisolikemod];
+
 function FilenameIsAbsolute(const TheFilename: string):boolean;
 function FilenameIsWinAbsolute(const TheFilename: string): boolean;
 function FilenameIsUnixAbsolute(const TheFilename: string): boolean;
@@ -1081,6 +1211,7 @@ begin
   FIncludeStack := TFPList.Create;
   FDefines := CS;
   FMacros:=CS;
+  FCurrentModeSwitches:=FPCModeSwitches;
 end;
 
 destructor TPascalScanner.Destroy;
@@ -1136,6 +1267,7 @@ function TPascalScanner.FetchToken: TToken;
 var
   IncludeStackItem: TIncludeStackItem;
 begin
+  FPreviousToken:=FCurToken;
   while true do
   begin
     Result := DoFetchToken;
@@ -1176,7 +1308,7 @@ begin
 //  Writeln(Result, '(',CurTokenString,')');
 end;
 
-function TPascalScanner.ReadNonPascalTilEndToken(StopAtLineEnd: boolean
+function TPascalScanner.ReadNonPascalTillEndToken(StopAtLineEnd: boolean
   ): TToken;
 var
   StartPos: PChar;
@@ -1277,9 +1409,16 @@ begin
   OldLength:=0;
   FCurTokenString := '';
 
-  while TokenStr[0] in ['#', ''''] do
-  begin
+  repeat
     case TokenStr[0] of
+      '^' :
+        begin
+        TokenStart := TokenStr;
+        Inc(TokenStr);
+        if TokenStr[0] in ['a'..'z','A'..'Z'] then
+          Inc(TokenStr);
+        if Result=tkEOF then Result := tkChar else Result:=tkString;
+        end;
       '#':
         begin
           TokenStart := TokenStr;
@@ -1315,7 +1454,10 @@ begin
             Inc(TokenStr);
           end;
           Inc(TokenStr);
-          Result := tkString;
+          if ((TokenStr - TokenStart)=3) then // 'z'
+            Result := tkChar
+          else
+            Result := tkString;
         end;
     else
       Break;
@@ -1325,8 +1467,7 @@ begin
     if SectionLength > 0 then
       Move(TokenStart^, FCurTokenString[OldLength + 1], SectionLength);
     Inc(OldLength, SectionLength);
-  end;
-
+  until false;
 end;
 
 procedure TPascalScanner.PushStackItem;
@@ -1452,10 +1593,82 @@ 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]
+  Case P of
+  'DELPHI':
+     begin
+     CurrentModeSwitches:=delphimodeswitches;
+     FOptions:=FOptions+[po_delphi]
+     end;
+  'DELPHIUNICODE':
+     begin
+     CurrentModeSwitches:=DelphiUnicodeModeSwitches;
+     FOptions:=FOptions+[po_delphi]
+     end;
+  'TP':
+     begin
+     CurrentModeSwitches:=TPModeSwitches;
+     FOptions:=FOptions-[po_delphi]
+     end;
+  'GPC':
+     begin
+     CurrentModeSwitches:=GPCModeSwitches;
+     FOptions:=FOptions-[po_delphi]
+     end;
+  'ISO':
+     begin
+     CurrentModeSwitches:=ISOModeSwitches;
+     FOptions:=FOptions-[po_delphi]
+     end;
+  'EXTENDED':
+     begin
+     CurrentModeSwitches:=ExtPasModeSwitches;
+     FOptions:=FOptions-[po_delphi]
+     end;
+  'MACPAS':
+     begin
+     CurrentModeSwitches:=MacModeSwitches;
+     FOptions:=FOptions-[po_delphi]
+     end;
+  'OBJFPC':
+    begin
+    CurrentModeSwitches:=ObjFPCModeSwitches;
+    FOptions:=FOptions+[po_delphi]
+    end;
+  'FPC',
+  'DEFAULT':
+    begin
+      CurrentModeSwitches:=FPCModeSwitches;
+      FOptions:=FOptions-[po_delphi]
+    end;
   else
-    Options:=Options-[po_delphi]
+    Error(nErrInvalidMode,SErrInvalidMode,[Param])
+  end;
+end;
+
+procedure TPascalScanner.HandleModeSwitch(const Param: String);
+
+Var
+  MS : TModeSwitch;
+  MSN,PM : String;
+  P : Integer;
+
+begin
+  MSN:=Uppercase(Param);
+  MS:=High(TModeSwitch);
+  P:=Pos(' ',MSN);
+  if P<>0 then
+    begin
+    PM:=Trim(Copy(MSN,P+1,Length(MSN)-P));
+    MSN:=Copy(MSN,1,P-1);
+    end;
+  While (MS<>msNone) and (SModeSwitchNames[MS]<>MSN) do
+   MS:=Pred(MS);
+  if MS=msNone then
+    Error(nErrInvalidModeSwitch,SErrInvalidModeSwitch,[Param]);
+  if (PM='') or (PM='+') or (PM='ON') then
+    CurrentModeSwitches:=CurrentModeSwitches+[MS]
+  else
+    CurrentModeSwitches:=CurrentModeSwitches-[MS];
 end;
 
 Procedure TPascalScanner.PushSkipMode;
@@ -1568,8 +1781,9 @@ end;
 Procedure TPascalScanner.HandleELSE(Const AParam : String);
 
 begin
+  if AParam='' then;
   if PPSkipStackIndex = 0 then
-     Error(nErrInvalidPPElse,sErrInvalidPPElse);
+    Error(nErrInvalidPPElse,sErrInvalidPPElse);
   if PPSkipMode = ppSkipIfBranch then
     PPIsSkipping := false
   else if PPSkipMode = ppSkipElseBranch then
@@ -1580,6 +1794,7 @@ end;
 Procedure TPascalScanner.HandleENDIF(Const AParam : String);
 
 begin
+  if AParam='' then;
   if PPSkipStackIndex = 0 then
     Error(nErrInvalidPPEndif,sErrInvalidPPEndif);
   Dec(PPSkipStackIndex);
@@ -1612,6 +1827,9 @@ begin
   'MODE':
      if not PPIsSkipping then
       HandleMode(Param);
+  'MODESWITCH':
+     if not PPIsSkipping then
+      HandleModeSwitch(Param);
   'DEFINE':
      if not PPIsSkipping then
        HandleDefine(Param);
@@ -1641,6 +1859,7 @@ var
   i: TToken;
   OldLength, SectionLength, NestingLevel, Index: Integer;
 begin
+  result:=tkLineEnding;
   if TokenStr = nil then
     if not FetchLine then
     begin
@@ -1968,8 +2187,14 @@ begin
       end;
     '^':
       begin
+      if ForceCaret or PPisSkipping or
+         (PreviousToken in [tkeof,tkComment,tkIdentifier,tkNil,tkOperator,tkBraceClose,tkSquaredBraceClose,tkCARET]) then
+        begin
         Inc(TokenStr);
         Result := tkCaret;
+        end
+      else
+        Result:=DoFetchTextToken;
       end;
     '\':
       begin
@@ -2003,9 +2228,9 @@ begin
             TokenStart := TokenStr;
           end else
           begin
-            if not(po_delphi in Options) and (TokenStr[0] = '{') then
+            if (msNestedComment in CurrentModeSwitches) and (TokenStr[0] = '{') then
               Inc(NestingLevel)
-            else if TokenStr[0] = '}' then
+            else if (TokenStr[0] = '}') and not PPIsSkipping then
               Dec(NestingLevel);
             Inc(TokenStr);
           end;
@@ -2084,9 +2309,20 @@ begin
 end;
 
 procedure TPascalScanner.SetOptions(AValue: TPOptions);
+
+Var
+  isModeSwitch : Boolean;
+
 begin
   if FOptions=AValue then Exit;
+  // Change of mode ?
+  IsModeSwitch:=(po_delphi in Avalue) <> (po_delphi in FOptions);
   FOptions:=AValue;
+  if isModeSwitch then
+    if (po_delphi in FOptions) then
+      CurrentModeSwitches:=DelphiModeSwitches
+    else
+      CurrentModeSwitches:=FPCModeSwitches
 end;
 
 function TPascalScanner.FetchLine: boolean;
@@ -2135,6 +2371,11 @@ begin
     FDefines.Delete(I);
 end;
 
+procedure TPascalScanner.SetCompilerMode(S: String);
+begin
+  HandleMode(S);
+end;
+
 function TPascalScanner.CurSourcePos: TPasSourcePos;
 begin
   Result.FileName:=CurFilename;
@@ -2142,4 +2383,12 @@ begin
   Result.Column:=CurColumn;
 end;
 
+Function TPascalScanner.SetForceCaret (AValue : Boolean): Boolean;
+
+begin
+  Result:=FForceCaret;
+  FForceCaret:=AValue;
+end;
+
+
 end.

packages/fcl-passrc/tests/tcclasstype.pas

@@ -37,6 +37,7 @@ type
     Procedure EndClass(AEnd : String = 'end');
     Procedure AddMember(S : String);
     Procedure ParseClass;
+    Procedure ParseClassFail(Msg: string; MsgNumber: integer);
     Procedure DoParseClass(FromSpecial : Boolean = False);
     procedure SetUp; override;
     procedure TearDown; override;
@@ -92,6 +93,7 @@ type
     procedure TestHintFieldUninmplemented;
     Procedure TestMethodSimple;
     Procedure TestMethodSimpleComment;
+    Procedure TestMethodWithDotFails;
     Procedure TestClassMethodSimple;
     Procedure TestClassMethodSimpleComment;
     Procedure TestConstructor;
@@ -149,8 +151,11 @@ type
     procedure TestInterfaceDisp;
     procedure TestInterfaceParentedEmpty;
     procedure TestInterfaceOneMethod;
+    procedure TestInterfaceDispIDMethod;
+    procedure TestInterfaceDispIDMethod2;
     procedure TestInterfaceProperty;
     procedure TestInterfaceDispProperty;
+    procedure TestInterfaceDispPropertyReadOnly;
     procedure TestInterfaceNoConstructor;
     procedure TestInterfaceNoDestructor;
     procedure TestInterfaceNoFields;
@@ -326,6 +331,23 @@ begin
   DoParseClass(False);
 end;
 
+procedure TTestClassType.ParseClassFail(Msg: string; MsgNumber: integer);
+var
+  ok: Boolean;
+begin
+  ok:=false;
+  try
+    ParseClass;
+  except
+    on E: EParserError do
+      begin
+      AssertEquals('Expected {'+Msg+'}, but got msg {'+Parser.LastMsg+'}',MsgNumber,Parser.LastMsgNumber);
+      ok:=true;
+      end;
+  end;
+  AssertEquals('Missing parser error {'+Msg+'} ('+IntToStr(MsgNumber)+')',true,ok);
+end;
+
 procedure TTestClassType.DoParseClass(FromSpecial: Boolean);
 begin
   EndClass;
@@ -360,7 +382,6 @@ begin
     AssertNull('No helperfortype if not helper',TheClass.HelperForType);
   if TheClass.Members.Count>0 then
     FMember1:=TObject(TheClass.Members[0]) as TPaselement;
-
 end;
 
 procedure TTestClassType.SetUp;
@@ -406,6 +427,7 @@ procedure TTestClassType.AssertProperty(P: TPasProperty;
   AVisibility: TPasMemberVisibility; AName, ARead, AWrite, AStored,
   AImplements: String; AArgCount: Integer; ADefault, ANodefault: Boolean);
 begin
+  AssertEquals('Property Name',AName,P.Name);
   AssertEquals(P.Name+': Visibility',AVisibility,P.Visibility);
   Assertequals(P.Name+': No args',AArgCount,P.Args.Count);
   Assertequals(P.Name+': Read accessor',ARead,P.ReadAccessorName);
@@ -765,6 +787,12 @@ begin
   AssertEquals('Comment','c'+sLineBreak,Method1.DocComment);
 end;
 
+procedure TTestClassType.TestMethodWithDotFails;
+begin
+  AddMember('Procedure DoSomething.Stupid');
+  ParseClassFail('Expected ";"',nParserExpectTokenError);
+end;
+
 procedure TTestClassType.TestClassMethodSimple;
 begin
   AddMember('Class Procedure DoSomething');
@@ -1039,7 +1067,7 @@ begin
   ParseClass;
   DefaultMethod;
   AssertEquals('Default visibility',visDefault,Method1.Visibility);
-  AssertEquals('No modifiers',[pmMessage],Method1.Modifiers);
+  AssertEquals('message modifier',[pmMessage],Method1.Modifiers);
   AssertEquals('Default calling convention',ccDefault, Method1.ProcType.CallingConvention);
   AssertEquals('Message name','123',Method1.MessageName);
 end;
@@ -1050,7 +1078,7 @@ begin
   ParseClass;
   DefaultMethod;
   AssertEquals('Default visibility',visDefault,Method1.Visibility);
-  AssertEquals('No modifiers',[pmMessage],Method1.Modifiers);
+  AssertEquals('message modifiers',[pmMessage],Method1.Modifiers);
   AssertEquals('Default calling convention',ccDefault, Method1.ProcType.CallingConvention);
   AssertEquals('Message name','''aha''',Method1.MessageName);
 end;
@@ -1609,6 +1637,31 @@ begin
   AssertNull('No UUID',TheClass.GUIDExpr);
 end;
 
+procedure TTestClassType.TestInterfaceDispIDMethod;
+
+begin
+  StartInterface('IInterface','');
+  AddMember('Procedure DoSomething(A : Integer) dispid 12');
+  ParseClass;
+  DefaultMethod;
+  AssertEquals('Default visibility',visDefault,Method1.Visibility);
+  AssertEquals('dispid modifier',[pmDispID],Method1.Modifiers);
+  AssertNotNull('dispid expression',Method1.DispIDExpr);
+  AssertEquals('Default calling convention',ccDefault, Method1.ProcType.CallingConvention);
+end;
+
+procedure TTestClassType.TestInterfaceDispIDMethod2;
+begin
+  StartInterface('IInterface','');
+  AddMember('Procedure DoSomething(A : Integer); dispid 12');
+  ParseClass;
+  DefaultMethod;
+  AssertEquals('Default visibility',visDefault,Method1.Visibility);
+  AssertEquals('dispid modifier',[pmDispID],Method1.Modifiers);
+  AssertNotNull('dispid expression',Method1.DispIDExpr);
+  AssertEquals('Default calling convention',ccDefault, Method1.ProcType.CallingConvention);
+end;
+
 procedure TTestClassType.TestInterfaceProperty;
 begin
   StartInterface('IInterface','');
@@ -1647,6 +1700,23 @@ begin
   AssertEquals('Have number','1', (Property1.DispIDExpr as TPrimitiveExpr).Value);
 end;
 
+procedure TTestClassType.TestInterfaceDispPropertyReadOnly;
+begin
+  StartInterface('IInterface','',True);
+  AddMember('Property S : Integer readonly 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);
+  AssertTrue('DispID property is readonly',Property1.DispIDReadOnly);
+  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/tconstparser.pas

@@ -77,6 +77,8 @@ Type
     Procedure TestTypedExprConst;
     Procedure TestRecordConst;
     Procedure TestArrayConst;
+    Procedure TestRangeConst;
+    Procedure TestArrayOfRangeConst;
   end;
 
   { TTestResourcestringParser }
@@ -508,6 +510,28 @@ begin
   AssertExpression('Element 2 value',R.Values[1],pekNumber,'2');
 end;
 
+procedure TTestConstParser.TestRangeConst;
+begin
+  Typed:='0..1';
+  ParseConst('1');
+  AssertEquals('Range type',TPasRangeType,TheConst.VarType.ClassType);
+  AssertExpression('Float const', TheExpr,pekNumber,'1');
+end;
+
+procedure TTestConstParser.TestArrayOfRangeConst;
+Var
+  R : TArrayValues;
+begin
+  Typed:='array [0..7] of 0..1';
+  ParseConst('(0, 0, 0, 0, 0, 0, 0, 0)');
+  AssertEquals('Array Values',TArrayValues,TheExpr.ClassType);
+  R:=TheExpr as TArrayValues;
+  AssertEquals('Expression list of ',pekListOfExp,TheExpr.Kind);
+  AssertEquals('elements',8,Length(R.Values));
+//  AssertEquals('Range type',TPasRangeType,TheConst.VarType.ClassType);
+//  AssertExpression('Float const', TheExpr,pekNumber,'1');
+end;
+
 { TTestResourcestringParser }
 
 function TTestResourcestringParser.ParseResourcestring(ASource: String

packages/fcl-passrc/tests/tcprocfunc.pas

@@ -132,6 +132,7 @@ type
     Procedure TestProcedureCdeclForward;
     Procedure TestFunctionCDeclForward;
     Procedure TestProcedureCompilerProc;
+    Procedure TestProcedureNoReturn;
     Procedure TestFunctionCompilerProc;
     Procedure TestProcedureCDeclCompilerProc;
     Procedure TestFunctionCDeclCompilerProc;
@@ -152,6 +153,7 @@ type
     Procedure TestProcedureExternalName;
     Procedure TestFunctionExternalName;
     Procedure TestProcedureCdeclExternal;
+    Procedure TestProcedureAlias;
     Procedure TestFunctionCdeclExternal;
     Procedure TestProcedureCdeclExternalLibName;
     Procedure TestFunctionCdeclExternalLibName;
@@ -159,6 +161,7 @@ type
     Procedure TestFunctionCdeclExternalLibNameName;
     Procedure TestProcedureCdeclExternalName;
     Procedure TestFunctionCdeclExternalName;
+    Procedure TestFunctionAlias;
     Procedure TestOperatorTokens;
     procedure TestOperatorNames;
     Procedure TestFunctionNoResult;
@@ -959,6 +962,12 @@ begin
   AssertProc([pmCompilerProc],ccDefault,0);
 end;
 
+procedure TTestProcedureFunction.TestProcedureNoReturn;
+begin
+  ParseProcedure(';noreturn;','');
+  AssertProc([pmnoreturn],ccDefault,0);
+end;
+
 procedure TTestProcedureFunction.TestFunctionCompilerProc;
 begin
   AddDeclaration('function A : Integer; compilerproc');
@@ -1159,6 +1168,22 @@ begin
   AssertExpression('Library symbol expression',Func.LibrarySymbolName,pekString,'''symbolname''');
 end;
 
+procedure TTestProcedureFunction.TestFunctionAlias;
+begin
+  AddDeclaration('function A : Integer; alias: ''myalias''');
+  ParseFunction;
+  AssertFunc([],ccDefault,0);
+  AssertEquals('Alias name','''myalias''',Func.AliasName);
+end;
+
+procedure TTestProcedureFunction.TestProcedureAlias;
+begin
+  AddDeclaration('Procedure A; Alias : ''myalias''');
+  ParseProcedure;
+  AssertProc([],ccDefault,0);
+  AssertEquals('Alias name','''myalias''',Proc.AliasName);
+end;
+
 procedure TTestProcedureFunction.TestOperatorTokens;
 
 Var

packages/fcl-passrc/tests/tcscanner.pas

@@ -60,6 +60,8 @@ type
     procedure TearDown; override;
     Function TokenToString(tk : TToken) : string;
     Procedure AssertEquals(Msg : String; Expected,Actual : TToken); overload;
+    Procedure AssertEquals(Msg : String; Expected,Actual : TModeSwitch); overload;
+    Procedure AssertEquals(Msg : String; Expected,Actual : TModeSwitches); overload;
     procedure NewSource(Const Source : string; DoClear : Boolean = True);
     Procedure DoTestToken(t : TToken; Const ASource : String; Const CheckEOF : Boolean = True);
     Procedure TestToken(t : TToken; Const ASource : String; Const CheckEOF : Boolean = True);
@@ -67,6 +69,7 @@ type
     Property LastIDentifier : String Read FLI Write FLi;
     Property Scanner : TPascalScanner Read FScanner;
   published
+    Procedure TestEmpty;
     procedure TestEOF;
     procedure TestWhitespace;
     procedure TestComment1;
@@ -82,6 +85,7 @@ type
     procedure TestString;
     procedure TestNumber;
     procedure TestChar;
+    procedure TestCharString;
     procedure TestBraceOpen;
     procedure TestBraceClose;
     procedure TestMul;
@@ -209,6 +213,7 @@ type
     Procedure TestDefine11;
     Procedure TestDefine12;
     Procedure TestDefine13;
+    Procedure TestDefine14;
     Procedure TestInclude;
     Procedure TestInclude2;
     Procedure TestUnDefine1;
@@ -216,6 +221,7 @@ type
     procedure TestMacro2;
     procedure TestMacro3;
     procedure TestMacroHandling;
+    Procedure TestModeSwitch;
   end;
 
 implementation
@@ -364,12 +370,40 @@ begin
   AssertEquals(Msg,TokenToString(Expected),TokenToString(Actual));
 end;
 
+procedure TTestScanner.AssertEquals(Msg: String; Expected, Actual: TModeSwitch);
+begin
+  AssertEquals(Msg,GetEnumName(TypeInfo(TModeSwitch),Ord(Expected)),
+                   GetEnumName(TypeInfo(TModeSwitch),Ord(Actual)))
+end;
+
+procedure TTestScanner.AssertEquals(Msg: String; Expected, Actual: TModeSwitches);
+
+  Function ToString(S : TModeSwitches) : String;
+
+  Var
+    M : TModeSwitch;
+
+  begin
+    Result:='';
+    For M in TModeswitch do
+      if M in S then
+        begin
+        If (Result<>'') then
+          Result:=Result+', ';
+        Result:=Result+GetEnumName(TypeInfo(TModeSwitch), Ord(M));
+        end;
+  end;
+
+begin
+  AssertEquals(Msg,ToString(Expected),ToString(Actual));
+end;
+
 procedure TTestScanner.NewSource(const Source: string; DoClear : Boolean = True);
 begin
   if DoClear then
     FResolver.Clear;
   FResolver.AddStream('afile.pp',TStringStream.Create(Source));
-  Writeln('// TestName');
+  Writeln('// '+TestName);
   Writeln(Source);
   FScanner.OpenFile('afile.pp');
 end;
@@ -433,6 +467,13 @@ begin
     end;
 end;
 
+procedure TTestScanner.TestEmpty;
+begin
+  AssertNotNull('Have Scanner',Scanner);
+  AssertTrue('Options is empty',[]=Scanner.Options);
+  AssertEquals('FPC modes is default',FPCModeSwitches,Scanner.CurrentModeSwitches);
+end;
+
 procedure TTestScanner.TestEOF;
 begin
   TestToken(tkEOF,'')
@@ -514,6 +555,11 @@ begin
   TestToken(pscanner.tkString,'''A string''');
 end;
 
+procedure TTestScanner.TestCharString;
+
+begin
+  TestToken(pscanner.tkChar,'''A''');
+end;
 
 procedure TTestScanner.TestNumber;
 
@@ -1396,6 +1442,26 @@ begin
   TestTokens([tkin],'{$IFDEF ALWAYS} }; ą è {$ELSE} in {$ENDIF}');
 end;
 
+procedure TTestScanner.TestDefine14;
+Const
+   Source = '{$ifdef NEVER_DEFINED}' +sLineBreak+
+            'type'+sLineBreak+
+            '  TNPEventModel = ('+sLineBreak+
+            '  NPEventModelCarbon = 0,'+sLineBreak+
+            '  NPEventModelCocoa = 1'+sLineBreak+
+            '}; // yes, this is an error... except this code should never be included.'+sLineBreak+
+            'ą'+sLineBreak+
+            '|'+sLineBreak+
+            '{$endif}'+sLineBreak+
+            ''+sLineBreak+
+            'begin'+sLineBreak+
+            'end.'+sLineBreak;
+begin
+  NewSource(Source,True);
+  While FScanner.fetchToken<>tkEOF do
+
+end;
+
 procedure TTestScanner.TestInclude;
 begin
   FResolver.AddStream('myinclude.inc',TStringStream.Create('if true then'));
@@ -1449,6 +1515,29 @@ begin
   AssertEQuals('Correct identifier', 'somethingweird',LastIdentifier);
 end;
 
+procedure TTestScanner.TestModeSwitch;
+
+Const
+   PlusMinus = [' ','+','-'];
+
+Var
+  M : TModeSwitch;
+  C : Char;
+begin
+  For M in TModeSwitch do
+    for C in PlusMinus do
+      if SModeSwitchNames[M]<>'' then
+        begin
+        Scanner.CurrentModeSwitches:=[];
+        NewSource('{$MODESWITCH '+SModeSwitchNames[M]+' '+C+'}');
+        While not (Scanner.FetchToken=tkEOF) do;
+        if C in [' ','+'] then
+          AssertTrue(SModeSwitchNames[M]+C+' sets '+GetEnumName(TypeInfo(TModeSwitch),Ord(M)),M in Scanner.CurrentModeSwitches)
+        else
+          AssertFalse(SModeSwitchNames[M]+C+' removes '+GetEnumName(TypeInfo(TModeSwitch),Ord(M)),M in Scanner.CurrentModeSwitches);
+        end;
+end;
+
 initialization
   RegisterTests([TTestTokenFinder,TTestStreamLineReader,TTestScanner]);
 end.

packages/fcl-passrc/tests/tcstatements.pas

@@ -63,6 +63,9 @@ Type
     Procedure TestIfElse;
     Procedure TestIfElseBlock;
     Procedure TestIfSemiColonElseError;
+    procedure TestIfforElseBlock;
+    procedure TestIfRaiseElseBlock;
+    procedure TestIfWithBlock;
     Procedure TestNestedIf;
     Procedure TestNestedIfElse;
     Procedure TestWhile;
@@ -93,6 +96,7 @@ Type
     Procedure TestCaseElseBlock2Assignments;
     Procedure TestCaseIfCaseElse;
     Procedure TestCaseIfElse;
+    Procedure TestCaseElseNoSemicolon;
     Procedure TestRaise;
     Procedure TestRaiseEmpty;
     Procedure TestRaiseAt;
@@ -583,6 +587,41 @@ begin
   AssertEquals('begin end block',TPasImplBeginBlock,I.ElseBranch.ClassType);
 end;
 
+procedure TTestStatementParser.TestIfforElseBlock;
+
+Var
+  I : TPasImplIfElse;
+
+begin
+  TestStatement(['if a then','for X := 1 downto 0 do Writeln(X)','else', 'for X := 0 to 1 do Writeln(X)']);
+  I:=AssertStatement('If statement',TPasImplIfElse) as TPasImplIfElse;
+  AssertExpression('IF condition',I.ConditionExpr,pekIdent,'a');
+  AssertEquals('For statement',TPasImplForLoop,I.ifBranch.ClassType);
+  AssertEquals('For statement',TPasImplForLoop,I.ElseBranch.ClassType);
+end;
+
+procedure TTestStatementParser.TestIfRaiseElseBlock;
+Var
+  I : TPasImplIfElse;
+begin
+  TestStatement(['if a then','raise','else', 'for X := 0 to 1 do Writeln(X)']);
+  I:=AssertStatement('If statement',TPasImplIfElse) as TPasImplIfElse;
+  AssertExpression('IF condition',I.ConditionExpr,pekIdent,'a');
+  AssertEquals('For statement',TPasImplRaise,I.ifBranch.ClassType);
+  AssertEquals('For statement',TPasImplForLoop,I.ElseBranch.ClassType);
+end;
+
+procedure TTestStatementParser.TestIfWithBlock;
+Var
+  I : TPasImplIfElse;
+begin
+  TestStatement(['if a then','with b do something','else', 'for X := 0 to 1 do Writeln(X)']);
+  I:=AssertStatement('If statement',TPasImplIfElse) as TPasImplIfElse;
+  AssertExpression('IF condition',I.ConditionExpr,pekIdent,'a');
+  AssertEquals('For statement',TPasImplWithDo,I.ifBranch.ClassType);
+  AssertEquals('For statement',TPasImplForLoop,I.ElseBranch.ClassType);
+end;
+
 procedure TTestStatementParser.TestIfSemiColonElseError;
 
 begin
@@ -1168,6 +1207,29 @@ begin
   AssertNotNull('If statement has else block',TPasImplIfElse(S.Elements[0]).ElseBranch);
 end;
 
+procedure TTestStatementParser.TestCaseElseNoSemicolon;
+Var
+  C : TPasImplCaseOf;
+  S : TPasImplCaseStatement;
+begin
+  DeclareVar('integer');
+  TestStatement(['case a of','1 : dosomething;','2 : dosomethingmore','else','a:=1;','end;']);
+  C:=AssertStatement('Case statement',TpasImplCaseOf) as TpasImplCaseOf;
+  AssertNotNull('Have case expression',C.CaseExpr);
+  AssertExpression('Case expression',C.CaseExpr,pekIdent,'a');
+  AssertEquals('case label count',3,C.Elements.Count);
+  S:=TPasImplCaseStatement(C.Elements[0]);
+  AssertEquals('case 1',1,S.Expressions.Count);
+  AssertExpression('Case With identifier 1',TPasExpr(S.Expressions[0]),pekNumber,'1');
+  S:=TPasImplCaseStatement(C.Elements[1]);
+  AssertEquals('case 2',1,S.Expressions.Count);
+  AssertExpression('Case With identifier 1',TPasExpr(S.Expressions[0]),pekNumber,'2');
+  AssertEquals('third is else',TPasImplCaseElse,TObject(C.Elements[2]).ClassType);
+  AssertNotNull('Have else branch',C.ElseBranch);
+  AssertEquals('Correct else branch class',TPasImplCaseElse,C.ElseBranch.ClassType);
+  AssertEquals('1 statements in else branch ',1,TPasImplCaseElse(C.ElseBranch).Elements.Count);
+end;
+
 procedure TTestStatementParser.TestRaise;
 
 Var

packages/fcl-passrc/tests/tctypeparser.pas

@@ -43,7 +43,7 @@ type
     Procedure DoParseEnumerated(Const ASource : String; Const AHint : String; ACount : integer);
     Procedure DoTestFileType(Const AType : String; Const AHint : String; ADestType : TClass = Nil);
     Procedure DoTestRangeType(Const AStart,AStop,AHint : String);
-    Procedure DoParseSimpleSet(Const ASource : String; Const AHint : String);
+    Procedure DoParseSimpleSet(Const ASource : String; Const AHint : String; IsPacked : Boolean = False);
     Procedure DoParseComplexSet(Const ASource : String; Const AHint : String);
     procedure DoParseRangeSet(const ASource: String; const AHint: String);
     Procedure DoTestComplexSet;
@@ -129,6 +129,7 @@ type
     Procedure TestFileTypePlatform;
     Procedure TestRangeType;
     Procedure TestCharRangeType;
+    Procedure TestCharRangeType2;
     Procedure TestRangeTypeDeprecated;
     Procedure TestRangeTypePlatform;
     Procedure TestIdentifierRangeType;
@@ -136,6 +137,7 @@ type
     Procedure TestIdentifierRangeTypePlatform;
     Procedure TestNegativeIdentifierRangeType;
     Procedure TestSimpleSet;
+    Procedure TestPackedSet;
     Procedure TestSimpleSetDeprecated;
     Procedure TestSimpleSetPlatform;
     Procedure TestComplexSet;
@@ -234,6 +236,7 @@ type
     Procedure TestOnePlatformFieldDeprecated;
     Procedure TestOnePlatformFieldPlatform;
     Procedure TestOneConstOneField;
+    Procedure TestOneGenericField;
     Procedure TestTwoFields;
     procedure TestTwoFieldProtected;
     procedure TestTwoFieldStrictPrivate;
@@ -1776,6 +1779,16 @@ begin
   AssertField2([]);
 end;
 
+procedure TTestRecordTypeParser.TestOneGenericField;
+begin
+  TestFields(['Generic : Integer;'],'',False);
+  AssertEquals('Member 1 field type',TPasVariable,TObject(TheRecord.Members[0]).ClassType);
+  AssertEquals('Field 1 name','Generic',Field1.Name);
+  AssertNotNull('Have 1 Field type',Field1.VarType);
+  AssertEquals('Field 1 type',TPasUnresolvedTypeRef,Field1.VarType.ClassType);
+  AssertEquals('Field 1 type name','Integer',Field1.VarType.Name);
+end;
+
 procedure TTestRecordTypeParser.TestTwoFields;
 begin
   TestFields(['x : integer;','y : integer'],'',False);
@@ -2507,12 +2520,15 @@ begin
   AssertEquals('Range start',AStop,Stringreplace(TPasRangeType(TheType).RangeEnd,' ','',[rfReplaceAll]));
 end;
 
-procedure TTestTypeParser.DoParseSimpleSet(const ASource: String;
-  const AHint: String);
+procedure TTestTypeParser.DoParseSimpleSet(const ASource: String; const AHint: String; IsPacked: Boolean);
 begin
-  ParseType('Set of '+ASource,TPasSetType,AHint);
+  if IsPacked then
+    ParseType('Packed Set of '+ASource,TPasSetType,AHint)
+  else
+    ParseType('Set of '+ASource,TPasSetType,AHint);
   AssertNotNull('Have enumtype',TPasSetType(TheType).EnumType);
   AssertEquals('Element type ',TPasUnresolvedTypeRef,TPasSetType(TheType).EnumType.ClassType);
+  AssertEquals('IsPacked is correct',isPacked,TPasSetType(TheType).IsPacked);
 end;
 
 procedure TTestTypeParser.DoParseComplexSet(const ASource: String;
@@ -3029,6 +3045,11 @@ begin
   DoTestRangeType('#1','#4','');
 end;
 
+procedure TTestTypeParser.TestCharRangeType2;
+begin
+  DoTestRangeType('''A''','''B''','');
+end;
+
 procedure TTestTypeParser.TestRangeTypeDeprecated;
 begin
   DoTestRangeType('1','4','deprecated');
@@ -3097,6 +3118,11 @@ begin
   DoTestComplexSet;
 end;
 
+procedure TTestTypeParser.TestPackedSet;
+begin
+  DoParseSimpleSet('Byte','',True);
+end;
+
 procedure TTestTypeParser.TestRangeLowHigh;
 
 begin

packages/fcl-passrc/tests/tcvarparser.pas

@@ -279,10 +279,10 @@ end;
 
 procedure TTestVarParser.TestVarExternalLibName;
 begin
-  ParseVar('integer; external ''mylib'' name ''d''','');
+  ParseVar('integer; external ''mylib'' name ''de''','');
   AssertEquals('Variable modifiers',[vmexternal],TheVar.VarModifiers);
   AssertEquals('Library name','''mylib''',TheVar.LibraryName);
-  AssertEquals('Library name','''d''',TheVar.ExportName);
+  AssertEquals('Library name','''de''',TheVar.ExportName);
 end;
 
 procedure TTestVarParser.TestVarCVar;
@@ -305,9 +305,9 @@ end;
 
 procedure TTestVarParser.TestVarPublicName;
 begin
-  ParseVar('integer; public name ''c''','');
+  ParseVar('integer; public name ''ce''','');
   AssertEquals('Variable modifiers',[vmpublic],TheVar.VarModifiers);
-  AssertEquals('Public export name','''c''',TheVar.ExportName);
+  AssertEquals('Public export name','''ce''',TheVar.ExportName);
 end;
 
 procedure TTestVarParser.TestVarDeprecatedExternalName;

packages/fcl-passrc/tests/testpassrc.lpi

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

packages/pastojs/tests/tcconverter.pp

@@ -108,7 +108,6 @@ type
     Procedure TestMemberExpressionArrayTwoDim;
     Procedure TestVariable;
     Procedure TestArrayVariable;
-    procedure TestClassDecleration;
   end;
 
   { TTestStatementConverter }
@@ -374,6 +373,7 @@ Var
   I : TJSUnaryPostPlusPlusExpression;
   C : TJSRelationalExpressionLE;
   VS: TJSVariableStatement;
+  LoopEndVar: String;
 
 begin
   // For I:=1 to 100 do a:=b;
@@ -385,24 +385,27 @@ begin
   F.Body:=CreateAssignStatement();
   L:=TJSStatementList(Convert(F,TJSStatementList));
   // Should be a list of two statements:
-  //   i:=1;
-  //   for(var $loopend=100; i<=$loopend; i++){ a:=b; }
-  A:=TJSSimpleAssignStatement(AssertElement('First in list is Init statement',TJSSimpleAssignStatement,L.A));
-  AssertIdentifier('Init statement LHS is loop variable',A.LHS,'i');
-  AssertLiteral('Init statement RHS is start value',A.Expr,1);
+  //   var $loopend1=100;
+  //   for(i=1; i<=$loopend1; i++){ a:=b; }
+
+  // "var $loopend1=100"
+  LoopEndVar:=DefaultLoopEndVarName+'1';
+  VS:=TJSVariableStatement(AssertElement('First in list is var '+LoopEndVar,TJSVariableStatement,L.A));
+  VD:=TJSVarDeclaration(AssertElement('var '+LoopEndVar,TJSVarDeclaration,VS.A));
+  AssertEquals('Correct name for '+LoopEndVar,LoopEndVar,VD.Name);
+  AssertLiteral('Correct end value',VD.Init,100);
 
   E:=TJSForStatement(AssertElement('Second in list is "for" statement',TJSForStatement,L.B));
 
-  // "var $loopend=100"
-  VS:=TJSVariableStatement(AssertElement('var '+LoopEndVarName,TJSVariableStatement,E.Init));
-  VD:=TJSVarDeclaration(AssertElement('var '+LoopEndVarName,TJSVarDeclaration,VS.A));
-  AssertEquals('Correct name for '+LoopEndVarName,LoopEndVarName,VD.Name);
-  AssertLiteral('Correct end value',VD.Init,100);
+  // i:=1
+  A:=TJSSimpleAssignStatement(AssertElement('Init statement',TJSSimpleAssignStatement,E.Init));
+  AssertIdentifier('Init statement LHS is loop variable',A.LHS,'i');
+  AssertLiteral('Init statement RHS is start value',A.Expr,1);
 
-  // i<=$loopend
+  // i<=$loopend1
   C:=TJSRelationalExpressionLE(AssertElement('Condition is <= expression',TJSRelationalExpressionLE,E.Cond));
   AssertIdentifier('Cond LHS is loop variable',C.A,'i');
-  AssertIdentifier('Cond RHS is '+LoopEndVarName,C.B,LoopEndVarName);
+  AssertIdentifier('Cond RHS is '+LoopEndVar,C.B,LoopEndVar);
 
   // i++
   I:=TJSUnaryPostPlusPlusExpression(AssertElement('Increment is ++ statement',TJSUnaryPostPlusPlusExpression,E.Incr));
@@ -422,6 +425,7 @@ Var
   I : TJSUnaryPostMinusMinusExpression;
   C : TJSRelationalExpressionGE;
   VS: TJSVariableStatement;
+  LoopEndVar: String;
 
 begin
   // For I:=100 downto 1 do a:=b;
@@ -435,24 +439,27 @@ begin
   L:=TJSStatementList(Convert(F,TJSStatementList));
 
   // Should be a list of two statements:
-  //   i:=100;
-  //   for(var $loopend=1; i>=$loopend; i--){ a:=b; }
-  A:=TJSSimpleAssignStatement(AssertElement('First in list is Init statement',TJSSimpleAssignStatement,L.A));
-  AssertIdentifier('Init statement LHS is loop variable',A.LHS,'i');
-  AssertLiteral('Init statement RHS is start value',A.Expr,100);
+  //   var $loopend1=1;
+  //   for(i=100; i>=$loopend1; i--){ a:=b; }
+
+  // "var $loopend1=1"
+  LoopEndVar:=DefaultLoopEndVarName+'1';
+  VS:=TJSVariableStatement(AssertElement('var '+LoopEndVar,TJSVariableStatement,L.A));
+  VD:=TJSVarDeclaration(AssertElement('var '+LoopEndVar,TJSVarDeclaration,VS.A));
+  AssertEquals('Correct name for '+LoopEndVar,LoopEndVar,VD.Name);
+  AssertLiteral('Correct end value',VD.Init,1);
 
   E:=TJSForStatement(AssertElement('Second in list is "for" statement',TJSForStatement,L.B));
 
-  // "var $loopend=1"
-  VS:=TJSVariableStatement(AssertElement('var '+LoopEndVarName,TJSVariableStatement,E.Init));
-  VD:=TJSVarDeclaration(AssertElement('var '+LoopEndVarName,TJSVarDeclaration,VS.A));
-  AssertEquals('Correct name for '+LoopEndVarName,LoopEndVarName,VD.Name);
-  AssertLiteral('Correct end value',VD.Init,1);
+  // i=100;
+  A:=TJSSimpleAssignStatement(AssertElement('First in list is Init statement',TJSSimpleAssignStatement,E.Init));
+  AssertIdentifier('Init statement LHS is loop variable',A.LHS,'i');
+  AssertLiteral('Init statement RHS is start value',A.Expr,100);
 
-  // i>=$loopend
+  // i>=$loopend1
   C:=TJSRelationalExpressionGE(AssertElement('Condition is >= expression',TJSRelationalExpressionGE,E.Cond));
   AssertIdentifier('Cond LHS is loop variable',C.A,'i');
-  AssertIdentifier('Cond RHS is '+LoopEndVarName,C.B,LoopEndVarName);
+  AssertIdentifier('Cond RHS is '+LoopEndVar,C.B,LoopEndVar);
 
   // i--
   I:=TJSUnaryPostMinusMinusExpression(AssertElement('Increment is -- statement',TJSUnaryPostMinusMinusExpression,E.Incr));
@@ -596,22 +603,33 @@ Procedure TTestStatementConverter.TestTryExceptStatement;
 Var
   T : TPasImplTry;
   F : TPasImplTryExcept;
-  El : TJSTryFinallyStatement;
+  El : TJSTryCatchStatement;
   L : TJSStatementList;
 
 begin
-  // Try a:=B except b:=c end;
+  // Try a:=b except b:=c end;
+  (*
+    Becomes:
+    try {
+     a=b;
+    } catch {
+      b = c;
+    }
+  *)
   T:=TPasImplTry.Create('',Nil);
   T.AddElement(CreateAssignStatement('a','b'));
   F:=T.AddExcept;
   F.AddElement(CreateAssignStatement('b','c'));
-  El:=TJSTryFinallyStatement(Convert(T,TJSTryCatchStatement));
+  // Convert
+  El:=TJSTryCatchStatement(Convert(T,TJSTryCatchStatement));
+  AssertEquals('No exception object name','',String(El.Ident));
+  // check "a=b;"
   L:=AssertListStatement('try..except block is statement list',El.Block);
   AssertAssignStatement('Correct assignment in try..except block',L.A,'a','b');
   AssertNull('No second statement',L.B);
+  // check "b=c;'
   L:=AssertListStatement('try..except block is statement list',El.BCatch);
   AssertAssignStatement('Correct assignment in except..end block',L.A,'b','c');
-  AssertEquals('Correct exception object name',lowercase(DefaultJSExceptionObject),String(El.Ident));
   AssertNull('No second statement',L.B);
 end;
 
@@ -621,22 +639,24 @@ Var
   T : TPasImplTry;
   F : TPasImplTryExcept;
   O : TPasImplExceptOn;
-  El : TJSTryFinallyStatement;
+  El : TJSTryCatchStatement;
   L : TJSStatementList;
   I : TJSIfStatement;
-  IC : TJSRelationalExpressionInstanceOf;
-  V : TJSVarDeclaration;
+  IC : TJSCallExpression;
+  D: TJSDotMemberExpression;
+  ExObj: TJSElement;
+  VS: TJSVariableStatement;
+  V: TJSVarDeclaration;
 
 begin
-  // Try a:=B except on E : exception do  b:=c end;
   // Try a:=B except on E : exception do  b:=c end;
   (*
     Becomes:
     try {
      a=b;
-    } catch (ExceptObject) {
-      if (ExceptObject instanceof exception) {
-        var e = ExceptObject;
+    } catch (exceptobject) {
+      if (exception.isPrototypeOf(exceptobject)) {
+        var e = exceptobject;
         b = c;
       }
     }
@@ -647,21 +667,29 @@ begin
   O:=F.AddExceptOn('E','Exception');
   O.Body:=CreateAssignStatement('b','c');
   // Convert
-  El:=TJSTryFinallyStatement(Convert(T,TJSTryCatchStatement));
+  El:=TJSTryCatchStatement(Convert(T,TJSTryCatchStatement));
+  // check "catch(exceptobject)"
   AssertEquals('Correct exception object name',lowercase(DefaultJSExceptionObject),String(El.Ident));
-  L:=AssertListStatement('try..except block is statement list',El.BCatch);
-  AssertNull('No second statement',L.B);
-  I:=TJSIfStatement(AssertElement('On block is if',TJSIfStatement,L.A));
-  Ic:=TJSRelationalExpressionInstanceOf(AssertElement('If condition is InstanceOf expression',TJSRelationalExpressionInstanceOf,I.Cond));
-  Assertidentifier('InstanceOf left is exception object',Ic.A,lowercase(DefaultJSExceptionObject));
-  // Lowercased exception - May need checking
-  Assertidentifier('InstanceOf right is original exception type',Ic.B,'exception');
-  L:=AssertListStatement('On block is always a list',i.btrue);
-  V:=TJSVarDeclaration(AssertElement('First statement in list is a var declaration',TJSVarDeclaration,L.A));
+  // check "if"
+  I:=TJSIfStatement(AssertElement('On block is if',TJSIfStatement,El.BCatch));
+  // check if condition "exception.isPrototypeOf(exceptobject)"
+  IC:=TJSCallExpression(AssertElement('If condition is call expression',TJSCallExpression,I.Cond));
+  D:=TJSDotMemberExpression(AssertElement('exception.isPrototypeOf is dot member expression',TJSDotMemberExpression,IC.Expr));
+  Assertidentifier('left side of exception.isPrototypeOf',D.MExpr,'exception');
+  AssertEquals('right side of exception.isPrototypeOf','isPrototypeOf',String(D.Name));
+  AssertNotNull('args of exception.isPrototypeOf(exceptobject)',IC.Args);
+  AssertEquals('args of exception.isPrototypeOf(exceptobject)',1,IC.Args.Elements.Count);
+  ExObj:=IC.Args.Elements.Elements[0].Expr;
+  Assertidentifier('arg of exception.isPrototypeOf(exceptobject)',ExObj,lowercase(DefaultJSExceptionObject));
+  // check statement "var e = exceptobject;"
+  L:=AssertListStatement('On block is always a list',I.BTrue);
+  writeln('TTestStatementConverter.TestTryExceptStatementOnE ',L.A.ClassName);
+  VS:=TJSVariableStatement(AssertElement('First statement in list is a var statement',TJSVariableStatement,L.A));
+  V:=TJSVarDeclaration(AssertElement('var declaration e=ExceptObject',TJSVarDeclaration,VS.A));
   AssertEquals('Variable name is identifier in On A : Ex do','e',V.Name);
-  Assertidentifier('Variable init is exception object',v.init,lowercase(DefaultJSExceptionObject));
-  L:=AssertListStatement('Second statement is again list',L.B);
-  AssertAssignStatement('Original assignment in second statement',L.A,'b','c');
+  Assertidentifier('Variable init is exception object',V.Init,lowercase(DefaultJSExceptionObject));
+  // check "b = c;"
+  AssertAssignStatement('Original assignment in second statement',L.B,'b','c');
 end;
 
 Procedure TTestStatementConverter.TestReRaise;
@@ -669,23 +697,26 @@ Var
   T : TPasImplTry;
   F : TPasImplTryExcept;
   O : TPasImplExceptOn;
-  El : TJSTryFinallyStatement;
+  El : TJSTryCatchStatement;
   L : TJSStatementList;
   I : TJSIfStatement;
-  IC : TJSRelationalExpressionInstanceOf;
+  IC : TJSCallExpression;
   R : TJSThrowStatement;
   V : TJSVarDeclaration;
+  D: TJSDotMemberExpression;
+  ExObj: TJSElement;
+  VS: TJSVariableStatement;
 
 begin
-  // Try a:=B except on E : exception do  b:=c end;
+  // Try a:=B except on E : exception do raise; end;
   (*
     Becomes:
     try {
      a=b;
-    } catch (jsexception) {
-      if jsexception instanceof exception {
-        var e = jsexception;
-        throw jsexception;
+    } catch (exceptobject) {
+      if (exception.isPrototypeOf(exceptobject)) {
+        var e = exceptobject;
+        throw exceptobject;
       }
     }
   *)
@@ -695,20 +726,28 @@ begin
   O:=F.AddExceptOn('E','Exception');
   O.Body:=TPasImplRaise.Create('',Nil);
   // Convert
-  El:=TJSTryFinallyStatement(Convert(T,TJSTryCatchStatement));
+  El:=TJSTryCatchStatement(Convert(T,TJSTryCatchStatement));
+  // check "catch(exceptobject)"
   AssertEquals('Correct exception object name',lowercase(DefaultJSExceptionObject),String(El.Ident));
-  L:=AssertListStatement('try..except block is statement list',El.BCatch);
-  AssertNull('No second statement',L.B);
-  I:=TJSIfStatement(AssertElement('On block is if',TJSIfStatement,L.A));
-  Ic:=TJSRelationalExpressionInstanceOf(AssertElement('If condition is InstanceOf expression',TJSRelationalExpressionInstanceOf,I.Cond));
-  Assertidentifier('InstanceOf left is exception object',Ic.A,lowercase(DefaultJSExceptionObject));
-  // Lowercased exception - May need checking
-  L:=AssertListStatement('On block is always a list',i.btrue);
-  V:=TJSVarDeclaration(AssertElement('First statement in list is a var declaration',TJSVarDeclaration,L.A));
+  // check "if"
+  I:=TJSIfStatement(AssertElement('On block is if',TJSIfStatement,El.BCatch));
+  // check if condition "exception.isPrototypeOf(exceptobject)"
+  IC:=TJSCallExpression(AssertElement('If condition is call expression',TJSCallExpression,I.Cond));
+  D:=TJSDotMemberExpression(AssertElement('exception.isPrototypeOf is dot member expression',TJSDotMemberExpression,IC.Expr));
+  Assertidentifier('left side of exception.isPrototypeOf',D.MExpr,'exception');
+  AssertEquals('right side of exception.isPrototypeOf','isPrototypeOf',String(D.Name));
+  AssertNotNull('args of exception.isPrototypeOf(ExceptObject)',IC.Args);
+  AssertEquals('args of exception.isPrototypeOf(ExceptObject)',1,IC.Args.Elements.Count);
+  ExObj:=IC.Args.Elements.Elements[0].Expr;
+  Assertidentifier('arg of exception.isPrototypeOf(ExceptObject)',ExObj,lowercase(DefaultJSExceptionObject));
+  // check statement "var e = exceptobject;"
+  L:=AssertListStatement('On block is always a list',I.BTrue);
+  writeln('TTestStatementConverter.TestTryExceptStatementOnE ',L.A.ClassName);
+  VS:=TJSVariableStatement(AssertElement('First statement in list is a var statement',TJSVariableStatement,L.A));
+  V:=TJSVarDeclaration(AssertElement('var declaration e=ExceptObject',TJSVarDeclaration,VS.A));
   AssertEquals('Variable name is identifier in On A : Ex do','e',V.Name);
-  Assertidentifier('Variable init is exception object',v.init,lowercase(DefaultJSExceptionObject));
-  L:=AssertListStatement('Second statement is again list',L.B);
-  R:=TJSThrowStatement(AssertElement('On block is throw statement',TJSThrowStatement,L.A));
+  Assertidentifier('Variable init is exception object',V.Init,lowercase(DefaultJSExceptionObject));
+  R:=TJSThrowStatement(AssertElement('On block is throw statement',TJSThrowStatement,L.B));
   Assertidentifier('R expression is original exception ',R.A,lowercase(DefaultJSExceptionObject));
 end;
 
@@ -756,6 +795,7 @@ begin
   AssertNotNull('Convert returned a result',E);
   if not (E is TJSUnary) then
     Fail('Do not have unary class, but: '+E.ClassName);
+  AssertEquals('TTestExpressionConverter.TestUnaryExpression: wrong class',AClass.ClassName,E.ClassName);
   Result:=TJSUnary(E);
 end;
 
@@ -1186,27 +1226,7 @@ begin
   A:=TJSArrayLiteral(AssertElement('Init is array literal',TJSArrayLiteral,VD.Init));
   AssertEquals('No elements',0,A.Elements.Count);
 end;
-procedure TTestExpressionConverter.TestClassDecleration;
-var
-  C: TPasClassType;
-  Decl: TPasDeclarations;
-  Sl: TJSStatementList;
-  Uni: TJSUnary;
-  Asi: TJSSimpleAssignStatement;
-  pex: TJSPrimaryExpressionIdent;
-  Call: TJSCallExpression;
-begin
-  Decl:=TPasDeclarations.Create('',Nil);
-  C:=TPasClassType.Create('myclass',Nil);
-  Decl.Declarations.Add(c);
-  Sl:=TJSStatementList(Convert(Decl,TJSStatementList));
-  Uni:=TJSUnary(AssertElement('Sl.A is TJSUnary',TJSUnary,Sl.A));
-  Asi:=TJSSimpleAssignStatement(AssertElement('Sl.A is TJSUnary',TJSSimpleAssignStatement,Uni.A));
-  pex:=TJSPrimaryExpressionIdent(AssertElement('Asi.LHS is TJSPrimaryExpressionIdent',TJSPrimaryExpressionIdent,Asi.LHS));
-  AssertEquals('Correct name','myclass',String(pex.Name));
-  Call:=TJSCallExpression(AssertElement('Asi.Expr is TJSCallExpression',TJSCallExpression,Asi.Expr));
-  if Call=nil then ;
-end;
+
 procedure TTestTestConverter.TestEmpty;
 begin
   AssertNotNull('Have converter',Converter);

utils/fpdoc/dw_man.pp

@@ -1001,7 +1001,7 @@ var
 
 begin
   DocNode:=Engine.FindDocNode(Package);
-  If (PackageDescr='') then
+  If (PackageDescr='') and assigned(DocNode) then
     PackageDescr:=GetDescrString(Package,DocNode.ShortDescr);
   StartManPage(Package,DocNode);
   Try
@@ -1025,7 +1025,10 @@ begin
         WriteB(L[i]);
         M:=TPasModule(L.Objects[i]);
         D:=Engine.FindDocNode(M);
-        WriteLn(GetDescrString(M,D.ShortDescr))
+        if Assigned(D) then
+          WriteLn(GetDescrString(M,D.ShortDescr))
+        else
+          WriteLn(GetDescrString(M,Nil))
         end;
       StartSection(SDocSeeAlso);
       WriteSeeAlso(DocNode,True);
@@ -1151,14 +1154,17 @@ procedure TManWriter.WriteUnitPage(AModule : TPasModule);
 
 Var
   DocNode : TDocNode;
-
+  S : String;
 begin
   DocNode:=Engine.FindDocNode(AModule);
   StartManPage(AModule,DocNode);
   Try
     PageTitle(AModule.Name,ManSection,PackageName,PackageDescr);
     StartSection(SManDocName);
-    Writeln(DocNode.Name+' \- '+GetDescrString(AModule,DocNode.ShortDescr));
+    if Assigned(DocNode) then
+      S:=GetDescrString(AModule,DocNode.ShortDescr);
+
+    Writeln(AModule.Name+' \- '+S);
     if Assigned(DocNode) and not IsDescrNodeEmpty(DocNode.Descr) then
       begin
       StartSection(SManDocDescription);

utils/fpdoc/intl/dwriter.de.po

@@ -1,5 +1,5 @@
 #: dwriter:serrfilewriting
-msgid "An error occured during writing of file \"%s\": %s"
+msgid "An error occurred during writing of file \"%s\": %s"
 msgstr "Beim Schreiben der Datei \"%s\" ist ein Fehler aufgetrete: %s"
 
 #: dwriter:serrinvalidshortdescr