* fcl-db: sql parser tests:

- cosmetic changes (capitalization, comments)
- add tests for SET TERM, symbol literal parsing introduced in r27907
- Lazarus test project: default+debug build mode: no optimalization, more checks enabled

git-svn-id: trunk@27908 -

packages/fcl-db/tests/tcparser.pas

@@ -25,9 +25,9 @@ type
 
   { TTestParser }
 
-  TTestParser = Class(TSQLparser)
+  TTestParser = Class(TSQLParser)
   public
-    Procedure ParseStringDef(Out DT : TSQLDataType; Out Len : Integer; Out ACharset : TSQLStringtype);
+    procedure ParseStringDef(Out DT : TSQLDataType; Out Len : Integer; Out ACharset : TSQLStringtype);
     Function  ParseType(Flags : TParseTypeFlags) : TSQLTypeDefinition;
     Function  ParseConstraint : TSQLExpression;
     Function  ParseProcedureStatements : TSQLStatement;
@@ -39,17 +39,17 @@ type
   Private
     FSource : TStringStream;
     FParser : TTestParser;
-    FToFree: TSQLElement;
+    FToFree : TSQLElement; //will be freed by test teardown
     FErrSource : string;
   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);
-    Function CheckClass(E : TSQLElement; C : TSQLElementClass) : TSQLElement;
+    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);
+    function CheckClass(E : TSQLElement; C : TSQLElementClass) : TSQLElement;
     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;
     procedure AssertEquals(const AMessage: String; Expected, Actual: TSQLToken); overload;
     procedure AssertEquals(const AMessage: String; Expected, Actual: TSQLBinaryoperation); overload;
     procedure AssertEquals(const AMessage: String; Expected, Actual: TSQLUnaryoperation); overload;
@@ -65,23 +65,23 @@ type
     procedure AssertEquals(const AMessage: String; Expected, Actual: TTriggerState); overload;
     procedure AssertEquals(const AMessage: String; Expected, Actual: TTriggerOperations); overload;
     function AssertLiteralExpr(Const AMessage : String; Element : TSQLExpression; ALiteralClass : TSQLElementClass) : TSQLLiteral;
-    Procedure AssertIdentifierName(Const AMessage : String; Const AExpected : String; Element : TSQLElement);
-    Procedure AssertField(AField : TSQLElement; Const AName : String; Const AAlias : String = '');
-    Procedure AssertAggregate(AField : TSQLElement; AAgregate : TSQLAggregateFunction; Const AFieldName : String; AOption : TSQLAggregateOption; Const AAlias : String = '');
-    Procedure AssertAggregateExpression(E : TSQLElement; AAgregate : TSQLAggregateFunction; Const AFieldName : String; AOption : TSQLAggregateOption);
-    Procedure AssertTable(ATable : TSQLElement; Const AName : String; Const AAlias : String = '');
-    Function AssertJoin(AJoin : TSQLElement; Const AFirst,ASecond : String; Const aJoinType : TSQLJoinType) : TSQLJoinTableReference;
-    Function AssertJoinOn(AJoin : TSQLExpression; Const AFirst,ASecond : String; Const AOperation : TSQLBinaryOperation) : TSQLBinaryExpression;
-    Function AssertOrderBy(AOrderBy : TSQLElement; Const AField : String; Const ANumber : Integer; Const AOrdering : TSQLOrderDirection) : TSQLOrderByElement;
-    Function AssertSecondaryFile(ASecondaryFile : TSQLElement; Const AFile : String; Const ALength,AStart : Integer) : TSQLDatabaseFileInfo;
+    procedure AssertIdentifierName(Const AMessage : String; Const AExpected : String; Element : TSQLElement);
+    procedure AssertField(AField : TSQLElement; Const AName : String; Const AAlias : String = '');
+    procedure AssertAggregate(AField : TSQLElement; AAgregate : TSQLAggregateFunction; Const AFieldName : String; AOption : TSQLAggregateOption; Const AAlias : String = '');
+    procedure AssertAggregateExpression(E : TSQLElement; AAgregate : TSQLAggregateFunction; Const AFieldName : String; AOption : TSQLAggregateOption);
+    procedure AssertTable(ATable : TSQLElement; Const AName : String; Const AAlias : String = '');
+    function AssertJoin(AJoin : TSQLElement; Const AFirst,ASecond : String; Const aJoinType : TSQLJoinType) : TSQLJoinTableReference;
+    function AssertJoinOn(AJoin : TSQLExpression; Const AFirst,ASecond : String; Const AOperation : TSQLBinaryOperation) : TSQLBinaryExpression;
+    function AssertOrderBy(AOrderBy : TSQLElement; Const AField : String; Const ANumber : Integer; Const AOrdering : TSQLOrderDirection) : TSQLOrderByElement;
+    function AssertSecondaryFile(ASecondaryFile : TSQLElement; Const AFile : String; Const ALength,AStart : Integer) : TSQLDatabaseFileInfo;
     procedure TestTypeError;
-    Procedure TestStringError;
-    Procedure TestCheckError;
-    Procedure TestParseError;
+    procedure TestStringError;
+    procedure TestCheckError;
+    procedure TestParseError;
     procedure SetUp; override;
     procedure TearDown; override;
-    Property Parser : TTestParser Read FParser;
-    Property ToFree : TSQLElement Read FToFree Write FTofree;
+    property Parser : TTestParser Read FParser;
+    property ToFree : TSQLElement Read FToFree Write FTofree;
   end;
 
   { TTestDropParser }
