paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-09 22:48:57 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Fix bug ID #32625: added several firebird constructs

Browse Source 
git-svn-id: trunk@43139 -
This commit is contained in:
michael 2019-10-06 11:20:20 +00:00
parent e89383a104
commit 01b946706b
8 changed files with 462 additions and 114 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -3173,6 +3173,7 @@ packages/fcl-db/examples/loadlibdemo.pp svneol=native#text/plain
packages/fcl-db/examples/logsqldemo.lpi svneol=native#text/plain
packages/fcl-db/examples/logsqldemo.pas svneol=native#text/plain
packages/fcl-db/examples/myext.pp svneol=native#text/plain
packages/fcl-db/examples/parsesql.pas svneol=native#text/plain
packages/fcl-db/examples/pqeventstest.pp svneol=native#text/plain
packages/fcl-db/examples/showcsv.pp svneol=native#text/plain
packages/fcl-db/examples/sqlite3extdemo.pp svneol=native#text/plain

64
packages/fcl-db/examples/parsesql.pas Normal file
View File

@ -0,0 +1,64 @@
{
This file is part of the Free Component Library
Copyright (c) 2019 by the Free Pascal development team
Demo for SQL source syntax parser
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
program parsesql;
uses sysutils, classes, fpsqlparser, fpsqlscanner,fpsqltree;
Procedure parseScript(const aFilename:String; AScript :TStringList);
var
i: integer;
Parser: TSQLParser;
ResultList: TSQLElementList;
ScriptStream:TFileStream;
begin
ScriptStream:=TFileStream.Create(aFilename, fmopenreadwrite or fmshareexclusive);
try
ScriptStream.Position:=0;
Parser := TSQLParser.Create(ScriptStream);
try
ResultList := Parser.ParseScript([poAllowSetTerm]);
for i:=0 to ResultList.Count-1 do
AScript.Add(ResultList[i].GetAsSQL([sfoDoubleQuoteIdentifier]));
finally
Parser.Free;
end;
finally
ScriptStream.Free;
ResultList.Free;
end;
end;
Var
L : TStringList;
S : String;
begin
if ParamCount<>1 then
begin
Writeln('Parse & Dump SQL');
Writeln('Usage : parsesql <filename>');
Halt(1);
end;
L:=TStringList.Create;
try
ParseScript(ParamStr(1),L);
for S in L do Writeln(S);
Finally
L.Free;
end;
end.

204
packages/fcl-db/src/sql/fpsqlparser.pas
View File

@ -35,10 +35,14 @@ Type
TSelectFlag = (sfSingleTon,sfUnion,sfInto);
TSelectFlags = Set of TSelectFlag;
TParserOption = (poPartial,poAllowSetTerm);
TParserOptions = set of TParserOption;
{ TSQLParser }
TSQLParser = Class(TObject)
Private
FOptions : TParserOptions;
FInput : TStream;
FScanner : TSQLScanner;
FCurrent : TSQLToken;
@ -100,6 +104,7 @@ Type
function ParseAlterTableStatement(AParent: TSQLElement): TSQLAlterTableStatement;
function ParseCreateViewStatement(AParent: TSQLElement; IsAlter: Boolean): TSQLCreateOrAlterStatement;
function ParseCreateTriggerStatement(AParent: TSQLElement; IsAlter: Boolean): TSQLCreateOrAlterStatement;
function ParseSetTermStatement(AParent: TSQLElement): TSQLSetTermStatement;
function ParseSetGeneratorStatement(AParent: TSQLElement) : TSQLSetGeneratorStatement;
function ParseCreateDatabaseStatement(AParent: TSQLElement; IsAlter: Boolean ): TSQLCreateDatabaseStatement;
function ParseCreateShadowStatement(AParent: TSQLElement; IsAlter: Boolean ): TSQLCreateShadowStatement;
@ -158,9 +163,11 @@ Type
Function ParseGrantStatement(AParent: TSQLElement): TSQLGrantStatement;
Function ParseRevokeStatement(AParent: TSQLElement): TSQLGrantStatement;
// Parse single element
Function Parse : TSQLElement;
Function Parse : TSQLElement; overload;
Function Parse(aOptions : TParserOptions) : TSQLElement; overload;
// Parse script containing 1 or more elements
Function ParseScript(AllowPartial : Boolean = False) : TSQLElementList;
Function ParseScript(AllowPartial : Boolean) : TSQLElementList; deprecated 'use options';
Function ParseScript(aOptions : TParserOptions = []) : TSQLElementList;
// Auxiliary stuff
Function CurrentToken : TSQLToken;
Function CurrentTokenString : String;
@ -173,6 +180,8 @@ Type
function CurSource: String;
Function CurLine : Integer;
Function CurPos : Integer;
Property Options : TParserOptions Read FOptions;
Property Scanner : TSQLScanner Read FScanner;
end;
{ ESQLParser }
@ -196,19 +205,19 @@ uses typinfo;
Resourcestring
SerrUnmatchedBrace = 'Expected ).';
SErrCommaOrBraceExpected = 'Expected , or ).';
// SErrCommaOrBraceExpected = 'Expected , or ).';
SErrUnexpectedToken = 'Unexpected token: %s';
SErrUnexpectedTokenOf = 'Unexpected token: %s, expected one of %s';
SErrTokenMismatch = 'Unexpected token: ''%s'', expected: ''%s''';
SErrExpectedDBObject = 'Expected database object type. Got: ''%s''';
SErrDomainNotAllowed = 'Domain name not allowed in type definition.';
SErrExpectedChar = 'Expected CHAR or CHARACTER, got "%s"';
//SErrExpectedChar = 'Expected CHAR or CHARACTER, got "%s"';
SErrVaryingNotAllowed = 'VARYING not allowed at this point.';
SErrUnknownBooleanOp = 'Unknown boolean operation';
SErrUnknownComparison = 'unknown Comparison operation';
SErrIntegerExpected = 'Integer expression expected';
SErrInvalidUseOfCollate = 'Invalid use of COLLATE';
SErrCannotAlterGenerator = 'Alter generator statement unknown';
//SErrCannotAlterGenerator = 'Alter generator statement unknown';
SErrInvalidLiteral = 'Invalid literal: "%s"';
SErrNoAggregateAllowed = 'Aggregate function not allowed.';
SErrAsteriskOnlyInCount = '* allowed only in COUNT aggregate';
@ -218,6 +227,8 @@ Resourcestring
SErrUnionFieldCountMatch = 'Field count mismatch in select union : %d <> %d';
SErrInvalidExtract = 'Invalid element for extract: %s';
SErrOuterWithout = 'OUTER without preceding LEFT, RIGHT or FULL';
// SErrRestartWithAlter = 'RESTART only with ALTER SEQUENCE';
SErrCommaOrSquareArray = 'Expected , or ] in array dimension';
Function StringToSQLExtractElement(Const S : TSQLStringType; Out Res : TSQLExtractElement) : Boolean;
@ -365,6 +376,8 @@ begin
tsqlFull : J.JoinType:=jtFullOuter;
tsqlLeft : J.JoinType:=jtLeft;
tsqlRight : J.JoinType:=jtRight;
else
expect([tsqlInner,tsqlFull,tsqlJoin,tsqlOuter,tsqlLeft,tsqlRight]);
end;
if CurrentToken<>tsqlJoin then
GetNextToken;
@ -627,6 +640,8 @@ begin
tsqlBraceOpen : E.Jointype:=pjtJoin;
tsqlSort : E.JoinType:=pjtSort;
tsqlMerge : E.JoinType:=pjtMerge;
else
expect([tsqlJoin,tsqlmerge,tsqlSort,tsqlBraceOpen]);
end;
If (CurrentToken<>tsqlBraceOpen) then
GetNextToken;
@ -1140,7 +1155,7 @@ begin
GetNextToken;
Include(O,ioAscending);
end
else If (CurrentToken=tsqlDescending) then
else If (CurrentToken=tsqlDescending) or (CurrentToken=tsqlDesc) then
begin
GetNextToken;
Include(O,ioDescending);
@ -1255,8 +1270,6 @@ end;
function TSQLParser.ParseIfStatement(AParent: TSQLElement): TSQLIFStatement;
Var
Pt : TSQLToken;
begin
// On Entry, we're on the IF token
@ -1269,10 +1282,7 @@ begin
Consume(tsqlThen);
Result.TrueBranch:=ParseProcedureStatement(Result);
If (CurrentToken=tsqlSemicolon) and (PeekNextToken=tsqlElse) then
begin
PT:=CurrentToken;
GetNextToken;
end
GetNextToken
else if (CurrentToken=tsqlElse) then
if not (PreviousToken=tsqlEnd) then
UnexpectedToken;
@ -1558,19 +1568,39 @@ end;
function TSQLParser.ParseCreateGeneratorStatement(AParent: TSQLElement; IsAlter: Boolean
): TSQLCreateOrAlterStatement;
Var
isSequence : Boolean;
Gen : TSQLCreateOrAlterGenerator;
Alt : TSQLAlterGeneratorStatement absolute gen;
begin
isSequence:=CurrentToken=tsqlSequence;
GetNextToken;
Expect(tsqlIdentifier);
If IsAlter then
Error(SErrCannotAlterGenerator);
Result:=TSQLCreateOrAlterStatement(CreateElement(TSQLCreateGeneratorStatement,AParent));
if isAlter then
Gen:=TSQLCreateOrAlterGenerator(CreateElement(TSQLAlterGeneratorStatement,AParent))
else
Gen:=TSQLCreateOrAlterGenerator(CreateElement(TSQLCreateGeneratorStatement,AParent));
try
Result:=Gen;
Result.ObjectName:=CreateIdentifier(Result,CurrentTokenString);
Gen.IsSequence:=isSequence;
GetNextToken;
if isAlter then
begin
Expect(tsqlrestart);
Alt.HasRestart:=True;
GetNexttoken;
Consume(tsqlWith);
Expect(tsqlIntegerNumber);
Alt.Restart:=StrToInt(CurrentTokenString);
GetNexttoken;
end
except
FreeAndNil(Result);
Raise;
end;
GetNextToken; // Comma;
end;
function TSQLParser.ParseCreateRoleStatement(AParent: TSQLElement;
@ -1602,6 +1632,8 @@ begin
GetNextToken;
expect([tsqlCharacter,tsqlChar]);
end;
else
Expect([tsqlNCHAR,tsqlVarChar,tsqlCharacter,tsqlChar, tsqlCString, tsqlNational]);
end;
GetNextToken; // VARYING, Start of size, CHARACTER SET or end
If (CurrentToken=tsqlVarying) then // CHAR VARYING or CHARACTER VARYING;
@ -1854,13 +1886,15 @@ end;
function TSQLParser.ParseTypeDefinition(AParent: TSQLElement;
Flags: TParseTypeFlags): TSQLTypeDefinition;
Var
TN : String;
adCount : Integer;
ADS : TArrayDims;
AD : Integer;
DT : TSQLDataType;
AA : Boolean; // Allow Array
GN : Boolean; // Do GetNextToken ?
NN : Boolean; // Not Null ?
sc,prec : Integer;
bt : integer;
D : TSQLTypeDefinition;
@ -1870,12 +1904,10 @@ Var
begin
// We are positioned on the token prior to the type definition.
AA:=True;
GN:=True;
prec:=0;
sc:=0;
bt:=0;
NN:=True;
Coll:=Nil;
Case GetNextToken of
tsqlIdentifier :
@ -1956,12 +1988,30 @@ begin
If GN then
GetNextToken;
// We are now on array definition or rest of type.
ADCount:=0;
ADS:=Default(TArrayDims);
If (CurrentToken=tsqlSquareBraceOpen) then
begin
GetNextToken;
Expect(tsqlIntegerNumber);
AD:=Strtoint(CurrentTokenString);
GetNextToken;
Repeat
GetNextToken;
Expect(tsqlIntegerNumber);
AD:=StrToInt(CurrentTokenString);
Inc(ADCount);
SetLength(ADS,ADCount);
ADS[ADCount-1][1]:=1;
ADS[ADCount-1][2]:=AD;
GetNextToken;
if CurrentToken=tsqlCOLON then
begin
GetNextToken;
Expect(tsqlIntegerNumber);
AD:=Strtoint(CurrentTokenString);
ADS[ADCount-1][1]:=AD;
GetNextToken;
end;
if Not (CurrentToken in [tsqlSquareBraceClose,tsqlComma]) then
Error(SErrCommaOrSquareArray);
until (CurrentToken=tsqlSquareBraceClose);
Expect(tsqlSquareBraceClose);
GetNextToken;
end
@ -1988,7 +2038,7 @@ begin
D.Len:=PRec;
D.Scale:=Sc;
D.BlobType:=bt;
D.ArrayDim:=AD;
D.ArrayDims:=ADS;
D.Charset:=CS;
D.Collation:=Coll;
D.Constraint:=C;
@ -2105,7 +2155,6 @@ function TSQLParser.ParseExprLevel1(AParent: TSQLElement; EO: TExpressionOptions
var
tt: TSQLToken;
B : TSQLBinaryExpression;
Right: TSQLExpression;
L : TSQLLiteralExpression;
begin
@ -2348,6 +2397,8 @@ begin
tsqlPlus : B.Operation:=boAdd;
tsqlMinus : B.Operation:=boSubtract;
tsqlConcatenate : B.Operation:=boConcat;
else
expect([tsqlPlus,tsqlMinus,tsqlConcatenate]);
end;
end;
Except
@ -2380,6 +2431,8 @@ begin
Case tt of
tsqlMul : B.Operation:=boMultiply;
tsqlDiv : B.Operation:=boDivide;
else
// Do nothing
end;
end;
Except
@ -2459,14 +2512,10 @@ end;
function TSQLParser.ParseIdentifierList(AParent: TSQLElement;
AList: TSQLelementList): integer;
Var
Done : Boolean;
begin
// on entry, we're on first identifier
Expect(tsqlIdentifier);
Result:=0;
Done:=False;
repeat
if CurrentToken=tsqlComma then
GetNextToken;
@ -2545,6 +2594,8 @@ begin
tsqlAvg : Result.Aggregate:=afAvg;
tsqlMax : Result.Aggregate:=afMax;
tsqlMin : Result.Aggregate:=afMin;
else
Expect([tsqlMin,tsqlMax,tsqlAvg,tsqlSum,tsqlCount]);
end;
GetNextToken;
Consume(tsqlBraceOpen);
@ -2635,6 +2686,8 @@ begin
tsqlAny : C:=TSQLAnyExpression;
tsqlSome : C:=TSQLSomeExpression;
tsqlSingular : C:=TSQLSingularExpression;
else
expect([tsqlExists, tsqlAll,tsqlAny,tsqlSome,tsqlSingular]);
end;
GetNextToken;
Consume(tsqlBraceOpen);
@ -2927,11 +2980,12 @@ begin
T.Moment:=tmAfter;
Repeat
GetNextToken;
Expect([tsqlDelete,tsqlInsert,tsqlUpdate]);
Case CurrentToken of
tsqlDelete : T.Operations:=T.Operations+[toDelete];
tsqlUpdate : T.Operations:=T.Operations+[toUpdate];
tsqlInsert : T.Operations:=T.Operations+[toInsert];
else
Expect([tsqlDelete,tsqlInsert,tsqlUpdate]);
end;
GetNextToken;
Until (CurrentToken<>tsqlOr);
@ -2973,6 +3027,36 @@ begin
end;
end;
function TSQLParser.ParseSetTermStatement(AParent: TSQLElement ): TSQLSetTermStatement;
begin
// On entry, we're on the 'TERM' token
Consume(tsqlTerm) ;
try
Result:=TSQLSetTermStatement(CreateElement(TSQLSetTermStatement,AParent));
case CurrentToken of
// Only semicolon or something unknown are allowed.
tsqlSemiColon : Result.NewValue:=TokenInfos[CurrentToken];
tsqlunknown : Result.NewValue:=CurrentTokenString;
tsqlSymbolString,
tsqlIdentifier : Result.NewValue:=CurrentTokenString;
else
expect([tsqlSemiColon,tsqlTerminator,tsqlunknown, tsqlSymbolString]);
end;
GetNextToken;
// Next token depends on whether an alternative token is in effect...
if Scanner.AlternateTerminator<>'' then
Expect(tsqlTerminator)
else
Expect(tsqlSEMICOLON);
if Result.NewValue=TokenInfos[tsqlSEMICOLON] then
FScanner.AlternateTerminator:=''
else
FScanner.AlternateTerminator:=Result.NewValue;
except
FreeAndNil(Result);
Raise;
end;
end;
function TSQLParser.ParseSecondaryFile(AParent: TSQLElement) : TSQLDatabaseFileInfo;
@ -3163,22 +3247,42 @@ begin
end;
function TSQLParser.ParseCreateStatement(AParent: TSQLElement; IsAlter: Boolean
): TSQLCreateOrAlterStatement;
function TSQLParser.ParseCreateStatement(AParent: TSQLElement; IsAlter: Boolean): TSQLCreateOrAlterStatement;
var
Tok : TSQLToken;
isOrAlter : Boolean;
isRecreate : Boolean;
begin
Case GetNextToken of
isRecreate:=CurrentToken=tsqlRecreate;
tok:=GetNextToken;
isOrAlter:=tok=tsqlOR;
if isOrAlter then
begin
GetNextToken;
Consume(tsqlAlter);
if Not (CurrentToken in [tsqlProcedure,tsqlTrigger]) then
Expect([tsqlProcedure,tsqlTrigger]);
end;
if isRecreate then
Expect([tsqlProcedure,tsqlTable,tsqlView]);
Case CurrentToken of
tsqlTable : if IsAlter then
Result:=ParseAlterTableStatement(AParent)
else
Result:=ParseCreateTableStatement(AParent);
tsqlUnique,
tsqlDesc,
tsqlAsc,
tsqlAscending,
tsqlDescending,
tsqlIndex : Result:=ParseCreateIndexStatement(AParent,IsAlter);
tsqlView : Result:=ParseCreateViewStatement(AParent,IsAlter);
tsqlProcedure : Result:=ParseCreateProcedureStatement(AParent,IsAlter);
tsqlDomain : Result:=ParseCreateDomainStatement(AParent,IsAlter);
tsqlSequence,
tsqlGenerator : Result:=ParseCreateGeneratorStatement(AParent,IsAlter);
tsqlException : Result:=ParseCreateExceptionStatement(AParent,IsAlter);
tsqlTrigger : Result:=ParseCreateTriggerStatement(AParent,IsAlter);
@ -3192,6 +3296,8 @@ begin
else
Error(SErrExpectedDBObject,[CurrentTokenString]);
end;
Result.IsCreateOrAlter:=isOrAlter;
Result.isRecreate:=IsRecreate;
end;
function TSQLParser.ParseDropStatement(AParent: TSQLElement
@ -3377,6 +3483,11 @@ begin
Consume(tsqlSet);
Case CurrentToken of
tsqlGenerator : Result:=ParseSetGeneratorStatement(AParent); //SET GENERATOR
tsqlTerm :
if poAllowSetTerm in Foptions then
Result:=ParseSetTermStatement(AParent) //SET term
else
UnexpectedToken;
else
// For the time being
UnexpectedToken;
@ -3571,6 +3682,8 @@ begin
UnexpectedToken;
CreateGrantee(true,TSQLProcedureGrantee);
end;
else
Expect([tsqlUser, tsqlIdentifier, TsqlGroup, TsqlPublic,TsqlTrigger, TsqlView, TsqlProcedure]);
end;
Until (GetNextToken<>tsqlComma);
@ -3878,6 +3991,7 @@ begin
tsqlUpdate : Result:=ParseUpdateStatement(Nil);
tsqlInsert : Result:=ParseInsertStatement(Nil);
tsqlDelete : Result:=ParseDeleteStatement(Nil);
tsqlReCreate,
tsqlCreate,
tsqlAlter : Result:=ParseCreateStatement(Nil,(tsqlAlter=CurrentToken));
tsqlDrop : Result:=ParseDropStatement(Nil);
@ -3893,7 +4007,7 @@ begin
else
UnexpectedToken;
end;
if Not (CurrentToken in [tsqlEOF,tsqlSemicolon]) then
if Not (CurrentToken in [tsqlEOF,tsqlSemicolon,tsqlTerminator]) then
begin
FreeAndNil(Result);
if (CurrentToken=tsqlBraceClose) then
@ -3902,12 +4016,28 @@ begin
end;
end;
function TSQLParser.ParseScript(AllowPartial : Boolean = False): TSQLElementList;
function TSQLParser.Parse(aOptions: TParserOptions): TSQLElement;
begin
FOptions:=aOptions;
Result:=Parse();
end;
function TSQLParser.ParseScript(AllowPartial : Boolean): TSQLElementList;
begin
if AllowPartial then
Result:=ParseScript([poPartial])
else
Result:=ParseScript([])
end;
Function TSQLParser.ParseScript(aOptions : TParserOptions = []) : TSQLElementList;
var
E : TSQLElement;
begin
Foptions:=aOptions;
Result:=TSQLElementList.Create(True);
try
E:=Parse;
@ -3917,7 +4047,7 @@ begin
E:=Parse;
end;
except
If Not AllowPartial then
If Not (poPartial in Options) then
begin
FreeAndNil(Result);
Raise;

27
packages/fcl-db/src/sql/fpsqlscanner.pp
View File

@ -44,7 +44,7 @@ type
tsqlIntegerNumber,tsqlFloatNumber,tsqlComment,
tsqlBraceOpen,tsqlBraceClose,tsqlSquareBraceOpen,tsqlSquareBraceClose,
tsqlPlaceHolder {question mark},
tsqlCOMMA,tsqlCOLON,tsqlDOT,tsqlSEMICOLON,
tsqlCOMMA,tsqlCOLON,tsqlDOT,tsqlSEMICOLON,tsqlTerminator,
tsqlGT,tsqlLT,tsqlPLUS,tsqlMINUS,tsqlMUL,tsqlDIV,tsqlConcatenate,
tsqlEQ,tsqlGE,tsqlLE,tsqlNE,
{ Reserved words/keywords start here. They must be last }
@ -70,13 +70,13 @@ type
tSQLTABLE, tsqlText, tsqlTrigger, tsqlTime, tsqlTimeStamp, tsqlType, tsqlTo, tsqlTransaction, tsqlThen,
tsqlUNION, tsqlUPDATE, tsqlUPPER, tsqlUNIQUE, tsqlUSER,
tsqlValue, tsqlVALUES, tsqlVARIABLE, tsqlVIEW, tsqlVARCHAR,TSQLVARYING,
tsqlWHERE, tsqlWITH, tsqlWHILE, tsqlWork, tsqlWhen
tsqlWHERE, tsqlWITH, tsqlWHILE, tsqlWork, tsqlWhen,tsqlSequence,tsqlRestart,tsqlrecreate,tsqlterm
);
TSQLTokens = set of TSQLToken;
const
FirstKeyword = tsqlAll;
LastKeyWord = tsqlWhen;
LastKeyWord = tsqlTerm;
sqlComparisons = [tsqleq,tsqlGE,tsqlLE,tsqlNE,tsqlGT,tsqlLT,tsqlIn,tsqlIS,
tsqlbetween,tsqlLike,tsqlContaining,tsqlStarting,tsqlNOT];
sqlInvertableComparisons = [tsqlLike,tsqlContaining,tsqlStarting,tsqlIN,tsqlIS, tsqlBetween];
@ -90,7 +90,8 @@ const
'symbol string',
'integer number','float number', 'comment',
'(',')', '[',']',
'?',',',':','.',';','>','<',
'?',',',':','.',';','',
'>','<',
'+','-','*','/','||',
'=','>=','<=','<>',
// Identifiers last:
@ -115,7 +116,7 @@ const
'TABLE', 'TEXT', 'TRIGGER', 'TIME', 'TIMESTAMP', 'TYPE', 'TO', 'TRANSACTION', 'THEN',
'UNION', 'UPDATE', 'UPPER', 'UNIQUE', 'USER',
'VALUE','VALUES','VARIABLE', 'VIEW','VARCHAR','VARYING',
'WHERE', 'WITH', 'WHILE','WORK','WHEN'
'WHERE', 'WITH', 'WHILE','WORK','WHEN','SEQUENCE','RESTART','RECREATE','TERM'
);
Type
@ -166,9 +167,8 @@ Type
TSQLScanner = class
private
FAlternateTerminator: String;
FOptions: TSQLScannerOptions;
FReturnComments: Boolean;
FReturnWhiteSpace: Boolean;
FSourceFile: TLineReader;
FSourceFilename: string;
FCurRow: Integer;
@ -219,6 +219,7 @@ Type
property CurToken: TSQLToken read FCurToken;
property CurTokenString: string read FCurTokenString;
Property ExcludeKeywords : TStrings Read GetExcludeKeywords Write SetExcludeKeywords;
Property AlternateTerminator : String Read FAlternateTerminator Write FAlternateTerminator;
end;
@ -240,6 +241,7 @@ Var
begin
For T:=FirstKeyword to LastKeyWord do
IdentifierTokens[T]:=T;
IdentifierTokensOK:=True;
end;
constructor TFileLineReader.Create(const AFilename: string);
@ -479,7 +481,7 @@ Var
Delim : Char;
TokenStart : PChar;
Len,OLen : Integer;
S : String;
S : UnicodeString;
Procedure AppendBufToTokenString(DoNextToken : Boolean);
@ -653,7 +655,10 @@ begin
BuildKeyWords;
P:=FKeyWords.Find(S);
If (P<>Nil) then
Result:=P^; //keyword found
Result:=P^ //keyword found
else if (AlternateTerminator<>'') and (S=AlternateTerminator) then
Result:=tsqlTerminator;
{ I:=FirstKeyword;
While (Result=tsqlIdentifier) and (I<=Lastkeyword) do
begin
@ -687,6 +692,8 @@ begin
result:=tsqlSymbolString;
SetLength(FCurTokenString,Len);
Move(TokenStart^,FCurTokenString[1],Len);
if (AlternateTerminator<>'') and (CurtokenString=AlternateTerminator) then
Exit(tsqlTerminator);
// Check if this is a keyword or identifier/literal
// Probably not (due to naming rules) but it doesn't hurt
@ -950,7 +957,7 @@ Var
begin
FPos:=FBufPos;
SetLength(Result,0);
Result:='';
Repeat
PRun:=@Buffer[FBufPos];
While (FBufPos<FBufLen) and Not (PRun^ in [10,13]) do

112
packages/fcl-db/src/sql/fpsqltree.pp
View File

@ -511,10 +511,12 @@ Type
sdtChar,sdtVarChar, sdtNChar, sdtNVarChar, sdtCstring,
sdtBlob);
TArrayDim = Array[1..2] of Integer;
TArrayDims = Array of TArrayDim;
TSQLTypeDefinition = Class(TSQLElement)
private
FArrayDim: Integer;
FArrayDims: TArrayDims;
FBlobType: Integer;
FByValue: Boolean;
FCharSet: TSQLStringType;
@ -534,7 +536,7 @@ Type
Property TypeName : String Read FtypeName Write FTypeName;
Property Len : Integer Read Flen Write Flen; // Length of string or precision for BCD
Property Scale : Byte Read FScale Write FScale;
Property ArrayDim : Integer Read FArrayDim Write FArrayDim;
Property ArrayDims : TArrayDims Read FArrayDims Write FArrayDims;
Property BlobType : Integer Read FBlobType Write FBlobType;
Property NotNull : Boolean Read FNotNull Write FNotNull;
Property Collation : TSQLCollation Read FCollation Write FCollation;
@ -875,15 +877,24 @@ Type
TSQLCreateOrAlterStatement = Class(TSQLDDLStatement)
private
FDBO: TSQLIdentifierName;
FIsCreateOrAlter: Boolean;
FIsReCreate: Boolean;
Public
Destructor Destroy; override;
Function GetAsSQL(Options : TSQLFormatOptions; AIndent : Integer = 0): TSQLStringType; override;
Property ObjectName : TSQLIdentifierName Read FDBO Write FDBO;
Property IsCreateOrAlter : Boolean Read FIsCreateOrAlter Write FIsCreateOrAlter;
Property IsRecreate : Boolean Read FIsReCreate Write FIsReCreate;
end;
{ Generator }
TSQLCreateOrAlterGenerator = Class(TSQLCreateOrAlterStatement);
TSQLCreateOrAlterGenerator = Class(TSQLCreateOrAlterStatement)
Private
FIsIsSequence: Boolean;
public
Property IsSequence : Boolean Read FIsIsSequence Write FIsIsSequence;
end;
{ TSQLCreateGeneratorStatement }
@ -892,6 +903,18 @@ Type
Function GetAsSQL(Options : TSQLFormatOptions; AIndent : Integer = 0): TSQLStringType; override;
end;
{ TAlterGeneratorStatement }
TSQLAlterGeneratorStatement = Class(TSQLCreateOrAlterGenerator)
private
FHasRestart: Boolean;
FRestart: Int64;
Public
Function GetAsSQL(Options : TSQLFormatOptions; AIndent : Integer = 0): TSQLStringType; override;
Property Restart : Int64 Read FRestart Write FRestart;
Property HasRestart : Boolean Read FHasRestart Write FHasRestart;
end;
{ TSQLSetGeneratorStatement }
TSQLSetGeneratorStatement = Class(TSQLCreateOrAlterGenerator)
@ -1803,6 +1826,16 @@ Type
Function GetAsSQL(Options : TSQLFormatOptions; AIndent : Integer = 0): TSQLStringType; override;
end;
{ TSQLSetTermStatement }
TSQLSetTermStatement = Class(TSQLStatement)
private
FNewValue: string;
Public
Function GetAsSQL(Options : TSQLFormatOptions; AIndent : Integer = 0): TSQLStringType; override;
Property NewValue : string Read FNewValue Write FNewValue;
end;
Const
CharTypes = [sdtChar,sdtVarChar,sdtNChar,sdtNVarChar,sdtCString];
ExtractElementNames : Array[TSQLExtractElement] of String
@ -1811,7 +1844,7 @@ Const
// Format a SQL keyword according to OPTIONS
Function SQLKeyWord(Const AWord : TSQLStringType; Options : TSQLFormatOptions) : TSQLStringType;
Function SQLListSeparator(Options: TSQLFormatOptions) : String;
Procedure GetSepPrefixIndent(DoNewLine,DoIndent : Boolean; Var Sep,Prefix : TSQLStringType; Var AIndent : Integer);
Procedure GetSepPrefixIndent(DoNewLine,DoIndent : Boolean; Out Sep,Prefix : TSQLStringType; Out AIndent : Integer);
Function SQLFormatString(Const AValue : TSQLStringType; Options : TSQLFormatOptions) : TSQLStringType;
implementation
@ -1848,7 +1881,7 @@ begin
Delete(Result,Length(Result),1);
end;
Procedure GetSepPrefixIndent(DoNewLine,DoIndent : Boolean; Var Sep,Prefix : TSQLStringType; Var AIndent : Integer);
Procedure GetSepPrefixIndent(DoNewLine,DoIndent : Boolean; Out Sep,Prefix : TSQLStringType; Out AIndent : Integer);
begin
Prefix:='';
@ -1866,6 +1899,20 @@ begin
Sep:=', ';
end;
{ TSQLSetTermStatement }
function TSQLSetTermStatement.GetAsSQL(Options: TSQLFormatOptions; AIndent: Integer): TSQLStringType;
begin
Result:='SET TERM '+NewValue;
end;
{ TSQLAlterGeneratorStatement }
function TSQLAlterGeneratorStatement.GetAsSQL(Options: TSQLFormatOptions; AIndent: Integer): TSQLStringType;
begin
Result:=inherited GetAsSQL(Options, AIndent);
end;
{ TSQLSetISQLStatement }
function TSQLSetISQLStatement.GetAsSQL(Options: TSQLFormatOptions;
@ -2195,6 +2242,9 @@ Var
'DECIMAL','NUMERIC','DATE','TIMESTAMP','TIME',
'CHAR','VARCHAR','NATIONAL CHARACTER','NATIONAL CHARACTER VARYING','CSTRING',
'BLOB');
Var
D : TArrayDim;
I : integer;
begin
If DataType=sdtDomain then
@ -2219,8 +2269,21 @@ begin
end;
If (CharSet<>'') then
Result:=Result+SQLKeyWord(' CHARACTER SET ',Options)+CharSet;
If (ArrayDim<>0) then
Result:=Result+Format(' [%d]',[ArrayDim]);
If (Length(ArrayDims)>0) then
begin
Result:=Result+'[';
For I:=0 to Length(ArrayDims)-1 do
begin
If I>0 then
Result:=Result+',';
D:=ArrayDims[I];
if D[1]<>1 then
Result:=Result+Format('%d:%d',[D[1],D[2]])
else
Result:=Result+Format('%d',[D[1],D[2]]);
end;
Result:=Result+']';
end;
If Assigned(FDefault) then
Result:=Result+SQLKeyWord(' DEFAULT ',Options)+DefaultValue.GetAsSQL(Options,AIndent);
If NotNull then
@ -2497,7 +2560,13 @@ begin
end;
destructor TSQLCreateTableStatement.Destroy;
Var
N : String;
begin
N:=Self.ObjectName.Name;
Writeln(N);
FreeAndNil(FexternalFile);
FreeAndNil(FFieldDefs);
FreeAndNil(FConstraints);
@ -2531,7 +2600,10 @@ begin
Result:=' ('+sLineBreak+Result+')'
else
Result:=' ('+Result+')';
S:=SQLKeyWord('CREATE TABLE ',Options)+inherited GetAsSQL(Options, AIndent);
S:='CREATE';
if IsRecreate then
S:='RE'+S;
S:=SQLKeyWord(S+' TABLE ',Options)+inherited GetAsSQL(Options, AIndent);
If Assigned(FExternalFile) then
S:=S+SQLKeyWord(' EXTERNAL FILE ',Options)+ExternalFileName.GetAsSQL(Options,AIndent);
Result:=S+Result;
@ -3089,6 +3161,7 @@ function TSQLAggregateFunctionExpression.GetAsSQL(Options: TSQLFormatOptions;
Const
OpCodes : Array[TSQLAggregateFunction] of string = ('COUNT','SUM','AVG','MAX','MIN');
Var
E : TSQLStringType;
@ -3098,6 +3171,8 @@ begin
aoAsterisk : E:='*';
aoAll : E:=SQLKeyword('ALL',Options);
aoDistinct : E:=SQLKeyWord('DISTINCT',Options);
else
E:='';
end;
If Assigned(FExpression) and (Option<>aoAsterisk) then
begin
@ -3567,6 +3642,8 @@ begin
Result:='';
If Self is TSQLAlterProcedureStatement then
Result:=SQLKeyword('ALTER ',Options)
else if IsRecreate then
Result:=SQLKeyword('RECREATE ',Options)
else
Result:=SQLKeyword('CREATE ',Options);
Result:=Result+SQLKeyWord('PROCEDURE ',Options);
@ -3653,7 +3730,7 @@ function TSQLStatementBlock.GetAsSQL(Options: TSQLFormatOptions;
AIndent: Integer): TSQLStringType;
Var
I,J : Integer;
I: Integer;
S : String;
begin
S:='';
@ -3721,6 +3798,7 @@ Var
DoNewLine : Boolean;
begin
S:='';
Result:=SQLKeyWord('FOR ',Options);
If Assigned(FSelect) then
@ -3930,8 +4008,7 @@ Const
Var
A : Boolean;
S,Sep : TSQLStringType;
I : Integer;
S: TSQLStringType;
O : TTriggerOperation;
begin
@ -4180,8 +4257,13 @@ end;
function TSQLCreateGeneratorStatement.GetAsSQL(Options: TSQLFormatOptions;
AIndent: Integer): TSQLStringType;
begin
Result:=SQLKeyWord('CREATE GENERATOR ',Options)+Inherited GetAsSQL(Options, AIndent);
if IsSequence then
Result:=SQLKeyWord('CREATE SEQUENCE ',Options)
else
Result:=SQLKeyWord('CREATE GENERATOR ',Options);
Result:=Result+Inherited GetAsSQL(Options, AIndent);
end;
{ TSQLCreateRoleStatement }
@ -4301,7 +4383,11 @@ Var
I : Integer;
begin
Result:=SQLKeyWord('CREATE VIEW ',Options)+inherited GetAsSQL(Options, AIndent);
if IsRecreate then
Result:=SQLKeyWord('RECREATE VIEW ',Options)
else
Result:=SQLKeyWord('CREATE VIEW ',Options);
Result:=Result+inherited GetAsSQL(Options, AIndent);
If (Fields.Count>0) then
begin
S:='';

23
packages/fcl-db/tests/tcgensql.pas
View File

@ -19,7 +19,7 @@ unit tcgensql;
interface
uses
Classes, SysUtils, fpcunit, testutils, testregistry,fpsqltree;
Classes, SysUtils, fpcunit, testregistry,fpsqltree;
type
TSQLDropStatementClass = Class of TSQLDropStatement;
@ -196,10 +196,7 @@ procedure TTestGenerateSQL.AssertSQL(const AElement: TSQLElement;
const ASQL: TSQLStringType; AOptions: TSQLFormatOptions = []);
Var
S,S2 : TSQLStringType;
L : TStringList;
I : Integer;
S: TSQLStringType;
begin
S:=AElement.GetAsSQL(AOptions);
AssertEquals('Correct SQL',ASQL,S);
@ -1802,7 +1799,6 @@ procedure TTestGenerateSQL.TestBlock;
Var
B,B2 : TSQLStatementBlock;
S : TSQLExitStatement;
L : TSQLSelectStatement;
begin
@ -2275,10 +2271,8 @@ procedure TTestGenerateSQL.TestGrantTable;
Var
G : TSQLTableGrantStatement;
U : TSQLUserGrantee;
{%H-}U : TSQLUserGrantee;
PU : TSQLColumnPrivilege;
PG : TSQLProcedureGrantee;
begin
G:=TSQLTableGrantStatement.Create(Nil);
G.TableName:=CreateIdentifier('A');
@ -2355,10 +2349,6 @@ procedure TTestGenerateSQL.TestGrantProcedure;
Var
G : TSQLProcedureGrantStatement;
U : TSQLUserGrantee;
PU : TSQLColumnPrivilege;
PG : TSQLProcedureGrantee;
begin
G:=TSQLProcedureGrantStatement.Create(Nil);
G.ProcedureName:=CreateIdentifier('A');
@ -2390,8 +2380,6 @@ end;
procedure TTestGenerateSQL.TestGrantRole;
Var
G : TSQLRoleGrantStatement;
U : TSQLUserGrantee;
begin
G:=TSQLRoleGrantStatement.Create(Nil);
G.Roles.Add(CreateIdentifier('A'));
@ -2412,10 +2400,7 @@ end;
procedure TTestGenerateSQL.TestRevokeTable;
Var
G : TSQLTableRevokeStatement;
U : TSQLUserGrantee;
PU : TSQLColumnPrivilege;
PG : TSQLProcedureGrantee;
begin
G:=TSQLTableRevokeStatement.Create(Nil);
G.TableName:=CreateIdentifier('A');
@ -2491,8 +2476,6 @@ end;
procedure TTestGenerateSQL.TestRevokeProcedure;
Var
G : TSQLProcedureRevokeStatement;
PG : TSQLProcedureGrantee;
begin
G:=TSQLProcedureRevokeStatement.Create(Nil);
G.ProcedureName:=CreateIdentifier('A');

111
packages/fcl-db/tests/tcparser.pas
View File

@ -19,7 +19,7 @@ unit tcparser;
interface
uses
Classes, SysUtils, fpcunit, testutils, fpsqltree, fpsqlscanner, fpsqlparser, testregistry;
Classes, SysUtils, fpcunit, fpsqltree, fpsqlscanner, fpsqlparser, testregistry;
type
@ -37,16 +37,18 @@ type
TTestSQLParser = class(TTestCase)
Private
FParserOptions: TParserOptions;
FSource : TStringStream;
FParser : TTestParser;
FToFree : TSQLElement; //will be freed by test teardown
FErrSource : string;
function GetParserOptions: TParserOptions;
protected
procedure AssertTypeDefaults(TD: TSQLTypeDefinition; Len: Integer=0);
procedure TestStringDef(ASource: String; ExpectDT: TSQLDataType; ExpectLen: Integer; ExpectCharset : TSQLStringType='');
function TestType(ASource : string; AFlags : TParseTypeFlags; AExpectedType : TSQLDataType) : TSQLTypeDefinition;
function TestCheck(ASource : string; AExpectedConstraint : TSQLElementClass) : TSQLExpression;
procedure CreateParser(Const ASource : string);
procedure CreateParser(Const ASource : string; aOptions : TParserOptions = []);
function CheckClass(E : TSQLElement; C : TSQLElementClass) : TSQLElement;
procedure TestDropStatement(Const ASource : string;C : TSQLElementClass);
function TestCreateStatement(Const ASource,AName : string;C: TSQLElementClass) : TSQLCreateOrAlterStatement;
@ -81,6 +83,7 @@ type
procedure SetUp; override;
procedure TearDown; override;
property Parser : TTestParser Read FParser;
property ParserOptions : TParserOptions Read GetParserOptions Write FParserOptions;
property ToFree : TSQLElement Read FToFree Write FTofree;
end;
@ -107,9 +110,20 @@ type
TTestGeneratorParser = Class(TTestSQLParser)
Published
procedure TestCreateGenerator;
procedure TestCreateSequence;
procedure TestAlterSequence;
procedure TestSetGenerator;
end;
{ TTestSetTermParser }
TTestSetTermParser = Class(TTestSQLParser)
Published
procedure TestSetTermNoOption;
procedure TestSetTermOption;
end;
{ TTestRoleParser }
TTestRoleParser = Class(TTestSQLParser)
@ -660,6 +674,7 @@ type
procedure TestParseStatementError;
function TestStatement(Const ASource : String) : TSQLStatement;
procedure TestStatementError(Const ASource : String);
Public
property Statement : TSQLStatement Read FStatement;
Published
procedure TestException;
@ -855,6 +870,21 @@ implementation
uses typinfo;
{ TTestSetTermParser }
procedure TTestSetTermParser.TestSetTermNoOption;
begin
FErrSource:='SET TERM ^ ;';
AssertException(ESQLParser,@TestParseError);
end;
procedure TTestSetTermParser.TestSetTermOption;
begin
CreateParser('SET TERM ^ ;');
FToFree:=Parser.Parse([poAllowSetTerm]);
AssertEquals('Terminator set','^',Parser.Scanner.AlternateTerminator);
end;
{ TTestGlobalParser }
procedure TTestGlobalParser.TestEmpty;
@ -904,12 +934,14 @@ begin
FreeAndNil(FToFree);
end;
procedure TTestSQLParser.CreateParser(const ASource: string);
procedure TTestSQLParser.CreateParser(const ASource: string; aOptions: TParserOptions = []);
begin
FSource:=TStringStream.Create(ASource);
FParserOptions:=aOptions;
FParser:=TTestParser.Create(FSource);
end;
Function TTestSQLParser.CheckClass(E: TSQLElement; C: TSQLElementClass) : TSQLElement;
begin
AssertEquals(C,E.ClassType);
@ -1062,9 +1094,6 @@ end;
procedure TTestSQLParser.AssertEquals(const AMessage: String; Expected,
Actual: TTriggerOperations);
Var
NE,NA : String;
begin
If Expected<>Actual then
Fail(Amessage)
@ -1270,13 +1299,21 @@ begin
AssertEquals('End of stream reached',tsqlEOF,Parser.CurrentToken);
end;
function TTestSQLParser.GetParserOptions: TParserOptions;
begin
if Assigned(FParser) then
Result:=FParser.Options
else
Result:=FParserOptions;
end;
procedure TTestSQLParser.AssertTypeDefaults(TD : TSQLTypeDefinition;Len : Integer = 0);
begin
AssertNull(TD.DefaultValue);
AssertNull(TD.Check);
AssertNull(TD.Collation);
AssertEquals('Array dim 0',0,TD.ArrayDim);
AssertEquals('Array dim 0',0,Length(TD.ArrayDims));
AssertEquals('Blob type 0',0,TD.BlobType);
AssertEquals('Not required',False,TD.NotNull);
AssertEquals('Length',Len,TD.Len);
@ -1404,6 +1441,26 @@ begin
TestCreateStatement('CREATE GENERATOR A','A',TSQLCreateGeneratorStatement);
end;
procedure TTestGeneratorParser.TestCreateSequence;
Var
C : TSQLCreateOrAlterStatement;
begin
C:=TestCreateStatement('CREATE SEQUENCE A','A',TSQLCreateGeneratorStatement);
AssertEquals('Sequence detected',True,TSQLCreateGeneratorStatement(c).IsSequence);
end;
procedure TTestGeneratorParser.TestAlterSequence;
Var
C : TSQLCreateOrAlterStatement;
D : TSQLAlterGeneratorStatement absolute C;
begin
C:=TestCreateStatement('ALTER SEQUENCE A RESTART WITH 100','A',TSQLAlterGeneratorStatement);
AssertEquals('Sequence detected',True,D.IsSequence);
AssertEquals('Sequence restart ',True,D.HasRestart);
AssertEquals('Sequence restart value',100,D.Restart);
end;
procedure TTestGeneratorParser.TestSetGenerator;
Var
@ -1611,7 +1668,9 @@ Var
begin
TD:=TestType('INT [3]',[],sdtInteger);
AssertEquals('Array of length 3',3,TD.ArrayDim);
AssertEquals('Array of length',1,Length(TD.ArrayDims));
AssertEquals('Upper bound',3,TD.ArrayDims[0][2]);
AssertEquals('Lower bound',1,TD.ArrayDims[0][1]);
AssertEquals('End of stream reached',tsqlEOF,Parser.CurrentToken);
end;
@ -1781,31 +1840,26 @@ end;
procedure TTestTypeParser.TestSmallInt;
Var
TD : TSQLTypeDefinition;
begin
TD:=TestType('SMALLINT',[],sdtSmallint);
TestType('SMALLINT',[],sdtSmallint);
end;
procedure TTestTypeParser.TestFloat;
Var
TD : TSQLTypeDefinition;
begin
TD:=TestType('FLOAT',[],sdtFloat);
TestType('FLOAT',[],sdtFloat);
end;
procedure TTestTypeParser.TestDoublePrecision;
var
TD : TSQLTypeDefinition;
begin
TD:=TestType('DOUBLE PRECISION',[],sdtDoublePrecision);
TestType('DOUBLE PRECISION',[],sdtDoublePrecision);
end;
procedure TTestTypeParser.TestDoublePrecisionDefault;
var
TD : TSQLTypeDefinition;
begin
TD:=TestType('DOUBLE PRECISION DEFAULT 0',[],sdtDoublePrecision);
TestType('DOUBLE PRECISION DEFAULT 0',[],sdtDoublePrecision);
end;
procedure TTestTypeParser.TestBlobError1;
@ -4736,7 +4790,6 @@ end;
procedure TTestSelectParser.TestWhereExists;
Var
F : TSQLSelectField;
E : TSQLExistsExpression;
S : TSQLSelectStatement;
@ -6163,19 +6216,14 @@ end;
procedure TTestProcedureStatement.TestExit;
Var
E : TSQLExitStatement;
begin
E:=TSQLExitStatement(CheckClass(TestStatement('EXIT'),TSQLExitStatement));
CheckClass(TestStatement('EXIT'),TSQLExitStatement);
end;
procedure TTestProcedureStatement.TestSuspend;
Var
E : TSQLSuspendStatement;
begin
E:=TSQLSuspendStatement(CheckClass(TestStatement('Suspend'),TSQLSuspendStatement));
CheckClass(TestStatement('Suspend'),TSQLSuspendStatement);
end;
procedure TTestProcedureStatement.TestEmptyBlock;
@ -7594,8 +7642,6 @@ end;
procedure TTestGrantParser.TestPublicPrivilege;
Var
t : TSQLTableGrantStatement;
P : TSQLPublicGrantee;
begin
TestGrant('GRANT SELECT ON A TO PUBLIC');
T:=TSQLTableGrantStatement(CheckClass(Statement,TSQLTableGrantStatement));
@ -8051,8 +8097,6 @@ end;
procedure TTestRevokeParser.TestPublicPrivilege;
Var
t : TSQLTableRevokeStatement;
P : TSQLPublicGrantee;
begin
TestRevoke('Revoke SELECT ON A FROM PUBLIC');
T:=TSQLTableRevokeStatement(CheckClass(Statement,TSQLTableRevokeStatement));
@ -8171,6 +8215,7 @@ initialization
TTestDeclareExternalFunctionParser,
TTestGrantParser,
TTestRevokeParser,
TTestGlobalParser]);
TTestGlobalParser,
TTestSetTermParser]);
end.

