fbintf/parsertest/parsertest.lpr

program parsertest;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes, SysUtils, CustApp, IBUtils
  { you can add units after this };

const
  TestStrings: array [0..4] of string = (
  'with recursive Depts As (' +
        'Select DEPT_NO, DEPARTMENT, "HEAD_DEPT", cast(DEPARTMENT  as VarChar(256)) as DEPT_PATH /* test */,' +
        'cast(DEPT_NO as VarChar(64)) as DEPT_KEY_PATH ' + LF +
        'From DEPARTMENT Where HEAD_DEPT is NULL ' + LF +
        'UNION ALL' + CRLF +
        'Select D.DEPT_NO, D.DEPARTMENT, D.HEAD_DEPT, Depts.DEPT_PATH ||  '' / '' || D.DEPARTMENT as DEPT_PATH,' +
        'Depts.DEPT_KEY_PATH || '';'' || D.DEPT_NO as DEPT_KEY_PATH ' +
        'From DEPARTMENT  D'+ CR +
        'JOIN Depts On D.HEAD_DEPT = Depts.DEPT_NO' + LF +
        ')' +
        '//ignore' + LF +
        '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 '  +
        'A.JOB_GRADE, A.JOB_COUNTRY, A.SALARY, A.FULL_NAME, D.DEPT_PATH, D.DEPT_KEY_PATH' + LF +
        'From EMPLOYEE A' +  LF +
        'JOIN Depts D On D.DEPT_NO = A.DEPT_NO',
        'Update EMPLOYEE A Set '#13#10'  A.DEPT_NO = :DEPT_NO,'#13#10 +
        '  A.FIRST_NAME = ''Mr'' || :FIRST_NAME,'#13#10+
        '  A.HIRE_DATE = :HIRE_DATE,'#13#10+
        '  A.JOB_CODE = :JOB_CODE,'#13#10'  A.JOB_COUNTRY = :JOB_COUNTRY,'#13#10+
        '  A.JOB_GRADE = :JOB_GRADE,'#13#10'  A.LAST_NAME = :LAST_NAME,'#13#10+
        '  A.PHONE_EXT = :PHONE_EXT,'#13#10'  A.SALARY = :SALARY ' +
        'Where A.EMP_NO = :OLD_EMP_NO;',

        'INSERT INTO EMPLOYEE (EMP_NO, FIRST_NAME, LAST_NAME, PHONE_EXT, HIRE_DATE,' +
        'DEPT_NO, JOB_CODE, JOB_GRADE, JOB_COUNTRY, SALARY /* what''s this */) '+
        'VALUES (:EMP_NO, :FIRST_NAME, :LAST_NAME, :PHONE_EXT, :HIRE_DATE, //end comment' + CRLF +
        ':DEPT_NO, :"JOB""CODE", ''Tester''''s way'''''''''', :JOB_COUNTRY, :"$SALARY")',
        'Select * from EMPLOYEE Where EMP_NO = :EMP_NO',
        '')  ;

type

  { SQLParserTest }

  SQLParserTest = class(TCustomApplication)
  private
    procedure WriteToken(token: TSQLTokens; text: string);
    procedure AnalyseSQL(S: string);
    procedure AnalyseAll;
  protected
    procedure DoRun; override;
  public
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
    procedure WriteHelp; virtual;
  end;

  { TSQLStringTokeniser }

  TSQLStringTokeniser = class(TSQLwithNamedParamsTokeniser)
//  TSQLStringTokeniser = class(TSQLTokeniser)
  private
    FInString: string;
    FIndex: integer;
  protected
    function GetChar: char; override;
  public
    constructor Create(S: string);
  end;

  { TSQLStringTokeniser }

  function TSQLStringTokeniser.GetChar: char;
  begin
    if FIndex <= Length(FInString) then
    begin
      Result := FInString[FIndex];
      Inc(FIndex);
    end
    else
      Result := #0;
  end;

  constructor TSQLStringTokeniser.Create(S: string);
  begin
    inherited Create;
    FInString := S;
    FIndex := 1;
  end;

