ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/parsertest/parsertest.lpr
Revision: 263
Committed: Thu Dec 6 15:55:01 2018 UTC (5 years, 3 months ago) by tony
File size: 6026 byte(s)
Log Message:
Release 2.3.2 committed

File Contents

# Content
1 program parsertest;
2
3 {$mode objfpc}{$H+}
4
5 uses
6 {$IFDEF UNIX}{$IFDEF UseCThreads}
7 cthreads,
8 {$ENDIF}{$ENDIF}
9 Classes, SysUtils, CustApp, IBUtils
10 { you can add units after this };
11
12 const
13 TestStrings: array [0..4] of string = (
14 'with recursive Depts As (' +
15 'Select DEPT_NO, DEPARTMENT, "HEAD_DEPT", cast(DEPARTMENT as VarChar(256)) as DEPT_PATH /* test */,' +
16 'cast(DEPT_NO as VarChar(64)) as DEPT_KEY_PATH ' + LF +
17 'From DEPARTMENT Where HEAD_DEPT is NULL ' + LF +
18 'UNION ALL' + CRLF +
19 'Select D.DEPT_NO, D.DEPARTMENT, D.HEAD_DEPT, Depts.DEPT_PATH || '' / '' || D.DEPARTMENT as DEPT_PATH,' +
20 'Depts.DEPT_KEY_PATH || '';'' || D.DEPT_NO as DEPT_KEY_PATH ' +
21 'From DEPARTMENT D'+ CR +
22 'JOIN Depts On D.HEAD_DEPT = Depts.DEPT_NO' + LF +
23 ')' +
24 '//ignore' + LF +
25 '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 ' +
26 'A.JOB_GRADE, A.JOB_COUNTRY, A.SALARY, A.FULL_NAME, D.DEPT_PATH, D.DEPT_KEY_PATH' + LF +
27 'From EMPLOYEE A' + LF +
28 'JOIN Depts D On D.DEPT_NO = A.DEPT_NO',
29 'Update EMPLOYEE A Set '#13#10' A.DEPT_NO = :DEPT_NO,'#13#10 +
30 ' A.FIRST_NAME = ''Mr'' || :FIRST_NAME,'#13#10+
31 ' A.HIRE_DATE = :HIRE_DATE,'#13#10+
32 ' A.JOB_CODE = :JOB_CODE,'#13#10' A.JOB_COUNTRY = :JOB_COUNTRY,'#13#10+
33 ' A.JOB_GRADE = :JOB_GRADE,'#13#10' A.LAST_NAME = :LAST_NAME,'#13#10+
34 ' A.PHONE_EXT = :PHONE_EXT,'#13#10' A.SALARY = :SALARY ' +
35 'Where A.EMP_NO = :OLD_EMP_NO;',
36
37 'INSERT INTO EMPLOYEE (EMP_NO, FIRST_NAME, LAST_NAME, PHONE_EXT, HIRE_DATE,' +
38 'DEPT_NO, JOB_CODE, JOB_GRADE, JOB_COUNTRY, SALARY /* what''s this */) '+
39 'VALUES (:EMP_NO, :FIRST_NAME, :LAST_NAME, :PHONE_EXT, :HIRE_DATE, //end comment' + CRLF +
40 ':DEPT_NO, :"JOB""CODE", ''Tester''''s way'''''''''', :JOB_COUNTRY, :"$SALARY")',
41 'Select * from EMPLOYEE Where EMP_NO = :EMP_NO',
42 '') ;
43
44 type
45
46 { SQLParserTest }
47
48 SQLParserTest = class(TCustomApplication)
49 private
50 procedure WriteToken(token: TSQLTokens; text: string);
51 procedure AnalyseSQL(S: string);
52 procedure AnalyseAll;
53 protected
54 procedure DoRun; override;
55 public
56 constructor Create(TheOwner: TComponent); override;
57 destructor Destroy; override;
58 procedure WriteHelp; virtual;
59 end;
60
61 { TSQLStringTokeniser }
62
63 TSQLStringTokeniser = class(TSQLwithNamedParamsTokeniser)
64 // TSQLStringTokeniser = class(TSQLTokeniser)
65 private
66 FInString: string;
67 FIndex: integer;
68 protected
69 function GetChar: char; override;
70 public
71 constructor Create(S: string);
72 end;
73
74 { TSQLStringTokeniser }
75
76 function TSQLStringTokeniser.GetChar: char;
77 begin
78 if FIndex <= Length(FInString) then
79 begin
80 Result := FInString[FIndex];
81 Inc(FIndex);
82 end
83 else
84 Result := #0;
85 end;
86
87 constructor TSQLStringTokeniser.Create(S: string);
88 begin
89 inherited Create;
90 FInString := S;
91 FIndex := 1;
92 end;
93
94 { SQLParserTest }
95
96 procedure SQLParserTest.WriteToken(token: TSQLTokens; text: string);
97 begin
98 case token of
99 sqltSpace:
100 write('sqltSpace ');
101 sqltSemiColon:
102 write('sqltSemiColon ');
103 sqltPlaceholder:
104 write('sqltPlaceholder ');
105 sqltPipe:
106 write('sqltPipe ');
107 sqltSingleQuotes:
108 write('sqltSingleQuotes ');
109 sqltDoubleQuotes:
110 write('sqltDoubleQuotes ');
111 sqltComma:
112 write('sqltComma ');
113 sqltEquals:
114 write('sqltEquals ');
115 sqltPeriod:
116 write('sqltPeriod ');
117 sqltIdentifier:
118 write('sqltIdentifier ');
119 sqltIdentifierInDoubleQuotes:
120 write('sqltIdentifierInDoubleQuotes ');
121 sqltNumberString:
122 write('sqltNumberString ');
123 sqltBadIdentifier:
124 write('sqltBadIdentifier ');
125 sqltString:
126 write('sqltString ');
127 sqltParam:
128 write('sqlParam ');
129 sqltQuotedParam:
130 write('sqltQuotedParam ');
131 sqltColon:
132 write('sqltColon ');
133 sqltComment:
134 write('sqltComment ');
135 sqltCommentLine:
136 write('sqltCommentLine ');
137 sqltQuotedString:
138 write('sqltQuotedString ');
139 sqltAsterisk:
140 write('sqltAsterisk ');
141 sqltForwardSlash:
142 write('sqltForwardSlash ');
143 sqltOpenSquareBracket:
144 write('sqltOpenSquareBracket ');
145 sqltCloseSquareBracket:
146 write('sqltCloseSquareBracket ');
147 sqltOpenBracket:
148 write('sqltOpenBracket ');
149 sqltCloseBracket:
150 write('sqltCloseBracket ');
151 sqltCR:
152 write('sqltCR ');
153 sqltEOL:
154 write('sqltEOL ');
155 sqltEOF:
156 write('sqltEOF ');
157 end;
158 writeln('"',text,'" ');
159 end;
160
161 procedure SQLParserTest.AnalyseSQL(S: string);
162 var SQLTokeniser: TSQLTokeniser;
163 begin
164 SQLTokeniser := TSQLStringTokeniser.Create(S);
165 try
166 writeln('Analysing:');
167 writeln(S);
168 writeln;
169 while not SQLTokeniser.EOF do
170 WriteToken(SQLTokeniser.GetNextToken,SQLTokeniser.TokenText);
171 finally
172 SQLTokeniser.Free;
173 end;
174 end;
175
176 procedure SQLParserTest.AnalyseAll;
177 var i: integer;
178 begin
179 for i := 0 to length(TestStrings) -1 do
180 AnalyseSQL(TestStrings[i]);
181 end;
182
183 procedure SQLParserTest.DoRun;
184 var
185 ErrorMsg: String;
186 begin
187 // quick check parameters
188 ErrorMsg := CheckOptions('h', 'help');
189 if ErrorMsg <> '' then begin
190 ShowException(Exception.Create(ErrorMsg));
191 Terminate;
192 Exit;
193 end;
194
195 // parse parameters
196 if HasOption('h', 'help') then begin
197 WriteHelp;
198 Terminate;
199 Exit;
200 end;
201
202 { add your program here }
203 AnalyseAll;
204 Flush(output);
205 readln;
206
207 // stop program loop
208 Terminate;
209 end;
210
211 constructor SQLParserTest.Create(TheOwner: TComponent);
212 begin
213 inherited Create(TheOwner);
214 StopOnException := True;
215 end;
216
217 destructor SQLParserTest.Destroy;
218 begin
219 inherited Destroy;
220 end;
221
222 procedure SQLParserTest.WriteHelp;
223 begin
224 { add your help code here }
225 writeln('Usage: ', ExeName, ' -h');
226 end;
227
228 var
229 Application: SQLParserTest;
230 begin
231 Application := SQLParserTest.Create(nil);
232 Application.Title := 'SQL Parser Test';
233 Application.Run;
234 Application.Free;
235 end.
236