34
packages/fcl-db/tests/tcsqlscanner.pas
View File

@ -19,7 +19,7 @@ unit tcsqlscanner;
interface
uses
Classes, SysUtils, fpcunit, testutils, testregistry, fpsqlscanner;
Classes, SysUtils, fpcunit, testregistry, fpsqlscanner;
type
@ -223,6 +223,11 @@ type
procedure TestWhile;
procedure TestWith;
procedure TestWork;
procedure TestTerm;
procedure TestTermExclude;
procedure TestRecreate;
procedure TestRestart;
procedure TestSequence;
Procedure Test2Words;
procedure Test3Words;
procedure TestIdentifier;
@ -1350,6 +1355,33 @@ begin
CheckToken(tsqlWork,'work');
end;
procedure TTestSQLScanner.TestTerm;
begin
CheckToken(tsqlTerm,'term');
end;
procedure TTestSQLScanner.TestTermExclude;
begin
CreateScanner('term');
FScanner.Excludekeywords.Add('term');
AssertEquals('Term is identifier',tsqlIdentifier,FScanner.FetchToken);
end;
procedure TTestSQLScanner.TestRecreate;
begin
CheckToken(tsqlRecreate,'recreate');
end;
procedure TTestSQLScanner.TestRestart;
begin
CheckToken(tsqlRestart,'restart');
end;
procedure TTestSQLScanner.TestSequence;
begin
CheckToken(tsqlSequence,'sequence');
end;
procedure TTestSQLScanner.CheckTokens(ASource : String; ATokens : Array of TSQLToken);
Var