@@ -106,16 +106,16 @@ type
 
   TTestGeneratorParser = Class(TTestSQLParser)
   Published
-    Procedure TestCreateGenerator;
-    Procedure TestSetGenerator;
+    procedure TestCreateGenerator;
+    procedure TestSetGenerator;
   end;
 
   { TTestRoleParser }
 
   TTestRoleParser = Class(TTestSQLParser)
   Published
-    Procedure TestCreateRole;
-    Procedure TestAlterRole;
+    procedure TestCreateRole;
+    procedure TestAlterRole;
   end;
 
   { TTestTypeParser }
@@ -123,7 +123,7 @@ type
   TTestTypeParser = Class(TTestSQLParser)
   private
   Published
-    Procedure TestStringType1;
+    procedure TestStringType1;
     procedure TestStringType2;
     procedure TestStringType3;
     procedure TestStringType4;
@@ -137,12 +137,12 @@ type
     procedure TestStringType12;
     procedure TestStringType13;
     procedure TestStringType14;
-    Procedure TestStringType15;
+    procedure TestStringType15;
     procedure TestStringType16;
     procedure TestStringType17;
     procedure TestStringType18;
     procedure TestStringType19;
-    Procedure TestStringTypeErrors1;
+    procedure TestStringTypeErrors1;
     procedure TestStringTypeErrors2;
     procedure TestStringTypeErrors3;
     procedure TestTypeInt1;
@@ -190,7 +190,7 @@ type
     procedure TestCheckNotNull;
     procedure TestCheckBraces;
     procedure TestCheckBracesError;
-    Procedure TestCheckParamError;
+    procedure TestCheckParamError;
     procedure TestCheckIdentifierError;
     procedure TestIsEqual;
     procedure TestIsNotEqual1;
@@ -211,7 +211,7 @@ type
     procedure TestNotBetween;
     procedure TestLikeEscape;
     procedure TestNotLikeEscape;
-    Procedure TestAnd;
+    procedure TestAnd;
     procedure TestOr;
     procedure TestNotOr;
   end;
@@ -222,9 +222,9 @@ type
   TTestDomainParser = Class(TTestSQLParser)
   private
   Published
-    Procedure TestSimpleDomain;
-    Procedure TestSimpleDomainAs;
-    Procedure TestNotNullDomain;
+    procedure TestSimpleDomain;
+    procedure TestSimpleDomainAs;
+    procedure TestNotNullDomain;
     procedure TestDefaultNotNullDomain;
     procedure TestCheckDomain;
     procedure TestDefaultCheckNotNullDomain;
@@ -245,9 +245,9 @@ type
 
   TTestExceptionParser = Class(TTestSQLParser)
   Published
-    Procedure TestException;
+    procedure TestException;
     procedure TestAlterException;
-    Procedure TestExceptionError1;
+    procedure TestExceptionError1;
     procedure TestExceptionError2;
   end;
 
@@ -279,7 +279,7 @@ type
   private
     procedure DoTestCreateReferencesField(Const ASource : String; AOnUpdate,AOnDelete : TForeignKeyAction);
   Published
-    Procedure TestCreateOneSimpleField;
+    procedure TestCreateOneSimpleField;
     procedure TestCreateTwoSimpleFields;
     procedure TestCreateOnePrimaryField;
     procedure TestCreateOneNamedPrimaryField;
@@ -309,56 +309,56 @@ type
     procedure TestCreateNamedUniqueConstraint;
     procedure TestCreateCheckConstraint;
     procedure TestCreateNamedCheckConstraint;
-    Procedure TestAlterDropField;
-    Procedure TestAlterDropFields;
-    Procedure TestAlterDropConstraint;
-    Procedure TestAlterDropConstraints;
-    Procedure TestAlterRenameField;
+    procedure TestAlterDropField;
+    procedure TestAlterDropFields;
+    procedure TestAlterDropConstraint;
+    procedure TestAlterDropConstraints;
+    procedure TestAlterRenameField;
     procedure TestAlterRenameColumnField;
-    Procedure TestAlterFieldType;
-    Procedure TestAlterFieldPosition;
-    Procedure TestAlterAddField;
-    Procedure TestAlterAddFields;
-    Procedure TestAlterAddPrimarykey;
-    Procedure TestAlterAddNamedPrimarykey;
-    Procedure TestAlterAddCheckConstraint;
+    procedure TestAlterFieldType;
+    procedure TestAlterFieldPosition;
+    procedure TestAlterAddField;
+    procedure TestAlterAddFields;
+    procedure TestAlterAddPrimarykey;
+    procedure TestAlterAddNamedPrimarykey;
+    procedure TestAlterAddCheckConstraint;
     procedure TestAlterAddNamedCheckConstraint;
-    Procedure TestAlterAddForeignkey;
-    Procedure TestAlterAddNamedForeignkey;
+    procedure TestAlterAddForeignkey;
+    procedure TestAlterAddNamedForeignkey;
   end;
 
   { TTestDeleteParser }
 
   TTestDeleteParser = Class(TTestSQLParser)
   Private
-    Function TestDelete(Const ASource , ATable: String) : TSQLDeleteStatement;
+    function TestDelete(Const ASource , ATable: String) : TSQLDeleteStatement;
   Published
-    Procedure TestSimpleDelete;
-    Procedure TestSimpleDeleteAlias;
-    Procedure TestDeleteWhereNull;
+    procedure TestSimpleDelete;
+    procedure TestSimpleDeleteAlias;
+    procedure TestDeleteWhereNull;
   end;
 
   { TTestUpdateParser }
 
   TTestUpdateParser = Class(TTestSQLParser)
   Private
