* Patch from "gvs" Mantis 17543. Fixes some bugs in implementation parsing

     (if..then-else, while do) and adds support for inherited and self
 * review of test_parser example/test + a good source to test with.

git-svn-id: trunk@17079 -

.gitattributes

@@ -2173,6 +2173,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/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
 packages/fcl-passrc/src/pastree.pp svneol=native#text/plain
 packages/fcl-passrc/src/paswrite.pp svneol=native#text/plain

packages/fcl-passrc/examples/test_parser.pp

@@ -1,7 +1,151 @@
+{   This is a test-program for the fcl-passrc package (except writer-class).
+
+    Please notice that i have done this to find out how good the parser workes,
+    it is not thought to be a good example to use the fcl-passrc package but
+    may give you hints on using it.
+
+    It is done to test the source of these units for usability, completeness and
+    bugs. It is base on the fcl-passrc exampe.
+    It workes like a pretty-printer to compare the output of this program with
+    the original code, but is not thought to be a real pretty-printer as
+    e.g. the semicolons can sometimes not be set at the place they sould be
+    (this imformation is not available from the parsing-engine, as a parser
+    should only give you a positiv result if the source is valid, otherwise
+    you get a negative result).
+    Also the output is not always in the same order as in input as this
+    information is not available easily.
+    
+    !!!Do not expect this program to produce executeable output!!!
+
+    Status: -workes with one Unit or Program
+            -Some type declarations missing
+            -string[n] the [n] part missing -> missing in parser
+            -array of const -> missing in parser
+            -Hints deprecated, etc. missing sometimes
+            -the parser splits x,y:atype
+              x:atype
+              y:atype
+             i tryed to put them together again
+            - () missing in statements: () expression and typecast
+            -missing forward class declaration like x=class
+            -incomplete !
+
+            parser: -ugly ''' quotation from scanner, why not #39 ?
+                    -see comments in the program for hints
+                    -incomplete !
+
+    Usage: call with one complete filename of a Unit or Program
+           defaults for the parser are 'linux' and 'i386'
+
+    Output: is 'pretty-printed' to stdout or unformated
+            The unformated output is thought to be diffed with the original
+            source to see differences caused by the parser (a tool to unformat
+            a souce file is in progress but not finished jet).
+
+    Bugs: 1. In case of unimplemented statements (like up to now asm) the parser
+             cause a excemtion to abort the program hard.
+          2. Missing implementaion in this program should not print out anything
+             or result in not pascal conform output.
+
+    Hit: The parser uses directives given in the source file.
+
+   Hints to read the code:
+    There are comments in the code with hints and marks of possible bugs.
+    During development some code was modified for true order output but the
+    old code is still available as a comment as it is easier to understand.
+    This is programmed using 'recursive' calls. Most options in functions are
+    for printing the output.
+    There is no writer-class used to keep it simple and see what is done.
+    All output is produced by direct writing to stdout, this cause problems in
+    furter development; a function result as string may be more usable.
+
+    The parser was written to be used for unit interface and was expanded to
+    work with program and implementation too. It does nearly no seperate
+    things for programs, they are adapted to the unit scheme (see main).
+
+    The order will change in following case:
+     -function with forward declaration (also overloading etc.)
+
+
+  Inheritance (only the important ones):
+
+    TInterfaceSection, TImplementationSection, TProgramSection
+     |
+    TPasSection
+     |
+    TPasDeclarations
+     |
+    TPasElement
+     |
+    TPasElementBase
+     |
+    TObject
+
+    TInitializationSection, TFinalizationSection
+     |
+    TPasImplBlock
+     |
+    TPasImplElement
+     |
+    TPasElement
+     |
+    TPasElementBase
+     |
+    TObject
+
+    TPasProgram
+     |
+    TPasModule
+     |
+    TPasElement
+     |
+    TPasElementBase
+     |
+    TObject
+
+  Dependance Structure :
+
+    TPasPackage = class(TPasElement)
+      |
+    Modules: TList;
+
+    TPasModule = class(TPasElement)
+      |-InterfaceSection: TInterfaceSection;
+      |  |-Declarations -> forward part, unit only
+      |
+      |-ImplementationSection: TImplementationSection;
+      |  |-Declarations -> full declaration, unit and program
+      |     |-Functions: TList;
+      |        |-TPasFunction = class(TPasProcedureBase)
+      |           |-Body: TProcedureBody;
+      |              |-Declarations -> declaration and sub function
+      |              |-Body: TPasImplBlock; -> procedure block
+      |
+      |-InitializationSection: TInitializationSection;
+      |  |-TPasImplBlock.Elements: TList; -> main block
+      |
+      |-FinalizationSection: TFinalizationSection;
+         |-TPasImplBlock.Elements: TList; -> unit only
+
+    Declarations = class(TPasElement)
+      |-Declarations: TList; -> the following are all in here
+      |-ResStrings: TList;
+      |-Types: TList;
+      |-Consts: TList;
+      |-Classes: TList;
+      |-Functions: TList;
+      |-Variables: TList;
+      |-Properties: TList;
+    }
+
+
+program test_parser1;
 {$mode objfpc}{$H+}
 
 uses SysUtils, Classes, PParser, PasTree;
 
+//# types the parser needs
+
 type
   { We have to override abstract TPasTreeContainer methods.
     See utils/fpdoc/dglobals.pp for an implementation of TFPDocEngine,
@@ -31,43 +175,1779 @@ begin
   Result := nil;
 end;
 
+
+//# main var
 var
   M: TPasModule;
   E: TPasTreeContainer;
   I: Integer;
-  Decls: TList;
-  cmdl : string;
+  cmdl, TargetOS, TargetCPU : string;
+  isim, //is Impleamentation, only for GetTPasProcedureBody
+  Unformated:boolean; // no Formating in output
+  
+
+//# tools
+
+ function GetIndent(indent:integer):String;
+   var i:integer;
+  begin
+   Result:='';
+   if not Unformated then 
+      for i:=1 to indent do Result:=Result+' ';
+  end;
+
+ //delete ugly quoting '''STRING'''
+ function DelQuot(s:String):String;
+    var i:integer;
+    const s1=#39#39#39;
+   begin
+    Result:='';
+    i:=pos(s1,s);
+    while i > 0 do
+     begin
+      if i > 0 then delete(s,i,2);
+      i:=pos(s1,s);
+     end; 
+    //if i > 0 then delete(s,i,2);
+    Result:=s;
+   end;
+
+ //LeadingSpace only valid if Formated output (as this will be one line in output)
+ //UnFormated: all is printed in a new line
+ procedure WriteFmt(LeadingSpace:boolean; s:String; Semicolon:boolean);
+  begin
+   if Semicolon then s:=s+';';
+   if Unformated then writeln(s)
+    else if LeadingSpace then write(' ',s)
+     else write(s);
+  end;
+
+//# parsing output
+
+function GetTPasImplBlock(lb:TPasImplBlock; indent,declistby:integer;
+                           LastNoSem,NoFirstIndent:boolean):boolean; forward;
+
+function GetTPasImplElement(le:TPasImplElement; lindent:integer;
+                             lLastNoSem,NoFirstIndent:boolean):boolean; forward;
+
+procedure GetDecls(Decl:TPasDeclarations; indent:integer); forward;
+//procedure PrintDecls(Decl:TPasDeclarations; indent:integer); forward;
+
+//# most is for implementation or implblocks except the expr things
+
+function ReturnTPasMemberHints(h:TPasMemberHints):String;
+ begin
+  Result:='';
+  if hDeprecated    in h then Result:=' deprecated'; 
+  if hLibrary       in h then Result:=Result+' library';
+  if hPlatform      in h then Result:=Result+' platform';
+  if hExperimental  in h then Result:=Result+' experimental';
+  if hUnimplemented in h then Result:=Result+' unimplemented';
+ end;      
+   
+function GetTPasMemberHints(h:TPasMemberHints):Boolean;
+ begin
+  Result:=false;
+  if hDeprecated in h then begin write(' deprecated'); Result:=true; end;
+  if hLibrary in h then begin write(' library'); Result:=true; end;
+  if hPlatform in h then begin write(' platform'); Result:=true; end;
+  if hExperimental in h then begin write(' experimental'); Result:=true; end;
+  if hUnimplemented in h then begin write(' unimplemented'); Result:=true; end;
+ end;   
+
+
+
+
+function GetTPasExprKind(lpek:TPasExprKind):String;
+ begin
+  Result:='';
+  case lpek of
+    pekIdent:Result:='ID';
+    pekNumber:Result:='NUMBER';
+    pekString:Result:='STRING';
+    pekSet:Result:='SET';
+    pekNil:Result:='NIL';
+    pekBoolConst:Result:='BOOL';
+    pekRange:Result:='RANGE';
+    pekUnary:Result:='UNARY';
+    pekBinary:Result:='BINARY';
+    pekFuncParams:Result:='FUNCPAR';
+    pekArrayParams:Result:='ARRAYPAR';
+    pekListOfExp:Result:='EXPLIST';
+  end;
+ end;
+
+procedure GetTPasExpr(lex:TPasExpr);
+ var lex1:TpasExpr;
+     lpe:TParamsExpr;
+     l:integer;
+     lbk,rbk,sep:string;
+     lav:TArrayValues;
+     lrv:TRecordValues;
+     rvi:TRecordValuesItem;
+
+
+ function GetExpKind(ek:TPasExprKind; var lbrak,rbrak:string):string;
+  begin
+   lbrak:='';
+   rbrak:='';
+   Result:='';
+   case ek of
+    pekIdent:Result:='ID';
+    pekNumber:Result:='NU';
+    pekString:begin lbrak:=#39; rbrak:=#39; Result:=#39; end;
+    pekSet:begin lbrak:='['; rbrak:=']'; Result:=','; end;
+    pekNil:Result:='NIL';
+    pekBoolConst:Result:='';
+    pekRange:Result:='..';
+    pekUnary:Result:='';
+    pekBinary:Result:='';
+    pekFuncParams:begin lbrak:='('; rbrak:=')'; Result:=','; end;
+    pekArrayParams:begin lbrak:='['; rbrak:=']'; Result:=','; end;
+    pekListOfExp:Result:=',';
+    pekInherited:Result:=' InheriteD';
+    pekSelf:Result:=' SelF';
+   end;
+  end;
+
+ function GetOp(lop:TExprOpCode):string;
+  begin
+   Result:='';
+   case lop of
+    eopNone:Result:='';
+    eopAdd:Result:='+';
+    eopSubtract:Result:='-';
+    eopMultiply:Result:='*';
+    eopDivide:Result:='/';
+    eopDiv:Result:=' div ';
+    eopMod:Result:=' mod ';
+    eopPower:Result:='^';
+    eopShr:Result:=' shr ';
+    eopSHl:Result:=' shl ';
+    eopNot:Result:=' not ';
+    eopAnd:Result:=' and ';
+    eopOr:Result:=' or ';
+    eopXor:Result:=' xor ';
+    eopEqual:Result:='=';
+    eopNotEqual:Result:='<>';
+    eopLessThan:Result:='<';
+    eopGreaterThan:Result:='>';
+    eopLessthanEqual:Result:='<=';
+    eopGreaterThanEqual:Result:='>=';
+    eopIn:Result:=' in ';
+    eopIs:Result:=' is ';
+    eopAs:Result:=' as ';
+    eopSymmetricaldifference:Result:='><';
+    eopAddress:Result:='@';
+    eopDeref:Result:='^';
+    eopSubIdent:Result:='.';
+   end;
+  end;
+
+ begin
+  if lex is TBinaryExpr then //compined constants
+   begin
+    sep:=GetExpKind(lex.Kind,lbk,rbk);
+    //write('|');
+    write(lbk);
+    GetTPasExpr(TBinaryExpr(lex).left);
+    write(GetOp(TBinaryExpr(lex).OpCode));
+    write(sep);
+    GetTPasExpr(TBinaryExpr(lex).right);
+    write(rbk);
+    //write('|');
+    //write(' [',lex.Name,' ',GetTPasExprKind(lex.Kind),']');
+   end
+    else
+     begin
+      //write('UNARY');
+      if lex is TUnaryExpr then
+       begin
+        lex1:=TUnaryExpr(lex).Operand;
+        if lex.OpCode = eopDeref then
+         begin
+          GetTPasExpr(lex1);
+          write(GetOp(lex.OpCode)); //unary last, only: p^
+         end
+        else
+         begin
+          write(GetOp(lex.OpCode)); //unary first: -1
+          GetTPasExpr(lex1);
+         end;
+       end;
+      if lex is TPrimitiveExpr then write(TPrimitiveExpr(lex).Value) //simple constant
+      else
+      if lex is TBoolConstExpr then write(TBoolConstExpr(lex).Value)
+      else
+      if lex is TNilExpr then write('nil')
+      else
+      if lex is TInheritedExpr then write('Inherited ')
+      else
+      if lex is TSelfExpr then write('Self')
+      else
+      if lex is TParamsExpr then //writeln(param1,param2,..,paramn);
+        begin
+         //write(' PAREX ');
+         lpe:=TParamsExpr(lex);
+         GetTPasExpr(lpe.Value);
+         if length(lpe.Params) >0 then
+          begin
+           sep:=GetExpKind(lpe.Kind,lbk,rbk);
+           write(lbk); //write('(');
+           for l:=0 to High(lpe.Params)-1 do
+            begin
+             GetTPasExpr(lpe.Params[l]);
+             write(sep); //seperator
+            end;
+           GetTPasExpr(lpe.Params[High(lpe.Params)]);
+           write(rbk);//write(')');
+          end
+         else
+          begin //funcion()
+           sep:=GetExpKind(lpe.Kind,lbk,rbk);
+           write(lbk,rbk);
+          end;
+        end
+      else if lex is TArrayValues then  //const AnArrayConst: Array[1..3] of Integer = (1,2,3);
+        begin
+         write('(');
+         lav:=TArrayValues(lex);
+         if length(lav.Values) > 0 then
+          begin
+           for l:=0 to high(lav.Values)-1 do
+            begin
+             GetTPasExpr(TPasExpr(lav.Values[l]));
+             write(',');
+            end;
+           GetTPasExpr(TPasExpr(lav.Values[high(lav.Values)]));
+          end;
+         write(')');
+        end
+      else if lex is TRecordValues then
+        begin
+         write('(');
+         lrv:=TRecordValues(lex);
+         if length(lrv.Fields) > 0 then
+          begin
+           for l:=0 to high(lrv.Fields)-1 do
+            begin
+             rvi:=TRecordValuesItem(lrv.Fields[l]);
+             write(rvi.Name,':');
+             GetTPasExpr(rvi.ValueExp);
+             write(';');
+            end;
+           rvi:=TRecordValuesItem(lrv.Fields[high(lrv.Fields)]);
+           write(rvi.Name,':');
+           GetTPasExpr(rvi.ValueExp);
+          end;
+         write(')');
+        end
+      else
+       begin
+        //?
+        //writeln('{ Unknown Expression: ');
+        //if assigned(lex) then GetTPasExprKind(lex.Kind);
+        //writeln('}');
+       end;
+     end;
+ end;
+
+
+//NoFirstIndent only for block in case:
+procedure GetTPasSmt(lsmt:TPasImplStatement; lindent:integer; DoNoSem,NoFirstIndent:boolean);
+ var l:integer;
+     lics:TPasImplCaseStatement;
+     DoSem:boolean;
+     liwd:TPasImplWithDo;
+     liwhd:TPasImplWhileDo;
+     lieo:TPasImplExceptOn;
+     lifl:TPasImplForLoop;
+     lir:TPasImplRaise;
+      s,s1:String;//s1 only first line of block statement
+
+begin
+  DoSem:=true;
+  s:=GetIndent(lindent);
+  if NoFirstIndent then s1:=' ' else s1:=s;
+  if lsmt is TPasImplSimple then
+    begin
+     write(s1); GetTPasExpr(TPasImplSimple(lsmt).expr);
+     //DoSem:=true;
+    end
+   else if lsmt is TPasImplAssign then
+    begin
+     write(s1); GetTPasExpr(TPasImplAssign(lsmt).left);
+     write(':= ');
+     GetTPasExpr(TPasImplAssign(lsmt).right);
+     //DoSem:=true;
+    end
+   else if lsmt is TPasImplCaseStatement then
+    begin
+     lics:=TPasImplCaseStatement(lsmt);
+     if lics.Expressions.Count>0 then
+      begin
+       write(s);
+       for l:=0 to lics.Expressions.Count-2 do
+          write(DelQuot(lics.Expressions[l]),',');
+       write(DelQuot(lics.Expressions[lics.Expressions.Count-1]),': '); // !!bug too much ' in expression
+       //if not assigned(lics.Body) then writeln('TPasImplCaseStatement missing BODY');
+       //if assigned(lics.Body) and (TPasImplBlock(lics.Body).Elements.Count >0) then
+       //  GetTPasImplBlock(TPasImplBlock(lics.Body),lindent+1,0,false,true)
+       //    else GetTPasImplBlock(TPasImplBlock(lics),lindent+1,0,false,true);  // !!bug missing body, assigned but empty
+        if assigned(lics.Body) then
+         begin
+          if not GetTPasImplElement(lics.Body,lindent+1,false,true) then ;//writeln(';');
+         end
+          else writeln(';');
+      end;
+     DoSem:=false;
+    end
+   else if lsmt is TPasImplWithDo then
+    begin
+     liwd:=TPasImplWithDo(lsmt);   // !!Bug: missing with do at following with do !solved see Bug
+     write(s1,'with ',liwd.Name);
+     if liwd.Expressions.Count>0 then
+      begin
+       for l:=0 to liwd.Expressions.Count-2 do
+         write(liwd.Expressions[l],',');
+       write(liwd.Expressions[liwd.Expressions.Count-1]);
+      end;
+     writeln(' do');
+     //if TPasImplBlock(liwd.Body).Elements.Count >0  then
+       //GetTPasImplBlock(TPasImplBlock(liwd.Body),0); // !!Bug: BODY Not used
+       //else
+     GetTPasImplBlock(TPasImplBlock(liwd),lindent+1,0,false,false);
+     DoSem:=false;
+    end
+   else if lsmt is TPasImplWhileDo then
+    begin
+     liwhd:=TPasImplWhileDo(lsmt);
+     writeln(s1,'while ',DelQuot(liwhd.Condition),' do');
+     //if not GetTPasImplBlock(TPasImplBlock(liwhd.Body),0) then // !!Bug: BODY Not used
+     GetTPasImplBlock(TPasImplBlock(liwhd),lindent,0,DoNoSem,false); //OK for all constructs
+     DoNoSem:=false; //?
+     DoSem:=false;
+    end
+   else if lsmt is TPasImplExceptOn then
+    begin
+     lieo:=TPasImplExceptOn(lsmt);
+     writeln(s,'on ',lieo.VariableName,': ',lieo.TypeName,' do');
+     if TPasImplBlock(lieo.Body) is TPasImplRaise then
+      begin
+       write(s,'raise ');//raise is in TPasImplBlock in this case
+       GetTPasImplBlock(TPasImplBlock(lieo.Body),lindent+1,0,false,true);
+      end
+       else GetTPasImplBlock(TPasImplBlock(lieo.Body),lindent+1,0,false,false);
+     DoSem:=false;
+    end
+   else if lsmt is TPasImplForLoop then
+    begin
+     lifl:=TPasImplForLoop(lsmt);
+     //TODO variable
+     write(s1,'for ',lifl.VariableName,':= ',lifl.StartValue,' ');
+     if lifl.Down then write('down');
+     writeln('to ',lifl.EndValue,' do');
+     GetTPasImplBlock(TPasImplBlock(lifl),lindent+1,0,false,false);
+     DoSem:=false;
+    end
+   else if lsmt is TPasImplRaise then
+    begin
+     write(s1,'raise ');
+     lir:=TPasImplRaise(lsmt);
+     if not GetTPasImplBlock(TPasImplBlock(lir),lindent,0,DoNoSem,true) then
+      writeln(';');
+     DoNoSem:=false;
+     DoSem:=false;
+    end
+   else
+    begin
+     if assigned(lsmt.Elements) then
+      begin
+       writeln('{ Unknown SMT(s): '); //,lsmt.Name,' ',lsmt.ElementTypeName);
+       for l:=0 to lsmt.Elements.Count-1 do
+         write(s,' SMT ',l,' ',TPasElement(lsmt.Elements[l]).Name);
+       writeln('}');
+      end;
+     DoSem:=false;
+    end;
+  if not DoNoSem then
+   begin
+    if DoSem then writeln(';');
+   end
+    else writeln;
+end;
+
+
+ //result: result of TPasImplBlock or valid element
+ //NoFirstIndent only for block in case:
+ function GetTPasImplElement(le:TPasImplElement; lindent:integer;
+                             lLastNoSem,NoFirstIndent:boolean):boolean;
+  var liie:TPasImplIfElse;
+      lico:TPasImplCaseOf;
+      lice:TPasImplCaseElse;
+      liru:TPasImplRepeatUntil;
+      lit:TPasImplTry;
+      //lic:TPasImplCommand;
+      s,s1:String;//s1 only first line of block statement
+
 begin
-  if Paramcount<1 then
+  Result:=true;
+  s:=GetIndent(lindent);
+  if NoFirstIndent then s1:=' ' else s1:=s;
+    if le is TPasImplStatement then
+      begin
+       if NoFirstIndent then lindent:=0;
+       GetTPasSmt(TPasImplStatement(le),lindent+1,lLastNoSem,NoFirstIndent);
+      end
+     else if le is TPasImplIfElse then
+      begin
+       liie:=TPasImplIfElse(le);
+       write(s1,'if ',DelQuot(liie.Condition),' then ');
+       if assigned(liie.ElseBranch) then
+        begin
+         writeln;
+         GetTPasImplElement(liie.IfBranch,lindent+1,true,false);
+         writeln(s,'else');// {if}');
+         GetTPasImplElement(liie.ElseBranch,lindent+1,lLastNoSem,false);
+        end
+       else
+        begin //no else part
+         if assigned(liie.IfBranch) then
+          begin
+           writeln;
+           if not GetTPasImplElement(liie.IfBranch,lindent+1,false,false) then
+             writeln(';');
+          end
+           else writeln(';'); //empty if then;
+        end;
+      end
+     else if le is TPasImplCaseOf then
+      begin
+       lico:=TPasImplCaseOf(le);
+       writeln(s1,'case ',lico.Expression,' of ');
+       if assigned(lico.ElseBranch) then //workaround duplicate bug
+        begin                            //reduce count of CaseOf as CaseElse is in there
+         lice:=lico.ElseBranch;
+         GetTPasImplBlock(TPasImplBlock(lico),lindent+1,1,false,false);
+        end
+          else GetTPasImplBlock(TPasImplBlock(lico),lindent+1,0,false,false); // !! else duplicate in here
+       if assigned(lico.ElseBranch) then
+        begin
+         writeln(s,'else');//' {case}');
+         lice:=lico.ElseBranch;
+         GetTPasImplBlock(TPasImplBlock(lice),lindent+1,0,false,false);
+        end;
+       if lLastNoSem then writeln(s,'end')//' {case}')
+        else writeln(s,'end;');// {case}');
+       //Result:=false; ??? GetTPasImplBlock
+      end
+     else if le is TPasImplRepeatUntil then
+      begin
+        liru:=TPasImplRepeatUntil(le);
+        writeln(s1,'repeat');
+        GetTPasImplBlock(TPasImplBlock(liru),lindent+1,0,false,false);
+        write(s,'until ',DelQuot(liru.Condition));
+        if lLastNoSem then writeln
+         else writeln(';');
+      end
+     else if le is TPasImplTryFinally then
+      begin
+       writeln(s,'finally');
+       GetTPasImplBlock(TPasImplBlock(le),lindent+1,0,false,false);
+      end
+     else if le is TPasImplTryExcept then
+      begin
+       writeln(s,'except');
+       GetTPasImplBlock(TPasImplBlock(le),lindent+1,0,false,false);
+      end
+     else if le is TPasImplTryExceptElse then
+      begin
+       writeln(s,'else');// {try}');
+       GetTPasImplBlock(TPasImplBlock(le),lindent+1,0,false,false);
+      end
+     else if le is TPasImplTry then
+      begin
+       lit:=TPasImplTry(le);
+       writeln(s1,'try');
+       GetTPasImplBlock(TPasImplBlock(le),lindent+1,0,false,false);
+       if assigned(lit.FinallyExcept) then
+          GetTPasImplElement(TPasImplElement(lit.FinallyExcept),lindent+1,false,false);
+       if assigned(lit.ElseBranch) then
+          GetTPasImplElement(TPasImplElement(lit.ElseBranch),lindent+1,false,false);
+       if lLastNoSem then writeln(s,'end')// {try} ') //there is no ImplBeginBlock
+        else writeln(s,'end;');// {try} ');
+      end
+     else if le is TPasImplCommand then
+      begin
+       //ignore because empty
+       // lic:=TPasImplCommand(le);
+       // writeln(' CMD ',lic.Command,' ',lic.Name,' ',lic.ElementTypeName);
+      end
+     else if le is TPasImplLabelMark then
+      begin
+       writeln(s1,'label ',TPasImplLabelMark(le).LabelId,';');
+      end
+     else if le is TPasImplBlock then
+      begin
+       //IfElse, case:
+       Result:=GetTPasImplBlock(TPasImplBlock(le),lindent+1,0,lLastNoSem,NoFirstIndent);
+      end
+     else
+      begin
+       Result:=false;
+       //writeln(s,';');
+       //writeln(' EL ',l);//,' ',le.Name)//,' ',le.ElementTypeName,' ',le.FullName);
+      end;
+ end;
+     
+// indent: indent from page left side
+// DecListBy: dec(elements.count) because of case duplicate else bug
+// LastNoSem: only true on last expr before else in a if clause
+// NoFirstIndent: if line was started by other block like in case at -> 1:Noindent;
+// Result: true if elements not empty
+function GetTPasImplBlock(lb:TPasImplBlock; indent,declistby:integer;
+                           LastNoSem,NoFirstIndent:boolean):boolean;
+   var l,n:integer;
+       lbe:TPasImplElement;
+       NoSem:boolean;
+       ls:String;     
+
+begin
+  Result:=false;
+  NoSem:=false;
+  ls:=GetIndent(indent);
+  if not assigned(lb) then exit;
+  //if lb is TPasImplRaise then writeln('RAISE');
+  if assigned(lb.Elements) then
+   begin
+    if lb is TPasImplBeginBlock then
+     begin
+      NoSem:=LastNoSem;
+      LastNoSem:=false;
+      if NoFirstIndent then
+       begin
+        writeln('begin');////NFI');
+        NoFirstIndent:=false;
+       end
+        else writeln(ls,'begin');
+      inc(indent);
+     end;
+
+    if lb.Elements.Count >0 then
+     begin
+      Result:=true;
+      n:=lb.Elements.Count-1;
+      //workaround CaseOf duplicate bug
+      if (declistby >0)and(lb.Elements.Count >declistby) then dec(n,declistby);
+      for l:=0 to n do
+       begin
+        lbe:=TPasImplElement(lb.Elements[l]);
+        //write(l:2,'/',n:2,' '); //No of curent element, max element
+        if ((l = 0)and NoFirstIndent) then
+         begin //index0
+          if l=n then GetTPasImplElement(lbe,0,LastNoSem,false)
+           else GetTPasImplElement(lbe,0,false,false)
+         end
+        else if l<>n then GetTPasImplElement(lbe,indent,false,false) //other index
+        else GetTPasImplElement(lbe,indent,LastNoSem,false); //indexn
+       end;
+     end
+    else
+     begin //block is empty
+      //write(ls,' {!EMPTY!}');
+       {if not NoSem then
+        begin
+         if lb is TPasImplBeginBlock then writeln //empty compound need no ;
+          else writeln(';')
+        end
+         else
+          writeln;}
+     end;
+    if lb is TPasImplBeginBlock then
+      if not NoSem then writeln(ls,'end;')// {Block}') 
+        else writeln(ls,'end');// {Block}');
+   end
+    else
+      writeln(';'); //writeln(' {!empty!};')
+end;
+
+
+//# Declarations (type,var,const,..)
+
+procedure GetTPasArrayType(lpat:TPasArrayType);
+ begin
+  if lpat.IsPacked then write('packed ');
+  write('Array');
+  if lpat.IndexRange <> '' then write('[',lpat.IndexRange,']');
+  if assigned(lpat.ElType) then write(' of ',lpat.ElType.Name);
+   // BUG: of const missing in Procedure ConstArrayArgProc(A: Array of const); pparser: 643
+ end;
+
+//write out one variable or constant declaration, also used in types
+//In spite of the use of GetPasVariables this is still used !
+procedure GetTPasVar(lpv:TPasVariable; lindent:integer; NoLF:boolean);//BUG string[] pparser: 482
+   var i,j:integer;
+       //lppt:TPasProcedureType;
+       //lpa:TPasArgument;
+       //lpat:TPasArrayType;
+       s,s1:string;
+       prct:TPasRecordType;
+
+  begin
+   if not Assigned(lpv) then exit;
+   s:=GetIndent(lindent);
+   write(s,lpv.Name);//,'  ',lpv.value,' ',lpv.Modifiers,' ',lpv.AbsoluteLocation);
+   if assigned(lpv.VarType) then
+     begin
+       //if TPasType(lpa.ArgType).ElementTypeName <>'unresolved type reference' then
+       //,TPasType(lpa.ArgType).Name,' ');//,TPasType(lpa.ArgType).FullName,TPasType(lpa.ArgType).ElementTypeName)
+       // PParser 2099: ArgType := nil; if IsUntyped then => Arg.ArgType := ArgType;
+       //     else write(':? ');
+       write(': ');
+       if lpv.VarType is TPasArrayType then
+        begin
+         GetTPasArrayType(TPasArrayType(lpv.VarType));
+        end
+       else if lpv.VarType is TPasSetType then
+        begin
+         write('set of ',TPasSetType(lpv.VarType).EnumType.Name);
+        end
+       else
+        begin
+          if lpv.VarType is TPasPointerType then
+                write('^',TPasPointerType(lpv.VarType).DestType.Name)
+          else if lpv.VarType is TPasRecordType then //var record
+           begin
+            j:=lindent+Length(lpv.Name)+4;
+            s1:=GetIndent(j);
+            prct:=TPasRecordType(lpv.VarType);
+            if prct.IsBitPacked then write('bitpacked ');
+            if prct.IsPacked then write('packed ');
+            writeln('Record');
+            for i:=0 to prct.Members.Count-1 do
+             begin
+              GetTPasVar(TPasVariable(prct.Members[i]),j+1,false);
+             end;
+            write(s1,'end');
+           end
+          else
+           begin
+            write(TPasType(lpv.VarType).Name);
+            //if TPasType(lpv.VarType) is TPasAliasType then write(TPasAliasType(lpv.VarType).Name);
+           end;
+        end;
+     end;
+   if lpv.Value <> '' then write('=',lpv.Value);
+   if assigned(lpv.Expr) then // var ?, const AnArrayConst : Array[1..3] of Integer = (1,2,3);
+     begin
+      write('=');
+      GetTPasExpr(lpv.Expr);
+     end;
+     
+   if lpv.Modifiers <>'' then //Modifiers starts with ;
+    begin
+     write(' ',lpv.Modifiers,';');
+     if GetTPasMemberHints(lpv.Hints) then write(';');
+    end
+   else
     begin
-     // remember to put the whole cmdline in quotes, and
-     // to always add some path options. Even if only -Fu. -Fi.
-      writeln('usage: test_parser <commandline>');
-      halt;
+     GetTPasMemberHints(lpv.Hints);
+     write(';');
     end;
-  cmdl:=paramstr(1);
-  if paramcount>1 then
-    for i:=2 to paramcount do
-      cmdl:=cmdl+' '+paramstr(i);
+   if not NoLF then writeln;
+  end;
+  
+//write out a list of variables only
+//more compact than the output of seperate calls of GetTPasVar
+procedure GetPasVariables(vl:TList; lindent:integer; NoLF,NoSEM:boolean);
+   var v,i,j:integer;
+       s,s1:string;
+       prct:TPasRecordType;
+       lpv:TPasVariable;
+       
+       same:boolean;
+       samestr,tmpstr:Ansistring;
+       samevar:array of integer;
+       svi:integer;
+
+  begin
+   if vl.Count <= 0 then exit; 
+   s:=GetIndent(lindent);
+   //> compare all variable types as string to find the ones with same type
+   samestr:='';
+   svi:=0;
+   SetLength(samevar,vl.count);
+   for v:=0 to vl.count-1 do
+    begin
+     tmpstr:=''; 
+     same:=true;   
+     lpv:=TPasVariable(vl[v]);
+     //write(s,lpv.Name);
+     if assigned(lpv.VarType) then
+      begin
+       tmpstr:=tmpstr+': ';
+       if lpv.VarType is TPasArrayType then
+         begin
+          //GetTPasArrayType(TPasArrayType(lpv.VarType));
+          tmpstr:=tmpstr+'array'+TPasArrayType(lpv.VarType).IndexRange;
+          if assigned(TPasArrayType(lpv.VarType).ElType) then
+           tmpstr:=tmpstr+TPasArrayType(lpv.VarType).ElType.Name;
+         end
+       else if lpv.VarType is TPasSetType then
+         begin
+          tmpstr:=tmpstr+'set of '+TPasSetType(lpv.VarType).EnumType.Name;
+         end
+       else
+        begin
+         if lpv.VarType is TPasPointerType then
+            tmpstr:=tmpstr+'^'+TPasPointerType(lpv.VarType).DestType.Name
+         else if lpv.VarType is TPasRecordType then //var record
+           begin
+            prct:=TPasRecordType(lpv.VarType);
+            if prct.IsBitPacked then tmpstr:=tmpstr+'bitpacked ';
+            if prct.IsPacked then tmpstr:=tmpstr+'packed ';
+            tmpstr:=tmpstr+'Record ';
+            for i:=0 to prct.Members.Count-1 do
+             begin
+              //todo
+              //GetTPasVar(TPasVariable(prct.Members[i]),j+1,false);
+             end;
+            tmpstr:=tmpstr+'end';
+           end
+         else
+          begin
+            tmpstr:=tmpstr+TPasType(lpv.VarType).Name;
+          end;
+        end;
+      end
+        else same:=false;
+     if lpv.Value <> '' then same:=false;//=
+     if assigned(lpv.Expr) then // var ?, const AnArrayConst : Array[1..3] of Integer = (1,2,3);
+      begin
+       same:=false;//=
+      end;
+     if lpv.Modifiers <>'' then //Modifiers starts with ;
+      begin
+       tmpstr:=tmpstr+' '+lpv.Modifiers+';';
+       tmpstr:=tmpstr+ReturnTPasMemberHints(lpv.Hints);
+      end
+     else
+      begin
+       tmpstr:=tmpstr+ReturnTPasMemberHints(lpv.Hints);
+      end;
+  //if v = 0 then begin samestr:=tmpstr; end;
+     if (not same)or(samestr <> tmpstr) then
+       begin
+        samestr:=tmpstr;
+        inc(svi);
+       end;
+     samevar[v]:=svi;
+   end;
+   //compare <
+   //now print them
+   svi:=-1; 
+   for v:=0 to vl.count-1 do
+    begin
+     lpv:=TPasVariable(vl[v]);
+     if not Assigned(lpv) then continue;
+     if svi <> samevar[v] then
+       begin
+        svi:=samevar[v];
+        if v>0 then writeln;
+        write(s,lpv.Name);//variblenname
+       end
+        else write(lpv.Name);
+     if (v < vl.Count-1)and(samevar[v+1]=svi) then write(',')
+      else
+       begin
+        if assigned(lpv.VarType) then
+         begin
+           write(': ');
+           if lpv.VarType is TPasArrayType then
+            begin
+             GetTPasArrayType(TPasArrayType(lpv.VarType));
+            end
+           else if lpv.VarType is TPasSetType then
+            begin
+             write('set of ',TPasSetType(lpv.VarType).EnumType.Name);
+            end
+           else
+            begin
+             if lpv.VarType is TPasPointerType then
+                write('^',TPasPointerType(lpv.VarType).DestType.Name)
+             else if lpv.VarType is TPasRecordType then //var record
+              begin
+               j:=lindent+Length(lpv.Name)+4;
+               s1:=GetIndent(j);
+               prct:=TPasRecordType(lpv.VarType);
+               if prct.IsBitPacked then write('bitpacked ');
+               if prct.IsPacked then write('packed ');
+               writeln('Record');
+               {for i:=0 to prct.Members.Count-1 do
+                 begin
+                  GetTPasVar(TPasVariable(prct.Members[i]),j+1,false);
+                 end;}
+               if prct.Members.Count > 0 then
+                 GetPasVariables(prct.Members,j+1,false,false);
+               write(s1,'end');
+              end
+             else
+              begin
+               write(TPasType(lpv.VarType).Name);
+              end;
+            end;
+         end;
+        if lpv.Value <> '' then write('=',lpv.Value);
+        if assigned(lpv.Expr) then // var ?, const AnArrayConst : Array[1..3] of Integer = (1,2,3);
+         begin
+          write('=');
+          GetTPasExpr(lpv.Expr);
+         end;
+
+        if lpv.Modifiers <>'' then //Modifiers starts with ;
+         begin
+          write(' ',lpv.Modifiers,';');
+          if GetTPasMemberHints(lpv.Hints) then write(';');
+         end
+        else
+         begin
+          GetTPasMemberHints(lpv.Hints);
+          if (v < vl.Count-1) then write(';')
+            else if (not NoSEM) then write(';');
+         end;
+	   //if not NoLF then writeln;
+       end;
+     end;
+    if not NoLF then writeln;
+  end;  
+  
+
+procedure GetTypes(pe:TPasElement; lindent:integer);
+  var i,j,k:integer;
+      s,s1,s2:string;
+      pet:TPasEnumType;
+      pev:TPasEnumValue;
+
+      prt:TPasRangeType;
+      prct:TPasRecordType;
+      pv:TPasVariant;
+      pst:TPasSetType;
+
+
+  function GetVariantRecord(pe:TPasElement; lindent:integer):boolean;
+    var i,j,k:integer;
+        prct:TPasRecordType;
+        pv:TPasVariant;
+        s,s1:string;
+
+   begin
+    Result:=false;
+    j:=lindent+Length(pe.Name)+2;
+    s:=GetIndent(lindent);
+    s1:=GetIndent(lindent+2);
+    prct:=TPasRecordType(pe);
+    {Now i use GetPasVariables for more compact output
+     for i:=0 to prct.Members.Count-1 do
+     begin
+      GetTPasVar(TPasVariable(prct.Members[i]),1,true);
+     end;}
+    if prct.Members.Count > 0 then GetPasVariables(prct.Members,1,true,true);  
+    if assigned(prct.Variants) then
+     begin
+      Result:=true;
+      writeln(';');
+      write(s,'case ');
+      if prct.VariantName <>'' then write(prct.VariantName,'=');
+      write(TPasType(prct.VariantType).Name);
+      writeln(' of');
+      if assigned(prct.Variants)then
+       if prct.Variants.Count >0 then
+        begin
+         for i:=0 to prct.Variants.Count-1 do
+          begin
+           pv:=TPasVariant(prct.Variants[i]);
+           write(s1,pv.Name);
+           for k:=0 to pv.Values.Count-1 do write(pv.Values[k]);
+           write(': (');
+           if GetVariantRecord(TPasElement(pv.Members),j+1) then
+             writeln(s1,');')
+              else writeln(');');
+          end;
+        end;
+     end;
+   end;
+
+ begin
+  s:=GetIndent(lindent);
+  write(s,pe.Name,'=');
+  if pe is TPasArrayType then
+   begin
+     GetTPasArrayType(TPasArrayType(pe));
+     writeln(';');
+   end
+  else if pe is TPasEnumType then
+   begin
+    pet:=TPasEnumType(pe);
+    write('(');
+    if pet.Values.Count > 0 then
+     begin
+      for j:=0 to pet.Values.Count-2 do
+       begin
+        pev:=TPasEnumValue(pet.Values[j]);
+        write(pev.name,',');
+        //pev.Value ?
+        //pev.AssignedValue ?
+        //pev.IsValueUsed ?
+       end;
+      pev:=TPasEnumValue(pet.Values[pet.Values.Count-1]);
+      write(pev.name);
+     end;
+    writeln(');');
+   end
+  else if pe is TPasFileType then
+   begin
+    writeln('file of ',TPasFileType(pe).ElType.Name,';');
+   end
+  else if pe is TPasProcedureType then
+   begin
+    writeln('procedure');
+   end
+  else if pe is TPasPointerType then
+   begin
+    //writeln('pointer');
+    writeln('^',TPasPointerType(pe).DestType.Name,';');
+   end
+  else if pe is TPasRangeType then
+   begin
+    prt:=TPasRangeType(pe);
+    writeln(prt.RangeStart,'..',prt.RangeEnd,';');
+   end
+  else if pe is TPasRecordType then
+   begin
+    j:=lindent+Length(pe.Name)+2;
+    s1:=GetIndent(j);
+    s2:=GetIndent(j+1);
+    prct:=TPasRecordType(pe);
+    if prct.IsBitPacked then write('bitpacket ');
+    if prct.IsPacked then write('packet');
+    writeln('record');
+    {Now i use GetPasVariables for more compact output
+     for i:=0 to prct.Members.Count-1 do
+     begin
+      GetTPasVar(TPasVariable(prct.Members[i]),j+1,false);
+     end;}
+    GetPasVariables(prct.Members,j+2,false,false);
+    if assigned(prct.Variants) then
+     begin
+      write(s1,'case ');
+      if prct.VariantName <>'' then write(prct.VariantName,'=');
+        write(TPasType(prct.VariantType).Name);
+      writeln(' of');
+      if assigned(prct.Variants)then
+       if prct.Variants.Count >0 then
+        begin
+         for i:=0 to prct.Variants.Count-1 do
+          begin
+           pv:=TPasVariant(prct.Variants[i]);
+           write(s2,pv.Name);
+           for k:=0 to pv.Values.Count-1 do write(pv.Values[k]);
+           write(': (');
+           if GetVariantRecord(TPasElement(pv.Members),j+2) then
+             writeln(s2,');')
+              else writeln(');');
+          end;
+        end;
+     end;
+    writeln(s1,'end;');
+   end
+  else if pe is TPasSetType then
+   begin
+    pst:=TPasSetType(pe);
+    writeln('set of ',pst.EnumType.Name,';');
+   end
+  else if pe is TPasClassOfType then writeln('Class of ',TPasClassOfType(pe).DestType.Name,';')
+  else
+   begin
+    
+    writeln('{ Unknown TYPE(s): ');
+    writeln(s,pe.Name);
+    writeln('}');
+    writeln;
+   end;
+ end;
+
+
+ function GetTPasArgumentAccess(acc:TArgumentAccess):String;
+  begin
+   Result:='';
+   case acc of
+     //argDefault:Result:='default'; //normal proccall is default
+     argConst:Result:='const';
+     argVar:Result:='var';
+     argOut:Result:='out';
+   end;
+  end;
+
+ procedure GetTCallingConvention(cc:TCallingConvention);  //TODO: test it
+  begin
+   case cc of
+     //ccDefault:write(' default;'); //normal proccall is default
+     ccRegister:WriteFmt(true,'Register;',false);
+     ccPascal  :WriteFmt(true,'Pascal;',false);
+     ccCDecl   :WriteFmt(true,'CDecl;',false);
+     ccStdCall :WriteFmt(true,'StdCall;',false);
+     ccOldFPCCall:WriteFmt(true,'OldFPCall;',false);
+     ccSafeCall:WriteFmt(true,'SaveCall;',false);
+   end;
+  end;
+  
+ procedure GetHiddenModifiers(Mfs:TProcedureModifiers);
+  begin
+   if pmInline in Mfs then WriteFmt(true,'inline;',false);
+   if pmAssembler in Mfs then WriteFmt(true,'assembler;',false);
+   if pmVarargs in Mfs then WriteFmt(true,'varargs;',false);
+   if pmCompilerProc in Mfs then WriteFmt(true,'compilerproc;',false);
+   if pmExtdecl in Mfs then WriteFmt(true,'extdecl;',false);
+  end; 
+
+  procedure GetTPasProcedure(lpp:TPasProcedure; indent:integer);
+   var l:integer;
+       lppt:TPasProcedureType;
+       lpa:TPasArgument;
+       s:String;
+       
+       same:boolean;
+       samevar:array of integer;//same index same type
+       aktaa:TArgumentAccess;
+       aktname,tmpname:String;
+       svi:integer;
+
+  begin
+   if not Assigned(lpp) then exit;
+   s:=GetIndent(indent);
+   if lpp is TPasConstructor then write(s,'Constructor ')
+    else if TPasElement(lpp) is TPasConstructorImpl then write(s,'Constructor ')
+    else if lpp is TPasDestructor then write(s,'Destructor ')
+    else if TPasElement(lpp) is TPasDestructorImpl then write(s,'Destructor ')
+    else if lpp is TPasClassProcedure then write(s,'Class Procedure ') //pparser.pp: 3221
+    else if lpp is TPasClassFunction then write(s,'Class Function ')
+    else if lpp is TPasFunction then write(s,'Function ')
+      else write(s,'Procedure ');
+   write(lpp.Name);//,' ',lpp.TypeName);
+   if assigned(lpp.ProcType) then
+    begin
+     lppt:=lpp.ProcType;
+     if assigned(lppt.Args) and (lppt.Args.Count > 0) then
+      begin
+       write('(');
+       if lppt.Args.Count > 0 then 
+        begin
+         //produce more compact output than the commented block below
+         //>find same declaration
+         //look ahead what is the same
+         SetLength(samevar,lppt.Args.Count);
+         svi:=0;
+         aktname:='';
+         for l:=0 to lppt.Args.Count-1 do
+          begin
+           same:=true;
+           tmpname:='';
+           lpa:=TPasArgument(lppt.Args.Items[l]);
+           if assigned(lpa.ArgType) then
+            begin
+             if lpa.ArgType is TPasArrayType then
+              begin
+                if assigned(TPasArrayType(lpa.ArgType).ElType) then tmpname:=TPasArrayType(lpa.ArgType).ElType.Name;
+              end
+               else tmpname:=TPasType(lpa.ArgType).Name;
+            end;
+           if l=0 then begin aktaa:=lpa.Access; aktname:=tmpname; end;   
+           if lpa.Access <> aktaa then begin same:=false; aktaa:=lpa.Access; end;//access type 
+           if (tmpname = '')or(tmpname <> aktname) then begin same:=false; aktname:=tmpname; end;//type name
+           if lpa.Value <> '' then same:=false;//var=value
+           if not same then inc(svi); 
+           samevar[l]:=svi;
+          end; 
+        //find same declaration<  
+        svi:=-1;
+        same:=false;
+        for l:=0 to lppt.Args.Count-1 do
+         begin
+          lpa:=TPasArgument(lppt.Args.Items[l]);
+          if svi <> samevar[l] then
+           begin
+            svi:=samevar[l];
+            if lpa.Access <> argDefault then write(GetTPasArgumentAccess(lpa.Access),' '); 
+            write(lpa.Name);//variblenname
+           end
+             else write(lpa.Name); 
+          if (l < lppt.Args.Count-1)and(samevar[l+1]=svi) then write(',')
+           else
+            begin
+             if assigned(lpa.ArgType) then
+              begin
+               write(': ');
+               if lpa.ArgType is TPasArrayType then
+                GetTPasArrayType(TPasArrayType(lpa.ArgType))
+                 else write(TPasType(lpa.ArgType).Name);
+              end;
+             if lpa.Value <> '' then write('=',lpa.Value);
+             if l< lppt.Args.Count-1 then write('; ');
+           end;    
+         end; 
+       {//simple version duplicates declarations of same type
+        for l:=0 to lppt.Args.Count-1 do
+        begin
+         lpa:=TPasArgument(lppt.Args.Items[l]);
+          if lpa.Access <> argDefault then write(GetTPasArgumentAccess(lpa.Access),' '); 
+         write(lpa.Name);//variblenname
+         if assigned(lpa.ArgType) then
+          begin
+           //if TPasType(lpa.ArgType).ElementTypeName <>'unresolved type reference' then
+           //,TPasType(lpa.ArgType).Name,' ');
+           //,TPasType(lpa.ArgType).FullName,TPasType(lpa.ArgType).ElementTypeName)
+           // PParser 2099: ArgType := nil; if IsUntyped then => Arg.ArgType := ArgType;
+           //     else write(':? ');
+           write(': ');
+           if lpa.ArgType is TPasArrayType then
+            begin
+             GetTPasArrayType(TPasArrayType(lpa.ArgType));
+            end
+             else  write(TPasType(lpa.ArgType).Name);
+          end;
+         if lpa.Value <> '' then write('=',lpa.Value);
+         if l< lppt.Args.Count-1 then write('; ');
+        end;}
+        end;
+       write(')');
+      end;
+     if lppt.IsOfObject then write(' of Object'); 
+     if (TPasElement(lpp) is TPasFunction)or(TPasElement(lpp) is TPasClassFunction) then 
+         write(': ',TPasFunctionType(lpp.ProcType).ResultEl.ResultType.Name);
+    end;
+   //writeln(';');
+   WriteFmt(false,'',true);
+   if lpp.IsVirtual then WriteFmt(true,'virtual;',false);
+   if lpp.IsOverload then WriteFmt(true,'overload;',false);
+   if lpp.IsAbstract then WriteFmt(true,'abstract;',false);
+   if lpp.IsDynamic then WriteFmt(true,'dynamic;',false);
+   if lpp.IsOverride then WriteFmt(true,'override;',false);
+   if lpp.IsExported then WriteFmt(true,'exported;',false);
+   if lpp.IsExternal then WriteFmt(true,'external;',false);
+   //pparser 2360: everyting behind external is ignored !!!
+   if lpp.IsMessage then
+    begin
+      write('message ');
+      if lpp.MessageType = pmtString then writeln(false,lpp.MessageName,true)
+       else WriteFmt(false,lpp.MessageName,true);//pmtInteger
+    end;
+   if lpp.IsReintroduced then WriteFmt(true,'reintroduce;',false);
+   if lpp.IsStatic then WriteFmt(true,'static;',false);
+   if lpp.IsForward then WriteFmt(true,'forward;',false);
+   GetHiddenModifiers(lpp.Modifiers);
+   GetTCallingConvention(lpp.CallingConvention);
+   if GetTPasMemberHints(TPasElement(lpp).Hints) then WriteFmt(false,'',true); //BUG ? missing hints
+   if not Unformated then writeln;
+  end;
+
+ procedure GetTPasProcedureBody(pb:TProcedureBody; indent:integer);
+   var j:integer;
+       pd:TPasDeclarations;
+       pib:TPasImplBlock;
+  begin
+   if assigned(pb) then
+    begin
+     if assigned(pb.Body)then
+      begin
+       if assigned(TPasDeclarations(pb).Functions)then
+        begin
+         pd:=TPasDeclarations(pb);
+         if isim then
+          begin
+           //writeln;
+           GetDecls(pd,indent+1);     //~recursion
+           //PrintDecls(pd,indent+1); //~recursion
+          end
+         else
+          if pd.Functions.Count >0 then //sub-functions
+           begin
+            for j:=0 to pd.Functions.Count-1 do
+              GetTPasProcedure(TPasProcedure(pd.Functions[j]),indent+1);
+           end;
+        end;
+       pib:=TPasImplBlock(pb.Body);
+       if assigned(pib) then
+        begin
+          GetTPasImplBlock(pib,indent,0,false,false); //indent depend on sub function level
+          if not Unformated then writeln; //('//block');
+        end;
+      end;
+    end;
+  end;
+
+ procedure GetTpasOverloadedProc(pop:TPasOverloadedProc; indent:integer);
+   var pp:TPasProcedure;
+       j:integer;
+  begin
+   if assigned(pop) then
+    begin
+     if pop.Overloads.Count >0 then
+      begin
+       for j:=0  to pop.Overloads.Count-1 do
+        begin
+         pp:=TPasProcedure(pop.Overloads[j]);
+         GetTPasProcedure(pp,indent);
+         GetTPasProcedureBody(pp.Body,indent);
+        end;
+      end;
+    end;
+  end;
+
+ function GetVisibility(v:TPasMemberVisibility):String;
+  begin
+   Result:='';
+   case v of
+    //visDefault:Result:='default';
+    visPrivate:Result:='private';
+    visProtected:Result:='protected';
+    visPublic:Result:='public';
+    visPublished:Result:='published';
+    visAutomated:Result:='automated';
+    visStrictPrivate:Result:='strictprivate';
+    visStrictProtected:Result:='strictprotected';
+   end;
+  end;
+
+ procedure GetTPasClass(pc:TPasClassType; indent:integer);
+   var j,l:integer;
+       s,s1,s2:String;
+       lpe:TPasElement;
+       lpp:TPasProperty;
+       lpa:TPasArgument;
+       vis:TPasMemberVisibility;
+       vars:TList;
+       IsVar:boolean;
+
+  procedure PrintVars;
+   begin
+    if vars.Count > 0 then GetPasVariables(vars,indent+1,false,false);
+    IsVar:=False;
+    vars.Clear;
+   end;
+
+  begin
+   if assigned(pc) then
+    begin
+     s:=GetIndent(indent);
+     write(s,pc.Name,'=');
+     if pc.IsPacked then write('packed ');
+     case pc.ObjKind of
+      okObject:write('Object');
+      okClass:write('Class');
+      okInterface:write('Interface');
+     end;
+     if assigned(pc.AncestorType) and (pc.AncestorType.ElementTypeName <> '') then
+        write('(',pc.AncestorType.Name,')');
+
+     if pc.IsForward or pc.IsShortDefinition then //pparser.pp: 3417 :class(anchestor); is allowed !
+      begin
+       writeln(';');
+       exit;
+      end;  
+    //Members: TList;
+    //InterfaceGUID: String;
+    //ClassVars: TList; //is this always empty ?
+    //Modifiers: TStringList;
+    //Interfaces: TList;
+      s1:=GetIndent(indent+1);
+      s2:=GetIndent(indent+2);
+      if pc.Members.Count > 0 then
+       begin
+        writeln;
+        vars:=TList.Create;
+        IsVar:=false;
+        for j:=0 to pc.Members.Count-1 do
+         begin
+           lpe:=TPasElement(pc.Members[j]);
+
+           //Class visibility, written on change
+           if j=0 then
+            begin
+             vis:=lpe.Visibility;
+             if GetVisibility(vis) <> '' then writeln(s1,GetVisibility(vis));
+            end
+           else
+            if vis <> lpe.Visibility then
+             begin
+              if IsVar then PrintVars;
+              if lpe.Visibility <> visDefault then //Class Function = visDefault
+               begin
+                vis:=lpe.Visibility;
+                if GetVisibility(vis) <> '' then writeln(s1,GetVisibility(vis));
+               end;
+             end;
+
+           if lpe is TPasOverloadedProc then
+            begin
+             if IsVar then PrintVars;
+             GetTPasOverloadedProc(TPasOverloadedProc(lpe),indent+2);
+            end
+           else if lpe is TPasProcedure then //TPasClassProcedure and
+            begin         //TPasClassFunction are both child of TPasProcedure
+             if IsVar then PrintVars;
+             GetTPasProcedure(TPasProcedure(lpe),indent+2);
+            end
+           else if lpe is TPasProperty then
+            begin
+             if IsVar then PrintVars;
+             lpp:=TPasProperty(lpe);
+             write(s2,'property ',lpp.Name);
+             if lpp.Args.Count >0 then
+              begin
+               for l:=0 to lpp.Args.Count-1 do
+                begin
+                 lpa:=TPasArgument(lpp.Args.Items[l]);
+                 if GetTPasArgumentAccess(lpa.Access) <> '' then
+                   write('[',GetTPasArgumentAccess(lpa.Access),' ',lpa.Name)
+                    else write('[',lpa.Name); //variblename
+                 if assigned(lpa.ArgType) then
+                  begin
+                   //if TPasType(lpa.ArgType).ElementTypeName <>'unresolved type reference' then
+                   //,TPasType(lpa.ArgType).Name,' ');
+                   //,TPasType(lpa.ArgType).FullName,TPasType(lpa.ArgType).ElementTypeName)
+                   // PParser 2099: ArgType := nil; if IsUntyped then => Arg.ArgType := ArgType;
+                   //     else write(':? ');
+                   write(': ');
+                   if lpa.ArgType is TPasArrayType then
+                    begin
+                     GetTPasArrayType(TPasArrayType(lpa.ArgType));
+                    end
+                     else  write(TPasType(lpa.ArgType).Name);
+                  end;
+                 if lpa.Value <> '' then write('=',lpa.Value);
+                 write(']');
+                end;
+              end;//args
+             if assigned(lpp.VarType) then
+              begin
+               write(': ',TPasType(lpp.VarType).Name);
+              end;
+             if lpp.IndexValue <> '' then write(' Index ',lpp.IndexValue);
+             if lpp.ReadAccessorName <> '' then write(' Read ',lpp.ReadAccessorName);
+             if lpp.WriteAccessorName <> '' then write(' Write ',lpp.WriteAccessorName);
+             if lpp.ImplementsName <> '' then write(' Implements ',lpp.ImplementsName);
+             if lpp.IsDefault then write(' Default ',lpp.DefaultValue);
+             if lpp.IsNodefault then write(' NoDefault');
+             if lpp.StoredAccessorName <> '' then write(' Stored ',lpp.StoredAccessorName);
+             GetTPasMemberHints(lpp.Hints);
+             writeln(';');
+            end
+           else if lpe is TPasVariable then
+            begin
+             //this is done with printvars
+             //GetTPasVar(TPasVariable(lpe),indent+1,false);
+             IsVar:=true;
+             vars.add(lpe);
+            end
+           else
+            begin
+             if IsVar then PrintVars;
+             writeln('{ Unknown Declaration(s) in Class/Object/Interface: ');
+             writeln(s,lpe.Name);
+             writeln('}');
+            end;
+         end;
+        //writeln(s,'end;');//'//class');
+         if IsVar then PrintVars;
+         vars.free;
+       end
+        else  writeln;//(';'); //x=class(y);
+     writeln(s,'end;');
+    end;
+  end;
+
+
+procedure GetDecls(Decl:TPasDeclarations; indent:integer);
+ var i,j:integer;
+     pe:TPasElement;
+     pp:TPasProcedure;
+     ps:TPasSection;
+     s:string;
+     x:(None,ResStrings,Types,Consts,Classes,Functions,Variables,Properties);
+     l:TList;
+
+  procedure PrintVars;
+   begin
+    if l.Count > 0 then GetPasVariables(l,indent+1,false,false);
+   end;
+
+begin
+ s:=GetIndent(indent);
+ x:=None;
+ if assigned(Decl)then
+  begin
+   l:=TList.Create;
+   pe:=TPasElement(Decl);
+   if pe is TPasSection then
+    begin
+     {(Decl is TInterfaceSection)or(Decl is TImplementationSection) or
+     (Decl is TProgramSection}
+     ps:=TPasSection(pe);
+     if ps.UsesList.Count >0 then
+      begin
+       write(s,'uses ');
+       ps:=TPasSection(Decl);
+       if not Unformated then begin writeln; write(s,'  '); end;
+       for i:=0 to ps.UsesList.Count-2 do
+        if UpCase(TPasElement(ps.UsesList[i]).Name) = 'SYSTEM' then continue //do not print system
+         else write(TPasElement(ps.UsesList[i]).Name,',');                   //as it is added by parser
+       writeln(TPasElement(ps.UsesList[ps.UsesList.Count-1]).Name,';');
+       if not Unformated then writeln;
+      end;
+    end;
+   if assigned(Decl.Declarations)and(Decl.Declarations.Count > 0) then
+   for j:=0 to Decl.Declarations.Count-1 do
+    begin
+     pe:=TPasElement(Decl.Declarations[j]);
+     if pe is TPasResString then
+       begin
+        if x = Variables then PrintVars;
+        if x <> ResStrings then
+         begin
+          if not Unformated then writeln;
+          writeln(s,'ResourceString');
+          x:=ResStrings;
+         end;
+        writeln(s,pe.Name,'=',DelQuot(TPasResString(pe).Value),';'); //too much '''
+       end
+     else if pe is TPasConst then
+       begin
+        if x = Variables then PrintVars;
+        if x <> Consts then
+         begin
+          if not Unformated then writeln;
+          writeln(s,'const');
+          x:=Consts;
+         end;
+        GetTPasVar(TPasVariable(pe),indent+1,false);
+       end
+     else if pe is TPasVariable then
+       begin
+        if x <> Variables then
+         begin
+          if not Unformated then writeln;
+          writeln(s,'var');
+          x:=Variables;
+          l.Clear;
+         end;
+        l.Add(pe);
+        //this is done with printvars
+        //GetTPasVar(TPasVariable(pe),indent+1,false);
+       end
+     else if pe is TPasClassType then
+       begin
+        if x = Variables then PrintVars;
+        if x <> Types then
+         begin
+          if not Unformated then writeln;
+          writeln(s,'Type');
+          x:=Types;
+         end;
+        GetTPasClass(TPasClassType(pe),indent+1);
+       end
+     else if pe is TPasType then
+       begin
+        if x = Variables then PrintVars;
+        if x <> Types then
+         begin
+          if not Unformated then writeln;
+          writeln(s,'Type');
+          x:=Types;
+         end;
+        GetTypes(TPasElement(pe),indent+1);
+       end
+     else if pe is TPasProcedureBase then
+       begin
+        if x = Variables then PrintVars;
+        if (x <> Functions)and not Unformated then writeln;
+        x:=Functions;
+        if pe is TPasOverloadedProc then
+          begin
+           GetTpasOverloadedProc(TPasOverloadedProc(pe),indent);
+          end
+         else
+          begin
+           pp:=TPasProcedure(pe);
+           GetTPasProcedure(pp,indent);
+           GetTPasProcedureBody(pp.Body,indent);
+          end;
+       end
+      else
+       begin
+        if x = Variables then PrintVars;
+        x:=None;
+        writeln('{ Unknown Declaration: ',pe.Name,' }');
+       end;
+    end;
+   if x = Variables then PrintVars;
+   l.Free;
+  end;
+end;
+
+{replaced by GetDecls
+ this does the same but not in true order
+
+procedure PrintDecls(Decl:TPasDeclarations; indent:integer);
+ var i:integer;
+     pe:TPasElement;
+     pp:TPasProcedure;
+     ps:TPasSection;
+     s:string;
+     istype:boolean;
+
+begin
+ istype:=false;
+ s:=GetIndent(indent);
+ if (Decl is TInterfaceSection)or(Decl is TImplementationSection) or
+     (Decl is TProgramSection) then
+  if TPasSection(Decl).UsesList.Count >0 then
+    begin
+     write(s,'uses ');
+     ps:=TPasSection(Decl);
+     if not Unformated then begin writeln; write(s,'  '); end;
+     for i:=0 to ps.UsesList.Count-2 do
+      if UpCase(TPasElement(ps.UsesList[i]).Name) = 'SYSTEM' then continue //do not print system
+       else write(TPasElement(ps.UsesList[i]).Name,',');                   //as it is added by parser
+     writeln(TPasElement(ps.UsesList[ps.UsesList.Count-1]).Name,';');
+     if not Unformated then writeln;
+    end;
+
+  if assigned(Decl.ResStrings) then
+    if Decl.ResStrings.Count >0 then
+     begin
+      writeln('ResourceString');
+      for i := 0 to Decl.ResStrings.Count - 1 do
+       begin
+        pe:=TPasElement(Decl.ResStrings[i]);
+        writeln(s,pe.Name,'=',DelQuot(TPasResString(pe).Value),';'); //too much '''
+       end;
+      if not Unformated then writeln;
+     end;
+
+  if assigned(Decl.Consts)then
+    if Decl.Consts.Count >0 then
+     begin
+      writeln(s,'const');
+      for i:=0 to Decl.Consts.Count-1 do GetTPasVar(TPasVariable(Decl.Consts[i]),indent+1,false);
+      if not Unformated then writeln;
+     end;
+
+  if assigned(Decl.Types) then
+    if Decl.Types.Count >0 then
+     begin
+      writeln(s,'Type');
+      for i := 0 to Decl.Types.Count - 1 do
+       begin
+        GetTypes(TPasElement(Decl.Types[i]),indent+1);
+       end;
+      if not Unformated then writeln;
+      istype:=true; 
+     end;
+
+  if assigned(Decl.Classes) then
+    if Decl.Classes.Count >0 then
+     begin
+      if not istype then writeln('Type');
+      for i := 0 to Decl.Classes.Count - 1 do
+       begin
+        pe:=TPasElement(Decl.Classes[i]);
+        GetTPasClass(TPasClassType(pe),indent+1);
+        if not Unformated then writeln;
+       end;
+     end;
+
+  if assigned(Decl.Variables)then
+    if Decl.Variables.Count >0 then
+     begin
+       writeln(s,'var');
+       //Now i use GetPasVariables for more compact output
+       //for i:=0 to Decl.Variables.Count-1 do GetTPasVar(TPasVariable(Decl.Variables[i]),indent+1,false);
+       GetPasVariables(Decl.Variables,indent+1,false,false);
+       if not Unformated then writeln;
+     end;
+
+  if assigned(Decl.Functions) then
+   begin
+    for i := 0 to Decl.Functions.Count - 1 do
+     begin
+       pe:=TPasElement(Decl.Functions[i]);
+       if pe is TPasOverloadedProc then
+        begin
+         GetTpasOverloadedProc(TPasOverloadedProc(pe),indent);
+        end
+       else
+        begin
+         pp:=TPasProcedure(pe);
+         GetTPasProcedure(pp,indent);
+         GetTPasProcedureBody(pp.Body,indent);
+        end;
+     end;
+   end;
+end;   }
+
+//# parameter
+
+ procedure PrintUsage;
+  begin
+   writeln('usage: test_parser1 <Options> <Commandline> File');
+   writeln;
+   writeln(' <Options> : Options for test_parser1');
+   writeln('  -u  : Unformated output');
+   writeln('  -OS <os>   : <os>  = WINDOWS, LINUX (default), FREEBSD, NETBSD,');
+   writeln('                        SUNOS, BEOS, QNX, GO32V2');
+   writeln('  -CPU <cpu> : <cpu> = i386 (default), x86_64');
+   writeln(' <Commandline> : is the commandline for the parser');
+   writeln('  -d<define>        : <define> = Directive');
+   writeln('  -Fi<include_path> : <include_path> = ?');
+   writeln('  -I<include_path>  : <include_path> = ?');
+   writeln('  -Sd               : mode delphi');
+   writeln(' File : a pascal source file (Program or Unit)');
+  end;
+
+ procedure GetParam;
+  begin
+    if paramcount>0 then
+     begin
+      cmdl:='';
+      i:=1;
+      repeat
+        if paramstr(i) = '-h' then
+         begin
+          PrintUsage;
+          halt(0);
+         end
+        else if paramstr(i) = '-u' then Unformated:= true
+        else if paramstr(i) = '-OS' then
+         begin
+          if i < paramcount then
+           begin
+            inc(i);
+            TargetOS:=paramstr(i);
+            if (TargetOS = '')or(TargetOS[1] = '-') then halt(1);
+           end
+            else halt(1);
+         end
+        else if paramstr(i) = '-CPU' then
+         begin
+          if i < paramcount then
+           begin
+            inc(i);
+            TargetCPU:=paramstr(i);
+            if (TargetCPU = '')or(TargetCPU[1] = '-') then halt(1);
+           end
+            else halt(1);
+         end
+        else
+          cmdl:=cmdl+' '+paramstr(i);
+       inc(i);
+      until i > paramcount;
+     end;
+    if (Paramcount < 1)or(cmdl = '') then
+     begin
+      // remember to put the whole cmdline in quotes, and
+      // to always add some path options. Even if only -Fu. -Fi.
+       writeln('Error: No file for input given !');
+       PrintUsage;
+       halt(1);
+     end;
+  end;
+
+//# ***    main    ***
+
+begin
+  isim:=false;
+  Unformated:=false;//false to format output to be human readable
+  TargetOS:='linux';
+  TargetCPU:='i386';
+  GetParam;
+  //writeln(TargetOS,' ',TargetCPU,' ',cmdl);halt;
   E := TSimpleEngine.Create;
   try
     try
-      M := ParseSource(E, cmdl , 'linux', 'i386');
+      M := ParseSource(E, cmdl ,TargetOS ,TargetCPU);
     except
       on excep:EParserError do
         begin
-          writeln(excep.message,' line:',excep.row,' column:',excep.column,' file:',excep.filename); 
+          writeln(excep.message,' line:',excep.row,' column:',excep.column,' file:',excep.filename);
           raise;
+       end;
+    end;
+
+   if M is TPasProgram then
+    begin
+     writeln('Program ',M.Name,';');
+     if not Unformated then writeln;
+     if assigned(M.ImplementationSection) then
+       begin
+        isim:=true;
+        if not Unformated then writeln;
+        GetDecls(M.ImplementationSection as TPasDeclarations,0);
+        //PrintDecls(M.ImplementationSection as TPasDeclarations,0);
+       end;
+     if assigned(M.InitializationSection) then // MAIN BLOCK
+       begin
+        isim:=false;
+        if not Unformated then writeln;
+        writeln('begin');//writeln('begin {Begin MAIN Program}')
+        GetTPasImplBlock(M.InitializationSection as TPasImplBlock,1,0,false,false);
        end;  
-      end;      
-    { Cool, we successfully parsed the unit.
-      Now output some info about it. }
-    Decls := M.InterfaceSection.Declarations;
-    for I := 0 to Decls.Count - 1 do
-      Writeln('Interface item ', I, ': ', (TObject(Decls[I]) as TPasElement).Name);
+    end
+   else
+    begin
+      { Cool, we successfully parsed the unit.
+        Now output some info about it. }
+      writeln('Unit ',M.Name,';');
+      if not Unformated then writeln;
+      Writeln('Interface');
+      if not Unformated then writeln;
+      GetDecls(M.InterfaceSection as TPasDeclarations,0);
+      //PrintDecls(M.InterfaceSection as TPasDeclarations,0);
 
-    FreeAndNil(M);
-  finally 
-    FreeAndNil(E) 
+      if assigned(M.ImplementationSection) then
+       begin
+        isim:=true;
+        if not Unformated then writeln;
+        Writeln('Implementation');
+        if not Unformated then writeln;
+        GetDecls(M.ImplementationSection as TPasDeclarations,0);
+        //PrintDecls(M.ImplementationSection as TPasDeclarations,0);
+        if TPasElement(M.ImplementationSection) is TPasImplElement then writeln('{MAIN}');
+       end;
+      if assigned(M.InitializationSection) then //is this begin .. end. of a unit too ?
+       begin
+        isim:=true;
+        if not Unformated then writeln;
+        Writeln('Initialization');
+        if not Unformated then writeln;
+        GetTPasImplBlock(M.InitializationSection as TPasImplBlock,1,0,false,false);
+        if assigned(M.FinalizationSection) then
+         begin
+          isim:=true;
+          if not Unformated then writeln;
+          Writeln('Finalization');
+          if not Unformated then writeln;
+          GetTPasImplBlock(M.FinalizationSection as TPasImplBlock,1,0,false,false);
+         end;
+       end;
     end;
+    if not Unformated then writeln('end.')
+     else
+      begin
+       writeln('end');
+       writeln('.');
+      end;
+    FreeAndNil(M);
+  finally
+    FreeAndNil(E);
+  end;
 end.

packages/fcl-passrc/examples/testunit1.pp

@@ -0,0 +1,713 @@
+//This is only for testing the parser, it is not intended to be runable in a real
+//program but for checking the contructs to be parsed well.
+//All statements are written like testparser would print them out to diff the 
+//result with this file again to show differences. 
+//Based on /utils/fpdoc/testunit.pp
+{$mode objfpc}
+{$h+}
+unit testunit1;
+
+interface
+
+ uses 
+  SysUtils,Classes;
+
+ const
+  AnIntegerConst=1;
+  AStringConst='Hello, World!';
+  AFLoatconst=1.23;
+  ABooleanConst=True;
+  ATypedConst: Integer=3;
+  AnArrayConst: Array[1..3] of Integer=(1,2,3);
+  ARecordConst: TMethod=(Code:nil;Data:nil);
+  ASetConst=[true,false];
+  ADeprecatedConst=1 deprecated;
+   
+ Type
+  TAnEnumType=(one,two,three);
+  TASetType=set of TAnEnumType;
+  TAnArrayType=Array[1..10] of Integer;
+  TASubRangeType=one..two;
+  TABooleanArrayType=Array[Boolean] of Integer;  
+  TARecordType=record
+                   X,Y: Integer;
+                   Z: String;
+                      end;
+  TAVariantRecordType=record
+                          A: String;
+                          Case Integer of
+                        1: (X,Y : Integer);
+                        2: (phi,Omega : Real);
+                         end; 
+  TAVariantRecordType2=record
+                          A: String;
+                          Case Atype : Integer of
+                            1 : (X,Y : Integer);
+                            2 : (phi,Omega : Real);
+                          end; 
+                          
+  MyRec = Record  
+          X : Longint;  
+          Case byte of  
+            2 : (Y : Longint;  
+                 case byte of  
+                 3 : (Z : Longint);  
+                 );  
+          end;                           
+                          
+//  TADeprecatedType = Integer deprecated;
+
+  { TMyParentClass }
+
+  TMyParentClass=Class(TComponent)
+  Private 
+    FI: Integer;
+    Function GetA(AIndex: Integer): String;
+    Function GetIP(AIndex: integer): String;
+    procedure SetA(AIndex: Integer; const AValue: String);
+    procedure SetIP(AIndex: integer; const AValue: String);
+    Procedure WriteI(AI: Integer);
+    Function ReadI: Integer;
+  Protected
+    Procedure AProtectedMethod;
+    Property AProtectedProp: Integer Read FI Write FI;  
+  Public
+    Constructor Create(AOwner: TComponent); override;
+    Destructor Destroy; override;
+    Procedure AVirtualProc; virtual;
+    Procedure AnAbstractProc; virtual; abstract;
+    Procedure AMessageProc(var Msg);message 123;
+    Procedure AStringMessageProc(var Msg);message '123';
+    Procedure ADeprecatedProc; deprecated;
+    Procedure APlatformProc; Platform;
+    Property IntProp: Integer Read FI Write Fi;
+    Property IntROProp: Integer Read FI;
+    Property GetIntProp: Integer Read ReadI Write WriteI;
+    Property AnArrayProp[AIndex: Integer]: String Read GetA Write SetA;
+    Property AnIndexProp: String Index 1 Read GetIP Write SetIP;
+    Property AnIndexProp2: String Index 2 Read GetIP Write SetIP;
+  Published
+    Procedure SomePublishedMethod;
+  end;
+  
+  { TMyChildClass }
+
+  TMyChildClass=Class(TMyParentClass)
+  Public
+    Procedure AVirtualProc; Override;
+    Procedure AnAbstractProc; Override;
+  Published
+    Property AProtectedProp;
+  end;
+  
+ TPasFunctionType=Class(TPasProcedureType)
+  public
+    destructor Destroy; override;
+    Class Function TypeName: string; override;
+    Function ElementTypeName: string; override;
+    Function GetDeclaration(Full: boolean): string; override;
+  public
+    ResultEl: TPasResultElement;
+  end; 
+                        
+ var
+  ASimpleVar: Integer;  
+  ATypedVar: TMethod;
+  ARecordVar: Record
+                 A,B: Integer;
+               end;
+  AnArrayVar: Array[1..10] of Integer;
+  ATypedArray: Array[TanEnumType] of Integer;
+  AInitVar: Integer=1;
+  
+  ADeprecatedVar: Integer deprecated;
+  ACVarVar: Integer ; cvar;
+  AnExternalVar: Integer ;external name 'avar';
+  AnExternalLibVar: Integer ;external 'library' name 'avar';
+      
+ Procedure SimpleProc;
+ Procedure OverloadedProc(A: Integer);
+ Procedure OverloadedProc(B: String);
+ Function SimpleFunc: Integer;
+ Function OverloadedFunc(A: Integer): Integer;
+ Function OverloadedFunc(B: String): Integer;  
+
+ Procedure ConstArgProc(const A: Integer); 
+ Procedure VarArgProc(var A: Integer); 
+ Procedure OutArgProc(out A: Integer); 
+ Procedure UntypedVarArgProc(var A); 
+ Procedure UntypedConstArgProc(const A); 
+ Procedure UntypedOutArgProc(out A); 
+
+ Procedure ArrayArgProc(A: TAnArrayType);
+ Procedure OpenArrayArgProc(A: Array of string);
+ Procedure ConstArrayArgProc(A: Array of const);
+
+ Procedure externalproc; external;
+ Procedure externalnameProc; external name 'aname';
+ Procedure externallibnameProc; external 'alibrary' name 'aname';
+
+  
+Implementation
+
+
+ Procedure SimpleProc;
+
+ procedure  SubProc;
+  begin
+   s:= s+'a';
+  end;
+
+ begin
+  a:= 1;
+  c:= a+b;
+  for i:= 1 to 10 do 
+    write(a);
+ end;
+
+ Procedure OverloadedProc(A: Integer);
+ begin
+  if i=1 then ;
+ end;
+
+ Procedure OverloadedProc(B: String);
+ begin
+ end;
+
+ Function SimpleFunc: Integer;
+ begin
+ end;
+
+ Function OverloadedFunc(A: Integer): Integer; 
+ begin
+ end;
+
+ Function OverloadedFunc(B: String): Integer;  
+ begin
+ end;
+
+ Procedure ArrayArgProc(A: TAnArrayType);
+ begin
+ end;
+
+ Procedure OpenArrayArgProc(A: Array of String);
+ begin
+ end;
+
+ Procedure ConstArrayArgProc(A: Array of const);
+ begin
+ end;
+
+ Procedure ConstArgProc(const A: Integer); 
+ begin
+ end;
+
+ Procedure VarArgProc(var A: Integer); 
+ begin
+ end;
+
+ Procedure OutArgProc(out A: Integer); 
+ begin
+ end;
+
+ Procedure UntypedVarArgProc(var A); 
+ begin
+ end;
+
+ Procedure UntypedConstArgProc(const A); 
+ begin
+ end;
+
+ Procedure UntypedOutArgProc(out A); 
+ begin
+ end;
+
+{ TMyChildClass }
+ procedure TMyChildClass.AVirtualProc;
+ begin
+  inherited AVirtualProc;
+ end;
+
+ procedure TMyChildClass.AnAbstractProc;
+ procedure  SubCProc;
+  begin
+   sc:= sc+'ac';
+  end;
+
+ begin
+  // Cannot call ancestor
+ end;
+
+{ TMyParentClass }
+ procedure TMyParentClass.WriteI(AI: Integer);
+ begin
+ end;
+
+ Function TMyParentClass.GetA(AIndex: Integer): String;
+ begin
+ end;
+
+ Function TMyParentClass.GetIP(AIndex: integer): String;
+ begin
+ end;
+
+ procedure TMyParentClass.SetA(AIndex: Integer; const AValue: String);
+ begin
+ end;
+
+ procedure TMyParentClass.SetIP(AIndex: integer; const AValue: String);
+ begin
+ end;
+
+ Function TMyParentClass.ReadI: Integer;
+ begin
+ end;
+
+ procedure TMyParentClass.AProtectedMethod;
+ begin
+ end;
+
+ constructor TMyParentClass.Create(AOwner: TComponent);
+ begin
+  inherited Create(AOwner);
+ end;
+
+ destructor TMyParentClass.Destroy;
+ begin
+  inherited Destroy;
+ end;
+
+ procedure TMyParentClass.AVirtualProc;
+ begin
+ end;
+
+ procedure TMyParentClass.AMessageProc(var Msg);
+ begin
+ end;
+
+ procedure TMyParentClass.AStringMessageProc(var Msg);
+ begin
+ end;
+
+ procedure TMyParentClass.ADeprecatedProc;
+ begin
+ end;
+
+ procedure TMyParentClass.APlatformProc;
+ begin
+ end;
+
+ procedure TMyParentClass.SomePublishedMethod;
+ begin
+ end;
+ 
+ Class Function TPasFunctionType.TypeName: String;
+ begin
+  Result:= 'Function';
+ end;
+
+ procedure Statements;
+ const
+  cint=1;
+  cint1=-1;
+  creal=3.1415;
+  Addi=1+2;
+  Subs=2-3;
+  Muti=3*3;
+  Divi=3/5;
+  //Powe=2^3;
+  Modu=5 mod 3;
+  IDiv=5 div 3;
+  fals= not TRUE;
+  cand=true and false;
+  cor=true or false;
+  cxor=true xor false;
+  lt=2<3;
+  gt=3>2;
+  let=2<=3;
+  get=3>=2;
+  LeftShift=2 shl 3;
+  RightShift=2 shr 3;
+  ConstString='01'+'ab';
+
+ Type
+  Passenger=Record
+                Name: String[30];
+                Flight: String[10];
+  end;
+
+ Type 
+  AR=record
+      X,Y: LongInt;
+     end;
+  //PAR = Record;
+ var
+  TheCustomer: Passenger;
+  L: ^LongInt;
+  P: PPChar;
+  S,T: Ar;
+      
+ begin
+  X:= X+Y;
+  //EparserError on C++ style
+  //X+=Y;      { Same as X := X+Y, needs -Sc command line switch}
+  //x-=y;
+  //X/=2;      { Same as X := X/2, needs -Sc command line switch}
+  //x*=y;
+  Done:= False;
+  Weather:= Good;
+  //MyPi := 4* Tan(1); warum * ?
+  L^:= 3;
+  P^^:= 'A';
+  Usage;
+  WriteLn('Pascal is an easy language !');
+  Doit();
+  //label jumpto;
+  //Jumpto :
+  //  Statement;
+  //Goto jumpto;
+
+  Case i of
+    3: DoSomething;
+    1..5: DoSomethingElse;
+  end;
+
+  Case C of  
+    'a': WriteLn('A pressed');
+    'b': WriteLn('B pressed');
+    'c': WriteLn('C pressed');
+  else  
+   WriteLn('unknown letter pressed : ',C);
+  end;
+
+  Case C of
+    'a','e','i','o','u': WriteLn('vowel pressed');
+    'y': WriteLn('This one depends on the language');
+  else
+   WriteLn('Consonant pressed');
+  end;
+
+  Case Number of
+    1..10: WriteLn('Small number');
+    11..100: WriteLn('Normal, medium number');
+  else
+   WriteLn('HUGE number');
+  end;
+
+  case block of
+    1: begin
+	writeln('1');
+	end;
+    2: writeln('2');
+  else
+    writeln('3');
+    writeln('4');
+  end;
+
+  If exp1 Then
+    If exp2 then
+      Stat1
+  else
+    stat2;
+
+  If exp3 Then
+      begin
+      If exp4 then
+	Stat5
+      else
+	stat6
+      end;
+
+  If exp7 Then
+    begin
+    If exp8 then
+	Stat9
+    end
+  else
+    stat2;
+
+ if i is integer then
+  begin
+    write('integer');
+  end
+  else 
+    if i is real then 
+  begin
+    write('real');
+  end
+  else 
+    write('0'); 
+
+  if Today in[Monday..Friday] then
+    WriteLn('Must work harder')
+  else
+    WriteLn('Take a day off.');
+
+  for Day:= Monday to Friday do 
+    Work;
+  for I:= 100 downto 1 do
+    WriteLn('Counting down : ',i);
+  for I:= 1 to 7*dwarfs do 
+    KissDwarf(i);
+
+  for i:= 0 to 10 do
+    begin
+    j:= 2+1;
+    write(i,j);
+    end;
+
+  repeat
+    WriteLn('I =',i);
+    I:= I+2;
+  until I>100;
+    
+  repeat
+    X:= X/2;
+  until x<10e-3;
+
+  I:= I+2;
+  while i<=100 do
+    begin
+     WriteLn('I =',i);
+     I:= I+2;
+    end;
+    X:= X/2;
+    while x>=10e-3 do 
+      dec(x);
+
+    while x>0 do 
+    while y>0 do 
+      begin
+	dec(x);
+	dec(y);
+      end;
+
+    while x>0 do
+    if x>2 then 
+     dec(x)
+    else 
+     dec(x,2);
+
+      X:= 2+3;
+
+    TheCustomer.Name:= 'Michael';
+    TheCustomer.Flight:= 'PS901';
+
+    With TheCustomer do
+      begin
+       Name:= 'Michael';
+       Flight:= 'PS901';
+      end;
+
+  With A,B,C,D do
+   Statement;
+
+    With A do
+     With B do
+      With C do
+       With D do 
+        Statement;
+
+    S.X:= 1;S.Y:= 1;
+    T.X:= 2;T.Y:= 2;
+    With S,T do
+      WriteLn(X,' ',Y);
+
+    {asm
+      Movl $1,%ebx
+      Movl $0,%eax
+      addl %eax,%ebx
+    end; ['EAX','EBX'];}
+
+    try
+	try
+	  M:= ParseSource(E,cmdl,'linux','i386');
+	except
+	  on excep: EParserError do
+	    begin
+	      writeln(excep.message,' line:',excep.row,' column:',excep.column,' file:',excep.filename);
+	      raise ;
+	  end;
+	end;
+	Decls:= M.InterfaceSection.Declarations;
+	for I:= 0 to Decls.Count-1 do
+	  Writeln('Interface item ',I,': ');
+
+	FreeAndNil(M);
+    finally
+	FreeAndNil(E)
+   end;
+   
+   raise EParserError.Create(Format(SParserErrorAtToken, [Msg, CurTokenName]) {$ifdef addlocation}+' ('+inttostr(scanner.currow)+' '+inttostr(scanner.curcolumn)+')'{$endif},Scanner.CurFilename, Scanner.CurRow, Scanner.CurColumn);
+    
+    // try else
+ end;
+
+ procedure Expression;
+ begin
+  A:= a+b *c /(-e+f)*3 div 2 + 4 mod 5 - 2 shl 3 + 3 shr 1 ;
+  b:= (a and not b) or c xor d;
+  u:= i<=2 or a<>b or j>=3;
+  u:= i=1 or a>b or b<a or i<>2;
+  u:= i in [1..2];
+
+ If F=@AddOne Then  
+  WriteLn('Functions are equal');
+
+ If F()=Addone then  
+  WriteLn('Functions return same values ');
+
+ z:= [today,tomorrow];
+ z:= [Monday..Friday,Sunday];
+ z:= [2,3*2,6*2,9*2];
+ z:= ['A'..'Z','a'..'z','0'..'9'];
+
+ x:= Byte('A');
+ x:= Char(48);
+ x:= boolean(1);
+ x:= longint(@Buffer);
+ x:= Integer('A');
+ x:= Char(4875);
+ x:= Word(@Buffer);
+
+ B:= Byte(C);
+ Char(B):= C;
+
+ TWordRec(W).L:= $FF;
+ TWordRec(W).H:= 0;
+ S:= TObject(P).ClassName;
+
+ P:= @MyProc; //warum @ ? fix pparser 769 ?
+
+ Dirname:= Dirname+'\';
+
+ W:= [mon,tue]+[wed,thu,fri]; // equals [mon,tue,wed,thu,fri]
+ W:= [mon,tue,wed]-[wed];     // equals [mon,tue]
+ W:= [mon,tue,wed]*[wed,thu,fri]; // equals [wed] warum * ?
+
+ (C as TEdit).Text:= 'Some text';
+ C:= O as TComponent;
+
+ if A is TComponent then ;
+ If A is B then ;
+
+ Inherited ;
+ Inherited Test;
+
+  if true then
+    Inherited
+  else
+    DoNothing;
+
+  if true then
+    Inherited Test
+  else
+    DoNothing;
+
+   Inherited P:= 3;  
+   Inherited SetP1(3); 
+   Result:= Char(P and $FF);  
+   Result:= Char((Inherited P) and $FF);  
+   Inherited P:= Ord(AValue);
+   Result:= Inherited InterPretOption(Cmd,Arg);
+
+  raise Exception.Create(SErrMultipleSourceFiles);
+
+  if Filename<>'' then
+	  raise Exception.Create(SErrMultipleSourceFiles);
+
+  if Filename<>'' then
+	  raise Exception.Create(SErrMultipleSourceFiles)
+	else
+	  Filename:= s;
+
+  Self.Write(EscapeText(AText)); 
+  TObject.Create(Self);
+ end;
+
+ constructor TPasPackage.Create(const AName: String; AParent: TPasElement);
+ begin
+  if (Length(AName)>0)and(AName[1]<>'#') then
+   Inherited Create('#'+AName,AParent)
+  else
+   Inherited Create(AName,AParent);
+  Modules:= TList.Create;
+ end;         
+
+ Function TPascalScanner.FetchToken: TToken;
+ var
+  IncludeStackItem: TIncludeStackItem;
+
+ begin
+  while true do
+  begin
+    Result:= DoFetchToken;
+     if FCurToken=tkEOF then
+      if FIncludeStack.Count>0 then
+      begin
+        CurSourceFile.Free;
+        IncludeStackItem:= TIncludeStackItem(FIncludeStack[FIncludeStack.Count-1]);
+        FIncludeStack.Delete(FIncludeStack.Count-1);
+        FCurSourceFile:= IncludeStackItem.SourceFile;
+        FCurFilename:= IncludeStackItem.Filename;
+        FCurToken:= IncludeStackItem.Token;
+        FCurTokenString:= IncludeStackItem.TokenString;
+        FCurLine:= IncludeStackItem.Line;
+        FCurRow:= IncludeStackItem.Row;
+        TokenStr:= IncludeStackItem.TokenStr;
+        IncludeStackItem.Free;
+        Result:= FCurToken;
+      end 
+    else
+      break
+    else
+      if not PPIsSkipping then
+        break;
+  end;
+ end;  
+
+ Procedure IFS;
+ begin
+  if true then
+   repeat
+   until false
+  else
+    Noting;
+ end;           
+
+
+ Procedure IFS(x: integer); overload;
+ begin
+  if true then
+    case x of
+     1: writeln;
+     2: write;
+   else 
+    writeln('#');
+   end
+  else
+    Noting;
+ end;
+
+ Procedure IFS1; 
+ begin
+  if true then
+    while true do
+     Something
+  else
+    Noting;
+ end;
+
+ Procedure IFS3;
+ begin
+  if true then
+   if true then 
+    write
+   else 
+    writeln;
+ end; 
+
+Initialization
+ 
+  hallo:= valid;
+end.

packages/fcl-passrc/src/pastree.pp

@@ -121,7 +121,7 @@ type
   end;
 
   TPasExprKind = (pekIdent, pekNumber, pekString, pekSet, pekNil, pekBoolConst, pekRange,
-     pekUnary, pekBinary, pekFuncParams, pekArrayParams, pekListOfExp);
+     pekUnary, pekBinary, pekFuncParams, pekArrayParams, pekListOfExp, pekInherited, pekSelf);
 
   TExprOpCode = (eopNone,
                  eopAdd,eopSubtract,eopMultiply,eopDivide, eopDiv,eopMod, eopPower,// arithmetic
@@ -178,6 +178,20 @@ type
     function GetDeclaration(full : Boolean) : string; override;
   end;
 
+  { TInheritedExpr }
+
+  TInheritedExpr = class(TPasExpr)
+    constructor Create(AParent : TPasElement); overload;
+    function GetDeclaration(full : Boolean) : string; override;
+  end;
+
+  { TSelfExpr }
+
+  TSelfExpr = class(TPasExpr)
+    constructor Create(AParent : TPasElement); overload;
+    function GetDeclaration(full : Boolean) : string; override;
+  end;
+
   { TParamsExpr }
 
   TParamsExpr = class(TPasExpr)
@@ -454,6 +468,7 @@ type
     AncestorType: TPasType;     // TPasClassType or TPasUnresolvedTypeRef
     IsPacked: Boolean;        // 12/04/04 - Dave - Added
     IsForward : Boolean;
+    IsShortDefinition: Boolean;//class(anchestor); without end
     Members: TList;     // array of TPasElement objects
     InterfaceGUID : string; // 15/06/07 - Inoussa
 
@@ -1346,6 +1361,7 @@ constructor TPasClassType.Create(const AName: string; AParent: TPasElement);
 begin
   inherited Create(AName, AParent);
   IsPacked := False;                     // 12/04/04 - Dave - Added
+  IsShortDefinition := False;
   Members := TList.Create;
   Modifiers := TStringList.Create;
   ClassVars := TList.Create;
@@ -1388,7 +1404,7 @@ var
 begin
   for i := 0 to Args.Count - 1 do
     TPasArgument(Args[i]).Release;
-  Args.Free;
+  FreeAndNil(Args);
   inherited Destroy;
 end;
 
@@ -1726,12 +1742,14 @@ begin
   Result:=TPasImplAssign.Create('', Self);
   Result.left:=left;
   Result.right:=right;
+  AddElement(Result);
 end;
 
 function TPasImplBlock.AddSimple(exp:TPasExpr):TPasImplSimple;
 begin
   Result:=TPasImplSimple.Create('', Self);
   Result.expr:=exp;
+  AddElement(Result);
 end;
 
 function TPasImplBlock.CloseOnSemicolon: boolean;
@@ -2661,13 +2679,29 @@ begin
   Fields[i].ValueExp:=Value;
 end;
 
-{ TArrayValues }
+{ TNilExpr }
 
 Function TNilExpr.GetDeclaration(Full :Boolean):AnsiString;
 begin
   Result:='Nil';
 end;
 
+{ TInheritedExpr }
+
+Function TInheritedExpr.GetDeclaration(Full :Boolean):AnsiString;
+begin
+  Result:='Inherited';
+end;
+
+{ TSelfExpr }
+
+Function TSelfExpr.GetDeclaration(Full :Boolean):AnsiString;
+begin
+  Result:='Self';
+end;
+
+{ TArrayValues }
+
 Function TArrayValues.GetDeclaration(Full: Boolean):AnsiString;
 
 Var
@@ -2712,6 +2746,20 @@ begin
   inherited Create(AParent,pekNil, eopNone);
 end;
 
+{ TInheritedExpr }
+
+constructor TInheritedExpr.Create(AParent : TPasElement);
+begin
+  inherited Create(AParent,pekInherited, eopNone);
+end;
+
+{ TSelfExpr }
+
+constructor TSelfExpr.Create(AParent : TPasElement);
+begin
+  inherited Create(AParent,pekSelf, eopNone);
+end;
+
 { TPasLabels }
 
 constructor TPasLabels.Create(const AName:string;AParent:TPasElement);

packages/fcl-passrc/src/pparser.pp

@@ -766,6 +766,40 @@ begin
     tkfalse, tktrue:    x:=TBoolConstExpr.Create(Aparent,pekBoolConst, CurToken=tktrue);
     tknil:              x:=TNilExpr.Create(Aparent);
     tkSquaredBraceOpen: x:=ParseParams(AParent,pekSet);
+    tkinherited: begin
+      //inherited; inherited function
+      x:=TInheritedExpr.Create(AParent);
+      NextToken;
+      if (length(CurTokenText)>0) and (CurTokenText[1] in ['A'..'_']) then begin
+        b:=TBinaryExpr.Create(AParent,x, DoParseExpression(AParent), eopNone);
+        if not Assigned(b.right) then Exit; // error
+        x:=b;
+        UngetToken;
+      end
+       else UngetToken;
+    end;
+    tkself: begin
+      x:=TPrimitiveExpr.Create(AParent,pekString, CurTokenText); //function(self);
+      x:=TSelfExpr.Create(AParent);
+      NextToken;
+      if CurToken = tkDot then begin // self.Write(EscapeText(AText));
+        optk:=CurToken;
+        NextToken;
+        b:=TBinaryExpr.Create(AParent,x, ParseExpIdent(AParent), TokenToExprOp(optk));
+        if not Assigned(b.right) then Exit; // error
+        x:=b;
+      end
+       else UngetToken;
+    end;
+    tkAt: begin
+      // P:=@function;
+      NextToken;
+      if (length(CurTokenText)=0) or not (CurTokenText[1] in ['A'..'_']) then begin
+        UngetToken;
+        ParseExc(SParserExpectedIdentifier);
+      end;
+      x:=TPrimitiveExpr.Create(AParent,pekString, '@'+CurTokenText);
+    end;
     tkCaret: begin
       // ^A..^_ characters. See #16341
       NextToken;
@@ -2714,6 +2748,27 @@ begin
           // empty then => add dummy command
           CurBlock.AddCommand('');
         end;
+        if TPasImplIfElse(CurBlock).ElseBranch<>nil then
+        begin
+          // this and the following 3 may solve TPasImplIfElse.AddElement BUG
+          // ifs without begin end
+          // if .. then
+          //  if .. then
+          //   else
+          // else
+          CloseBlock;
+          CloseStatement(false);
+        end;
+      end else if (CurBlock is TPasImplWhileDo) then
+      begin
+        //if .. then while .. do smt else ..
+        CloseBlock;
+        UngetToken;
+      end else if (CurBlock is TPasImplRaise) then
+      begin
+        //if .. then Raise Exception else ..
+        CloseBlock;
+        UngetToken;
       end else if (CurBlock is TPasImplTryExcept) then
       begin
         CloseBlock;
@@ -2795,16 +2850,17 @@ begin
             repeat
               Expr:=ParseExpression(Parent);
               //writeln(i,'CASE value="',Expr,'" Token=',CurTokenText);
-              if CurBlock is TPasImplCaseStatement then
-                TPasImplCaseStatement(CurBlock).Expressions.Add(Expr)
-              else
-                CurBlock:=TPasImplCaseOf(CurBlock).AddCase(Expr);
               NextToken;
               if CurToken=tkDotDot then
               begin
                 Expr:=Expr+'..'+ParseExpression(Parent);
                 NextToken;
               end;
+              // do not miss '..'
+              if CurBlock is TPasImplCaseStatement then
+                TPasImplCaseStatement(CurBlock).Expressions.Add(Expr)
+              else
+                CurBlock:=TPasImplCaseOf(CurBlock).AddCase(Expr);
               //writeln(i,'CASE after value Token=',CurTokenText);
               if CurToken=tkColon then break;
               if CurToken<>tkComma then
@@ -2932,7 +2988,7 @@ begin
         begin
           // assign statement
           NextToken;
-          right:=ParseExpIdent(Parent);
+          right:=DoParseExpression(nil); // this may solve TPasImplWhileDo.AddElement BUG
           CmdElem:=CurBlock.AddAssign(left, right);
           UngetToken;
         end;
@@ -2943,7 +2999,7 @@ begin
           // label mark. todo: check mark identifier in the list of labels
           CmdElem:=CurBlock.AddLabelMark(TPrimitiveExpr(left).Value);
           left.Free;
-        end
+        end;
       else
         // simple statement (function call)
         CmdElem:=CurBlock.AddSimple(left);
@@ -3130,36 +3186,62 @@ function TPasParser.ParseClassDecl(Parent: TPasElement;
 var
   CurVisibility: TPasMemberVisibility;
 
-  procedure ProcessMethod(const MethodTypeName: String; HasReturnValue: Boolean);
+  procedure ProcessMethod(ProcType: TProcType);
   var
     Owner: TPasElement;
     Proc: TPasProcedure;
-    s: String;
+    s,Name: String;
     pt: TProcType;
+    HasReturnValue: Boolean;
+
   begin
+    HasReturnValue:=false;
     ExpectIdentifier;
-    Owner := CheckIfOverloaded(TPasClassType(Result), CurTokenString);
-    if HasReturnValue then
+    Name := CurTokenString;
+    Owner := CheckIfOverloaded(TPasClassType(Result), Name);
+    case ProcType of
+     ptFunction:
     begin
-      Proc := TPasFunction(CreateElement(TPasFunction, CurTokenString, Owner,
+         Proc := TPasFunction(CreateElement(TPasFunction, Name, Owner,
         CurVisibility));
       Proc.ProcType := Engine.CreateFunctionType('', 'Result', Proc, True,
         Scanner.CurFilename, Scanner.CurRow);
-    end else
+        HasReturnValue:=true;
+       end;
+     ptClassFunction:
     begin
-      // !!!: The following is more than ugly
-      if MethodTypeName = 'constructor' then
-        Proc := TPasConstructor(CreateElement(TPasConstructor, CurTokenString,
-          Owner, CurVisibility))
-      else if MethodTypeName = 'destructor' then
-        Proc := TPasDestructor(CreateElement(TPasDestructor, CurTokenString,
-          Owner, CurVisibility))
+         Proc := TPasClassFunction(CreateElement(TPasClassFunction, Name, Owner));
+         Proc.ProcType := Engine.CreateFunctionType('', 'Result', Proc, True,
+          Scanner.CurFilename, Scanner.CurRow);
+         HasReturnValue:=true;
+       end;
+     ptClassProcedure:
+       begin
+         Proc := TPasClassProcedure(CreateElement(TPasClassProcedure, Name, Owner));
+         Proc.ProcType := TPasProcedureType(CreateElement(TPasProcedureType, '',
+          Proc, CurVisibility));
+       end;
+     ptConstructor:
+       begin
+        Proc := TPasConstructor(CreateElement(TPasConstructor, Name,
+          Owner, CurVisibility));
+        Proc.ProcType := TPasProcedureType(CreateElement(TPasProcedureType, '',
+          Proc, CurVisibility));
+       end;
+     ptDestructor:
+       begin
+        Proc := TPasDestructor(CreateElement(TPasDestructor, Name,
+          Owner, CurVisibility));
+        Proc.ProcType := TPasProcedureType(CreateElement(TPasProcedureType, '',
+          Proc, CurVisibility));
+       end;
       else
-        Proc := TPasProcedure(CreateElement(TPasProcedure, CurTokenString,
+        Proc := TPasProcedure(CreateElement(TPasProcedure, Name,
           Owner, CurVisibility));
       Proc.ProcType := TPasProcedureType(CreateElement(TPasProcedureType, '',
         Proc, CurVisibility));
     end;
+    
     if Owner.ClassType = TPasOverloadedProc then
       TPasOverloadedProc(Owner).Overloads.Add(Proc)
     else
@@ -3302,6 +3384,8 @@ begin
     end
     else
       TPasClassType(Result).isForward:=CurToken=tkSemicolon;
+    if CurToken = tkSemicolon then
+       TPasClassType(Result).IsShortDefinition:=true;
 
     if CurToken <> tkSemicolon then
     begin
@@ -3364,13 +3448,19 @@ begin
 
             end;
           tkProcedure:
-            ProcessMethod('procedure', False);
+            ProcessMethod(ptProcedure);
           tkFunction:
-            ProcessMethod('function', True);
+            ProcessMethod(ptFunction);
           tkConstructor:
-            ProcessMethod('constructor', False);
+            ProcessMethod(ptConstructor);
           tkDestructor:
-            ProcessMethod('destructor', False);
+            ProcessMethod(ptDestructor);
+          tkclass:
+            begin
+             NextToken;
+             if CurToken = tkprocedure then ProcessMethod(ptClassProcedure)
+              else ProcessMethod(ptClassFunction);
+            end;               
           tkProperty:
             begin
               ExpectIdentifier;