mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-10-01 18:59:27 +02:00
* Parse operators better
git-svn-id: trunk@31226 -
This commit is contained in:
michael
parent
3d6a6512ad
commit
e4cd8565ae
@ -65,6 +65,8 @@ resourcestring
|
||||
SPasTreeOverloadedProcedure = 'overloaded procedure';
|
||||
SPasTreeProcedure = 'procedure';
|
||||
SPasTreeFunction = 'function';
|
||||
SPasTreeOperator = 'operator';
|
||||
SPasTreeClassOperator = 'class operator';
|
||||
SPasTreeClassProcedure = 'class procedure';
|
||||
SPasTreeClassFunction = 'class function';
|
||||
SPasTreeClassConstructor = 'class constructor';
|
||||
@ -765,14 +767,39 @@ type
|
||||
end;
|
||||
|
||||
{ TPasOperator }
|
||||
TOperatorType = (otUnknown,otImplicit,otExplicit,otMul,otPlus, otMinus, otDivision,otLessThan, otEqual,
|
||||
otGreaterThan, otAssign,otNotEqual,otLessEqualThan,otGreaterEqualThan,otPower,
|
||||
otSymmetricalDifference, otInc, otDec, otMod, otNegative, otPositive, otBitWiseOr, otDiv,
|
||||
otLeftShift, otLogicalOr, otBitwiseAnd, otbitwiseXor,otLogicalAnd,otLogicalNot,otLogicalXor,
|
||||
otRightShift);
|
||||
TOperatorTypes = set of TOperatorType;
|
||||
|
||||
TPasOperator = class(TPasProcedure)
|
||||
TPasOperator = class(TPasFunction)
|
||||
private
|
||||
FOperatorType: TOperatorType;
|
||||
FTokenBased: Boolean;
|
||||
public
|
||||
Class Function OperatorTypeToToken(T : TOperatorType) : String;
|
||||
Class Function OperatorTypeToOperatorName(T: TOperatorType) : String;
|
||||
Class Function TokenToOperatorType(S : String) : TOperatorType;
|
||||
Class Function NameToOperatorType(S : String) : TOperatorType;
|
||||
Procedure CorrectName;
|
||||
function ElementTypeName: string; override;
|
||||
function TypeName: string; override;
|
||||
function GetDeclaration (full : boolean) : string; override;
|
||||
Property OperatorType : TOperatorType Read FOperatorType Write FOperatorType;
|
||||
// True if the declaration was using a token instead of a
|
||||
Property TokenBased : Boolean Read FTokenBased Write FTokenBased;
|
||||
end;
|
||||
|
||||
Type
|
||||
{ TPasClassOperator }
|
||||
|
||||
TPasClassOperator = class(TPasOperator)
|
||||
function TypeName: string; override;
|
||||
end;
|
||||
|
||||
|
||||
{ TPasConstructor }
|
||||
|
||||
TPasConstructor = class(TPasProcedure)
|
||||
@ -1184,6 +1211,22 @@ const
|
||||
'@','^',
|
||||
'.');
|
||||
|
||||
|
||||
UnaryOperators = [otImplicit,otExplicit,otAssign,otNegative,otPositive];
|
||||
|
||||
OperatorTokens : Array[TOperatorType] of string
|
||||
= ('','','','*','+','-','/','<','=',
|
||||
'>',':=','<>','<=','>=','**',
|
||||
'><','Inc','Dec','mod','-','+','Or','div',
|
||||
'shl','or','and','xor','and','not','xor',
|
||||
'shr');
|
||||
OperatorNames : Array[TOperatorType] of string
|
||||
= ('','implicit','explicit','multiply','add','subtract','divide','lessthan','equal',
|
||||
'greaterthan','assign','notequal','lessthanequal','greaterthanequal','power',
|
||||
'symmetricaldifference','inc','dec','modulus','negative','positive','bitwiseor','intdivide',
|
||||
'leftshift','logicalor','bitwiseand','bitwisexor','logicaland','logicalnot','logicalxor',
|
||||
'rightshift');
|
||||
|
||||
cPasMemberHint : array[TPasMemberHint] of string =
|
||||
( 'deprecated', 'library', 'platform', 'experimental', 'unimplemented' );
|
||||
cCallingConventions : array[TCallingConvention] of string =
|
||||
@ -1199,6 +1242,13 @@ implementation
|
||||
|
||||
uses SysUtils;
|
||||
|
||||
{ TPasClassOperator }
|
||||
|
||||
function TPasClassOperator.TypeName: string;
|
||||
begin
|
||||
Result:='class operator';
|
||||
end;
|
||||
|
||||
{ TPasImplAsmStatement }
|
||||
|
||||
constructor TPasImplAsmStatement.Create(const AName: string;
|
||||
@ -1412,7 +1462,63 @@ begin
|
||||
end;
|
||||
|
||||
function TPasClassFunction.ElementTypeName: string; begin Result := SPasTreeClassFunction; end;
|
||||
function TPasOperator.ElementTypeName: string; begin Result := SPasTreeFunction end;
|
||||
|
||||
class function TPasOperator.OperatorTypeToToken(T: TOperatorType): String;
|
||||
begin
|
||||
Result:=OperatorTokens[T];
|
||||
end;
|
||||
|
||||
class function TPasOperator.OperatorTypeToOperatorName(T: TOperatorType
|
||||
): String;
|
||||
begin
|
||||
Result:=OperatorNames[T];
|
||||
end;
|
||||
|
||||
class function TPasOperator.TokenToOperatorType(S: String): TOperatorType;
|
||||
begin
|
||||
Result:=High(TOperatorType);
|
||||
While (Result>otUnknown) and (CompareText(S,OperatorTokens[Result])<>0) do
|
||||
Result:=Pred(Result);
|
||||
end;
|
||||
|
||||
class function TPasOperator.NameToOperatorType(S: String): TOperatorType;
|
||||
begin
|
||||
Result:=High(TOperatorType);
|
||||
While (Result>otUnknown) and (CompareText(S,OperatorNames[Result])<>0) do
|
||||
Result:=Pred(Result);
|
||||
end;
|
||||
|
||||
procedure TPasOperator.CorrectName;
|
||||
|
||||
Var
|
||||
I : Integer;
|
||||
|
||||
begin
|
||||
I:=Pos('(',Name);
|
||||
if I<>0 then
|
||||
Name:=Copy(Name,1,I)
|
||||
else
|
||||
Name:=Name+'(';
|
||||
if Assigned(ProcType) and Assigned(ProcType.Args) then
|
||||
for i:=0 to ProcType.Args.Count-1 do
|
||||
begin
|
||||
if i>0 then
|
||||
Name:=Name+',';
|
||||
Name:=Name+TPasArgument(ProcType.Args[i]).ArgType.Name;
|
||||
end;
|
||||
if Assigned(TPasFunctionType(ProcType).ResultEl) and
|
||||
Assigned(TPasFunctionType(ProcType).ResultEl.ResultType) then
|
||||
Name:=Name+'):'+TPasFunctionType(ProcType).ResultEl.ResultType.Name;
|
||||
end;
|
||||
|
||||
function TPasOperator.ElementTypeName: string;
|
||||
begin
|
||||
if self is TPasClassOperator then
|
||||
Result := SPasTreeClassOperator
|
||||
else
|
||||
Result := SPasTreeOperator
|
||||
end;
|
||||
|
||||
function TPasConstructor.ElementTypeName: string; begin Result := SPasTreeConstructor end;
|
||||
function TPasDestructor.ElementTypeName: string; begin Result := SPasTreeDestructor end;
|
||||
function TPasProcedureImpl.ElementTypeName: string; begin Result := SPasTreeProcedureImpl end;
|
||||
@ -2968,6 +3074,7 @@ begin
|
||||
end;
|
||||
GetModifiers(S);
|
||||
Result:=IndentStrings(S,Length(S[0]));
|
||||
|
||||
finally
|
||||
S.Free;
|
||||
end;
|
||||
|
||||
@ -38,6 +38,7 @@ resourcestring
|
||||
SParserExpectedCommaSemicolon = 'Expected "," or ";"';
|
||||
SParserExpectedAssignIn = 'Expected := or in';
|
||||
SParserExpectedCommaColon = 'Expected "," or ":"';
|
||||
SErrUnknownOperatorType = 'Unknown operator type: %s';
|
||||
SParserOnlyOneArgumentCanHaveDefault = 'A default value can only be assigned to 1 parameter';
|
||||
SParserExpectedLBracketColon = 'Expected "(" or ":"';
|
||||
SParserExpectedLBracketSemicolon = 'Expected "(" or ";"';
|
||||
@ -119,7 +120,7 @@ type
|
||||
property Column: Integer read FColumn;
|
||||
end;
|
||||
|
||||
TProcType = (ptProcedure, ptFunction, ptOperator, ptConstructor, ptDestructor,
|
||||
TProcType = (ptProcedure, ptFunction, ptOperator, ptClassOperator, ptConstructor, ptDestructor,
|
||||
ptClassProcedure, ptClassFunction, ptClassConstructor, ptClassDestructor);
|
||||
|
||||
|
||||
@ -175,6 +176,7 @@ type
|
||||
function CheckProcedureArgs(Parent: TPasElement; Args: TFPList; Mandatory: Boolean): boolean;
|
||||
function CheckVisibility(S: String; var AVisibility: TPasMemberVisibility): Boolean;
|
||||
procedure ParseExc(const Msg: String);
|
||||
procedure ParseExc(const Fmt: String; Args : Array of const);
|
||||
function OpLevel(t: TToken): Integer;
|
||||
Function TokenToExprOp (AToken : TToken) : TExprOpCode;
|
||||
function CreateElement(AClass: TPTreeElement; const AName: String; AParent: TPasElement): TPasElement;overload;
|
||||
@ -399,7 +401,7 @@ var
|
||||
if (length(s)>2) then
|
||||
case S[3] of
|
||||
'c' : Scanner.Options:=Scanner.Options+[po_cassignments];
|
||||
'd' : Parser.Options:=Parser.Options+[po_delphi];
|
||||
'd','2' : Parser.Options:=Parser.Options+[po_delphi];
|
||||
end;
|
||||
end;
|
||||
end else
|
||||
@ -556,6 +558,11 @@ begin
|
||||
Scanner.CurFilename, Scanner.CurRow, Scanner.CurColumn);
|
||||
end;
|
||||
|
||||
procedure TPasParser.ParseExc(const Fmt: String; Args: array of const);
|
||||
begin
|
||||
ParseExc(Format(Fmt,Args));
|
||||
end;
|
||||
|
||||
constructor TPasParser.Create(AScanner: TPascalScanner;
|
||||
AFileResolver: TBaseFileResolver; AEngine: TPasTreeContainer);
|
||||
begin
|
||||
@ -1943,7 +1950,10 @@ begin
|
||||
else
|
||||
Result:=ptDestructor;
|
||||
tkOperator:
|
||||
Result:=ptOperator;
|
||||
if IsClass then
|
||||
Result:=ptClassOperator
|
||||
else
|
||||
Result:=ptOperator;
|
||||
else
|
||||
ParseExc(SParserNotAProcToken);
|
||||
end;
|
||||
@ -2867,24 +2877,21 @@ procedure TPasParser.ParseProcedureOrFunctionHeader(Parent: TPasElement;
|
||||
|
||||
Var
|
||||
Tok : String;
|
||||
i: Integer;
|
||||
Proc: TPasProcedure;
|
||||
CC : TCallingConvention;
|
||||
PM : TProcedureModifier;
|
||||
Done: Boolean;
|
||||
|
||||
begin
|
||||
CheckProcedureArgs(Parent,Element.Args,ProcType=ptOperator);
|
||||
// Element must be non-nil. Removed all checks for not-nil.
|
||||
// If it is nil, the following fails anyway.
|
||||
CheckProcedureArgs(Parent,Element.Args,ProcType in [ptOperator,ptClassOperator]);
|
||||
case ProcType of
|
||||
ptFunction,ptClassFunction:
|
||||
begin
|
||||
ExpectToken(tkColon);
|
||||
if Assigned(Element) then // !!!
|
||||
TPasFunctionType(Element).ResultEl.ResultType := ParseType(Parent)
|
||||
else
|
||||
ParseType(nil);
|
||||
TPasFunctionType(Element).ResultEl.ResultType := ParseType(Parent)
|
||||
end;
|
||||
ptOperator:
|
||||
ptOperator,ptClassOperator:
|
||||
begin
|
||||
NextToken;
|
||||
if (CurToken=tkIdentifier) then
|
||||
@ -2897,10 +2904,7 @@ begin
|
||||
TPasFunctionType(Element).ResultEl.Name := 'Result'
|
||||
else
|
||||
ParseExc(SParserExpectedColonID);
|
||||
if Assigned(Element) then // !!!
|
||||
TPasFunctionType(Element).ResultEl.ResultType := ParseType(Parent)
|
||||
else
|
||||
ParseType(nil);
|
||||
TPasFunctionType(Element).ResultEl.ResultType := ParseType(Parent)
|
||||
end;
|
||||
end;
|
||||
if OfObjectPossible then
|
||||
@ -2934,16 +2938,20 @@ begin
|
||||
NextToken;
|
||||
If TokenisCallingConvention(CurTokenString,cc) then
|
||||
begin
|
||||
if Assigned(Element) then // !!!
|
||||
Element.CallingConvention:=Cc;
|
||||
Element.CallingConvention:=Cc;
|
||||
if cc = ccSysCall then
|
||||
begin
|
||||
// remove LibBase
|
||||
NextToken;
|
||||
// remove legacy or basesysv on MorphOS syscalls
|
||||
if CurTokenIsIdentifier('legacy') or CurTokenIsIdentifier('BaseSysV') then
|
||||
NextToken;
|
||||
NextToken; // remove offset
|
||||
if CurToken=tkSemiColon then
|
||||
UngetToken
|
||||
else
|
||||
// remove legacy or basesysv on MorphOS syscalls
|
||||
begin
|
||||
if CurTokenIsIdentifier('legacy') or CurTokenIsIdentifier('BaseSysV') then
|
||||
NextToken;
|
||||
NextToken; // remove offset
|
||||
end;
|
||||
end;
|
||||
ExpectToken(tkSemicolon);
|
||||
end
|
||||
@ -2982,21 +2990,8 @@ begin
|
||||
Until Done;
|
||||
if DoCheckHint then // deprecated,platform,experimental,library, unimplemented etc
|
||||
ConsumeSemi;
|
||||
if (ProcType = ptOperator) and (Parent is TPasProcedure) then
|
||||
begin
|
||||
Proc:=TPasProcedure(Parent);
|
||||
Proc.Name := Proc.Name + '(';
|
||||
for i := 0 to Proc.ProcType.Args.Count - 1 do
|
||||
begin
|
||||
if i > 0 then
|
||||
Proc.Name := Proc.Name + ', ';
|
||||
Proc.Name := Proc.Name +
|
||||
TPasArgument(Proc.ProcType.Args[i]).ArgType.Name;
|
||||
end;
|
||||
Proc.Name := Proc.Name + '): ' +
|
||||
TPasFunctionType(Proc.ProcType).ResultEl.ResultType.Name;
|
||||
end;
|
||||
|
||||
if (ProcType in [ptOperator,ptClassOperator]) and (Parent is TPasOperator) then
|
||||
TPasOperator(Parent).CorrectName;
|
||||
if (Parent is TPasProcedure)
|
||||
and (not TPasProcedure(Parent).IsForward)
|
||||
and (not TPasProcedure(Parent).IsExternal)
|
||||
@ -3659,12 +3654,13 @@ begin
|
||||
ptFunction : Result:=TPasFunction;
|
||||
ptClassFunction : Result:=TPasClassFunction;
|
||||
ptClassProcedure : Result:=TPasClassProcedure;
|
||||
ptClassConstructor : Result:=TPasClassConstructor;
|
||||
ptClassDestructor : Result:=TPasClassDestructor;
|
||||
ptClassConstructor : Result:=TPasClassConstructor;
|
||||
ptClassDestructor : Result:=TPasClassDestructor;
|
||||
ptProcedure : Result:=TPasProcedure;
|
||||
ptConstructor : Result:=TPasConstructor;
|
||||
ptDestructor : Result:=TPasDestructor;
|
||||
ptOperator : Result:=TPasOperator;
|
||||
ptClassOperator : Result:=TPasClassOperator;
|
||||
else
|
||||
ParseExc('Unknown procedure Type '+intToStr(Ord(ProcType)));
|
||||
end;
|
||||
@ -3690,28 +3686,60 @@ function TPasParser.ParseProcedureOrFunctionDecl(Parent: TPasElement; ProcType:
|
||||
var
|
||||
Name: String;
|
||||
PC : TPTreeElement;
|
||||
Ot : TOperatorType;
|
||||
IsTokenBased : Boolean;
|
||||
|
||||
begin
|
||||
If (ProcType<>ptOperator) then
|
||||
If (Not (ProcType in [ptOperator,ptClassOperator])) then
|
||||
Name:=ExpectProcName
|
||||
else
|
||||
begin
|
||||
NextToken;
|
||||
Name := 'operator ' + TokenInfos[CurToken];
|
||||
IsTokenBased:=Curtoken<>tkIdentifier;
|
||||
if IsTokenBased then
|
||||
OT:=TPasOperator.TokenToOperatorType(CurTokenText)
|
||||
else
|
||||
OT:=TPasOperator.NameToOperatorType(CurTokenString);
|
||||
if (ot=otUnknown) then
|
||||
ParseExc(SErrUnknownOperatorType,[CurTokenString]);
|
||||
Name:=OperatorNames[Ot];
|
||||
end;
|
||||
PC:=GetProcedureClass(ProcType);
|
||||
Parent:=CheckIfOverLoaded(Parent,Name);
|
||||
Result:=TPasProcedure(CreateElement(PC,Name,Parent,AVisibility));
|
||||
try
|
||||
if ProcType in [ptFunction, ptClassFunction] then
|
||||
Result.ProcType := CreateFunctionType('', 'Result', Result, True)
|
||||
else if ProcType=ptOperator then
|
||||
Result.ProcType := CreateFunctionType('', '__INVALID__', Result,True)
|
||||
if Not (ProcType in [ptFunction, ptClassFunction, ptOperator, ptClassOperator]) then
|
||||
Result.ProcType := TPasProcedureType(CreateElement(TPasProcedureType, '', Result))
|
||||
else
|
||||
Result.ProcType := TPasProcedureType(CreateElement(TPasProcedureType, '', Result));
|
||||
begin
|
||||
Result.ProcType := CreateFunctionType('', 'Result', Result, True);
|
||||
if (ProcType in [ptOperator, ptClassOperator]) then
|
||||
begin
|
||||
TPasOperator(Result).TokenBased:=IsTokenBased;
|
||||
TPasOperator(Result).OperatorType:=OT;
|
||||
TPasOperator(Result).CorrectName;
|
||||
end;
|
||||
end;
|
||||
ParseProcedureOrFunctionHeader(Result, Result.ProcType, ProcType, False);
|
||||
Result.Hints:=Result.ProcType.Hints;
|
||||
Result.HintMessage:=Result.ProcType.HintMessage
|
||||
Result.HintMessage:=Result.ProcType.HintMessage;
|
||||
// + is detected as 'positive', but is in fact Add if there are 2 arguments.
|
||||
if (ProcType in [ptOperator, ptClassOperator]) then
|
||||
With TPasOperator(Result) do
|
||||
begin
|
||||
if (OperatorType in [otPositive, otNegative]) then
|
||||
begin
|
||||
if (ProcType.Args.Count>1) then
|
||||
begin
|
||||
Case OperatorType of
|
||||
otPositive : OperatorType:=otPlus;
|
||||
otNegative : OperatorType:=otMinus;
|
||||
end;
|
||||
Name:=OperatorNames[OperatorType];
|
||||
TPasOperator(Result).CorrectName;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
except
|
||||
FreeAndNil(Result);
|
||||
Raise;
|
||||
@ -3802,6 +3830,7 @@ begin
|
||||
Prop.isClass:=isClass;
|
||||
Arec.Members.Add(Prop);
|
||||
end;
|
||||
tkOperator,
|
||||
tkProcedure,
|
||||
tkFunction :
|
||||
begin
|
||||
@ -3848,10 +3877,10 @@ begin
|
||||
else
|
||||
ParseExc(SParserTypeSyntaxError);
|
||||
end;
|
||||
if CurToken<>AEndToken then
|
||||
NextToken;
|
||||
If CurToken<>tkClass then
|
||||
isClass:=False;
|
||||
if CurToken<>AEndToken then
|
||||
NextToken;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
@ -43,6 +43,8 @@ Type
|
||||
FUseImplementation: Boolean;
|
||||
function GetPL: TPasLibrary;
|
||||
function GetPP: TPasProgram;
|
||||
procedure CleanupParser;
|
||||
procedure SetupParser;
|
||||
protected
|
||||
procedure SetUp; override;
|
||||
procedure TearDown; override;
|
||||
@ -56,6 +58,7 @@ Type
|
||||
Procedure StartParsing;
|
||||
Procedure ParseDeclarations;
|
||||
Procedure ParseModule;
|
||||
procedure ResetParser;
|
||||
Procedure CheckHint(AHint : TPasMemberHint);
|
||||
Function AssertExpression(Const Msg: String; AExpr : TPasExpr; aKind : TPasExprKind; AClass : TClass) : TPasExpr;
|
||||
Function AssertExpression(Const Msg: String; AExpr : TPasExpr; aKind : TPasExprKind; AValue : String) : TPrimitiveExpr;
|
||||
@ -74,6 +77,7 @@ Type
|
||||
Procedure AssertEquals(Const Msg : String; AExpected, AActual: TProcedureModifiers); overload;
|
||||
Procedure AssertEquals(Const Msg : String; AExpected, AActual: TAssignKind); overload;
|
||||
Procedure AssertEquals(Const Msg : String; AExpected, AActual: TProcedureMessageType); overload;
|
||||
Procedure AssertEquals(Const Msg : String; AExpected, AActual: TOperatorType); overload;
|
||||
Procedure HaveHint(AHint : TPasMemberHint; AHints : TPasMemberHints);
|
||||
Property Resolver : TStreamResolver Read FResolver;
|
||||
Property Scanner : TPascalScanner Read FScanner;
|
||||
@ -148,7 +152,8 @@ begin
|
||||
Result:=Module as TPasLibrary;
|
||||
end;
|
||||
|
||||
procedure TTestParser.SetUp;
|
||||
procedure TTestParser.SetupParser;
|
||||
|
||||
begin
|
||||
FResolver:=TStreamResolver.Create;
|
||||
FResolver.OwnsStreams:=True;
|
||||
@ -163,7 +168,8 @@ begin
|
||||
FIsUnit:=False;
|
||||
end;
|
||||
|
||||
procedure TTestParser.TearDown;
|
||||
procedure TTestParser.CleanupParser;
|
||||
|
||||
begin
|
||||
if Not Assigned(FModule) then
|
||||
FreeAndNil(FDeclarations)
|
||||
@ -181,6 +187,25 @@ begin
|
||||
FreeAndNil(FResolver);
|
||||
end;
|
||||
|
||||
procedure TTestParser.ResetParser;
|
||||
|
||||
begin
|
||||
CleanupParser;
|
||||
SetupParser;
|
||||
end;
|
||||
|
||||
procedure TTestParser.SetUp;
|
||||
begin
|
||||
Inherited;
|
||||
SetupParser;
|
||||
end;
|
||||
|
||||
procedure TTestParser.TearDown;
|
||||
begin
|
||||
CleanupParser;
|
||||
Inherited;
|
||||
end;
|
||||
|
||||
procedure TTestParser.StartUnit(AUnitName: String);
|
||||
begin
|
||||
FIsUnit:=True;
|
||||
@ -492,6 +517,13 @@ begin
|
||||
GetEnumName(TypeInfo(TProcedureMessageType),Ord(AActual)));
|
||||
end;
|
||||
|
||||
procedure TTestParser.AssertEquals(const Msg: String; AExpected,
|
||||
AActual: TOperatorType);
|
||||
begin
|
||||
AssertEquals(Msg,GetEnumName(TypeInfo(TOperatorType),Ord(AExpected)),
|
||||
GetEnumName(TypeInfo(TOperatorType),Ord(AExpected)));
|
||||
end;
|
||||
|
||||
procedure TTestParser.HaveHint(AHint: TPasMemberHint; AHints: TPasMemberHints);
|
||||
begin
|
||||
If not (AHint in AHints) then
|
||||
|
||||
@ -17,6 +17,7 @@ type
|
||||
FFunc: TPasFunction;
|
||||
FHint: String;
|
||||
FProc: TPasProcedure;
|
||||
FOperator:TPasOperator;
|
||||
procedure AddDeclaration(const ASource: string; const AHint: String='');
|
||||
procedure AssertArg(ProcType: TPasProcedureType; AIndex: Integer;
|
||||
AName: String; AAccess: TArgumentAccess; const TypeName: String;
|
||||
@ -33,6 +34,7 @@ type
|
||||
function ParseProcedure(const ASource: string; const AHint: String=''): TPasProcedure;
|
||||
Procedure ParseFunction;
|
||||
function ParseFunction(const ASource : String; AResult: string = ''; const AHint: String=''; CC : TCallingConvention = ccDefault): TPasProcedure;
|
||||
Procedure ParseOperator;
|
||||
protected
|
||||
procedure SetUp; override;
|
||||
procedure TearDown; override;
|
||||
@ -156,6 +158,8 @@ type
|
||||
Procedure TestFunctionCdeclExternalLibNameName;
|
||||
Procedure TestProcedureCdeclExternalName;
|
||||
Procedure TestFunctionCdeclExternalName;
|
||||
Procedure TestOperatorTokens;
|
||||
procedure TestOperatorNames;
|
||||
end;
|
||||
|
||||
implementation
|
||||
@ -199,7 +203,7 @@ begin
|
||||
AssertComment;
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.ParseProcedure;
|
||||
procedure TTestProcedureFunction.ParseProcedure;
|
||||
|
||||
begin
|
||||
// Writeln(source.text);
|
||||
@ -230,7 +234,19 @@ begin
|
||||
AssertEquals('Correct function result type name',AResult,FuncType.ResultEl.ResultType.Name);
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.ParseFunction;
|
||||
procedure TTestProcedureFunction.ParseOperator;
|
||||
begin
|
||||
// Writeln(source.text);
|
||||
ParseDeclarations;
|
||||
AssertEquals('One operator definition',1,Declarations.Functions.Count);
|
||||
AssertEquals('First declaration is function declaration.',TPasOperator,TObject(Declarations.Functions[0]).ClassType);
|
||||
FOperator:=TPasOperator(Declarations.Functions[0]);
|
||||
Definition:=FOperator;
|
||||
if (Hint<>'') then
|
||||
CheckHint(TPasMemberHint(Getenumvalue(typeinfo(TPasMemberHint),'h'+Hint)));
|
||||
end;
|
||||
|
||||
procedure TTestProcedureFunction.ParseFunction;
|
||||
begin
|
||||
// Writeln(source.text);
|
||||
ParseDeclarations;
|
||||
@ -367,13 +383,13 @@ begin
|
||||
TestEmptyProcedure;
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestEmptyFunction;
|
||||
procedure TTestProcedureFunction.TestEmptyFunction;
|
||||
begin
|
||||
ParseFunction('');
|
||||
AssertFunc([],ccDefault,0);
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestEmptyFunctionComment;
|
||||
procedure TTestProcedureFunction.TestEmptyFunctionComment;
|
||||
begin
|
||||
AddComment:=True;
|
||||
TestEmptyProcedure;
|
||||
@ -385,7 +401,7 @@ begin
|
||||
AssertProc([],ccDefault,0);
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestEmptyFunctionDeprecated;
|
||||
procedure TTestProcedureFunction.TestEmptyFunctionDeprecated;
|
||||
begin
|
||||
ParseFunction('','deprecated');
|
||||
AssertFunc([],ccDefault,0);
|
||||
@ -397,7 +413,7 @@ begin
|
||||
AssertProc([],ccDefault,0);
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestEmptyFunctionPlatform;
|
||||
procedure TTestProcedureFunction.TestEmptyFunctionPlatform;
|
||||
begin
|
||||
ParseFunction('','platform');
|
||||
AssertFunc([],ccDefault,0);
|
||||
@ -409,7 +425,7 @@ begin
|
||||
AssertProc([],ccDefault,0);
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestEmptyFunctionExperimental;
|
||||
procedure TTestProcedureFunction.TestEmptyFunctionExperimental;
|
||||
begin
|
||||
ParseFunction('','experimental');
|
||||
AssertFunc([],ccDefault,0);
|
||||
@ -421,7 +437,7 @@ begin
|
||||
AssertProc([],ccDefault,0);
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestEmptyFunctionUnimplemented;
|
||||
procedure TTestProcedureFunction.TestEmptyFunctionUnimplemented;
|
||||
begin
|
||||
ParseFunction('','unimplemented');
|
||||
AssertFunc([],ccDefault,0);
|
||||
@ -437,7 +453,7 @@ begin
|
||||
AssertArg(ProcType,0,'B',argDefault,'Integer','');
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestFunctionOneArg;
|
||||
procedure TTestProcedureFunction.TestFunctionOneArg;
|
||||
begin
|
||||
ParseFunction('(B : Integer)');
|
||||
AssertFunc([],ccDefault,1);
|
||||
@ -451,7 +467,7 @@ begin
|
||||
AssertArg(ProcType,0,'B',argVar,'Integer','');
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestFunctionOneVarArg;
|
||||
procedure TTestProcedureFunction.TestFunctionOneVarArg;
|
||||
begin
|
||||
ParseFunction('(Var B : Integer)');
|
||||
AssertFunc([],ccDefault,1);
|
||||
@ -465,7 +481,7 @@ begin
|
||||
AssertArg(ProcType,0,'B',argConst,'Integer','');
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestFunctionOneConstArg;
|
||||
procedure TTestProcedureFunction.TestFunctionOneConstArg;
|
||||
begin
|
||||
ParseFunction('(Const B : Integer)');
|
||||
AssertFunc([],ccDefault,1);
|
||||
@ -479,7 +495,7 @@ begin
|
||||
AssertArg(ProcType,0,'B',argOut,'Integer','');
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestFunctionOneOutArg;
|
||||
procedure TTestProcedureFunction.TestFunctionOneOutArg;
|
||||
begin
|
||||
ParseFunction('(Out B : Integer)');
|
||||
AssertFunc([],ccDefault,1);
|
||||
@ -493,7 +509,7 @@ begin
|
||||
AssertArg(ProcType,0,'B',argConstRef,'Integer','');
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestFunctionOneConstRefArg;
|
||||
procedure TTestProcedureFunction.TestFunctionOneConstRefArg;
|
||||
begin
|
||||
ParseFunction('(ConstRef B : Integer)');
|
||||
AssertFunc([],ccDefault,1);
|
||||
@ -508,7 +524,7 @@ begin
|
||||
AssertArg(ProcType,1,'C',argDefault,'Integer','');
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestFunctionTwoArgs;
|
||||
procedure TTestProcedureFunction.TestFunctionTwoArgs;
|
||||
begin
|
||||
ParseFunction('(B,C : Integer)');
|
||||
AssertFunc([],ccDefault,2);
|
||||
@ -524,7 +540,7 @@ begin
|
||||
AssertArg(ProcType,1,'C',argDefault,'Integer','');
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestFunctionTwoArgsSeparate;
|
||||
procedure TTestProcedureFunction.TestFunctionTwoArgsSeparate;
|
||||
begin
|
||||
ParseFunction('(B : Integer;C : Integer)');
|
||||
AssertFunc([],ccDefault,2);
|
||||
@ -539,7 +555,7 @@ begin
|
||||
AssertArg(ProcType,0,'B',argDefault,'Integer','1');
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestFunctionOneArgDefault;
|
||||
procedure TTestProcedureFunction.TestFunctionOneArgDefault;
|
||||
begin
|
||||
ParseFunction('(B : Integer = 1)');
|
||||
AssertFunc([],ccDefault,1);
|
||||
@ -553,7 +569,7 @@ begin
|
||||
AssertArg(ProcType,0,'B',argDefault,'MySet','[1, 2]');
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestFunctionOneArgDefaultSet;
|
||||
procedure TTestProcedureFunction.TestFunctionOneArgDefaultSet;
|
||||
begin
|
||||
ParseFunction('(B : MySet = [1,2])');
|
||||
AssertFunc([],ccDefault,1);
|
||||
@ -567,7 +583,7 @@ begin
|
||||
AssertArg(ProcType,0,'B',argDefault,'Integer','1 + 2');
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestFunctionOneArgDefaultExpr;
|
||||
procedure TTestProcedureFunction.TestFunctionOneArgDefaultExpr;
|
||||
begin
|
||||
ParseFunction('(B : Integer = 1 + 2)');
|
||||
AssertFunc([],ccDefault,1);
|
||||
@ -582,7 +598,7 @@ begin
|
||||
AssertArg(ProcType,1,'C',argDefault,'Integer','2');
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestFunctionTwoArgsDefault;
|
||||
procedure TTestProcedureFunction.TestFunctionTwoArgsDefault;
|
||||
begin
|
||||
ParseFunction('(B : Integer = 1; C : Integer = 2)');
|
||||
AssertFunc([],ccDefault,2);
|
||||
@ -597,7 +613,7 @@ begin
|
||||
AssertArg(ProcType,0,'B',argVar,'','');
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestFunctionOneUntypedVarArg;
|
||||
procedure TTestProcedureFunction.TestFunctionOneUntypedVarArg;
|
||||
begin
|
||||
ParseFunction('(Var B)');
|
||||
AssertFunc([],ccDefault,1);
|
||||
@ -612,7 +628,7 @@ begin
|
||||
AssertArg(ProcType,1,'C',argVar,'','');
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestFunctionTwoUntypedVarArgs;
|
||||
procedure TTestProcedureFunction.TestFunctionTwoUntypedVarArgs;
|
||||
begin
|
||||
ParseFunction('(Var B; Var C)');
|
||||
AssertFunc([],ccDefault,2);
|
||||
@ -627,7 +643,7 @@ begin
|
||||
AssertArg(ProcType,0,'B',argConst,'','');
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestFunctionOneUntypedConstArg;
|
||||
procedure TTestProcedureFunction.TestFunctionOneUntypedConstArg;
|
||||
begin
|
||||
ParseFunction('(Const B)');
|
||||
AssertFunc([],ccDefault,1);
|
||||
@ -642,7 +658,7 @@ begin
|
||||
AssertArg(ProcType,1,'C',argConst,'','');
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestFunctionTwoUntypedConstArgs;
|
||||
procedure TTestProcedureFunction.TestFunctionTwoUntypedConstArgs;
|
||||
begin
|
||||
ParseFunction('(Const B; Const C)');
|
||||
AssertFunc([],ccDefault,2);
|
||||
@ -657,7 +673,7 @@ begin
|
||||
AssertArrayArg(ProcType,0,'B',argDefault,'Integer');
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestFunctionOpenArrayArg;
|
||||
procedure TTestProcedureFunction.TestFunctionOpenArrayArg;
|
||||
begin
|
||||
ParseFunction('(B : Array of Integer)');
|
||||
AssertFunc([],ccDefault,1);
|
||||
@ -672,7 +688,7 @@ begin
|
||||
AssertArrayArg(ProcType,1,'C',argDefault,'Integer');
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestFunctionTwoOpenArrayArgs;
|
||||
procedure TTestProcedureFunction.TestFunctionTwoOpenArrayArgs;
|
||||
begin
|
||||
ParseFunction('(B : Array of Integer;C : Array of Integer)');
|
||||
AssertFunc([],ccDefault,2);
|
||||
@ -687,7 +703,7 @@ begin
|
||||
AssertArrayArg(ProcType,0,'B',argConst,'Integer');
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestFunctionConstOpenArrayArg;
|
||||
procedure TTestProcedureFunction.TestFunctionConstOpenArrayArg;
|
||||
begin
|
||||
ParseFunction('(Const B : Array of Integer)');
|
||||
AssertFunc([],ccDefault,1);
|
||||
@ -701,7 +717,7 @@ begin
|
||||
AssertArrayArg(ProcType,0,'B',argVar,'Integer');
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestFunctionVarOpenArrayArg;
|
||||
procedure TTestProcedureFunction.TestFunctionVarOpenArrayArg;
|
||||
begin
|
||||
ParseFunction('(Var B : Array of Integer)');
|
||||
AssertFunc([],ccDefault,1);
|
||||
@ -715,7 +731,7 @@ begin
|
||||
AssertArrayArg(ProcType,0,'B',argDefault,'');
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestFunctionArrayOfConstArg;
|
||||
procedure TTestProcedureFunction.TestFunctionArrayOfConstArg;
|
||||
begin
|
||||
ParseFunction('(B : Array of Const)');
|
||||
AssertFunc([],ccDefault,1);
|
||||
@ -729,100 +745,100 @@ begin
|
||||
AssertArrayArg(ProcType,0,'B',argConst,'');
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestFunctionConstArrayOfConstArg;
|
||||
procedure TTestProcedureFunction.TestFunctionConstArrayOfConstArg;
|
||||
begin
|
||||
ParseFunction('(Const B : Array of Const)');
|
||||
AssertFunc([],ccDefault,1);
|
||||
AssertArrayArg(FuncType,0,'B',argConst,'');
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestProcedureCdecl;
|
||||
procedure TTestProcedureFunction.TestProcedureCdecl;
|
||||
begin
|
||||
ParseProcedure('; cdecl');
|
||||
AssertProc([],ccCdecl,0);
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestFunctionCdecl;
|
||||
procedure TTestProcedureFunction.TestFunctionCdecl;
|
||||
begin
|
||||
ParseFunction('','','',ccCdecl);
|
||||
AssertFunc([],ccCdecl,0);
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestProcedureCdeclDeprecated;
|
||||
procedure TTestProcedureFunction.TestProcedureCdeclDeprecated;
|
||||
begin
|
||||
ParseProcedure('; cdecl;','deprecated');
|
||||
AssertProc([],ccCdecl,0);
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestFunctionCdeclDeprecated;
|
||||
procedure TTestProcedureFunction.TestFunctionCdeclDeprecated;
|
||||
begin
|
||||
ParseFunction('','','deprecated',ccCdecl);
|
||||
AssertFunc([],ccCdecl,0);
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestProcedureSafeCall;
|
||||
procedure TTestProcedureFunction.TestProcedureSafeCall;
|
||||
begin
|
||||
ParseProcedure('; safecall;','');
|
||||
AssertProc([],ccSafeCall,0);
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestFunctionSafeCall;
|
||||
procedure TTestProcedureFunction.TestFunctionSafeCall;
|
||||
begin
|
||||
ParseFunction('','','',ccSafecall);
|
||||
AssertFunc([],ccSafecall,0);
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestProcedurePascal;
|
||||
procedure TTestProcedureFunction.TestProcedurePascal;
|
||||
begin
|
||||
ParseProcedure('; pascal;','');
|
||||
AssertProc([],ccPascal,0);
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestFunctionPascal;
|
||||
procedure TTestProcedureFunction.TestFunctionPascal;
|
||||
begin
|
||||
ParseFunction('','','',ccPascal);
|
||||
AssertFunc([],ccPascal,0);
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestProcedureStdCall;
|
||||
procedure TTestProcedureFunction.TestProcedureStdCall;
|
||||
begin
|
||||
ParseProcedure('; stdcall;','');
|
||||
AssertProc([],ccstdcall,0);
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestFunctionStdCall;
|
||||
procedure TTestProcedureFunction.TestFunctionStdCall;
|
||||
begin
|
||||
ParseFunction('','','',ccStdCall);
|
||||
AssertFunc([],ccStdCall,0);
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestProcedureOldFPCCall;
|
||||
procedure TTestProcedureFunction.TestProcedureOldFPCCall;
|
||||
begin
|
||||
ParseProcedure('; oldfpccall;','');
|
||||
AssertProc([],ccoldfpccall,0);
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestFunctionOldFPCCall;
|
||||
procedure TTestProcedureFunction.TestFunctionOldFPCCall;
|
||||
begin
|
||||
ParseFunction('','','',ccOldFPCCall);
|
||||
AssertFunc([],ccOldFPCCall,0);
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestProcedurePublic;
|
||||
procedure TTestProcedureFunction.TestProcedurePublic;
|
||||
begin
|
||||
ParseProcedure('; public name ''myfunc'';','');
|
||||
AssertProc([pmPublic],ccDefault,0);
|
||||
AssertExpression('Public name',Proc.PublicName,pekString,'''myfunc''');
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestProcedurePublicIdent;
|
||||
procedure TTestProcedureFunction.TestProcedurePublicIdent;
|
||||
begin
|
||||
ParseProcedure('; public name exportname;','');
|
||||
AssertProc([pmPublic],ccDefault,0);
|
||||
AssertExpression('Public name',Proc.PublicName,pekIdent,'exportname');
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestFunctionPublic;
|
||||
procedure TTestProcedureFunction.TestFunctionPublic;
|
||||
begin
|
||||
AddDeclaration('function A : Integer; public name exportname');
|
||||
ParseFunction;
|
||||
@ -830,14 +846,14 @@ begin
|
||||
AssertExpression('Public name',Func.PublicName,pekIdent,'exportname');
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestProcedureCdeclPublic;
|
||||
procedure TTestProcedureFunction.TestProcedureCdeclPublic;
|
||||
begin
|
||||
ParseProcedure('; cdecl; public name exportname;','');
|
||||
AssertProc([pmPublic],ccCDecl,0);
|
||||
AssertExpression('Public name',Proc.PublicName,pekIdent,'exportname');
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestFunctionCdeclPublic;
|
||||
procedure TTestProcedureFunction.TestFunctionCdeclPublic;
|
||||
begin
|
||||
AddDeclaration('function A : Integer; cdecl; public name exportname');
|
||||
ParseFunction;
|
||||
@ -845,58 +861,58 @@ begin
|
||||
AssertExpression('Public name',Func.PublicName,pekIdent,'exportname');
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestProcedureOverload;
|
||||
procedure TTestProcedureFunction.TestProcedureOverload;
|
||||
begin
|
||||
ParseProcedure('; overload;','');
|
||||
AssertProc([pmOverload],ccDefault,0);
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestFunctionOverload;
|
||||
procedure TTestProcedureFunction.TestFunctionOverload;
|
||||
begin
|
||||
AddDeclaration('function A : Integer; overload');
|
||||
ParseFunction;
|
||||
AssertFunc([pmOverload],ccDefault,0);
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestProcedureVarargs;
|
||||
procedure TTestProcedureFunction.TestProcedureVarargs;
|
||||
begin
|
||||
ParseProcedure('; varargs;','');
|
||||
AssertProc([pmVarArgs],ccDefault,0);
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestFunctionVarArgs;
|
||||
procedure TTestProcedureFunction.TestFunctionVarArgs;
|
||||
begin
|
||||
AddDeclaration('function A : Integer; varargs');
|
||||
ParseFunction;
|
||||
AssertFunc([pmVarArgs],ccDefault,0);
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestProcedureCDeclVarargs;
|
||||
procedure TTestProcedureFunction.TestProcedureCDeclVarargs;
|
||||
begin
|
||||
ParseProcedure(';cdecl; varargs;','');
|
||||
AssertProc([pmVarArgs],ccCDecl,0);
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestFunctionCDeclVarArgs;
|
||||
procedure TTestProcedureFunction.TestFunctionCDeclVarArgs;
|
||||
begin
|
||||
AddDeclaration('function A : Integer; cdecl; varargs');
|
||||
ParseFunction;
|
||||
AssertFunc([pmVarArgs],ccCdecl,0);
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestProcedureForwardInterface;
|
||||
procedure TTestProcedureFunction.TestProcedureForwardInterface;
|
||||
begin
|
||||
AddDeclaration('procedure A; forward;');
|
||||
AssertException(EParserError,@ParseProcedure);
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestFunctionForwardInterface;
|
||||
procedure TTestProcedureFunction.TestFunctionForwardInterface;
|
||||
begin
|
||||
AddDeclaration('function A : integer; forward;');
|
||||
AssertException(EParserError,@ParseFunction);
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestProcedureForward;
|
||||
procedure TTestProcedureFunction.TestProcedureForward;
|
||||
begin
|
||||
UseImplementation:=True;
|
||||
AddDeclaration('procedure A; forward;');
|
||||
@ -904,7 +920,7 @@ begin
|
||||
AssertProc([pmforward],ccDefault,0);
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestFunctionForward;
|
||||
procedure TTestProcedureFunction.TestFunctionForward;
|
||||
begin
|
||||
UseImplementation:=True;
|
||||
AddDeclaration('function A : integer; forward;');
|
||||
@ -912,7 +928,7 @@ begin
|
||||
AssertFunc([pmforward],ccDefault,0);
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestProcedureCdeclForward;
|
||||
procedure TTestProcedureFunction.TestProcedureCdeclForward;
|
||||
begin
|
||||
UseImplementation:=True;
|
||||
AddDeclaration('procedure A; cdecl; forward;');
|
||||
@ -920,7 +936,7 @@ begin
|
||||
AssertProc([pmforward],ccCDecl,0);
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestFunctionCDeclForward;
|
||||
procedure TTestProcedureFunction.TestFunctionCDeclForward;
|
||||
begin
|
||||
UseImplementation:=True;
|
||||
AddDeclaration('function A : integer; cdecl; forward;');
|
||||
@ -928,92 +944,92 @@ begin
|
||||
AssertFunc([pmforward],ccCDecl,0);
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestProcedureCompilerProc;
|
||||
procedure TTestProcedureFunction.TestProcedureCompilerProc;
|
||||
begin
|
||||
ParseProcedure(';compilerproc;','');
|
||||
AssertProc([pmCompilerProc],ccDefault,0);
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestFunctionCompilerProc;
|
||||
procedure TTestProcedureFunction.TestFunctionCompilerProc;
|
||||
begin
|
||||
AddDeclaration('function A : Integer; compilerproc');
|
||||
ParseFunction;
|
||||
AssertFunc([pmCompilerProc],ccDefault,0);
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestProcedureCDeclCompilerProc;
|
||||
procedure TTestProcedureFunction.TestProcedureCDeclCompilerProc;
|
||||
begin
|
||||
ParseProcedure(';cdecl;compilerproc;','');
|
||||
AssertProc([pmCompilerProc],ccCDecl,0);
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestFunctionCDeclCompilerProc;
|
||||
procedure TTestProcedureFunction.TestFunctionCDeclCompilerProc;
|
||||
begin
|
||||
AddDeclaration('function A : Integer; cdecl; compilerproc');
|
||||
ParseFunction;
|
||||
AssertFunc([pmCompilerProc],ccCDecl,0);
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestProcedureAssembler;
|
||||
procedure TTestProcedureFunction.TestProcedureAssembler;
|
||||
begin
|
||||
ParseProcedure(';assembler;','');
|
||||
AssertProc([pmAssembler],ccDefault,0);
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestFunctionAssembler;
|
||||
procedure TTestProcedureFunction.TestFunctionAssembler;
|
||||
begin
|
||||
AddDeclaration('function A : Integer; assembler');
|
||||
ParseFunction;
|
||||
AssertFunc([pmAssembler],ccDefault,0);
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestProcedureCDeclAssembler;
|
||||
procedure TTestProcedureFunction.TestProcedureCDeclAssembler;
|
||||
begin
|
||||
ParseProcedure(';cdecl;assembler;','');
|
||||
AssertProc([pmAssembler],ccCDecl,0);
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestFunctionCDeclAssembler;
|
||||
procedure TTestProcedureFunction.TestFunctionCDeclAssembler;
|
||||
begin
|
||||
AddDeclaration('function A : Integer; cdecl; assembler');
|
||||
ParseFunction;
|
||||
AssertFunc([pmAssembler],ccCDecl,0);
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestProcedureExport;
|
||||
procedure TTestProcedureFunction.TestProcedureExport;
|
||||
begin
|
||||
ParseProcedure(';export;','');
|
||||
AssertProc([pmExport],ccDefault,0);
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestFunctionExport;
|
||||
procedure TTestProcedureFunction.TestFunctionExport;
|
||||
begin
|
||||
AddDeclaration('function A : Integer; export');
|
||||
ParseFunction;
|
||||
AssertFunc([pmExport],ccDefault,0);
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestProcedureCDeclExport;
|
||||
procedure TTestProcedureFunction.TestProcedureCDeclExport;
|
||||
begin
|
||||
ParseProcedure('cdecl;export;','');
|
||||
AssertProc([pmExport],ccCDecl,0);
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestFunctionCDeclExport;
|
||||
procedure TTestProcedureFunction.TestFunctionCDeclExport;
|
||||
begin
|
||||
AddDeclaration('function A : Integer; cdecl; export');
|
||||
ParseFunction;
|
||||
AssertFunc([pmExport],ccCDecl,0);
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestProcedureExternal;
|
||||
procedure TTestProcedureFunction.TestProcedureExternal;
|
||||
begin
|
||||
ParseProcedure(';external','');
|
||||
AssertProc([pmExternal],ccDefault,0);
|
||||
AssertNull('No Library name expression',Proc.LibraryExpr);
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestFunctionExternal;
|
||||
procedure TTestProcedureFunction.TestFunctionExternal;
|
||||
begin
|
||||
AddDeclaration('function A : Integer; external');
|
||||
ParseFunction;
|
||||
@ -1021,14 +1037,14 @@ begin
|
||||
AssertNull('No Library name expression',Func.LibraryExpr);
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestProcedureExternalLibName;
|
||||
procedure TTestProcedureFunction.TestProcedureExternalLibName;
|
||||
begin
|
||||
ParseProcedure(';external ''libname''','');
|
||||
AssertProc([pmExternal],ccDefault,0);
|
||||
AssertExpression('Library name expression',Proc.LibraryExpr,pekString,'''libname''');
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestFunctionExternalLibName;
|
||||
procedure TTestProcedureFunction.TestFunctionExternalLibName;
|
||||
begin
|
||||
AddDeclaration('function A : Integer; external ''libname''');
|
||||
ParseFunction;
|
||||
@ -1036,7 +1052,7 @@ begin
|
||||
AssertExpression('Library name expression',Func.LibraryExpr,pekString,'''libname''');
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestProcedureExternalLibNameName;
|
||||
procedure TTestProcedureFunction.TestProcedureExternalLibNameName;
|
||||
begin
|
||||
ParseProcedure(';external ''libname'' name ''symbolname''','');
|
||||
AssertProc([pmExternal],ccDefault,0);
|
||||
@ -1044,7 +1060,7 @@ begin
|
||||
AssertExpression('Library symbol expression',Proc.LibrarySymbolName,pekString,'''symbolname''');
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestFunctionExternalLibNameName;
|
||||
procedure TTestProcedureFunction.TestFunctionExternalLibNameName;
|
||||
begin
|
||||
AddDeclaration('function A : Integer; external ''libname'' name ''symbolname''');
|
||||
ParseFunction;
|
||||
@ -1053,7 +1069,7 @@ begin
|
||||
AssertExpression('Library symbol expression',Func.LibrarySymbolName,pekString,'''symbolname''');
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestProcedureExternalName;
|
||||
procedure TTestProcedureFunction.TestProcedureExternalName;
|
||||
begin
|
||||
ParseProcedure(';external name ''symbolname''','');
|
||||
AssertProc([pmExternal],ccDefault,0);
|
||||
@ -1061,7 +1077,7 @@ begin
|
||||
AssertExpression('Library symbol expression',Proc.LibrarySymbolName,pekString,'''symbolname''');
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestFunctionExternalName;
|
||||
procedure TTestProcedureFunction.TestFunctionExternalName;
|
||||
begin
|
||||
AddDeclaration('function A : Integer; external name ''symbolname''');
|
||||
ParseFunction;
|
||||
@ -1070,14 +1086,14 @@ begin
|
||||
AssertExpression('Library symbol expression',Func.LibrarySymbolName,pekString,'''symbolname''');
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestProcedureCdeclExternal;
|
||||
procedure TTestProcedureFunction.TestProcedureCdeclExternal;
|
||||
begin
|
||||
ParseProcedure('; cdecl; external','');
|
||||
AssertProc([pmExternal],ccCdecl,0);
|
||||
AssertNull('No Library name expression',Proc.LibraryExpr);
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestFunctionCdeclExternal;
|
||||
procedure TTestProcedureFunction.TestFunctionCdeclExternal;
|
||||
begin
|
||||
AddDeclaration('function A : Integer; cdecl; external');
|
||||
ParseFunction;
|
||||
@ -1085,14 +1101,14 @@ begin
|
||||
AssertNull('No Library name expression',Func.LibraryExpr);
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestProcedureCdeclExternalLibName;
|
||||
procedure TTestProcedureFunction.TestProcedureCdeclExternalLibName;
|
||||
begin
|
||||
ParseProcedure('; cdecl; external ''libname''','');
|
||||
AssertProc([pmExternal],ccCdecl,0);
|
||||
AssertExpression('Library name expression',Proc.LibraryExpr,pekString,'''libname''');
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestFunctionCdeclExternalLibName;
|
||||
procedure TTestProcedureFunction.TestFunctionCdeclExternalLibName;
|
||||
begin
|
||||
AddDeclaration('function A : Integer; cdecl; external ''libname''');
|
||||
ParseFunction;
|
||||
@ -1100,7 +1116,7 @@ begin
|
||||
AssertExpression('Library name expression',Func.LibraryExpr,pekString,'''libname''');
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestProcedureCdeclExternalLibNameName;
|
||||
procedure TTestProcedureFunction.TestProcedureCdeclExternalLibNameName;
|
||||
begin
|
||||
ParseProcedure('; cdecl; external ''libname'' name ''symbolname''','');
|
||||
AssertProc([pmExternal],ccCdecl,0);
|
||||
@ -1108,7 +1124,7 @@ begin
|
||||
AssertExpression('Library symbol expression',Proc.LibrarySymbolName,pekString,'''symbolname''');
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestFunctionCdeclExternalLibNameName;
|
||||
procedure TTestProcedureFunction.TestFunctionCdeclExternalLibNameName;
|
||||
begin
|
||||
AddDeclaration('function A : Integer; cdecl; external ''libname'' name ''symbolname''');
|
||||
ParseFunction;
|
||||
@ -1117,7 +1133,7 @@ begin
|
||||
AssertExpression('Library symbol expression',Func.LibrarySymbolName,pekString,'''symbolname''');
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestProcedureCdeclExternalName;
|
||||
procedure TTestProcedureFunction.TestProcedureCdeclExternalName;
|
||||
begin
|
||||
ParseProcedure('; cdecl; external name ''symbolname''','');
|
||||
AssertProc([pmExternal],ccCdecl,0);
|
||||
@ -1125,7 +1141,7 @@ begin
|
||||
AssertExpression('Library symbol expression',Proc.LibrarySymbolName,pekString,'''symbolname''');
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.TestFunctionCdeclExternalName;
|
||||
procedure TTestProcedureFunction.TestFunctionCdeclExternalName;
|
||||
begin
|
||||
AddDeclaration('function A : Integer; cdecl; external name ''symbolname''');
|
||||
ParseFunction;
|
||||
@ -1134,6 +1150,54 @@ begin
|
||||
AssertExpression('Library symbol expression',Func.LibrarySymbolName,pekString,'''symbolname''');
|
||||
end;
|
||||
|
||||
procedure TTestProcedureFunction.TestOperatorTokens;
|
||||
|
||||
Var
|
||||
t : TOperatorType;
|
||||
|
||||
begin
|
||||
For t:=otMul to High(TOperatorType) do
|
||||
// No way to distinguish between logical/bitwise or/and/Xor
|
||||
if not (t in [otBitwiseOr,otBitwiseAnd,otBitwiseXor]) then
|
||||
begin
|
||||
ResetParser;
|
||||
if t in UnaryOperators then
|
||||
AddDeclaration(Format('operator %s (a: Integer) : te',[OperatorTokens[t]]))
|
||||
else
|
||||
AddDeclaration(Format('operator %s (a: Integer; b: integer) : te',[OperatorTokens[t]]));
|
||||
ParseOperator;
|
||||
AssertEquals('Token based',Not (T in [otInc,otDec]),FOperator.TokenBased);
|
||||
AssertEquals('Correct operator type',T,FOperator.OperatorType);
|
||||
if t in UnaryOperators then
|
||||
AssertEquals('Correct operator name',format('%s(Integer):te',[OperatorNames[t]]),FOperator.Name)
|
||||
else
|
||||
AssertEquals('Correct operator name',format('%s(Integer,Integer):te',[OperatorNames[t]]),FOperator.Name);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestProcedureFunction.TestOperatorNames;
|
||||
|
||||
Var
|
||||
t : TOperatorType;
|
||||
|
||||
begin
|
||||
For t:=Succ(otUnknown) to High(TOperatorType) do
|
||||
begin
|
||||
ResetParser;
|
||||
if t in UnaryOperators then
|
||||
AddDeclaration(Format('operator %s (a: Integer) : te',[OperatorNames[t]]))
|
||||
else
|
||||
AddDeclaration(Format('operator %s (a: Integer; b: integer) : te',[OperatorNames[t]]));
|
||||
ParseOperator;
|
||||
AssertEquals('Token based',False,FOperator.TokenBased);
|
||||
AssertEquals('Correct operator type',T,FOperator.OperatorType);
|
||||
if t in UnaryOperators then
|
||||
AssertEquals('Correct operator name',format('%s(Integer):te',[OperatorNames[t]]),FOperator.Name)
|
||||
else
|
||||
AssertEquals('Correct operator name',format('%s(Integer,Integer):te',[OperatorNames[t]]),FOperator.Name);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestProcedureFunction.SetUp;
|
||||
begin
|
||||
Inherited;
|
||||
@ -1144,7 +1208,7 @@ begin
|
||||
Inherited;
|
||||
end;
|
||||
|
||||
Procedure TTestProcedureFunction.AssertComment;
|
||||
procedure TTestProcedureFunction.AssertComment;
|
||||
begin
|
||||
AssertEquals('Correct comment',' A comment'+sLineBreak,FProc.DocComment);
|
||||
end;
|
||||
|
||||
@ -169,7 +169,8 @@ type
|
||||
procedure AssertVariantSelector(AName, AType: string);
|
||||
procedure AssertField1(Hints: TPasMemberHints);
|
||||
procedure AssertField2(Hints: TPasMemberHints);
|
||||
procedure AssertMethod2(Hints: TPasMemberHints);
|
||||
procedure AssertMethod2(Hints: TPasMemberHints; isClass : Boolean = False);
|
||||
procedure AssertOperatorMethod2(Hints: TPasMemberHints; isClass : Boolean = False);
|
||||
procedure AssertVariant1(Hints: TPasMemberHints);
|
||||
procedure AssertVariant1(Hints: TPasMemberHints; VariantLabels : Array of string);
|
||||
procedure AssertVariant2(Hints: TPasMemberHints);
|
||||
@ -245,6 +246,7 @@ type
|
||||
Procedure TestFieldAnd2Methods;
|
||||
Procedure TestFieldAndProperty;
|
||||
Procedure TestFieldAndClassMethod;
|
||||
Procedure TestFieldAndClassOperator;
|
||||
Procedure TestNested;
|
||||
Procedure TestNestedDeprecated;
|
||||
Procedure TestNestedPlatform;
|
||||
@ -731,15 +733,20 @@ end;
|
||||
Function TTestProcedureTypeParser.ParseType(ASource: String;
|
||||
CC: TCallingConvention; ATypeClass: TClass; Const AHint: String
|
||||
): TPasProcedureType;
|
||||
|
||||
Var
|
||||
CCS : String;
|
||||
|
||||
begin
|
||||
if CC=ccdefault then
|
||||
Result:=TPasProcedureType(ParseType(ASource,ATypeClass,AHint))
|
||||
else
|
||||
begin
|
||||
CCS:=cCallingConventions[CC];
|
||||
if (AHint<>'') then
|
||||
Result:=TPasProcedureType(ParseType(ASource+';' +cCallingConventions[CC]+';',ATypeClass,AHint))
|
||||
Result:=TPasProcedureType(ParseType(ASource+';' +CCS+';',ATypeClass,AHint))
|
||||
else
|
||||
Result:=TPasProcedureType(ParseType(ASource+';' +cCallingConventions[CC],ATypeClass,AHint));
|
||||
Result:=TPasProcedureType(ParseType(ASource+';' +CCS,ATypeClass,AHint));
|
||||
end;
|
||||
FProc:=Result;
|
||||
AssertEquals('Correct calling convention for procedural type',cc,Result.CallingConvention);
|
||||
@ -1468,18 +1475,37 @@ begin
|
||||
AssertTrue('Field 2 hints match',Field2.Hints=Hints)
|
||||
end;
|
||||
|
||||
procedure TTestRecordTypeParser.AssertMethod2(Hints: TPasMemberHints);
|
||||
procedure TTestRecordTypeParser.AssertMethod2(Hints: TPasMemberHints; isClass : Boolean = False);
|
||||
|
||||
Var
|
||||
P : TPasProcedure;
|
||||
|
||||
begin
|
||||
AssertEquals('Member 2 type',TPasProcedure,TObject(TheRecord.Members[1]).ClassType);
|
||||
if IsClass then
|
||||
AssertEquals('Member 2 type',TPasClassProcedure,TObject(TheRecord.Members[1]).ClassType)
|
||||
else
|
||||
AssertEquals('Member 2 type',TPasProcedure,TObject(TheRecord.Members[1]).ClassType);
|
||||
P:=TPasProcedure(TheRecord.Members[1]);
|
||||
AssertEquals('Method name','dosomething2',P.Name);
|
||||
AssertTrue('Method hints match',P.Hints=Hints)
|
||||
end;
|
||||
|
||||
procedure TTestRecordTypeParser.AssertOperatorMethod2(Hints: TPasMemberHints;
|
||||
isClass: Boolean);
|
||||
Var
|
||||
P : TPasOperator;
|
||||
|
||||
begin
|
||||
if IsClass then
|
||||
AssertEquals('Member 2 type',TPasClassOperator,TObject(TheRecord.Members[1]).ClassType)
|
||||
else
|
||||
AssertEquals('Member 2 type',TPasOperator,TObject(TheRecord.Members[1]).ClassType);
|
||||
P:=TPasOperator(TheRecord.Members[1]);
|
||||
AssertEquals('Method name','assign(ta,Cardinal):Boolean',P.Name);
|
||||
|
||||
AssertTrue('Method hints match',P.Hints=Hints)
|
||||
end;
|
||||
|
||||
procedure TTestRecordTypeParser.AssertOneIntegerField(Hints : TPasMemberHints);
|
||||
|
||||
begin
|
||||
@ -1883,11 +1909,30 @@ Var
|
||||
P : TPasFunction;
|
||||
|
||||
begin
|
||||
Parser.Options:=[po_delphi];
|
||||
TestFields(['x : integer;','class procedure dosomething2;','function dosomething3 : Integer;'],'',False);
|
||||
AssertEquals('Member count',3,TheRecord.Members.Count);
|
||||
AssertField1([]);
|
||||
AssertMethod2([]);
|
||||
AssertEquals('Class procedure',TPasProcedure,TObject(TheRecord.Members[1]).ClassType);
|
||||
AssertMethod2([],True);
|
||||
AssertEquals('Class procedure',TPasClassProcedure,TObject(TheRecord.Members[1]).ClassType);
|
||||
AssertEquals('Member 3 type',TPasFunction,TObject(TheRecord.Members[2]).ClassType);
|
||||
P:=TPasFunction(TheRecord.Members[2]);
|
||||
AssertEquals('Method 2 name','dosomething3',P.Name);
|
||||
AssertTrue('Method 2 hints match',[]=P.Hints);
|
||||
// Standard type
|
||||
AssertEquals('Method 2 result type','Integer', P.FuncType.ResultEl.ResultType.Name);
|
||||
end;
|
||||
|
||||
procedure TTestRecordTypeParser.TestFieldAndClassOperator;
|
||||
|
||||
Var
|
||||
P : TPasFunction;
|
||||
|
||||
begin
|
||||
TestFields(['x : integer;','class operator assign(a : ta; b : Cardinal) : boolean;','function dosomething3 : Integer;'],'',False);
|
||||
AssertEquals('Member count',3,TheRecord.Members.Count);
|
||||
AssertField1([]);
|
||||
AssertOperatorMethod2([],True);
|
||||
AssertEquals('Member 3 type',TPasFunction,TObject(TheRecord.Members[2]).ClassType);
|
||||
P:=TPasFunction(TheRecord.Members[2]);
|
||||
AssertEquals('Method 2 name','dosomething3',P.Name);
|
||||
|
||||
@ -30,7 +30,7 @@
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
<CommandLineParams Value="--suite=TTestStatementParser.TestAsm"/>
|
||||
<CommandLineParams Value="--suite=TTestProcedureFunction.TestOperatorTokens"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="1">
|
||||
@ -46,22 +46,18 @@
|
||||
<Unit1>
|
||||
<Filename Value="tcscanner.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="tcscanner"/>
|
||||
</Unit1>
|
||||
<Unit2>
|
||||
<Filename Value="tctypeparser.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="tctypeparser"/>
|
||||
</Unit2>
|
||||
<Unit3>
|
||||
<Filename Value="tcstatements.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="tcstatements"/>
|
||||
</Unit3>
|
||||
<Unit4>
|
||||
<Filename Value="tcbaseparser.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="tcbaseparser"/>
|
||||
</Unit4>
|
||||
<Unit5>
|
||||
<Filename Value="tcmoduleparser.pas"/>
|
||||
@ -74,7 +70,6 @@
|
||||
<Unit7>
|
||||
<Filename Value="tcvarparser.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="tcvarparser"/>
|
||||
</Unit7>
|
||||
<Unit8>
|
||||
<Filename Value="tcclasstype.pas"/>
|
||||
@ -83,7 +78,6 @@
|
||||
<Unit9>
|
||||
<Filename Value="tcexprparser.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="tcexprparser"/>
|
||||
</Unit9>
|
||||
<Unit10>
|
||||
<Filename Value="tcprocfunc.pas"/>
|
||||
|
||||
Loading…
Reference in New Issue
Block a user