-    Function TestUpdate(Const ASource , ATable: String) : TSQLUpdateStatement;
+    function TestUpdate(Const ASource , ATable: String) : TSQLUpdateStatement;
   Published
-    Procedure TestUpdateOneField;
-    Procedure TestUpdateOneFieldFull;
-    Procedure TestUpdateTwoFields;
-    Procedure TestUpdateOneFieldWhereIsNull;
+    procedure TestUpdateOneField;
+    procedure TestUpdateOneFieldFull;
+    procedure TestUpdateTwoFields;
+    procedure TestUpdateOneFieldWhereIsNull;
   end;
 
   { TTestInsertParser }
 
   TTestInsertParser = Class(TTestSQLParser)
   Private
-    Function TestInsert(Const ASource , ATable: String) : TSQLInsertStatement;
+    function TestInsert(Const ASource , ATable: String) : TSQLInsertStatement;
   Published
-    Procedure TestInsertOneField;
+    procedure TestInsertOneField;
     procedure TestInsertTwoFields;
-    Procedure TestInsertOneValue;
+    procedure TestInsertOneValue;
     procedure TestInsertTwoValues;
   end;
 
@@ -367,18 +367,18 @@ type
   TTestSelectParser = Class(TTestSQLParser)
   Private
     FSelect : TSQLSelectStatement;
-    Function TestSelect(Const ASource : String) : TSQLSelectStatement;
-    Procedure TestSelectError(Const ASource : String);
-    Procedure DoExtractSimple(Expected : TSQLExtractElement);
-    Property Select : TSQLSelectStatement Read FSelect;
+    function TestSelect(Const ASource : String) : TSQLSelectStatement;
+    procedure TestSelectError(Const ASource : String);
+    procedure DoExtractSimple(Expected : TSQLExtractElement);
+    property Select : TSQLSelectStatement Read FSelect;
   Published
-    Procedure TestSelectOneFieldOneTable;
-    Procedure TestSelectOneFieldOneTableTransaction;
-    Procedure TestSelectOneArrayFieldOneTable;
-    Procedure TestSelectTwoFieldsOneTable;
+    procedure TestSelectOneFieldOneTable;
+    procedure TestSelectOneFieldOneTableTransaction;
+    procedure TestSelectOneArrayFieldOneTable;
+    procedure TestSelectTwoFieldsOneTable;
     procedure TestSelectOneFieldAliasOneTable;
     procedure TestSelectTwoFieldAliasesOneTable;
-    Procedure TestSelectOneDistinctFieldOneTable;
+    procedure TestSelectOneDistinctFieldOneTable;
     procedure TestSelectOneAllFieldOneTable;
     procedure TestSelectAsteriskOneTable;
     procedure TestSelectDistinctAsteriskOneTable;
@@ -393,7 +393,7 @@ type
     procedure TestSelectTwoFieldsThreeTablesJoin;
     procedure TestSelectTwoFieldsBracketThreeTablesJoin;
     procedure TestSelectTwoFieldsThreeBracketTablesJoin;
-    Procedure TestAggregateCount;
+    procedure TestAggregateCount;
     procedure TestAggregateCountAsterisk;
     procedure TestAggregateCountAll;
     procedure TestAggregateCountDistinct;
@@ -413,13 +413,13 @@ type
     procedure TestAggregateAvgAll;
     procedure TestAggregateAvgAsterisk;
     procedure TestAggregateAvgDistinct;
-    Procedure TestUpperConst;
+    procedure TestUpperConst;
     procedure TestUpperError;
-    Procedure TestGenID;
-    Procedure TestGenIDError1;
-    Procedure TestGenIDError2;
-    Procedure TestCastSimple;
-    Procedure TestExtractSimple;
+    procedure TestGenID;
+    procedure TestGenIDError1;
+    procedure TestGenIDError2;
+    procedure TestCastSimple;
+    procedure TestExtractSimple;
     procedure TestOrderByOneField;
     procedure TestOrderByTwoFields;
     procedure TestOrderByThreeFields;
@@ -435,10 +435,10 @@ type
     procedure TestGroupByOne;
     procedure TestGroupByTwo;
     procedure TestHavingOne;
-    Procedure TestUnionSimple;
+    procedure TestUnionSimple;
     procedure TestUnionSimpleAll;
     procedure TestUnionSimpleOrderBy;
-    Procedure TestUnionDouble;
+    procedure TestUnionDouble;
     procedure TestUnionError1;
     procedure TestUnionError2;
     procedure TestPlanOrderNatural;
@@ -455,7 +455,7 @@ type
     procedure TestWhereAll;
     procedure TestWhereAny;
     procedure TestWhereSome;
-    Procedure TestParam;
+    procedure TestParam;
     procedure TestParamExpr;
   end;
 
@@ -464,18 +464,18 @@ type
   TTestRollBackParser = Class(TTestSQLParser)
   Private
     FRollback : TSQLRollbackStatement;
-    Function TestRollback(Const ASource : String) : TSQLRollbackStatement;
-    Procedure TestRollbackError(Const ASource : String);
-    Property Rollback : TSQLRollbackStatement Read FRollback;
+    function TestRollback(Const ASource : String) : TSQLRollbackStatement;
+    procedure TestRollbackError(Const ASource : String);
+    property Rollback : TSQLRollbackStatement Read FRollback;
   Published
