diff --git a/.gitattributes b/.gitattributes index 5a65aab6c8..1a3a73a7a9 100644 --- a/.gitattributes +++ b/.gitattributes @@ -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 diff --git a/packages/fcl-db/examples/parsesql.pas b/packages/fcl-db/examples/parsesql.pas new file mode 100644 index 0000000000..2754606779 --- /dev/null +++ b/packages/fcl-db/examples/parsesql.pas @@ -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 '); + Halt(1); + end; + L:=TStringList.Create; + try + ParseScript(ParamStr(1),L); + for S in L do Writeln(S); + Finally + L.Free; + end; +end. + diff --git a/packages/fcl-db/src/sql/fpsqlparser.pas b/packages/fcl-db/src/sql/fpsqlparser.pas index 431d0f737a..6e4d16b0a9 100644 --- a/packages/fcl-db/src/sql/fpsqlparser.pas +++ b/packages/fcl-db/src/sql/fpsqlparser.pas @@ -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; diff --git a/packages/fcl-db/src/sql/fpsqlscanner.pp b/packages/fcl-db/src/sql/fpsqlscanner.pp index 2f4aa76b9a..d314876169 100644 --- a/packages/fcl-db/src/sql/fpsqlscanner.pp +++ b/packages/fcl-db/src/sql/fpsqlscanner.pp @@ -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'') 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:=''; diff --git a/packages/fcl-db/tests/tcgensql.pas b/packages/fcl-db/tests/tcgensql.pas index 165fab34d8..a2faffc875 100644 --- a/packages/fcl-db/tests/tcgensql.pas +++ b/packages/fcl-db/tests/tcgensql.pas @@ -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'); diff --git a/packages/fcl-db/tests/tcparser.pas b/packages/fcl-db/tests/tcparser.pas index 5552f63837..b55b34b68e 100644 --- a/packages/fcl-db/tests/tcparser.pas +++ b/packages/fcl-db/tests/tcparser.pas @@ -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. diff --git a/packages/fcl-db/tests/tcsqlscanner.pas b/packages/fcl-db/tests/tcsqlscanner.pas index c61c42711d..a6e11099b0 100644 --- a/packages/fcl-db/tests/tcsqlscanner.pas +++ b/packages/fcl-db/tests/tcsqlscanner.pas @@ -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