ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/testsuite/Test24.pas
Revision: 315
Committed: Thu Feb 25 11:56:36 2021 UTC (3 years, 8 months ago) by tony
Content type: text/x-pascal
File size: 9777 byte(s)
Log Message: 
Updated for IBX 4 release

File Contents

# User Rev Content
1 tony 315 unit Test24;
2    
3     {$mode objfpc}{$H+}
4    
5     {Test 24: IB Parser Tests}
6    
7     {Iterates through a set of test strings, parsing each one and displaying the
8     results including any parameters found. Note last string is the empty string}
9    
10    
11     interface
12    
13     uses
14     Classes, SysUtils, TestApplication, IBXTestBase, IB, IBSQLParser, IBUtils;
15    
16     const
17     aTestID = '24';
18     aTestTitle = 'IB Parser Tests';
19    
20     const
21     TestStrings: array [0..13] of string = (
22     'Select distinct A.EMP_NO, A.FIRST_NAME, A.LAST_NAME, A.PHONE_EXT, A.HIRE_DATE, A.DEPT_NO, A.JOB_CODE, 2.2, 2..30 ' +
23     'A.JOB_GRADE, A.JOB_COUNTRY, A.SALARY, A.FULL_NAME, D.DEPT_PATH, D.DEPT_KEY_PATH' + LF +
24     'From EMPLOYEE A' + LF +
25     'JOIN Depts D On D.DEPT_NO = A.DEPT_NO;',
26    
27     'with recursive Depts As (' +
28     'Select DEPT_NO, DEPARTMENT, "HEAD_DEPT", cast(DEPARTMENT as VarChar(256)) as DEPT_PATH /* test */,' +
29     'cast(DEPT_NO as VarChar(64)) as DEPT_KEY_PATH ' + LF +
30     'From DEPARTMENT Where HEAD_DEPT is NULL ' + LF +
31     'UNION ALL' + CRLF +
32     'Select D.DEPT_NO, D.DEPARTMENT, D.HEAD_DEPT, Depts.DEPT_PATH || '' / '' || D.DEPARTMENT as DEPT_PATH,' +
33     'Depts.DEPT_KEY_PATH || '';'' || D.DEPT_NO as DEPT_KEY_PATH ' +
34     'From DEPARTMENT D'+ CR +
35     'JOIN Depts On D.HEAD_DEPT = Depts.DEPT_NO' + LF +
36     ')' +
37     '--ignore' + LF +
38     'Select distinct A.EMP_NO, A.FIRST_NAME, A.LAST_NAME, A.PHONE_EXT, A.HIRE_DATE, A.DEPT_NO, A.JOB_CODE, 2.2, 2..30 ' +
39     'A.JOB_GRADE, A.JOB_COUNTRY, A.SALARY, A.FULL_NAME, D.DEPT_PATH, D.DEPT_KEY_PATH' + LF +
40     'From EMPLOYEE A' + LF +
41     'JOIN Depts D On D.DEPT_NO = A.DEPT_NO',
42    
43     'Update EMPLOYEE A Set '#13#10' A.DEPT_NO = :DEPT_NO,'#13#10 +
44     ' A.FIRST_NAME = ''Mr/Ms '' || :FIRST_NAME,'#13#10+
45     ' A.HIRE_DATE = :HIRE_DATE,'#13#10+
46     ' A.JOB_CODE = :JOB_CODE,'#13#10' A.JOB_COUNTRY = :JOB_COUNTRY,'#13#10+
47     ' A.JOB_GRADE = :JOB_GRADE,'#13#10' A.LAST_NAME = :LAST_NAME,'#13#10+
48     ' A.PHONE_EXT = :PHONE_EXT,'#13#10' A.SALARY = :SALARY ' +
49     'Where A.EMP_NO = :OLD_EMP_NO;',
50    
51     'INSERT INTO EMPLOYEE (EMP_NO, FIRST_NAME, LAST_NAME, PHONE_EXT, HIRE_DATE,' +
52     'DEPT_NO, JOB_CODE, JOB_GRADE, JOB_COUNTRY, SALARY /* what''s this */) '+
53     'VALUES (:EMP_NO, :FIRST_NAME, :LAST_NAME, :PHONE_EXT, :HIRE_DATE, //end comment' + CRLF +
54     ':DEPT_NO, :"JOB""CODE", ''Tester''''s way'''''''''', :JOB_COUNTRY, :"$SALARY")',
55    
56     'Select * from EMPLOYEE Where EMP_NO = :EMP_NO',
57    
58     'Select DEPT_NO, DEPARTMENT, "HEAD_DEPT", cast(DEPARTMENT as VarChar(256)) as DEPT_PATH /* test */,' +
59     'cast(DEPT_NO as VarChar(64)) as DEPT_KEY_PATH ' + LF +
60     'From DEPARTMENT Where HEAD_DEPT is NULL ' + LF +
61     'UNION ALL' + CRLF +
62     'Select D.DEPT_NO, D.DEPARTMENT, D.HEAD_DEPT, Depts.DEPT_PATH || '' / '' || D.DEPARTMENT as DEPT_PATH,' +
63     'Depts.DEPT_KEY_PATH || '';'' || D.DEPT_NO as DEPT_KEY_PATH ' +
64     'From DEPARTMENT D'+ CR +
65     'JOIN Depts On D.HEAD_DEPT = Depts.DEPT_NO',
66    
67     'Select DEPT_NO, DEPARTMENT, "HEAD_DEPT", cast(DEPARTMENT as VarChar(256)) as DEPT_PATH /* test */,' +
68     'cast(DEPT_NO as VarChar(64)) as DEPT_KEY_PATH ' + LF +
69     'From DEPARTMENT Where HEAD_DEPT is NULL ' + LF +
70     'UNION ALL' + CRLF +
71     'Select D.DEPT_NO, D.DEPARTMENT, D.HEAD_DEPT, Depts.DEPT_PATH || '' / '' || D.DEPARTMENT as DEPT_PATH,' +
72     'Depts.DEPT_KEY_PATH || '';'' || D.DEPT_NO as DEPT_KEY_PATH ' +
73     'From DEPARTMENT D'+ CR +
74     'JOIN Depts On D.HEAD_DEPT = Depts.DEPT_NO '+
75     'Order by 1,2',
76    
77     'with test1 as (Select * from Employee), test2 as (Select Emp_no, ''A test'' from Employee) '+
78     'Select * from test1',
79    
80     'with recursive Account_Types_List As('#10+
81     'Select ACCOUNTTYPE_ID, PARENT, ACCOUNTTYPENAME,'#10+
82     ' ACCOUNTTYPENAME as SortName, '''' as INDENT'#10+
83     'From MYLB_ACCOUNTTYPES'#10+
84     'Where PARENT is Null'#10+
85     'UNION ALL'#10+
86     'Select A.ACCOUNTTYPE_ID, A.PARENT, A.ACCOUNTTYPENAME,'#10+
87     'L.SortName || A.ACCOUNTTYPENAME as SortName, L.INDENT || '' '' as INDENT'#10+
88     'From MYLB_ACCOUNTTYPES A'#10+
89     'Join Account_Types_List L On A.PARENT = L.ACCOUNTTYPE_ID)'#10+
90     #10+
91     'Select ACCOUNTTYPE_ID, PARENT, INDENT || ACCOUNTTYPENAME as Name'#10+
92     'From Account_Types_List'#10+
93     #10+
94     'Order by SortName',
95    
96     'SELECT r.RDB$DB_KEY, cast(''Local'' as VarChar(6)) as MAPTYPE, r.RDB$MAP_NAME,'#10+
97     ' Case'#10+
98     ' When r.RDB$MAP_USING = ''P'' and r.RDB$MAP_PLUGIN is not null then cast (''Plugin '' || r.RDB$MAP_PLUGIN as VarChar(20))'#10+
99     ' When r.RDB$MAP_USING = ''P'' and r.RDB$MAP_PLUGIN is null then ''Any Plugin'''#10+
100     ' When r.RDB$MAP_USING = ''S'' then ''Any Plugin Serverwide'''#10+
101     ' When r.RDB$MAP_USING = ''M'' then ''Mapping'''#10+
102     ' When r.RDB$MAP_USING = ''*'' then ''*'''#10+
103     ' else'#10+
104     ' ''Using '' || r.RDB$MAP_USING || '','' || coalesce(r.RDB$MAP_PLUGIN,'''') End as MAP_USING,'#10+
105     ' r.RDB$MAP_USING, r.RDB$MAP_PLUGIN,'#10+
106     ' r.RDB$MAP_DB, r.RDB$MAP_FROM_TYPE, r.RDB$MAP_FROM,'#10+
107     ' Trim(r.RDB$MAP_FROM_TYPE) || '': '' || Trim(r.RDB$MAP_FROM) as MAP_FROM,'#10+
108     ' r.RDB$MAP_TO_TYPE,'#10+
109     ' T.RDB$TYPE_NAME as MAP_TO_TYPE, r.RDB$MAP_TO,'#10+
110     ' Trim(T.RDB$TYPE_NAME) || '': '' || Trim(r.RDB$MAP_TO) as MAP_TO,'#10+
111     ' r.RDB$SYSTEM_FLAG, r.RDB$DESCRIPTION'#10+
112     'FROM RDB$AUTH_MAPPING r'#10+
113     'JOIN RDB$TYPES T On T.RDB$TYPE = r.RDB$MAP_TO_TYPE and T.RDB$FIELD_NAME = ''RDB$MAP_TO_TYPE'''#10+
114     'UNION'#10+
115     'SELECT r.RDB$DB_KEY, ''Global'', r.SEC$MAP_NAME,'#10+
116     ' Case'#10+
117     ' When r.SEC$MAP_USING = ''P'' and r.SEC$MAP_PLUGIN is not null then cast (''Plugin '' || r.SEC$MAP_PLUGIN as VarChar(20))'#10+
118     ' When r.SEC$MAP_USING = ''P'' and r.SEC$MAP_PLUGIN is null then ''Any Plugin'''#10+
119     ' When r.SEC$MAP_USING = ''S'' then ''Any Plugin Serverwide'''#10+
120     ' When r.SEC$MAP_USING = ''M'' then ''Mapping'''#10+
121     ' When r.SEC$MAP_USING = ''*'' then ''*'''#10+
122     ' else'#10+
123     ' ''Using '' || r.SEC$MAP_USING || '','' || coalesce(r.SEC$MAP_PLUGIN,'''') End as MAP_USING,'#10+
124     ' r.SEC$MAP_USING, r.SEC$MAP_PLUGIN,'#10+
125     ' r.SEC$MAP_DB, r.SEC$MAP_FROM_TYPE, r.SEC$MAP_FROM,'#10+
126     ' Trim(r.SEC$MAP_FROM_TYPE) || '': '' || Trim(r.SEC$MAP_FROM) as MAP_FROM,'#10+
127     ' r.SEC$MAP_TO_TYPE,'#10+
128     ' T.RDB$TYPE_NAME as MAP_TO_TYPE,r.SEC$MAP_TO,'#10+
129     ' Trim(T.RDB$TYPE_NAME) || '': '' || Trim(r.SEC$MAP_TO) as MAP_TO,'#10+
130     ' null,null'#10+
131     'FROM SEC$GLOBAL_AUTH_MAPPING r'#10+
132     'JOIN RDB$TYPES T On T.RDB$TYPE = r.SEC$MAP_TO_TYPE and T.RDB$FIELD_NAME = ''RDB$MAP_TO_TYPE''',
133    
134     'Select * From A '+
135     'Group By a1,b1 '+
136     'Union '+
137     'Select * From B Rows 3 to 4',
138    
139     'Select * From A '+
140     'Union '+
141     'Select * From B Order by 1 Rows 3 to 4',
142    
143     'Select * From A '+
144     'Union '+
145     'Select * From B '+
146     'Union '+
147     'Select * FROM C Order by 1',
148    
149     '') ;
150     type
151    
152     { TTest24 }
153    
154     TTest24 = class(TIBXTestBase)
155     private
156     procedure WriteSelect(parser: TSelectSQLParser);
157     protected
158     function GetTestID: AnsiString; override;
159     function GetTestTitle: AnsiString; override;
160     public
161     procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
162     end;
163    
164    
165     implementation
166    
167     { TTest24 }
168    
169     procedure TTest24.WriteSelect(parser: TSelectSQLParser);
170     var j: integer;
171     begin
172     with parser do
173     begin
174     for j := 0 to CTECount -1 do
175     begin
176     write(OutFile,'CTE',j);
177     if CTES[j]^.Recursive then write(OutFile,' recursive');
178     writeln(OutFile,': ',CTES[j]^.Name,' as ',CTEs[j]^.text);
179     end;
180     writeln(OutFile,'Select: ' ,SelectClause);
181     writeln(OutFile,'From: ',FromClause);
182     writeln(OutFile,'Where: ',WhereClause);
183     writeln(OutFile,'Group By: ',GroupClause);
184     writeln(OutFile,'Having: ',HavingClause);
185     if Union <> nil then
186     begin
187     write(OutFile,'Union');
188     if Union.UnionAll then write(OutFile,' All');
189     writeln(OutFile);
190     WriteSelect(Union);
191     end;
192     writeln(OutFile,'Order by: ',OrderByClause);
193     writeln(OutFile,'Plan: ',PlanClause);
194     writeln(OutFile,'Rows: ',RowsClause);
195     writeln(OutFile,'SQL: ',SQLText);
196     writeln(OutFile,'Params: ');
197     for j := 0 to ParamList.Count - 1 do
198     write(OutFile,ParamList[j],',');
199     writeln(OutFile);
200     writeln(OutFile);
201     end;
202     end;
203    
204     function TTest24.GetTestID: AnsiString;
205     begin
206     Result := aTestID;
207     end;
208    
209     function TTest24.GetTestTitle: AnsiString;
210     begin
211     Result := aTestTitle;
212     end;
213    
214     procedure TTest24.RunTest(CharSet: AnsiString; SQLDialect: integer);
215     var i: integer;
216     parser: TSelectSQLParser;
217     begin
218     for i := 0 to Length(TestStrings) -1 do
219     begin
220     parser := TSelectSQLParser.Create(nil,TestStrings[i]);
221     try
222     with parser do
223     begin
224     writeln(OutFile,'Test String ',i);
225     writeln(OutFile,'---------------------------------------------------');
226     writeln(OutFile,TestStrings[i]);
227     writeln(OutFile,'---------------------------------------------------');
228     writeln(OutFile);
229     if NotaSelectStmt then
230     begin
231     writeln(OutFile,'Not a Select Statement');
232     continue;
233     end;
234     WriteSelect(parser);
235     if i = 4 then
236     Add2WhereClause('JOB_CODE = 2');
237     if i = 5 then
238     OrderByClause := '1';
239     writeln(Outfile,'Updated SQL');
240     writeln(OutFile,SQLText);
241     end;
242     finally
243     parser.Free
244     end;
245     end;
246     end;
247    
248     initialization
249     RegisterTest(TTest24);
250    
251     end.
252