-    Procedure TestRollback;
-    Procedure TestRollbackWork;
-    Procedure TestRollbackRelease;
-    Procedure TestRollbackWorkRelease;
-    Procedure TestRollbackTransaction;
-    Procedure TestRollbackTransactionWork;
-    Procedure TestRollbackTransactionRelease;
-    Procedure TestRollbackTransactionWorkRelease;
+    procedure TestRollback;
+    procedure TestRollbackWork;
+    procedure TestRollbackRelease;
+    procedure TestRollbackWorkRelease;
+    procedure TestRollbackTransaction;
+    procedure TestRollbackTransactionWork;
+    procedure TestRollbackTransactionRelease;
+    procedure TestRollbackTransactionWorkRelease;
   end;
 
   { TTestCommitParser }
@@ -483,26 +483,26 @@ type
   TTestCommitParser = Class(TTestSQLParser)
   Private
     FCommit : TSQLCommitStatement;
-    Function TestCommit(Const ASource : String) : TSQLCommitStatement;
-    Procedure TestCommitError(Const ASource : String);
-    Property Commit : TSQLCommitStatement Read FCommit;
+    function TestCommit(Const ASource : String) : TSQLCommitStatement;
+    procedure TestCommitError(Const ASource : String);
+    property Commit : TSQLCommitStatement Read FCommit;
   Published
-    Procedure TestCommit;
-    Procedure TestCommitWork;
-    Procedure TestCommitRelease;
-    Procedure TestCommitWorkRelease;
-    Procedure TestCommitTransaction;
-    Procedure TestCommitTransactionWork;
-    Procedure TestCommitTransactionRelease;
-    Procedure TestCommitTransactionWorkRelease;
-    Procedure TestCommitRetain;
-    Procedure TestCommitWorkRetain;
-    Procedure TestCommitReleaseRetain;
-    Procedure TestCommitWorkReleaseRetain;
-    Procedure TestCommitTransactionRetain;
-    Procedure TestCommitTransactionWorkRetain;
-    Procedure TestCommitTransactionReleaseRetain;
-    Procedure TestCommitTransactionWorkReleaseRetain;
+    procedure TestCommit;
+    procedure TestCommitWork;
+    procedure TestCommitRelease;
+    procedure TestCommitWorkRelease;
+    procedure TestCommitTransaction;
+    procedure TestCommitTransactionWork;
+    procedure TestCommitTransactionRelease;
+    procedure TestCommitTransactionWorkRelease;
+    procedure TestCommitRetain;
+    procedure TestCommitWorkRetain;
+    procedure TestCommitReleaseRetain;
+    procedure TestCommitWorkReleaseRetain;
+    procedure TestCommitTransactionRetain;
+    procedure TestCommitTransactionWorkRetain;
+    procedure TestCommitTransactionReleaseRetain;
+    procedure TestCommitTransactionWorkReleaseRetain;
     procedure TestCommitRetainSnapShot;
   end;
 
@@ -511,13 +511,13 @@ type
   TTestExecuteProcedureParser = Class(TTestSQLParser)
   Private
     FExecute : TSQLExecuteProcedureStatement;
-    Function TestExecute(Const ASource : String) : TSQLExecuteProcedureStatement;
-    Procedure TestExecuteError(Const ASource : String);
-    Property Execute: TSQLExecuteProcedureStatement Read FExecute;
+    function TestExecute(Const ASource : String) : TSQLExecuteProcedureStatement;
+    procedure TestExecuteError(Const ASource : String);
+    property Execute: TSQLExecuteProcedureStatement Read FExecute;
   Published
-    Procedure TestExecuteSimple;
-    Procedure TestExecuteSimpleTransaction;
-    Procedure TestExecuteSimpleReturningValues;
+    procedure TestExecuteSimple;
+    procedure TestExecuteSimpleTransaction;
+    procedure TestExecuteSimpleReturningValues;
     procedure TestExecuteSimpleReturning2Values;
     procedure TestExecuteOneArg;
     procedure TestExecuteOneArgNB;
@@ -538,12 +538,12 @@ type
   TTestConnectParser = Class(TTestSQLParser)
   Private
     FConnect : TSQLConnectStatement;
-    Function TestConnect(Const ASource : String) : TSQLConnectStatement;
-    Procedure TestConnectError(Const ASource : String);
-    Property Connect: TSQLConnectStatement Read FConnect;
+    function TestConnect(Const ASource : String) : TSQLConnectStatement;
+    procedure TestConnectError(Const ASource : String);
+    property Connect: TSQLConnectStatement Read FConnect;
   Published
-    Procedure TestConnectSimple;
-    Procedure TestConnectUser;
+    procedure TestConnectSimple;
+    procedure TestConnectUser;
     procedure TestConnectPassword;
     procedure TestConnectUserPassword;
     procedure TestConnectUserPasswordRole;
@@ -556,11 +556,11 @@ type
   TTestCreateDatabaseParser = Class(TTestSQLParser)
   Private
     FCreateDB : TSQLCreateDatabaseStatement;
-    Function TestCreate(Const ASource : String) : TSQLCreateDatabaseStatement;
-    Procedure TestCreateError(Const ASource : String);
-    Property CreateDB : TSQLCreateDatabaseStatement Read FCreateDB;
+    function TestCreate(Const ASource : String) : TSQLCreateDatabaseStatement;
+    procedure TestCreateError(Const ASource : String);
+    property CreateDB : TSQLCreateDatabaseStatement Read FCreateDB;
   published
-    Procedure TestSimple;
+    procedure TestSimple;
     procedure TestSimpleSchema;
     procedure TestSimpleUSer;
     procedure TestSimpleUSerPassword;
