* 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/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;