From c9cd1079d4306d09648e02d5db60fca78ed7c55e Mon Sep 17 00:00:00 2001 From: michael Date: Sun, 20 Nov 2011 22:48:29 +0000 Subject: [PATCH] * More extensive examples taken from RTL git-svn-id: trunk@19663 - --- packages/fcl-passrc/examples/test_parser.pp | 256 ++++++------ packages/fcl-passrc/examples/testunit1.pp | 412 ++++++++++++++++---- 2 files changed, 458 insertions(+), 210 deletions(-) diff --git a/packages/fcl-passrc/examples/test_parser.pp b/packages/fcl-passrc/examples/test_parser.pp index 399089dd0c..d951257ee0 100644 --- a/packages/fcl-passrc/examples/test_parser.pp +++ b/packages/fcl-passrc/examples/test_parser.pp @@ -107,7 +107,7 @@ TPasPackage = class(TPasElement) | - Modules: TList; + Modules: TFPList; TPasModule = class(TPasElement) |-InterfaceSection: TInterfaceSection; @@ -115,27 +115,27 @@ | |-ImplementationSection: TImplementationSection; | |-Declarations -> full declaration, unit and program - | |-Functions: TList; + | |-Functions: TFPList; | |-TPasFunction = class(TPasProcedureBase) | |-Body: TProcedureBody; | |-Declarations -> declaration and sub function | |-Body: TPasImplBlock; -> procedure block | |-InitializationSection: TInitializationSection; - | |-TPasImplBlock.Elements: TList; -> main block + | |-TPasImplBlock.Elements: TFPList; -> main block | |-FinalizationSection: TFinalizationSection; - |-TPasImplBlock.Elements: TList; -> unit only + |-TPasImplBlock.Elements: TFPList; -> 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; + |-Declarations: TFPList; -> the following are all in here + |-ResStrings: TFPList; + |-Types: TFPList; + |-Consts: TFPList; + |-Classes: TFPList; + |-Functions: TFPList; + |-Variables: TFPList; + |-Properties: TFPList; } @@ -859,7 +859,7 @@ procedure GetTPasVar(lpv:TPasVariable; lindent:integer; NoLF:boolean);//BUG stri //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); +procedure GetPasVariables(vl:TFPList; lindent:integer; NoLF,NoSEM:boolean); var v,i,j:integer; s,s1:string; prct:TPasRecordType; @@ -1021,6 +1021,96 @@ procedure GetPasVariables(vl:TList; lindent:integer; NoLF,NoSEM:boolean); if not NoLF then writeln; 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 GetTPasProcedureType(lppt:TPasProcedureType; indent:integer); + +Var + l : integer; + lpa:TPasArgument; + samevar:array of integer;//same index same type + aktaa:TArgumentAccess; + svi:integer; + same:boolean; + aktname,tmpname:String; + +begin + 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; + write(')'); + end; + end; + if (lppt is TPasFunctionType) then + write(': ',TPasFunctionType(lppt).ResultEl.ResultType.Name); + if lppt.IsOfObject then + write(' of Object'); +end; procedure GetTypes(pe:TPasElement; lindent:integer); var i,j,k:integer; @@ -1110,7 +1200,12 @@ procedure GetTypes(pe:TPasElement; lindent:integer); end else if pe is TPasProcedureType then begin - writeln('procedure'); + if pe is TPasFunctionType then + Write('function ') + else + Write('procedure '); + GetTPasProcedureType(TPasProcedureType(pe), lindent); + Writeln(';'); end else if pe is TPasPointerType then begin @@ -1166,27 +1261,29 @@ procedure GetTypes(pe:TPasElement; lindent:integer); writeln('set of ',pst.EnumType.Name,';'); end else if pe is TPasClassOfType then writeln('Class of ',TPasClassOfType(pe).DestType.Name,';') + else if pe is tPasAliasType then + begin + pe:=tPasAliasType(PE).DestType; + write(PE.name); + if pe is tPasStringType then + begin + if (TPasStringType(PE).LengthExpr<>'') then + Write('[',TPasStringType(PE).LengthExpr,']'); + end; + Writeln(';'); + end + else if pe is tPasUnresolvedTypeRef then writeln(TPasUnresolvedTypeRef(PE).name,';') else begin writeln('{ Unknown TYPE(s): '); - writeln(s,pe.Name); + writeln(s,pe.Name,' ',pe.classname); 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 @@ -1213,14 +1310,8 @@ procedure GetTypes(pe:TPasElement; lindent:integer); 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; @@ -1237,93 +1328,7 @@ procedure GetTypes(pe:TPasElement; lindent:integer); 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); + GetTPasProcedureType(lppt,Indent); end; //writeln(';'); WriteFmt(false,'',true); @@ -1425,7 +1430,7 @@ procedure GetTypes(pe:TPasElement; lindent:integer); lpp:TPasProperty; lpa:TPasArgument; vis:TPasMemberVisibility; - vars:TList; + vars:TFPList; IsVar:boolean; procedure PrintVars; @@ -1485,17 +1490,17 @@ procedure GetTypes(pe:TPasElement; lindent:integer); writeln(';'); exit; end; - //Members: TList; + //Members: TFPList; //InterfaceGUID: String; - //ClassVars: TList; //is this always empty ? + //ClassVars: TFPList; //is this always empty ? //Modifiers: TStringList; - //Interfaces: TList; + //Interfaces: TFPList; s1:=GetIndent(indent+1); s2:=GetIndent(indent+2); if pc.Members.Count > 0 then begin writeln; - vars:=TList.Create; + vars:=TFPList.Create; IsVar:=false; for j:=0 to pc.Members.Count-1 do begin @@ -1606,7 +1611,7 @@ procedure GetDecls(Decl:TPasDeclarations; indent:integer); ps:TPasSection; s:string; x:(None,ResStrings,Types,Consts,Classes,Functions,Variables,Properties); - l:TList; + l:TFPList; procedure PrintVars; begin @@ -1618,7 +1623,7 @@ begin x:=None; if assigned(Decl)then begin - l:=TList.Create; + l:=TFPList.Create; pe:=TPasElement(Decl); if pe is TPasSection then begin @@ -1914,7 +1919,6 @@ begin raise; end; end; - if M is TPasProgram then begin writeln('Program ',M.Name,';'); diff --git a/packages/fcl-passrc/examples/testunit1.pp b/packages/fcl-passrc/examples/testunit1.pp index 0a8b3ab6e7..21d142e747 100644 --- a/packages/fcl-passrc/examples/testunit1.pp +++ b/packages/fcl-passrc/examples/testunit1.pp @@ -12,6 +12,10 @@ interface uses SysUtils,Classes; +(* +resourcestring + SParserErrorAtToken = 'parser error at token'; + const AnIntegerConst=1; AStringConst='Hello, World!'; @@ -22,13 +26,34 @@ interface ARecordConst: TMethod=(Code:nil;Data:nil); ASetConst=[true,false]; ADeprecatedConst=1 deprecated; +*) Type + TLineEndStr = string [3]; + + TDeprecatedType = Integer deprecated; + TDeprecatedRecord = Record + x,Y : Integer; + end deprecated; + TDeprecatedFieldsRecord = Record + x,Y : Integer deprecated; + end; + TDeprecatedFieldsRecord2 = Record + x,Y : Integer deprecated + end; TAnEnumType=(one,two,three); TASetType=set of TAnEnumType; + TIntegerSet = Set of 0..SizeOf(Integer)*8-1; TAnArrayType=Array[1..10] of Integer; TASubRangeType=one..two; TABooleanArrayType=Array[Boolean] of Integer; + TDay = (monday,tuesday,wednesday,thursday,friday,saturday,sunday); + TShortDay = (mon,tue,wed,thu,fri,sat,sun); + TShortDays = set of TShortDay; + TDays = set of TDay; + TMyInteger = Integer; + ADouble = type double; + arangetypealias = type 0..$FF; TARecordType=record X,Y: Integer; Z: String; @@ -54,9 +79,36 @@ interface 3 : (Z : Longint); ); end; + +TYPE + PPoint = ^TPoint; + TPoint = OBJECT + X, Y: Sw_Integer; + END; + + PRect = ^TRect; + TRect = OBJECT + A, B: TPoint; { Corner points } + FUNCTION Empty: Boolean; + FUNCTION Equals (R: TRect): Boolean; + FUNCTION Contains (P: TPoint): Boolean; + PROCEDURE Copy (R: TRect); + PROCEDURE Union (R: TRect); + PROCEDURE Intersect (R: TRect); + PROCEDURE Move (ADX, ADY: Sw_Integer); + PROCEDURE Grow (ADX, ADY: Sw_Integer); + PROCEDURE Assign (XA, YA, XB, YB: Sw_Integer); + END; + + + TNotifyEvent = Procedure (Sender : TObject) of object; + TNotifyEvent2 = Function (Sender : TObject) : Integer of object; + // TADeprecatedType = Integer deprecated; - + TMyChildClass = Class; + MyInterface = Interface; + { TMyParentClass } TMyParentClass=Class(TComponent) @@ -99,18 +151,47 @@ interface Published Property AProtectedProp; end; - - TPasFunctionType=Class(TPasProcedureType) + TC = TMyChildClass; + + TPasFunctionType=Class(TObject) public destructor Destroy; override; - Class Function TypeName: string; override; - Function ElementTypeName: string; override; - Function GetDeclaration(Full: boolean): string; override; + Class Function TypeName: string; + Function ElementTypeName: string; + Function GetDeclaration(Full: boolean): string; + Procedure Something; strict + Private + Procedure SomethingElse; public - ResultEl: TPasResultElement; + ResultEl: TObject; end; - - var + + TPropModifiers = Class(TObject) + Private + FB : Integer; + Function IsStored : Boolean; + Function GetI(AI : Integer) : Integer; + Procedure SetI(AI : Integer; AVal : Integer); + Published + Property A : Integer Read FB Write FB Stored False; + Property B : Integer Read FB Write FB Stored True; + Property C : Integer Read FB Write FB Stored IsStored; + Property D : Integer Read FB Write FB Default 1; + Property E : Integer Read FB Write FB Stored True Default 1; + Public + Property Ints[AI : Integer] : Integer Read GetI Write SetI; default; + end; + + TPropModifiers2 = class(TPropModifiers) + Public + Property Ints[AI : Integer] : Integer Read GetI Write SetI; default; deprecated; + end; + + TEdit = Class(TObject) + Text : String; + end; + +var ASimpleVar: Integer; ATypedVar: TMethod; ARecordVar: Record @@ -122,8 +203,16 @@ interface ADeprecatedVar: Integer deprecated; ACVarVar: Integer ; cvar; - AnExternalVar: Integer ;external name 'avar'; - AnExternalLibVar: Integer ;external 'library' name 'avar'; + AnExternalVar1: Integer; external; + AnExternalVar2: Integer; external name 'avar'; + AnExternalLibVar: Integer; external 'library' name 'avar'; + APublicVar : String; public; + APublicVar2 : String; public name 'ANAME'; + APublicVar3 : String; export; + APublicVar4 : String; export name 'nono'; + APublicVar5 : String; cvar; external; + APublicVar6 : String; external name 'me'; + APublicVar7 : String deprecated; external name 'me'; Procedure SimpleProc; Procedure OverloadedProc(A: Integer); @@ -146,25 +235,31 @@ interface Procedure externalproc; external; Procedure externalnameProc; external name 'aname'; Procedure externallibnameProc; external 'alibrary' name 'aname'; - + Function hi(q : QWord) : DWord; [INTERNPROC: fpc_in_hi_qword]; +(* + Type generic TFPGListEnumerator = class(TObject) protected - FList: TFPSList; + FList: TFPList; FPosition: Integer; function GetCurrent: T; end; - TFPGListEnumeratorSpec = specialize TFPGListEnumerator; + TFPGListEnumeratorSpec = specialize TFPGListEnumerator; +*) Implementation Procedure SimpleProc; - procedure SubProc; + procedure SubProc; + Var S : String; begin s:= s+'a'; end; + Var + a,B,c,i : integer; begin a:= 1; @@ -174,6 +269,8 @@ Implementation end; Procedure OverloadedProc(A: Integer); + Var + i : integer; begin if i=1 then ; end; @@ -237,7 +334,11 @@ Implementation end; procedure TMyChildClass.AnAbstractProc; + procedure SubCProc; + + Var sc : string; + begin sc:= sc+'ac'; end; @@ -308,12 +409,142 @@ Implementation procedure TMyParentClass.SomePublishedMethod; begin end; - + + Class Function TPasFunctionType.TypeName: String; begin Result:= 'Function'; end; +Type + TI = Class(TComponent) + Public + FP : Integer; + Procedure SetP1(A : Integer); virtual; + Procedure M1;virtual; + Function F1 : Integer; virtual; + procedure test; virtual; + property P : Integer Read FP Write SetP1; + end; + + Procedure TI.M1; + begin + end; + Procedure TI.Test; + begin + end; + Function TI.F1 : Integer; + begin + Result:=0; + end; + Procedure TI.SetP1(A : Integer); + begin + FP:=A; + end; + +TYpe + TI2 = Class(TI) + procedure write(s : string); + Procedure SetP1(A : Integer); override; + Procedure M1;override; + Procedure Test;override; + Function F1 : integer; override; + procedure donothing; + property P : Integer Read F1 Write SetP1; + end; + Procedure TI2.M1; + begin + Inherited; + end; + Procedure TI2.Write(s : string); + begin + writeln(s); + end; + Function TI2.F1 :Integer; + begin + Result:=0; + end; + Procedure TI2.Test; + begin + if true then + Inherited Test + else + DoNothing; + Inherited test; + if true then + Inherited + else + DoNothing; + end; + Procedure TI2.DoNothing; + function escapetext(s : string) : string; + begin + end; + var + Atext : string; + begin + Self.Write(EscapeText(AText)); + TComponent.Create(Self); + end; + Procedure TI2.SetP1(A : Integer); + begin + FP:=A; + Inherited P:= 3; + Inherited SetP1(3); + Inherited P:= Ord(A); + end; + + + procedure usage; + begin + end; + Procedure DoSomething; + begin + end; + Procedure DoSomethingElse; + begin + end; + procedure stat1; + begin + end; + procedure stat2; + begin + end; + procedure stat3; + begin + end; + procedure stat4; + begin + end; + procedure stat5; + begin + end; + procedure stat6; + begin + end; + procedure stat7; + begin + end; + procedure stat8; + begin + end; + procedure stat9; + begin + end; + procedure doit; + begin + end; + procedure statement; + begin + end; + procedure work; + begin + end; + procedure kissdwarf(i : integer); + + begin + writeln('kiss dwarf',i); + end; procedure Statements; const cint=1; @@ -348,14 +579,32 @@ Implementation AR=record X,Y: LongInt; end; + TScanner = record + currow,curcolumn : integer; + curfilename : string; + end; + //PAR = Record; var + msg,curtokenname : string; TheCustomer: Passenger; L: ^LongInt; P: PPChar; S,T: Ar; - + M, X,Y : Double; + Done : Boolean; + Weather,Good: Boolean; + c : char; + j,dwarfs,i,Number,Block : integer; + exp1,exp2,exp3,exp4,exp5,exp6,exp7,exp8,exp9 : boolean; + o : Tobject; + day,today : tday; + A,B,D : Passenger; + E : Exception; + scanner : tscanner; + begin + O:=Nil; X:= X+Y; //EparserError on C++ style //X+=Y; { Same as X := X+Y, needs -Sc command line switch} @@ -376,7 +625,7 @@ Implementation //Goto jumpto; Case i of - 3: DoSomething; + 6: DoSomething; 1..5: DoSomethingElse; end; @@ -434,19 +683,19 @@ Implementation else stat2; - if i is integer then + if o is TObject then begin - write('integer'); + write('object'); end else - if i is real then + if o is TMyParentClass then begin write('real'); end else write('0'); - if Today in[Monday..Friday] then + if Today in [Monday..Friday] then WriteLn('Must work harder') else WriteLn('Take a day off.'); @@ -480,21 +729,21 @@ Implementation I:= I+2; end; X:= X/2; - while x>=10e-3 do - dec(x); + while i>=10e-3 do + dec(i); - while x>0 do - while y>0 do + while i>0 do + while j>0 do begin - dec(x); - dec(y); + dec(i); + dec(j); end; - while x>0 do - if x>2 then - dec(x) + while i>0 do + if i>2 then + dec(i) else - dec(x,2); + dec(i,2); X:= 2+3; @@ -507,12 +756,11 @@ Implementation Flight:= 'PS901'; end; - With A,B,C,D do + With A,B,D do Statement; With A do With B do - With C do With D do Statement; @@ -529,60 +777,77 @@ Implementation try try - M:= ParseSource(E,cmdl,'linux','i386'); + M:= Y; except on excep: EParserError do begin - writeln(excep.message,' line:',excep.row,' column:',excep.column,' file:',excep.filename); + writeln(excep.message,' : ',excep.classname); 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); + raise EParserError.Create(Format(SParserErrorAtToken, [Msg, CurTokenName]) {$ifdef addlocation}+' ('+inttostr(scanner.currow)+' '+inttostr(scanner.curcolumn)+')'{$endif}); // try else end; - procedure Expression; + function addone : integer; begin - A:= a+b *c /(-e+f)*3 div 2 + 4 mod 5 - 2 shl 3 + 3 shr 1 ; + end; + procedure myproc; + begin + end; + procedure Expression; + + Var + A,b,c,d,e,f,i,j : Integer; + x : double; + u : Boolean; + fu : function : integer; + ad : boolean; + z : tdays; + today,tomorrow : tday; + bs : set of byte; + cs : set of char; + cc : char; + W : TShortDays; + buffer : array[1..10] of byte; + P : Pointer; + SErrMultipleSourceFiles,FileName,Dirname,S : string; + o,co : tobject; + + begin + x:= 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 b2; + u:= (i<=2) or (a<>b) or (j>=3); + u:= (i=1) or (a>b) or (b2); u:= i in [1..2]; - If F=@AddOne Then + If Fu=@AddOne Then WriteLn('Functions are equal'); - If F()=Addone then + If Fu()=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']; + bs:= [2,3*2,6*2,9*2]; + cs:= ['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); + i:= Byte('A'); + cc:= Char(48); + ad:= boolean(1); + i:= longint(@Buffer); + i:= Integer('A'); + cc:= Char(225); + i:= 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 ? @@ -593,31 +858,12 @@ Implementation 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; + (Co as TEdit).Text:= 'Some text'; + Co:= O as TComponent; - if A is TComponent then ; - If A is B then ; + if co is TComponent then ; + If co is TC 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); @@ -629,8 +875,6 @@ Implementation else Filename:= s; - Self.Write(EscapeText(AText)); - TObject.Create(Self); end; constructor TPasPackage.Create(const AName: String; AParent: TPasElement);