@@ -593,11 +593,11 @@ type
   TTestAlterDatabaseParser = Class(TTestSQLParser)
   Private
     FAlterDB : TSQLAlterDatabaseStatement;
-    Function TestAlter(Const ASource : String) : TSQLAlterDatabaseStatement;
-    Procedure TestAlterError(Const ASource : String);
-    Property AlterDB : TSQLAlterDatabaseStatement Read FAlterDB;
+    function TestAlter(Const ASource : String) : TSQLAlterDatabaseStatement;
+    procedure TestAlterError(Const ASource : String);
+    property AlterDB : TSQLAlterDatabaseStatement Read FAlterDB;
   published
-    Procedure TestSimple;
+    procedure TestSimple;
     procedure TestLength;
     procedure TestStarting;
     procedure TestStartingLength;
@@ -612,11 +612,11 @@ type
   TTestCreateViewParser = Class(TTestSQLParser)
   Private
     FView : TSQLCreateViewStatement;
-    Function TestCreate(Const ASource : String) : TSQLCreateViewStatement;
-    Procedure TestCreateError(Const ASource : String);
-    Property View : TSQLCreateViewStatement Read FView;
+    function TestCreate(Const ASource : String) : TSQLCreateViewStatement;
+    procedure TestCreateError(Const ASource : String);
+    property View : TSQLCreateViewStatement Read FView;
   Published
-    Procedure TestSimple;
+    procedure TestSimple;
     procedure TestFieldList;
     procedure TestFieldList2;
     procedure TestSimpleWithCheckoption;
@@ -627,11 +627,11 @@ type
   TTestCreateShadowParser = Class(TTestSQLParser)
   Private
     FShadow : TSQLCreateShadowStatement;
-    Function TestCreate(Const ASource : String) : TSQLCreateShadowStatement;
-    Procedure TestCreateError(Const ASource : String);
-    Property Shadow : TSQLCreateShadowStatement Read FShadow;
+    function TestCreate(Const ASource : String) : TSQLCreateShadowStatement;
+    procedure TestCreateError(Const ASource : String);
+    property Shadow : TSQLCreateShadowStatement Read FShadow;
   published
-    Procedure TestSimple;
+    procedure TestSimple;
     procedure TestLength;
     procedure TestLength2;
     procedure TestLength3;
@@ -653,13 +653,13 @@ type
   Private
     FStatement : TSQLStatement;
     procedure TestParseStatementError;
-    Function TestStatement(Const ASource : String) : TSQLStatement;
-    Procedure TestStatementError(Const ASource : String);
-    Property Statement : TSQLStatement Read FStatement;
+    function TestStatement(Const ASource : String) : TSQLStatement;
+    procedure TestStatementError(Const ASource : String);
+    property Statement : TSQLStatement Read FStatement;
   Published
-    Procedure TestException;
-    Procedure TestExceptionError;
-    Procedure TestExit;
+    procedure TestException;
+    procedure TestExceptionError;
+    procedure TestExit;
     procedure TestSuspend;
     procedure TestEmptyBlock;
     procedure TestExitBlock;
@@ -713,11 +713,11 @@ type
   TTestCreateProcedureParser = Class(TTestSQLParser)
   Private
     FStatement : TSQLCreateProcedureStatement;
-    Function TestCreate(Const ASource : String) : TSQLCreateProcedureStatement;
-    Procedure TestCreateError(Const ASource : String);
-    Property Statement : TSQLCreateProcedureStatement Read FStatement;
+    function TestCreate(Const ASource : String) : TSQLCreateProcedureStatement;
+    procedure TestCreateError(Const ASource : String);
+    property Statement : TSQLCreateProcedureStatement Read FStatement;
   Published
-    Procedure TestEmptyProcedure;
+    procedure TestEmptyProcedure;
     procedure TestExitProcedure;
     procedure TestProcedureOneArgument;
     procedure TestProcedureTwoArguments;
@@ -733,13 +733,13 @@ type
   TTestCreateTriggerParser = Class(TTestSQLParser)
   Private
     FStatement : TSQLAlterCreateTriggerStatement;
-    Function TestCreate(Const ASource : String) : TSQLCreateTriggerStatement;
-    Function TestAlter(Const ASource : String) : TSQLAlterTriggerStatement;
-    Procedure TestCreateError(Const ASource : String);
-    Property Statement : TSQLAlterCreateTriggerStatement Read FStatement;
+    function TestCreate(Const ASource : String) : TSQLCreateTriggerStatement;
+    function TestAlter(Const ASource : String) : TSQLAlterTriggerStatement;
+    procedure TestCreateError(Const ASource : String);
+    property Statement : TSQLAlterCreateTriggerStatement Read FStatement;
   Published
-    Procedure TestEmptyTrigger;
-    Procedure TestExitTrigger;
+    procedure TestEmptyTrigger;
+    procedure TestExitTrigger;
     procedure TestEmptyTriggerAfterUpdate;
     procedure TestEmptyTriggerBeforeDelete;
     procedure TestEmptyTriggerBeforeInsert;
@@ -756,12 +756,12 @@ type
   TTestDeclareExternalFunctionParser = Class(TTestSQLParser)
   Private
     FStatement : TSQLDeclareExternalFunctionStatement;
