* Fix bug ID #32625: added several firebird constructs

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

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.lpi svneol=native#text/plain
packages/fcl-db/examples/logsqldemo.pas 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/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/pqeventstest.pp svneol=native#text/plain
packages/fcl-db/examples/showcsv.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 packages/fcl-db/examples/sqlite3extdemo.pp svneol=native#text/plain

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.

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -19,7 +19,7 @@ unit tcsqlscanner;
interface interface
uses uses
Classes, SysUtils, fpcunit, testutils, testregistry, fpsqlscanner; Classes, SysUtils, fpcunit, testregistry, fpsqlscanner;
type type
@ -223,6 +223,11 @@ type
procedure TestWhile; procedure TestWhile;
procedure TestWith; procedure TestWith;
procedure TestWork; procedure TestWork;
procedure TestTerm;
procedure TestTermExclude;
procedure TestRecreate;
procedure TestRestart;
procedure TestSequence;
Procedure Test2Words; Procedure Test2Words;
procedure Test3Words; procedure Test3Words;
procedure TestIdentifier; procedure TestIdentifier;
@ -1350,6 +1355,33 @@ begin
CheckToken(tsqlWork,'work'); CheckToken(tsqlWork,'work');
end; 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); procedure TTestSQLScanner.CheckTokens(ASource : String; ATokens : Array of TSQLToken);
Var Var