{ SQLParserTest }

procedure SQLParserTest.WriteToken(token: TSQLTokens; text: string);
begin
  case token of
  sqltSpace:
     write('sqltSpace ');
  sqltSemiColon:
     write('sqltSemiColon ');
  sqltPlaceholder:
     write('sqltPlaceholder ');
  sqltPipe:
     write('sqltPipe ');
  sqltSingleQuotes:
     write('sqltSingleQuotes ');
  sqltDoubleQuotes:
     write('sqltDoubleQuotes ');
  sqltComma:
     write('sqltComma ');
  sqltEquals:
     write('sqltEquals ');
  sqltPeriod:
    write('sqltPeriod ');
  sqltIdentifier:
     write('sqltIdentifier ');
  sqltIdentifierInDoubleQuotes:
     write('sqltIdentifierInDoubleQuotes ');
  sqltNumberString:
     write('sqltNumberString ');
  sqltBadIdentifier:
     write('sqltBadIdentifier ');
  sqltString:
     write('sqltString ');
  sqltParam:
     write('sqlParam ');
  sqltQuotedParam:
    write('sqltQuotedParam ');
  sqltColon:
     write('sqltColon ');
  sqltComment:
     write('sqltComment ');
  sqltCommentLine:
     write('sqltCommentLine ');
  sqltQuotedString:
     write('sqltQuotedString ');
  sqltAsterisk:
     write('sqltAsterisk ');
  sqltForwardSlash:
     write('sqltForwardSlash ');
  sqltOpenSquareBracket:
     write('sqltOpenSquareBracket ');
  sqltCloseSquareBracket:
     write('sqltCloseSquareBracket ');
  sqltOpenBracket:
     write('sqltOpenBracket ');
  sqltCloseBracket:
     write('sqltCloseBracket ');
  sqltCR:
     write('sqltCR ');
  sqltEOL:
     write('sqltEOL ');
  sqltEOF:
    write('sqltEOF ');
  end;
  writeln('"',text,'" ');
end;

procedure SQLParserTest.AnalyseSQL(S: string);
var SQLTokeniser: TSQLTokeniser;
begin
  SQLTokeniser := TSQLStringTokeniser.Create(S);
  try
    writeln('Analysing:');
    writeln(S);
    writeln;
    while not SQLTokeniser.EOF do
      WriteToken(SQLTokeniser.GetNextToken,SQLTokeniser.TokenText);
  finally
    SQLTokeniser.Free;
  end;
end;

procedure SQLParserTest.AnalyseAll;
var i: integer;
begin
  for i := 0 to length(TestStrings) -1 do
    AnalyseSQL(TestStrings[i]);
end;

procedure SQLParserTest.DoRun;
var
  ErrorMsg: String;
begin
  // quick check parameters
  ErrorMsg := CheckOptions('h', 'help');
  if ErrorMsg <> '' then begin
    ShowException(Exception.Create(ErrorMsg));
    Terminate;
    Exit;
  end;

  // parse parameters
  if HasOption('h', 'help') then begin
    WriteHelp;
    Terminate;
    Exit;
  end;

  { add your program here }
  AnalyseAll;
  Flush(output);
  readln;

  // stop program loop
  Terminate;
end;

constructor SQLParserTest.Create(TheOwner: TComponent);
begin
  inherited Create(TheOwner);
  StopOnException := True;
end;

destructor SQLParserTest.Destroy;
begin
  inherited Destroy;
end;

procedure SQLParserTest.WriteHelp;
begin
  { add your help code here }
  writeln('Usage: ', ExeName, ' -h');
end;

var
  Application: SQLParserTest;
begin
  Application := SQLParserTest.Create(nil);
  Application.Title := 'SQL Parser Test';
  Application.Run;
  Application.Free;
end.

Revision:	263
Committed:	Thu Dec 6 15:55:01 2018 UTC (5 years, 4 months ago) by tony
File size:	6026 byte(s)
Log Message:	Release 2.3.2 committed
#	User	Rev	Content
1	tony	263	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