-    Function TestCreate(Const ASource : String) : TSQLDeclareExternalFunctionStatement;
-    Procedure TestCreateError(Const ASource : String);
-    Property Statement : TSQLDeclareExternalFunctionStatement Read FStatement;
+    function TestCreate(Const ASource : String) : TSQLDeclareExternalFunctionStatement;
+    procedure TestCreateError(Const ASource : String);
+    property Statement : TSQLDeclareExternalFunctionStatement Read FStatement;
   Published
-    Procedure TestEmptyfunction;
-    Procedure TestEmptyfunctionByValue;
+    procedure TestEmptyfunction;
+    procedure TestEmptyfunctionByValue;
     procedure TestCStringfunction;
     procedure TestCStringFreeItfunction;
     procedure TestOneArgumentFunction;
@@ -773,71 +773,80 @@ type
   TTestGrantParser = Class(TTestSQLParser)
   Private
     FStatement : TSQLGrantStatement;
-    Function TestGrant(Const ASource : String) : TSQLGrantStatement;
-    Procedure TestGrantError(Const ASource : String);
-    Property Statement : TSQLGrantStatement Read FStatement;
+    function TestGrant(Const ASource : String) : TSQLGrantStatement;
+    procedure TestGrantError(Const ASource : String);
+    property Statement : TSQLGrantStatement Read FStatement;
   Published
-    Procedure TestSimple;
-    Procedure Test2Operations;
-    Procedure TestDeletePrivilege;
-    Procedure TestUpdatePrivilege;
-    Procedure TestInsertPrivilege;
-    Procedure TestReferencePrivilege;
-    Procedure TestAllPrivileges;
-    Procedure TestAllPrivileges2;
-    Procedure TestUpdateColPrivilege;
-    Procedure TestUpdate2ColsPrivilege;
-    Procedure TestReferenceColPrivilege;
-    Procedure TestReference2ColsPrivilege;
-    Procedure TestUserPrivilege;
-    Procedure TestUserPrivilegeWithGrant;
+    procedure TestSimple;
+    procedure Test2Operations;
+    procedure TestDeletePrivilege;
+    procedure TestUpdatePrivilege;
+    procedure TestInsertPrivilege;
+    procedure TestReferencePrivilege;
+    procedure TestAllPrivileges;
+    procedure TestAllPrivileges2;
+    procedure TestUpdateColPrivilege;
+    procedure TestUpdate2ColsPrivilege;
+    procedure TestReferenceColPrivilege;
+    procedure TestReference2ColsPrivilege;
+    procedure TestUserPrivilege;
+    procedure TestUserPrivilegeWithGrant;
     procedure TestGroupPrivilege;
     procedure TestProcedurePrivilege;
     procedure TestViewPrivilege;
     procedure TestTriggerPrivilege;
     procedure TestPublicPrivilege;
-    Procedure TestExecuteToUser;
+    procedure TestExecuteToUser;
     procedure TestExecuteToProcedure;
     procedure TestRoleToUser;
     procedure TestRoleToUserWithAdmin;
     procedure TestRoleToPublic;
     procedure Test2RolesToUser;
   end;
-  { TTestGrantParser }
+
+  { TTestRevokeParser }
 
   TTestRevokeParser = Class(TTestSQLParser)
   Private
     FStatement : TSQLRevokeStatement;
-    Function TestRevoke(Const ASource : String) : TSQLRevokeStatement;
-    Procedure TestRevokeError(Const ASource : String);
-    Property Statement : TSQLRevokeStatement Read FStatement;
+    function TestRevoke(Const ASource : String) : TSQLRevokeStatement;
+    procedure TestRevokeError(Const ASource : String);
+    property Statement : TSQLRevokeStatement Read FStatement;
   Published
-    Procedure TestSimple;
-    Procedure Test2Operations;
-    Procedure TestDeletePrivilege;
-    Procedure TestUpdatePrivilege;
-    Procedure TestInsertPrivilege;
-    Procedure TestReferencePrivilege;
-    Procedure TestAllPrivileges;
-    Procedure TestAllPrivileges2;
-    Procedure TestUpdateColPrivilege;
-    Procedure TestUpdate2ColsPrivilege;
-    Procedure TestReferenceColPrivilege;
-    Procedure TestReference2ColsPrivilege;
-    Procedure TestUserPrivilege;
-    Procedure TestUserPrivilegeWithRevoke;
+    procedure TestSimple;
+    procedure Test2Operations;
+    procedure TestDeletePrivilege;
+    procedure TestUpdatePrivilege;
+    procedure TestInsertPrivilege;
+    procedure TestReferencePrivilege;
+    procedure TestAllPrivileges;
+    procedure TestAllPrivileges2;
+    procedure TestUpdateColPrivilege;
+    procedure TestUpdate2ColsPrivilege;
+    procedure TestReferenceColPrivilege;
+    procedure TestReference2ColsPrivilege;
+    procedure TestUserPrivilege;
+    procedure TestUserPrivilegeWithRevoke;
     procedure TestGroupPrivilege;
     procedure TestProcedurePrivilege;
     procedure TestViewPrivilege;
     procedure TestTriggerPrivilege;
     procedure TestPublicPrivilege;
-    Procedure TestExecuteToUser;
+    procedure TestExecuteToUser;
     procedure TestExecuteToProcedure;
     procedure TestRoleToUser;
     procedure TestRoleToPublic;
     procedure Test2RolesToUser;
   end;
 
+  { TTestTermParser }
+
+  TTestTermParser = Class(TTestSQLParser)
+  published
+    procedure TestSetTerm;
+    procedure TestSetTermSemicolon;
+  end;
+
   { TTestGlobalParser }
 
   TTestGlobalParser = Class(TTestSQLParser)
@@ -849,6 +858,40 @@ implementation
 
 uses typinfo;
 
+{ TTestTermParser }
+
+procedure TTestTermParser.TestSetTerm;
+Var
+  S : TSQLSetTermStatement;
+
+begin
+  CreateParser('SET TERM ^ ;');
+  FToFree:=Parser.Parse;
+  S:=TSQLSetTermStatement(CheckClass(FToFree,TSQLSetTermStatement));
+  AssertEquals('New value','^',S.NewValue);
+  AssertEquals('Closing semicolon',tsqlSEMICOLON,Parser.CurrentToken);
+  Parser.GetNextToken;
+  AssertEquals('End of stream reached',tsqlEOF,Parser.CurrentToken);
+end;
+
+procedure TTestTermParser.TestSetTermSemicolon;
+Var
+  S : TSQLSetTermStatement;
+
+begin
+  CreateParser('SET TERM ; ^');
+  FParser.SetStatementTerminator('^'); // emulate a previous SET TERM ^ ;
+  AssertEquals('Closing statement terminator should match ^','^',Parser.GetStatementTerminator);
+  FToFree:=Parser.Parse;
+  S:=TSQLSetTermStatement(CheckClass(FToFree,TSQLSetTermStatement));
+  AssertEquals('New value',';',S.NewValue);
+  AssertEquals('Closing terminator',tsqlStatementTerminator,Parser.CurrentToken);
+  AssertEquals('Closing ^','^',Parser.CurrentTokenString);
+  Parser.GetNextToken;
+  AssertEquals('End of stream reached',tsqlEOF,Parser.CurrentToken);
+end;
+
+
 { TTestGlobalParser }
 
 procedure TTestGlobalParser.TestEmpty;
@@ -1225,7 +1268,7 @@ begin
   FToFree:=Parser.Parse;
 end;
 
-Procedure TTestSQLParser.TestStringDef(ASource : String; ExpectDT : TSQLDataType; ExpectLen : Integer; ExpectCharset : TSQLStringType='');
+procedure TTestSQLParser.TestStringDef(ASource : String; ExpectDT : TSQLDataType; ExpectLen : Integer; ExpectCharset : TSQLStringType='');
 
 Var
   Dt : TSQLDataType;
@@ -6697,7 +6740,7 @@ procedure TTestCreateProcedureParser.TestEmptyProcedure;
 
 begin
   TestCreate('CREATE PROCEDURE A AS BEGIN END');
-  AssertIdentifierName('Correcte procedure naam','A',Statement.ObjectName);
+  AssertIdentifierName('Correct procedure name','A',Statement.ObjectName);
   AssertEquals('No arguments',0,Statement.InputVariables.Count);
   AssertEquals('No return values',0,Statement.OutputVariables.Count);
   AssertEquals('No local variables',0,Statement.LocalVariables.Count);
@@ -6708,7 +6751,7 @@ procedure TTestCreateProcedureParser.TestExitProcedure;
 
 begin
   TestCreate('CREATE PROCEDURE A AS BEGIN EXIT; END');
-  AssertIdentifierName('Correcte procedure naam','A',Statement.ObjectName);
+  AssertIdentifierName('Correct procedure name','A',Statement.ObjectName);
   AssertEquals('No arguments',0,Statement.InputVariables.Count);
   AssertEquals('No return values',0,Statement.OutputVariables.Count);
   AssertEquals('No local variables',0,Statement.LocalVariables.Count);
@@ -6723,7 +6766,7 @@ Var
 
 begin
   TestCreate('CREATE PROCEDURE A (P INT) AS BEGIN END');
-  AssertIdentifierName('Correcte procedure naam','A',Statement.ObjectName);
+  AssertIdentifierName('Correct procedure name','A',Statement.ObjectName);
   AssertEquals('1 arguments',1,Statement.InputVariables.Count);
   P:=TSQLProcedureParamDef(CheckClass(Statement.InputVariables[0],TSQLProcedureParamDef));
   AssertIdentifierName('Correct parameter name','P',P.ParamName);
@@ -6740,7 +6783,7 @@ Var
 
 begin
   TestCreate('CREATE PROCEDURE A (P INT,Q CHAR(4)) AS BEGIN END');
-  AssertIdentifierName('Correcte procedure naam','A',Statement.ObjectName);
+  AssertIdentifierName('Correct procedure name','A',Statement.ObjectName);
   AssertEquals('Two arguments',2,Statement.InputVariables.Count);
   P:=TSQLProcedureParamDef(CheckClass(Statement.InputVariables[0],TSQLProcedureParamDef));
   AssertIdentifierName('Correct parameter name','P',P.ParamName);
@@ -6763,7 +6806,7 @@ Var
 
 begin
   TestCreate('CREATE PROCEDURE A RETURNS (P INT) AS BEGIN END');
-  AssertIdentifierName('Correcte procedure naam','A',Statement.ObjectName);
+  AssertIdentifierName('Correct procedure name','A',Statement.ObjectName);
   AssertEquals('1 return value',1,Statement.OutputVariables.Count);
   P:=TSQLProcedureParamDef(CheckClass(Statement.OutputVariables[0],TSQLProcedureParamDef));
   AssertIdentifierName('Correct parameter name','P',P.ParamName);
@@ -6780,7 +6823,7 @@ Var
 
 begin
   TestCreate('CREATE PROCEDURE A RETURNS (P INT, Q CHAR(5)) AS BEGIN END');
-  AssertIdentifierName('Correcte procedure naam','A',Statement.ObjectName);
+  AssertIdentifierName('Correct procedure name','A',Statement.ObjectName);
   AssertEquals('2 return values',2,Statement.OutputVariables.Count);
   P:=TSQLProcedureParamDef(CheckClass(Statement.OutputVariables[0],TSQLProcedureParamDef));
   AssertIdentifierName('Correct parameter name','P',P.ParamName);
@@ -8095,6 +8138,7 @@ initialization
                  TTestDeclareExternalFunctionParser,
                  TTestGrantParser,
                  TTestRevokeParser,
+                 TTestTermParser,
                  TTestGlobalParser]);
 end.
 

packages/fcl-db/tests/tcsqlscanner.pas

@@ -197,8 +197,8 @@ type
     Procedure TestStarting;
     procedure TestString;
     procedure TestSubtype;
-    Procedure TestSum;
-    Procedure TestSuspend;
+    procedure TestSum;
+    procedure TestSuspend;
     Procedure TestTable;
     Procedure TestThen;
     Procedure TestTime;
@@ -244,6 +244,8 @@ type
     procedure TestFloatLiteral;
     procedure TestStringLiteral1;
     procedure TestStringLiteral2;
+    procedure TestSymbolLiteral1;
+    procedure TestSymbolLiteral2;
     procedure TestStringError;
     procedure TestFloatError;
     Procedure TestOptionsoDoubleQuoteStringLiteral;
@@ -362,7 +364,7 @@ begin
   FLineReader:=TStreamLineReader.Create(Fstream);
   FScanner:=TSQLScanner.Create(FLineReader);
   FScanner.Options:=AOptions;
-  Result:=FSCanner;
+  Result:=FScanner;
 end;
 
 procedure TTestSQLScanner.FreeScanner;
@@ -644,6 +646,16 @@ begin
   CheckToken(tsqlSuspend,'Suspend');
 end;
 
+procedure TTestSQLScanner.TestSymbolLiteral1;
+begin
+  CheckToken(tsqlSymbolLiteral,'%');
+end;
+
+procedure TTestSQLScanner.TestSymbolLiteral2;
+begin
+  CheckToken(tsqlSymbolLiteral,'%^');
+end;
+
 procedure TTestSQLScanner.TestStarting;
 begin
   CheckToken(tsqlStarting,'starting');
@@ -1392,8 +1404,8 @@ end;
 
 procedure TTestSQLScanner.TestIdentifier5;
 begin
-  FErrorSource:='$0';
-  AssertException('Identifier cannot start with _',ESQLScannerError,@TestErrorSource);
+  // $0 should not be parsed as an identifier but as a symbol literal
+  CheckToken(tsqlSymbolLiteral,'$0');
 end;
 
 procedure TTestSQLScanner.TestIdentifierDotIdentifier;

packages/fcl-db/tests/testsqlscanner.lpi

@@ -1,4 +1,4 @@
-<?xml version="1.0"?>
+<?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <ProjectOptions>
     <Version Value="9"/>
@@ -13,8 +13,38 @@
       <CharSet Value=""/>
       <StringTable ProductVersion=""/>
     </VersionInfo>
-    <BuildModes Count="1">
-      <Item1 Name="default" Default="True"/>
+    <BuildModes Count="2">
+      <Item1 Name="Debug" Default="True"/>
+      <Item2 Name="Release">
+        <CompilerOptions>
+          <Version Value="11"/>
+          <Target>
+            <Filename Value="testsqlscanner"/>
+          </Target>
+          <SearchPaths>
+            <IncludeFiles Value="$(ProjOutDir)"/>
+            <OtherUnitFiles Value="../src/sql"/>
+            <UnitOutputDirectory Value="units/$(TargetCPU)-$(TargetOS)"/>
+          </SearchPaths>
+          <Parsing>
+            <SyntaxOptions>
+              <UseAnsiStrings Value="False"/>
+            </SyntaxOptions>
+          </Parsing>
+          <CodeGeneration>
+            <SmartLinkUnit Value="True"/>
+          </CodeGeneration>
+          <Linking>
+            <Debugging>
+              <GenerateDebugInfo Value="False"/>
+            </Debugging>
+            <LinkSmart Value="True"/>
+          </Linking>
+          <Other>
+            <CompilerPath Value="$(CompPath)"/>
+          </Other>
+        </CompilerOptions>
+      </Item2>
     </BuildModes>
     <PublishOptions>
       <Version Value="2"/>
@@ -83,13 +113,22 @@
     </SearchPaths>
     <Parsing>
       <SyntaxOptions>
+        <IncludeAssertionCode Value="True"/>
         <UseAnsiStrings Value="False"/>
       </SyntaxOptions>
     </Parsing>
+    <CodeGeneration>
+      <Checks>
+        <IOChecks Value="True"/>
+        <RangeChecks Value="True"/>
+        <OverflowChecks Value="True"/>
+        <StackChecks Value="True"/>
+      </Checks>
+      <Optimizations>
+        <OptimizationLevel Value="0"/>
+      </Optimizations>
+    </CodeGeneration>
     <Other>
-      <CompilerMessages>
-        <UseMsgFile Value="True"/>
-      </CompilerMessages>
       <CompilerPath Value="$(CompPath)"/>
     </Other>
   </CompilerOptions>

packages/fcl-db/tests/testsqlscanner.lpr

@@ -20,6 +20,8 @@ var
   Application: TMyTestRunner;
 
 
+{$R *.res}
+
 begin
   Application := TMyTestRunner.Create(nil);
   Application.Initialize;