├── src ├── version.inc ├── objectpascalparser.inc ├── states │ ├── opp.states.stacktokens.pas │ ├── opp.states.pas │ └── opp.states.stack.pas ├── parser │ └── opp.parser.pas ├── tokenizing │ ├── opp.tokenizing.tokens.pas │ └── opp.tokenizing.tokenizer.pas └── text │ ├── opp.text.pas │ └── opp.text.sourcefile.pas ├── testfiles ├── program.ansi.pas ├── program.utf8.pas ├── program.bom.utf8.pas ├── program.utf16be.pas ├── program.utf16le.pas ├── program.utf32be.pas ├── program.utf32le.pas ├── program.bom.utf16be.pas ├── program.bom.utf16le.pas ├── program.bom.utf32be.pas └── program.bom.utf32le.pas ├── example ├── ObjectPascalParserExample.ico ├── ObjectPascalParserExample.lpr ├── forms │ ├── form.main.pas │ └── form.main.lfm └── ObjectPascalParserExample.lpi ├── tests ├── tests │ └── opp.tests.pas ├── TestObjectPascalParserCLI.lpr ├── tokenizing │ ├── testobjectpascalparsertokenizingtokenizer.pas │ └── testobjectpascalparsertokenizingtokenizereof.pas ├── parser │ └── testobjectpascalparser.pas ├── states │ ├── testobjectpascalparserstatesstacktokens.pas │ └── testobjectpascalparserstatesstack.pas ├── TestObjectPascalParserCLI.lpi └── text │ └── testobjectpascalparsertextsourcefile.pas ├── LICENSE ├── CHANGELOG.md ├── README.md ├── .github └── workflows │ └── main.lazarus.yml └── cliff.toml /src/version.inc: -------------------------------------------------------------------------------- 1 | '0.1' 2 | -------------------------------------------------------------------------------- /src/objectpascalparser.inc: -------------------------------------------------------------------------------- 1 | {$IFDEF FPC} 2 | {$mode objfpc}{$H+} 3 | {$ENDIF} 4 | -------------------------------------------------------------------------------- /testfiles/program.ansi.pas: -------------------------------------------------------------------------------- 1 | program Test; 2 | 3 | begin 4 | WriteLn('Hello World!'); 5 | end. 6 | -------------------------------------------------------------------------------- /testfiles/program.utf8.pas: -------------------------------------------------------------------------------- 1 | program Test🌟; 2 | 3 | begin 4 | WriteLn('Hello World!'); 5 | end. 6 | -------------------------------------------------------------------------------- /testfiles/program.bom.utf8.pas: -------------------------------------------------------------------------------- 1 | program Test🌟; 2 | 3 | begin 4 | WriteLn('Hello World!'); 5 | end. 6 | -------------------------------------------------------------------------------- /testfiles/program.utf16be.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gcarreno/ObjectPascalParser/HEAD/testfiles/program.utf16be.pas -------------------------------------------------------------------------------- /testfiles/program.utf16le.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gcarreno/ObjectPascalParser/HEAD/testfiles/program.utf16le.pas -------------------------------------------------------------------------------- /testfiles/program.utf32be.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gcarreno/ObjectPascalParser/HEAD/testfiles/program.utf32be.pas -------------------------------------------------------------------------------- /testfiles/program.utf32le.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gcarreno/ObjectPascalParser/HEAD/testfiles/program.utf32le.pas -------------------------------------------------------------------------------- /testfiles/program.bom.utf16be.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gcarreno/ObjectPascalParser/HEAD/testfiles/program.bom.utf16be.pas -------------------------------------------------------------------------------- /testfiles/program.bom.utf16le.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gcarreno/ObjectPascalParser/HEAD/testfiles/program.bom.utf16le.pas -------------------------------------------------------------------------------- /testfiles/program.bom.utf32be.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gcarreno/ObjectPascalParser/HEAD/testfiles/program.bom.utf32be.pas -------------------------------------------------------------------------------- /testfiles/program.bom.utf32le.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gcarreno/ObjectPascalParser/HEAD/testfiles/program.bom.utf32le.pas -------------------------------------------------------------------------------- /example/ObjectPascalParserExample.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gcarreno/ObjectPascalParser/HEAD/example/ObjectPascalParserExample.ico -------------------------------------------------------------------------------- /example/ObjectPascalParserExample.lpr: -------------------------------------------------------------------------------- 1 | program ObjectPascalParserExample; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | uses 6 | {$IFDEF UNIX} 7 | cthreads, 8 | {$ENDIF} 9 | {$IFDEF HASAMIGA} 10 | athreads, 11 | {$ENDIF} 12 | Interfaces, // this includes the LCL widgetset 13 | Forms, Form.Main 14 | { you can add units after this }; 15 | 16 | {$R *.res} 17 | 18 | begin 19 | RequireDerivedFormResource:=True; 20 | Application.Scaled:=True; 21 | Application.Initialize; 22 | Application.CreateForm(TfrmMain, frmMain); 23 | Application.Run; 24 | end. 25 | 26 | -------------------------------------------------------------------------------- /tests/tests/opp.tests.pas: -------------------------------------------------------------------------------- 1 | unit OPP.Tests; 2 | 3 | {$I objectpascalparser.inc} 4 | 5 | interface 6 | 7 | uses 8 | Classes 9 | , SysUtils 10 | ; 11 | 12 | function DumpToTempFile(const AContent: String): String; 13 | 14 | 15 | implementation 16 | 17 | function DumpToTempFile(const AContent: String): String; 18 | var 19 | tmpFilename: String; 20 | stringStream: TstringStream; 21 | begin 22 | Result:= EmptyStr; 23 | stringStream:= TStringStream.Create(aContent); 24 | try 25 | tmpFilename:= GetTempFileName; 26 | stringStream.SaveToFile(tmpFilename); 27 | finally 28 | stringStream.Free; 29 | end; 30 | Result:= tmpFilename; 31 | end; 32 | 33 | end. 34 | 35 | -------------------------------------------------------------------------------- /src/states/opp.states.stacktokens.pas: -------------------------------------------------------------------------------- 1 | unit OPP.States.StackTokens; 2 | 3 | {$I objectpascalparser.inc} 4 | 5 | interface 6 | 7 | uses 8 | Classes 9 | , SysUtils 10 | , OPP.States 11 | , OPP.States.Stack 12 | ; 13 | 14 | type 15 | { TStatesStackTokens } 16 | TStatesStackTokens = class(TStatesStack) 17 | private 18 | protected 19 | public 20 | procedure Push(const AState: TTokenState); 21 | function Pop: TTokenState; 22 | function Peek: TTokenState; 23 | published 24 | end; 25 | 26 | implementation 27 | 28 | { TStatesStackTokens } 29 | 30 | procedure TStatesStackTokens.Push(const AState: TTokenState); 31 | begin 32 | inherited Push(Ord(AState)); 33 | end; 34 | 35 | function TStatesStackTokens.Pop: TTokenState; 36 | begin 37 | Result:= TTokenState(inherited Pop); 38 | end; 39 | 40 | function TStatesStackTokens.Peek: TTokenState; 41 | begin 42 | Result:= TTokenState(inherited Peek); 43 | end; 44 | 45 | end. 46 | 47 | -------------------------------------------------------------------------------- /src/parser/opp.parser.pas: -------------------------------------------------------------------------------- 1 | unit OPP.Parser; 2 | 3 | {$I objectpascalparser.inc} 4 | 5 | interface 6 | 7 | uses 8 | Classes 9 | , SysUtils 10 | , OPP.Text.SourceFile 11 | , OPP.Tokenizing.Tokenizer 12 | ; 13 | 14 | type 15 | { TOPPParser } 16 | TOPPParser = class(TObject) 17 | private 18 | FSourceFile: TTextSourceFile; 19 | FTokenizer: TTokenizingTokenizer; 20 | protected 21 | public 22 | constructor Create(const AFilename: String); 23 | destructor Destroy; override; 24 | 25 | procedure Parse; 26 | published 27 | end; 28 | 29 | implementation 30 | 31 | { TOPPParser } 32 | 33 | constructor TOPPParser.Create(const AFilename: String); 34 | begin 35 | FSourceFile:= TTextSourceFile.Create(AFilename); 36 | FTokenizer:= TTokenizingTokenizer.Create(FSourceFile); 37 | end; 38 | 39 | destructor TOPPParser.Destroy; 40 | begin 41 | FTokenizer.Free; 42 | FSourceFile.Free; 43 | inherited Destroy; 44 | end; 45 | 46 | procedure TOPPParser.Parse; 47 | begin 48 | { #todo 999 -ogcarreno : Kick start all the parsing } 49 | end; 50 | 51 | end. 52 | 53 | -------------------------------------------------------------------------------- /tests/TestObjectPascalParserCLI.lpr: -------------------------------------------------------------------------------- 1 | program TestObjectPascalParserCLI; 2 | 3 | {$I objectpascalparser.inc} 4 | 5 | {$IFNDEF FPC} 6 | {$apptype console} 7 | {$ENDIF} 8 | 9 | uses 10 | Classes 11 | , consoletestrunner 12 | , TestObjectPascalParserTextSourceFile 13 | , TestObjectPascalParserStatesStack 14 | , TestObjectPascalParserStatesStackTokens 15 | , TestObjectPascalParserTokenizingTokenizer 16 | , TestObjectPascalParserTokenizingTokenizerEOF 17 | , TestObjectPascalParser 18 | ; 19 | 20 | type 21 | 22 | { TTestObjectPascalParserRunner } 23 | TTestObjectPascalParserRunner = class(TTestRunner) 24 | protected 25 | // override the protected methods of TTestRunner to customize its behavior 26 | end; 27 | 28 | var 29 | Application: TTestObjectPascalParserRunner; 30 | 31 | begin 32 | 33 | DefaultRunAllTests:=True; 34 | DefaultFormat:=fPlain; 35 | Application := TTestObjectPascalParserRunner.Create(nil); 36 | Application.Initialize; 37 | Application.Title := 'Object Pascal Parser Console test runner'; 38 | Application.Run; 39 | Application.Free; 40 | end. 41 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright © 2024 Gustavo 'Gus' Carreno 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /src/states/opp.states.pas: -------------------------------------------------------------------------------- 1 | unit OPP.States; 2 | 3 | {$I objectpascalparser.inc} 4 | 5 | interface 6 | 7 | uses 8 | Classes 9 | , SysUtils 10 | ; 11 | 12 | type 13 | { EStatesStackEmpty } 14 | EStatesStackEmpty = class(Exception); 15 | 16 | { TTokenState } 17 | TTokenState = ( 18 | tsUndefined 19 | , tsWhiteSpace 20 | , tsMaybeCRLF 21 | ); 22 | 23 | resourcestring 24 | rsTokenStateInvalid = 'Token State Invalid'; 25 | rsTokenStateUndefined = 'Token State Undefined'; 26 | rsTokenStateWhiteSpace = 'Token State White Space'; 27 | rsTokenStateMaybeCRLF = 'Token State Maybe CRLF'; 28 | 29 | function TokenStateToString(const ATokenState:TTokenState): String; 30 | 31 | type 32 | { TLexerState } 33 | TLexerState = (tlUndefined); 34 | 35 | implementation 36 | 37 | function TokenStateToString(const ATokenState: TTokenState): String; 38 | begin 39 | Result:= EmptyStr; 40 | case ATokenState of 41 | tsUndefined: Result := rsTokenStateUndefined; 42 | tsWhiteSpace: Result:= rsTokenStateWhiteSpace; 43 | tsMaybeCRLF: Result := rsTokenStateMaybeCRLF; 44 | otherwise 45 | Result:= rsTokenStateInvalid; 46 | end; 47 | end; 48 | 49 | end. 50 | 51 | -------------------------------------------------------------------------------- /tests/tokenizing/testobjectpascalparsertokenizingtokenizer.pas: -------------------------------------------------------------------------------- 1 | unit TestObjectPascalParserTokenizingTokenizer; 2 | 3 | {$I objectpascalparser.inc} 4 | 5 | interface 6 | 7 | uses 8 | Classes 9 | , SysUtils 10 | , fpcunit 11 | //, testutils 12 | , testregistry 13 | , OPP.Text.SourceFile 14 | //, OPP.States 15 | //, OPP.Tokenizing.Tokens 16 | , OPP.Tokenizing.Tokenizer 17 | ; 18 | 19 | type 20 | 21 | TTestObjectPascalParserTokenizingTokenizer= class(TTestCase) 22 | private 23 | FTokenisingTokenizer: TTokenizingTokenizer; 24 | FSourceFile: TTextSourceFile; 25 | published 26 | procedure TestTokeninzingTokenizerCreate; 27 | end; 28 | 29 | implementation 30 | 31 | uses 32 | OPP.Tests 33 | ; 34 | 35 | procedure TTestObjectPascalParserTokenizingTokenizer.TestTokeninzingTokenizerCreate; 36 | begin 37 | FSourceFile:= TTextSourceFile.Create(DumpToTempFile(EmptyStr)); 38 | FTokenisingTokenizer:= TTokenizingTokenizer.Create(FSourceFile); 39 | try 40 | AssertNotNull('Tokenizing Tokenizer not null', FTokenisingTokenizer); 41 | finally 42 | FTokenisingTokenizer.Free; 43 | FSourceFile.Free; 44 | end; 45 | end; 46 | 47 | initialization 48 | 49 | RegisterTest(TTestObjectPascalParserTokenizingTokenizer); 50 | end. 51 | 52 | -------------------------------------------------------------------------------- /tests/parser/testobjectpascalparser.pas: -------------------------------------------------------------------------------- 1 | unit TestObjectPascalParser; 2 | 3 | {$I objectpascalparser.inc} 4 | 5 | interface 6 | 7 | uses 8 | Classes 9 | , SysUtils 10 | , fpcunit 11 | //, testutils 12 | , testregistry 13 | , OPP.Parser 14 | ; 15 | 16 | type 17 | 18 | { TTestObjectPascalParser } 19 | 20 | TTestObjectPascalParser= class(TTestCase) 21 | private 22 | FParser: TOPPParser; 23 | published 24 | procedure TestParserCreate; 25 | procedure TestParserParseAnsi; 26 | procedure TestParserParseUTF8; 27 | end; 28 | 29 | implementation 30 | 31 | uses 32 | OPP.Tests 33 | ; 34 | 35 | const 36 | cCodeProgramAnsi = 'program TestStar;'; 37 | cCodeProgramUTF8 = 'program Test🌟;'; 38 | 39 | procedure TTestObjectPascalParser.TestParserCreate; 40 | begin 41 | FParser:= TOPPParser.Create(DumpToTempFile('')); 42 | try 43 | AssertNotNull('OPP Parser not null', FParser); 44 | finally 45 | FParser.Free; 46 | end; 47 | end; 48 | 49 | procedure TTestObjectPascalParser.TestParserParseAnsi; 50 | begin 51 | FParser:= TOPPParser.Create(DumpToTempFile(cCodeProgramAnsi)); 52 | try 53 | { #todo 999 -ogcarreno : Test Ansi Parsing } 54 | finally 55 | FParser.Free; 56 | end; 57 | end; 58 | 59 | procedure TTestObjectPascalParser.TestParserParseUTF8; 60 | begin 61 | FParser:= TOPPParser.Create(DumpToTempFile(cCodeProgramUTF8)); 62 | try 63 | { #todo 999 -ogcarreno : Test UTF8 Parsing } 64 | finally 65 | FParser.Free; 66 | end; 67 | end; 68 | 69 | 70 | 71 | initialization 72 | 73 | RegisterTest(TTestObjectPascalParser); 74 | end. 75 | 76 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Release Notes 2 | 3 | Notable changes up to the last release. 4 | 5 | 6 | 7 | ## [0.1] - 2024-01-15 8 | 9 | ### Bug Fixes 10 | 11 | - Using `TStream.Read`, which is supported 12 | - Correct Stream Position after BOM test 13 | - Correct stream position if BOM or not 14 | - Can't use cast to `UnicodeString` on Windows 15 | - No codepage UTF8 for Windows/`macOS` 16 | - Giving up on `{$codepage UTF8}` 17 | - Forgot the path for the `.inc` 18 | 19 | ### Documentation 20 | 21 | - Some better grammar 22 | 23 | ### Features 24 | 25 | - States stack and tests 26 | - States Stack Tokens and tests 27 | - Tokenizer with initial tests for EOF 28 | - Start of Source File class 29 | - Now identifying UTF8 characters 30 | - Adding skeleton for top class: Parser 31 | - Tests for UTF16/UTF32 with BOM 32 | - Adding and example and CI/CD for it 33 | 34 | ### Miscellaneous Tasks 35 | 36 | - Initial commit 37 | - Adding Debug and Release build modes 38 | - Adding CI/CD 39 | - Changed name of the main workflow 40 | - Adding test files with all encodings 41 | - Add `BOM` `UTF8` and rename `BOM` files 42 | - Adding a version file 43 | 44 | ### Refactor 45 | 46 | - Renaming `GetToken` to `GetNextToken` 47 | - Using `fail-fast` into sub workflows 48 | - Eliminate magic numbers 49 | - Character decisions in own function 50 | - Using CodePoint, clean-up with TBytes 51 | - Fixing warnings: UnicodeString 52 | - Fixing more warnings: UnicodeString 53 | - Not using param on `ProcessCharacter` 54 | 55 | ### Testing 56 | 57 | - Added test for Source File Filename 58 | - Added Asserts for FileType and BOM 59 | - Adding EOF test on BOM UTF16/32 60 | 61 | -------------------------------------------------------------------------------- /src/tokenizing/opp.tokenizing.tokens.pas: -------------------------------------------------------------------------------- 1 | unit OPP.Tokenizing.Tokens; 2 | 3 | {$I objectpascalparser.inc} 4 | 5 | interface 6 | 7 | uses 8 | Classes 9 | , SysUtils 10 | ; 11 | 12 | type 13 | { TTokenError } 14 | TTokenError = ( 15 | teNone 16 | ); 17 | 18 | resourcestring 19 | rsTokenErrorInvalid = 'Token Error Invalid'; 20 | rsTokenErrorNone = 'Token Error None'; 21 | 22 | function TokenErrorToString(const ATokenError: TTokenError): String; 23 | 24 | type 25 | { TTokenType } 26 | TTokenType = ( 27 | ttUndefined 28 | , ttEOL 29 | , ttEOF 30 | ); 31 | 32 | resourcestring 33 | rsTokenTypeInvalid = 'Token Type Invalid'; 34 | rsTokenTypeUndefined = 'Token Type Undefined'; 35 | rsTokenTypeEOL = 'Token Type End of Line'; 36 | rsTokenTypeEOF = 'Token Type End of File'; 37 | 38 | function TokenTypeToString(const ATokenType: TTokenType): String; 39 | 40 | type 41 | { TToken } 42 | TToken = record 43 | Error: TTokenError; 44 | &Type: TTokenType; 45 | Line: Int64; 46 | Row: Int64; 47 | Element: UnicodeString; 48 | end; 49 | 50 | 51 | implementation 52 | 53 | function TokenErrorToString(const ATokenError: TTokenError): String; 54 | begin 55 | Result:= EmptyStr; 56 | case ATokenError of 57 | teNone:Result := rsTokenErrorNone; 58 | otherwise 59 | Result:= rsTokenErrorInvalid; 60 | end; 61 | end; 62 | 63 | function TokenTypeToString(const ATokenType: TTokenType): String; 64 | begin 65 | Result:= EmptyStr; 66 | case ATokenType of 67 | ttUndefined:Result := rsTokenTypeUndefined; 68 | ttEOL:Result := rsTokenTypeEOL; 69 | ttEOF:Result := rsTokenTypeEOF; 70 | otherwise 71 | Result:= rsTokenTypeInvalid; 72 | end; 73 | end; 74 | 75 | end. 76 | 77 | -------------------------------------------------------------------------------- /src/states/opp.states.stack.pas: -------------------------------------------------------------------------------- 1 | unit OPP.States.Stack; 2 | 3 | {$I objectpascalparser.inc} 4 | 5 | interface 6 | 7 | uses 8 | Classes 9 | , SysUtils 10 | , OPP.States 11 | ; 12 | 13 | type 14 | { TStatesStack } 15 | TStatesStack = class(TObject) 16 | private 17 | function GetCount: Integer; 18 | protected 19 | FStack: array of Cardinal; 20 | FTail: Integer; 21 | public 22 | constructor Create; 23 | destructor Destroy; override; 24 | 25 | procedure Push(const AState: Cardinal); 26 | function Pop: Cardinal; 27 | function Peek: Cardinal; 28 | 29 | property Count: Integer 30 | read GetCount; 31 | published 32 | end; 33 | 34 | resourcestring 35 | rsEStatesStackEmpty = 'The states stack is empty'; 36 | 37 | implementation 38 | 39 | { TStatesStack } 40 | 41 | constructor TStatesStack.Create; 42 | begin 43 | FTail:= -1; 44 | SetLength(FStack, FTail + 1); 45 | end; 46 | 47 | destructor TStatesStack.Destroy; 48 | begin 49 | SetLength(FStack, 0); 50 | inherited Destroy; 51 | end; 52 | 53 | function TStatesStack.GetCount: Integer; 54 | begin 55 | Result:= FTail + 1; 56 | end; 57 | 58 | procedure TStatesStack.Push(const AState: Cardinal); 59 | begin 60 | Inc(FTail); 61 | SetLength(FStack, FTail + 1); 62 | FStack[FTail]:= AState; 63 | end; 64 | 65 | function TStatesStack.Pop: Cardinal; 66 | begin 67 | if FTail > -1 then 68 | begin 69 | Result:= FStack[FTail]; 70 | Dec(FTail); 71 | SetLength(FStack, FTail + 1); 72 | end 73 | else 74 | raise EStatesStackEmpty.Create(rsEStatesStackEmpty); 75 | end; 76 | 77 | function TStatesStack.Peek: Cardinal; 78 | begin 79 | if FTail > -1 then 80 | begin 81 | Result:= FStack[FTail]; 82 | end 83 | else 84 | raise EStatesStackEmpty.Create(rsEStatesStackEmpty); 85 | end; 86 | 87 | end. 88 | 89 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Object Pascal Parser 2 | 3 | [![Build Status](https://github.com/gcarreno/ObjectPascalParser/actions/workflows/main.lazarus.yml/badge.svg?branch=main)](https://github.com/gcarreno/ObjectPascalParser/actions) 4 | [![Supports Windows](https://img.shields.io/badge/support-Windows-blue?logo=Windows)](https://github.com/gcarreno/ObjectPascalParser/releases/latest) 5 | [![Supports Linux](https://img.shields.io/badge/support-Linux-yellow?logo=Linux)](https://github.com/gcarreno/ObjectPascalParser/releases/latest) 6 | [![Supports macOS](https://img.shields.io/badge/support-macOS-black?logo=macOS)](https://github.com/gcarreno/ObjectPascalParser/releases/latest) 7 | [![License](https://img.shields.io/github/license/gcarreno/ObjectPascalParser)](https://github.com/gcarreno/ObjectPascalParser/blob/master/LICENSE) 8 | [![Latest Release](https://img.shields.io/github/v/release/gcarreno/ObjectPascalParser?label=latest%20release)](https://github.com/gcarreno/ObjectPascalParser/releases/latest) 9 | [![Downloads](https://img.shields.io/github/downloads/gcarreno/ObjectPascalParser/total)](https://github.com/gcarreno/ObjectPascalParser/releases) 10 | 11 | An attempt at an Object Pascal Parser. 12 | 13 | ## Objectives 14 | 15 | The main objective of this endeavour is primiraly to learn about tokenization and parsing, but it's also an attempt at decoupling the [Object Pascal LSP](https://github.com/genericptr/pascal-language-server) from Lazarus. 16 | 17 | ## Disclaimer 18 | 19 | I'm not, in any way, remotely knowledgeable enough to even understand what I'm doing correctly or other wise. 20 | This is my initial attempt at something like this, with only some tidbits of information, gathered here and there, in light conversations about the subject. 21 | 22 | ## Plea for help 23 | 24 | I welcome any input, or __constructive__ criticism of this effort, since I'm quite aware that I'll need a **ton** of help with this thing!! 25 | -------------------------------------------------------------------------------- /tests/states/testobjectpascalparserstatesstacktokens.pas: -------------------------------------------------------------------------------- 1 | unit TestObjectPascalParserStatesStackTokens; 2 | 3 | {$I objectpascalparser.inc} 4 | 5 | interface 6 | 7 | uses 8 | Classes 9 | , SysUtils 10 | , fpcunit 11 | //, testutils 12 | , testregistry 13 | , OPP.States 14 | , OPP.States.StackTokens 15 | ; 16 | 17 | type 18 | 19 | { TTestObjectPascalParserStatesStackTokens } 20 | 21 | TTestObjectPascalParserStatesStackTokens= class(TTestCase) 22 | private 23 | FStackTokens: TStatesStackTokens; 24 | protected 25 | procedure SetUp; override; 26 | procedure TearDown; override; 27 | published 28 | procedure TestStatesStackTokensCreate; 29 | procedure TestStatesStackTokensPush; 30 | procedure TestStatesStackTokensPop; 31 | procedure TestStatesStackTokensPeek; 32 | end; 33 | 34 | implementation 35 | 36 | procedure TTestObjectPascalParserStatesStackTokens.SetUp; 37 | begin 38 | inherited Setup; 39 | FStackTokens:= TStatesStackTokens.Create; 40 | end; 41 | 42 | procedure TTestObjectPascalParserStatesStackTokens.TearDown; 43 | begin 44 | inherited TearDown; 45 | FStackTokens.Free; 46 | end; 47 | 48 | procedure TTestObjectPascalParserStatesStackTokens.TestStatesStackTokensCreate; 49 | begin 50 | AssertEquals('States Stack Tokens Count is 0', 0, FStackTokens.Count); 51 | end; 52 | 53 | procedure TTestObjectPascalParserStatesStackTokens.TestStatesStackTokensPush; 54 | begin 55 | FStackTokens.Push(tsUndefined); 56 | AssertEquals('States Stack Tokens Count is 1', 1, FStackTokens.Count); 57 | end; 58 | 59 | procedure TTestObjectPascalParserStatesStackTokens.TestStatesStackTokensPop; 60 | var 61 | state: TTokenState; 62 | begin 63 | FStackTokens.Push(tsUndefined); 64 | AssertEquals('States Stack Tokens Count is 1', 1, FStackTokens.Count); 65 | state:= FStackTokens.Pop; 66 | AssertEquals('States Stack Tokens Count is 0', 0, FStackTokens.Count); 67 | AssertEquals('States Stack Tokens Pop is tsUndefined', Ord(tsUndefined), Ord(state)); 68 | end; 69 | 70 | procedure TTestObjectPascalParserStatesStackTokens.TestStatesStackTokensPeek; 71 | var 72 | state: TTokenState; 73 | begin 74 | FStackTokens.Push(tsUndefined); 75 | AssertEquals('States Stack Tokens Count is 1', 1, FStackTokens.Count); 76 | state:= FStackTokens.Peek; 77 | AssertEquals('States Stack Tokens Count is 1', 1, FStackTokens.Count); 78 | AssertEquals('States Stack Tokens Peek is tsUndefined', Ord(tsUndefined), Ord(state)); 79 | end; 80 | 81 | 82 | initialization 83 | 84 | RegisterTest(TTestObjectPascalParserStatesStackTokens); 85 | end. 86 | 87 | -------------------------------------------------------------------------------- /tests/states/testobjectpascalparserstatesstack.pas: -------------------------------------------------------------------------------- 1 | unit TestObjectPascalParserStatesStack; 2 | 3 | {$I objectpascalparser.inc} 4 | 5 | interface 6 | 7 | uses 8 | Classes 9 | , SysUtils 10 | , fpcunit 11 | //, testutils 12 | , testregistry 13 | , OPP.States 14 | , OPP.States.Stack 15 | ; 16 | 17 | type 18 | 19 | { TTestSates } 20 | 21 | TTestSates= class(TTestCase) 22 | private 23 | FStatesStack: TStatesStack; 24 | 25 | procedure RunPopException; 26 | protected 27 | procedure SetUp; override; 28 | procedure TearDown; override; 29 | published 30 | procedure TestStatesStackCreate; 31 | procedure TestStatesStackPush; 32 | procedure TestStatesStackPop; 33 | procedure TestStatesStackPopException; 34 | procedure TestStatesStackPeek; 35 | end; 36 | 37 | implementation 38 | 39 | procedure TTestSates.RunPopException; 40 | begin 41 | FStatesStack.Pop; 42 | end; 43 | 44 | procedure TTestSates.SetUp; 45 | begin 46 | inherited SetUp; 47 | FStatesStack:= TStatesStack.Create; 48 | end; 49 | 50 | procedure TTestSates.TearDown; 51 | begin 52 | inherited TearDown; 53 | FStatesStack.Free; 54 | end; 55 | 56 | procedure TTestSates.TestStatesStackCreate; 57 | begin 58 | AssertEquals('States Stack Count is 0', 0, FStatesStack.Count); 59 | end; 60 | 61 | procedure TTestSates.TestStatesStackPush; 62 | begin 63 | FStatesStack.Push(0); 64 | AssertEquals('States Stack Count is 1', 1, FStatesStack.Count); 65 | end; 66 | 67 | procedure TTestSates.TestStatesStackPop; 68 | var 69 | state: Cardinal; 70 | begin 71 | FStatesStack.Push(1); 72 | AssertEquals('States Stack Count is 1', 1, FStatesStack.Count); 73 | state:= FStatesStack.Pop; 74 | AssertEquals('States Stack Count is 0', 0, FStatesStack.Count); 75 | AssertEquals('States Stack State Pop is 1', 1, state); 76 | end; 77 | 78 | procedure TTestSates.TestStatesStackPopException; 79 | begin 80 | AssertException('States Stack Exception Empty', 81 | EStatesStackEmpty, 82 | @RunPopException, 83 | rsEStatesStackEmpty 84 | ); 85 | end; 86 | 87 | procedure TTestSates.TestStatesStackPeek; 88 | var 89 | state: Cardinal; 90 | begin 91 | FStatesStack.Push(2); 92 | AssertEquals('States Stack Count is 1', 1, FStatesStack.Count); 93 | state:= FStatesStack.Peek; 94 | AssertEquals('States Stack Count is 1', 1, FStatesStack.Count); 95 | AssertEquals('States Stack State Peek is 2', 2, state); 96 | end; 97 | 98 | 99 | initialization 100 | 101 | RegisterTest(TTestSates); 102 | end. 103 | 104 | -------------------------------------------------------------------------------- /.github/workflows/main.lazarus.yml: -------------------------------------------------------------------------------- 1 | name: OPP Main Workflow 2 | 3 | permissions: 4 | contents: write 5 | 6 | on: 7 | 8 | push: 9 | branches: [ main ] 10 | tags: [ "*" ] 11 | paths-ignore: [ "README.md", "CHANGELOG.md", "cliff.toml" ] 12 | 13 | pull_request: 14 | branches: [ main ] 15 | 16 | jobs: 17 | 18 | build: 19 | name: 01 - Build Application 20 | uses: gcarreno/re-usable-workflows/.github/workflows/build.lazarus.yml@main 21 | with: 22 | config: '{ 23 | "app-name": "ObjectPascalParserExample", 24 | "lpi-path": "example", 25 | "bin-path": "bin", 26 | "build-mode": "Release", 27 | "lazarus-packages": "", 28 | "matrix": { 29 | "os": [ 30 | "ubuntu-latest", 31 | "windows-latest", 32 | "macos-latest" 33 | ], 34 | "include":[ 35 | { 36 | "os": "ubuntu-latest", 37 | "triplet": "x86_64-linux" 38 | }, 39 | { 40 | "os": "windows-latest", 41 | "triplet": "x86_64-win64" 42 | }, 43 | { 44 | "os": "macos-latest", 45 | "triplet": "x86_64-darwin" 46 | } 47 | ], 48 | "lazarus-versions": [ 49 | "stable", 50 | "2.2.6" 51 | ] 52 | } 53 | }' 54 | fail-fast: false 55 | 56 | test: 57 | name: 02 - Test Application 58 | uses: gcarreno/re-usable-workflows/.github/workflows/test.lazarus.yml@main 59 | with: 60 | config: '{ 61 | "app-name": "TestObjectPascalParserCLI", 62 | "lpi-path": "tests", 63 | "bin-path": "bin", 64 | "build-mode": "Release", 65 | "lazarus-packages": "", 66 | "what-suite": "all", 67 | "output-format": "plain", 68 | "matrix": { 69 | "os":[ 70 | "ubuntu-latest", 71 | "windows-latest", 72 | "macos-latest" 73 | ], 74 | "lazarus-versions": [ 75 | "stable", 76 | "2.2.6" 77 | ] 78 | } 79 | }' 80 | fail-fast: false 81 | 82 | release: 83 | if: contains(github.ref_type, 'tag') 84 | 85 | name: 03 - Create GitHub Release 86 | uses: gcarreno/re-usable-workflows/.github/workflows/release.lazarus.yml@main 87 | needs: [ build, test ] 88 | with: 89 | config: '{ 90 | "app-name": "ObjectPascalParserExample", 91 | "tag": "${{ github.ref_name }}", 92 | "cliff-cfg": "cliff.toml", 93 | "win": "${{ needs.build.outputs.win-artefact-path }}", 94 | "lin": "${{ needs.build.outputs.lin-artefact-path }}", 95 | "osx": "${{ needs.build.outputs.osx-artefact-path }}" 96 | }' 97 | fail-fast: false 98 | -------------------------------------------------------------------------------- /example/forms/form.main.pas: -------------------------------------------------------------------------------- 1 | unit Form.Main; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | interface 6 | 7 | uses 8 | Classes 9 | , SysUtils 10 | , Forms 11 | , Controls 12 | , Graphics 13 | , Dialogs 14 | , Menus 15 | , ActnList 16 | , StdActns 17 | , PairSplitter 18 | , StdCtrls 19 | , ExtCtrls 20 | , ComCtrls 21 | , OPP.Parser 22 | ; 23 | 24 | type 25 | 26 | { TfrmMain } 27 | 28 | TfrmMain = class(TForm) 29 | actParserParse: TAction; 30 | alMain: TActionList; 31 | actFileExit: TFileExit; 32 | btnParserParse: TButton; 33 | memTopSourceCode: TMemo; 34 | mnuParser: TMenuItem; 35 | MenuItem2: TMenuItem; 36 | mnuFile: TMenuItem; 37 | mnuFileExit: TMenuItem; 38 | mmMain: TMainMenu; 39 | panTopButtons: TPanel; 40 | psMain: TPairSplitter; 41 | pssTop: TPairSplitterSide; 42 | pssBottom: TPairSplitterSide; 43 | tvBottomCodeTree: TTreeView; 44 | procedure FormCreate(Sender: TObject); 45 | procedure FormDestroy(Sender: TObject); 46 | 47 | procedure actParserParseExecute(Sender: TObject); 48 | private 49 | FParser: TOPPParser; 50 | procedure InitShortcuts; 51 | function DumpToTempFile(const AContent: String): String; 52 | public 53 | 54 | end; 55 | 56 | var 57 | frmMain: TfrmMain; 58 | 59 | resourcestring 60 | rsFormCaption = 'Object Pascal Parser v%s Example'; 61 | 62 | implementation 63 | 64 | {$R *.lfm} 65 | 66 | uses 67 | LCLType 68 | ; 69 | 70 | const 71 | cVersion = {$I version.inc}; 72 | 73 | { TfrmMain } 74 | 75 | procedure TfrmMain.FormCreate(Sender: TObject); 76 | begin 77 | Caption:= Format(rsFormCaption, [ cVersion ]) ; 78 | InitShortcuts; 79 | FParser:= nil; 80 | end; 81 | 82 | procedure TfrmMain.FormDestroy(Sender: TObject); 83 | begin 84 | if Assigned(FParser) then FParser.Free; 85 | end; 86 | 87 | procedure TfrmMain.InitShortcuts; 88 | begin 89 | {$IFDEF UNIX} 90 | actFileExit.ShortCut := KeyToShortCut(VK_Q, [ssCtrl]); 91 | {$ENDIF} 92 | {$IFDEF WINDOWS} 93 | actFileExit.ShortCut := KeyToShortCut(VK_X, [ssAlt]); 94 | {$ENDIF} 95 | end; 96 | 97 | function TfrmMain.DumpToTempFile(const AContent: String): String; 98 | var 99 | tmpFilename: String; 100 | stringStream: TstringStream; 101 | begin 102 | Result:= EmptyStr; 103 | stringStream:= TStringStream.Create(aContent); 104 | try 105 | tmpFilename:= GetTempFileName; 106 | stringStream.SaveToFile(tmpFilename); 107 | finally 108 | stringStream.Free; 109 | end; 110 | Result:= tmpFilename; 111 | end; 112 | 113 | procedure TfrmMain.actParserParseExecute(Sender: TObject); 114 | begin 115 | psMain.Enabled:= False; 116 | Application.ProcessMessages; 117 | 118 | MessageDlg( 119 | 'Object Pascal Parser', 120 | 'Parsing is not implemented yet!', 121 | mtWarning, 122 | [mbOK], 123 | 0 124 | ); 125 | (*FParser:= TOPPParser.Create(DumpToTempFile(memTopSourceCode.Text)); 126 | try 127 | FParser.Parse; 128 | { #todo 999 -ogcarreno : Read the code tree and dump it on the tree view } 129 | finally 130 | FreeAndNil(FParser); 131 | end;*) 132 | 133 | Application.ProcessMessages; 134 | psMain.Enabled:= False; 135 | end; 136 | 137 | end. 138 | 139 | -------------------------------------------------------------------------------- /cliff.toml: -------------------------------------------------------------------------------- 1 | # git-cliff ~ default configuration file 2 | # https://git-cliff.org/docs/configuration 3 | # 4 | # Lines starting with "#" are comments. 5 | # Configuration options are organized into tables and keys. 6 | # See documentation for more information on available options. 7 | 8 | [changelog] 9 | # changelog header 10 | header = """ 11 | # Release Notes\n 12 | Notable changes up to the last release.\n 13 | \n 14 | """ 15 | # template for the changelog body 16 | # https://tera.netlify.app/docs 17 | body = """ 18 | {% if version %}\ 19 | ## [{{ version | trim_start_matches(pat="v") }}] - {{ timestamp | date(format="%Y-%m-%d") }} 20 | {% else %}\ 21 | ## [unreleased] 22 | {% endif %}\ 23 | {% for group, commits in commits | group_by(attribute="group") %} 24 | ### {{ group | upper_first }} 25 | {% for commit in commits %} 26 | - {% if commit.breaking %}[**breaking**] {% endif %}{{ commit.message | upper_first }}\ 27 | {% endfor %} 28 | {% endfor %}\n 29 | """ 30 | # remove the leading and trailing whitespace from the template 31 | trim = true 32 | # changelog footer 33 | footer = """ 34 | For a list of all the changes up to date, please read [CHANGELOG.md](https://github.com/gcarreno/ObjectPascalParser/blob/main/CHANGELOG.md). 35 | 36 | """ 37 | # postprocessors 38 | postprocessors = [ 39 | # { pattern = '', replace = "https://github.com/gcarreno/TestIPScanner" }, # replace repository URL 40 | ] 41 | [git] 42 | # parse the commits based on https://www.conventionalcommits.org 43 | conventional_commits = true 44 | # filter out the commits that are not conventional 45 | filter_unconventional = true 46 | # process each line of a commit as an individual commit 47 | split_commits = false 48 | # regex for preprocessing the commit messages 49 | commit_preprocessors = [ 50 | # { pattern = '\((\w+\s)?#([0-9]+)\)', replace = "([#${2}](/issues/${2}))"}, # replace issue numbers 51 | ] 52 | # regex for parsing and grouping commits 53 | commit_parsers = [ 54 | { message = "^feat", group = "Features" }, 55 | { message = "^fix", group = "Bug Fixes" }, 56 | { message = "^doc", group = "Documentation" }, 57 | { message = "^perf", group = "Performance" }, 58 | { message = "^refactor", group = "Refactor" }, 59 | { message = "^style", group = "Styling" }, 60 | { message = "^test", group = "Testing" }, 61 | { message = "^chore\\(release\\): prepare for", skip = true }, 62 | { message = "^chore\\(deps\\)", skip = true }, 63 | { message = "^chore\\(pr\\)", skip = true }, 64 | { message = "^chore\\(pull\\)", skip = true }, 65 | { message = "^ign", skip = true}, 66 | { message = "^chore|ci", group = "Miscellaneous Tasks" }, 67 | { body = ".*security", group = "Security" }, 68 | { message = "^revert", group = "Revert" }, 69 | ] 70 | # protect breaking changes from being skipped due to matching a skipping commit_parser 71 | protect_breaking_commits = false 72 | # filter out the commits that are not matched by commit parsers 73 | filter_commits = false 74 | # glob pattern for matching git tags 75 | tag_pattern = "v[0-9]*" 76 | # regex for skipping tags 77 | skip_tags = "v0.1.0-beta.1" 78 | # regex for ignoring tags 79 | ignore_tags = "" 80 | # sort the tags topologically 81 | topo_order = false 82 | # sort the commits inside sections by oldest/newest order 83 | sort_commits = "oldest" 84 | # limit the number of commits included in the changelog. 85 | # limit_commits = 42 86 | -------------------------------------------------------------------------------- /example/forms/form.main.lfm: -------------------------------------------------------------------------------- 1 | object frmMain: TfrmMain 2 | Left = 397 3 | Height = 500 4 | Top = 32 5 | Width = 800 6 | Caption = 'frmMain' 7 | ClientHeight = 500 8 | ClientWidth = 800 9 | Constraints.MinHeight = 500 10 | Constraints.MinWidth = 800 11 | Menu = mmMain 12 | OnCreate = FormCreate 13 | OnDestroy = FormDestroy 14 | Position = poScreenCenter 15 | object psMain: TPairSplitter 16 | Cursor = crVSplit 17 | Left = 0 18 | Height = 500 19 | Top = 0 20 | Width = 800 21 | Align = alClient 22 | Position = 200 23 | SplitterType = pstVertical 24 | object pssTop: TPairSplitterSide 25 | Cursor = crArrow 26 | Left = 0 27 | Height = 200 28 | Top = 0 29 | Width = 800 30 | ClientWidth = 800 31 | ClientHeight = 200 32 | Constraints.MinHeight = 150 33 | object memTopSourceCode: TMemo 34 | Left = 4 35 | Height = 155 36 | Top = 4 37 | Width = 792 38 | Align = alClient 39 | BorderSpacing.Around = 4 40 | Lines.Strings = ( 41 | 'program HelloWorld;' 42 | '' 43 | 'begin' 44 | ' WriteLn(''Hello World!! 👋'');' 45 | 'end;' 46 | ) 47 | ScrollBars = ssAutoBoth 48 | TabOrder = 0 49 | end 50 | object panTopButtons: TPanel 51 | Left = 0 52 | Height = 37 53 | Top = 163 54 | Width = 800 55 | Align = alBottom 56 | AutoSize = True 57 | BevelOuter = bvNone 58 | ClientHeight = 37 59 | ClientWidth = 800 60 | TabOrder = 1 61 | object btnParserParse: TButton 62 | Left = 4 63 | Height = 33 64 | Top = 4 65 | Width = 80 66 | Action = actParserParse 67 | Align = alLeft 68 | AutoSize = True 69 | BorderSpacing.Left = 4 70 | BorderSpacing.Top = 4 71 | Constraints.MinWidth = 80 72 | TabOrder = 0 73 | end 74 | end 75 | end 76 | object pssBottom: TPairSplitterSide 77 | Cursor = crArrow 78 | Left = 0 79 | Height = 295 80 | Top = 205 81 | Width = 800 82 | ClientWidth = 800 83 | ClientHeight = 295 84 | Constraints.MinHeight = 200 85 | object tvBottomCodeTree: TTreeView 86 | Left = 4 87 | Height = 287 88 | Top = 4 89 | Width = 792 90 | Align = alClient 91 | BorderSpacing.Around = 4 92 | ReadOnly = True 93 | ScrollBars = ssAutoBoth 94 | TabOrder = 0 95 | Options = [tvoAutoItemHeight, tvoHideSelection, tvoKeepCollapsedNodes, tvoReadOnly, tvoShowButtons, tvoShowLines, tvoShowRoot, tvoToolTips, tvoThemedDraw] 96 | end 97 | end 98 | end 99 | object mmMain: TMainMenu 100 | Left = 499 101 | Top = 267 102 | object mnuFile: TMenuItem 103 | Caption = '&File' 104 | object mnuFileExit: TMenuItem 105 | Action = actFileExit 106 | end 107 | end 108 | object mnuParser: TMenuItem 109 | Caption = '&Parser' 110 | object MenuItem2: TMenuItem 111 | Action = actParserParse 112 | end 113 | end 114 | end 115 | object alMain: TActionList 116 | Left = 499 117 | Top = 330 118 | object actFileExit: TFileExit 119 | Category = 'File' 120 | Caption = 'E&xit' 121 | Hint = 'Exit' 122 | end 123 | object actParserParse: TAction 124 | Category = 'Parser' 125 | Caption = 'P&arse' 126 | OnExecute = actParserParseExecute 127 | end 128 | end 129 | end 130 | -------------------------------------------------------------------------------- /src/text/opp.text.pas: -------------------------------------------------------------------------------- 1 | unit OPP.Text; 2 | 3 | {$I objectpascalparser.inc} 4 | 5 | interface 6 | 7 | uses 8 | Classes 9 | , SysUtils 10 | ; 11 | 12 | const 13 | cBOMUTF8 : TBytes = ($EF, $BB, $BF); 14 | cBOMUTF16BE : TBytes = ($FE, $FF); 15 | cBOMUTF16LE : TBytes = ($FF, $FE); 16 | cBOMUTF32BE : TBytes = ($00, $00, $FE, $FF); 17 | cBOMUTF32LE : TBytes = ($00, $00, $FF, $FE); 18 | cBOMUTF8Len = 3; 19 | cBOMUTF16Len = 2; 20 | cBOMUTF32Len = 4; 21 | 22 | type 23 | { TTextFileType } 24 | TTextFileType = (tftUnknown, tftAnsi, tftUTF8, tftUTF16BE, tftUTF16LE, tftUTF32BE, tftUTF32LE); 25 | 26 | function TextFileTypeToString(const ATextFileType: TTextFileType): String; 27 | 28 | resourcestring 29 | rsTextFileTypeUnknown = 'Text File Type Unknown'; 30 | rsTextFileTypeAnsi = 'Text File Type Ansi'; 31 | rsTextFileTypeUTF8 = 'Text File Type UTF8'; 32 | rsTextFileTypeUTF16BE = 'Text File Type UTF16 Big Endian'; 33 | rsTextFileTypeUTF16LE = 'Text File Type UTF16 Little Endian'; 34 | rsTextFileTypeUTF32BE = 'Text File Type UTF32 Big Endian'; 35 | rsTextFileTypeUTF32LE = 'Text File Type UTF32 Little Endian'; 36 | 37 | type 38 | { TTextBOMType } 39 | TTextBOMType = (tbtUnknown, tbtUTF8, tbtUTF16BE, tbtUTF16LE, tbtUTF32BE, tbtUTF32LE); 40 | 41 | function TextBOMTypeToString(const ATextBOMType: TTextBOMType): String; 42 | 43 | resourcestring 44 | rsTextBOMTypeUnknown = 'Text BOM Type Unknown'; 45 | rsTextBOMTypeUTF8 = 'Text BOM Type UTF8'; 46 | rsTextBOMTypeUTF16BE = 'Text BOM Type UTF16 Big Endian'; 47 | rsTextBOMTypeUTF16LE = 'Text BOM Type UTF16 Little Endian'; 48 | rsTextBOMTypeUTF32BE = 'Text BOM Type UTF32 Big Endian'; 49 | rsTextBOMTypeUTF32LE = 'Text BOM Type UTF32 Little Endian'; 50 | 51 | type 52 | { TTextCharType } 53 | TTextCharType = (tctUnknown, tctAnsi, tctCodePoint); 54 | 55 | function TextCharTypeToString(const ATextCharType: TTextCharType): String; 56 | 57 | resourcestring 58 | rsTextCharTypeUnknown = 'Text Char Type Unknown'; 59 | rsTextCharTypeAnsi = 'Text Char Type Ansi'; 60 | rsTextCharTypeCodePoint = 'Text Char Type Code Point'; 61 | 62 | type 63 | { TTextCharacter } 64 | TTextCharacter = record 65 | &Type: TTextCharType; 66 | Value: UnicodeString; 67 | EOF: Boolean; 68 | end; 69 | 70 | implementation 71 | 72 | function TextFileTypeToString(const ATextFileType: TTextFileType): String; 73 | begin 74 | case ATextFileType of 75 | tftUnknown: Result:= rsTextFileTypeUnknown; 76 | tftAnsi: Result:= rsTextFileTypeAnsi; 77 | tftUTF8: Result:= rsTextFileTypeUTF8; 78 | tftUTF16BE: Result:= rsTextFileTypeUTF16BE; 79 | tftUTF16LE: Result:= rsTextFileTypeUTF16LE; 80 | tftUTF32BE: Result:= rsTextFileTypeUTF32BE; 81 | tftUTF32LE: Result:= rsTextFileTypeUTF32LE; 82 | end; 83 | end; 84 | 85 | function TextBOMTypeToString(const ATextBOMType: TTextBOMType): String; 86 | begin 87 | case ATextBOMType of 88 | tbtUnknown: Result:= rsTextBOMTypeUnknown; 89 | tbtUTF8: Result:= rsTextBOMTypeUTF8; 90 | tbtUTF16BE: Result:= rsTextBOMTypeUTF16BE; 91 | tbtUTF16LE: Result:= rsTextBOMTypeUTF16LE; 92 | tbtUTF32BE: Result:= rsTextBOMTypeUTF32BE; 93 | tbtUTF32LE: Result:= rsTextBOMTypeUTF32LE; 94 | end; 95 | end; 96 | 97 | function TextCharTypeToString(const ATextCharType: TTextCharType): String; 98 | begin 99 | case ATextCharType of 100 | tctUnknown: Result:= rsTextCharTypeUnknown; 101 | tctAnsi: Result:= rsTextCharTypeAnsi; 102 | tctCodePoint: Result:= rsTextCharTypeCodePoint; 103 | end; 104 | end; 105 | 106 | end. 107 | 108 | -------------------------------------------------------------------------------- /example/ObjectPascalParserExample.lpi: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | <Scaled Value="True"/> 12 | <ResourceType Value="res"/> 13 | <UseXPManifest Value="True"/> 14 | <XPManifest> 15 | <DpiAware Value="True"/> 16 | </XPManifest> 17 | <Icon Value="0"/> 18 | </General> 19 | <BuildModes Count="3"> 20 | <Item1 Name="Default" Default="True"/> 21 | <Item2 Name="Debug"> 22 | <CompilerOptions> 23 | <Version Value="11"/> 24 | <Target> 25 | <Filename Value="../bin/ObjectPascalParserExample"/> 26 | </Target> 27 | <SearchPaths> 28 | <IncludeFiles Value="../src;$(ProjOutDir)"/> 29 | <OtherUnitFiles Value="../src/parser;../src/states;../src/text;../src/tokenizing;forms"/> 30 | <UnitOutputDirectory Value="../bin/lib/$(TargetCPU)-$(TargetOS)"/> 31 | </SearchPaths> 32 | <Parsing> 33 | <SyntaxOptions> 34 | <IncludeAssertionCode Value="True"/> 35 | </SyntaxOptions> 36 | </Parsing> 37 | <CodeGeneration> 38 | <Checks> 39 | <IOChecks Value="True"/> 40 | <RangeChecks Value="True"/> 41 | <OverflowChecks Value="True"/> 42 | <StackChecks Value="True"/> 43 | </Checks> 44 | <VerifyObjMethodCallValidity Value="True"/> 45 | </CodeGeneration> 46 | <Linking> 47 | <Debugging> 48 | <DebugInfoType Value="dsDwarf3"/> 49 | <UseHeaptrc Value="True"/> 50 | <TrashVariables Value="True"/> 51 | <UseExternalDbgSyms Value="True"/> 52 | </Debugging> 53 | <Options> 54 | <Win32> 55 | <GraphicApplication Value="True"/> 56 | </Win32> 57 | </Options> 58 | </Linking> 59 | </CompilerOptions> 60 | </Item2> 61 | <Item3 Name="Release"> 62 | <CompilerOptions> 63 | <Version Value="11"/> 64 | <Target> 65 | <Filename Value="../bin/ObjectPascalParserExample"/> 66 | </Target> 67 | <SearchPaths> 68 | <IncludeFiles Value="../src;$(ProjOutDir)"/> 69 | <OtherUnitFiles Value="../src/parser;../src/states;../src/text;../src/tokenizing;forms"/> 70 | <UnitOutputDirectory Value="../bin/lib/$(TargetCPU)-$(TargetOS)"/> 71 | </SearchPaths> 72 | <CodeGeneration> 73 | <SmartLinkUnit Value="True"/> 74 | <Optimizations> 75 | <OptimizationLevel Value="3"/> 76 | </Optimizations> 77 | </CodeGeneration> 78 | <Linking> 79 | <Debugging> 80 | <GenerateDebugInfo Value="False"/> 81 | </Debugging> 82 | <LinkSmart Value="True"/> 83 | <Options> 84 | <Win32> 85 | <GraphicApplication Value="True"/> 86 | </Win32> 87 | </Options> 88 | </Linking> 89 | </CompilerOptions> 90 | </Item3> 91 | </BuildModes> 92 | <PublishOptions> 93 | <Version Value="2"/> 94 | <UseFileFilters Value="True"/> 95 | </PublishOptions> 96 | <RunParams> 97 | <FormatVersion Value="2"/> 98 | </RunParams> 99 | <RequiredPackages Count="1"> 100 | <Item1> 101 | <PackageName Value="LCL"/> 102 | </Item1> 103 | </RequiredPackages> 104 | <Units Count="2"> 105 | <Unit0> 106 | <Filename Value="ObjectPascalParserExample.lpr"/> 107 | <IsPartOfProject Value="True"/> 108 | </Unit0> 109 | <Unit1> 110 | <Filename Value="forms/form.main.pas"/> 111 | <IsPartOfProject Value="True"/> 112 | <ComponentName Value="frmMain"/> 113 | <HasResources Value="True"/> 114 | <ResourceBaseClass Value="Form"/> 115 | <UnitName Value="Form.Main"/> 116 | </Unit1> 117 | </Units> 118 | </ProjectOptions> 119 | <CompilerOptions> 120 | <Version Value="11"/> 121 | <Target> 122 | <Filename Value="../bin/ObjectPascalParserExample"/> 123 | </Target> 124 | <SearchPaths> 125 | <IncludeFiles Value="../src;$(ProjOutDir)"/> 126 | <OtherUnitFiles Value="../src/parser;../src/states;../src/text;../src/tokenizing;forms"/> 127 | <UnitOutputDirectory Value="../bin/lib/$(TargetCPU)-$(TargetOS)"/> 128 | </SearchPaths> 129 | <Linking> 130 | <Options> 131 | <Win32> 132 | <GraphicApplication Value="True"/> 133 | </Win32> 134 | </Options> 135 | </Linking> 136 | </CompilerOptions> 137 | <Debugging> 138 | <Exceptions Count="3"> 139 | <Item1> 140 | <Name Value="EAbort"/> 141 | </Item1> 142 | <Item2> 143 | <Name Value="ECodetoolError"/> 144 | </Item2> 145 | <Item3> 146 | <Name Value="EFOpenError"/> 147 | </Item3> 148 | </Exceptions> 149 | </Debugging> 150 | </CONFIG> 151 | -------------------------------------------------------------------------------- /src/tokenizing/opp.tokenizing.tokenizer.pas: -------------------------------------------------------------------------------- 1 | unit OPP.Tokenizing.Tokenizer; 2 | 3 | {$I objectpascalparser.inc} 4 | 5 | interface 6 | 7 | uses 8 | Classes 9 | , SysUtils 10 | , OPP.Text 11 | , OPP.Text.SourceFile 12 | , OPP.States 13 | , OPP.States.StackTokens 14 | , OPP.Tokenizing.Tokens 15 | ; 16 | 17 | type 18 | { ETokenizingTokenizerStackNotEmpty } 19 | ETokenizingTokenizerStackNotEmpty = class(Exception); 20 | 21 | { ETokenizingTokenizerUnknownCharType } 22 | ETokenizingTokenizerUnknownCharType = class(Exception); 23 | 24 | resourcestring 25 | rsETokenizingTokenizerStackNotEmpty = 'Tokenizing Tokenizer Stack Not Empty'; 26 | rsETokenizingTokenizerUnknownCharType = 'Tokenizing Tokenizer Unknown Char type'; 27 | 28 | type 29 | { TTokenizingTokenizer } 30 | TTokenizingTokenizer = class(Tobject) 31 | type 32 | { TLoopFlow } 33 | TLoopFlow = (lfNone, lfBreak, lfContinue); 34 | private 35 | FSSourceFile: TTextSourceFile; 36 | FCurrentChar: TTextCharacter; 37 | FCurrentToken: TToken; 38 | FLine: Int64; 39 | FRow: Int64; 40 | FStackTokens: TStatesStackTokens; 41 | 42 | procedure FillTokenWithReset; 43 | procedure FillTokenWithEOL(const ADoIncrement: Boolean = True); 44 | procedure FillTokenWithEOF; 45 | 46 | function ProcessCharacter: TLoopFlow; 47 | protected 48 | public 49 | constructor Create(const ASourceFile: TTextSourceFile); 50 | destructor Destroy; override; 51 | 52 | function GetNextToken: TToken; 53 | published 54 | end; 55 | 56 | implementation 57 | 58 | { TTokenizingTokenizer } 59 | 60 | constructor TTokenizingTokenizer.Create(const ASourceFile: TTextSourceFile); 61 | begin 62 | FSSourceFile:= ASourceFile; 63 | FCurrentChar.&Type:= tctUnknown; 64 | FCurrentChar.Value:= ''; 65 | FCurrentChar.EOF:= False; 66 | FLine:= 0; 67 | FRow:= 0; 68 | FStackTokens:= TStatesStackTokens.Create; 69 | end; 70 | 71 | destructor TTokenizingTokenizer.Destroy; 72 | begin 73 | if Assigned(FStackTokens) then FStackTokens.Free; 74 | inherited Destroy; 75 | end; 76 | 77 | procedure TTokenizingTokenizer.FillTokenWithReset; 78 | begin 79 | FCurrentToken.Error:= teNone; 80 | FCurrentToken.&Type:= ttUndefined; 81 | FCurrentToken.Line:= FLine; 82 | FCurrentToken.Row:= FRow; 83 | FCurrentToken.Element:= UnicodeString(EmptyStr); 84 | end; 85 | 86 | procedure TTokenizingTokenizer.FillTokenWithEOL(const ADoIncrement: Boolean); 87 | begin 88 | FCurrentToken.Error:= teNone; 89 | FCurrentToken.&Type:= ttEOL; 90 | if ADoIncrement then 91 | begin 92 | Inc(FLine); 93 | FRow:= 0; 94 | end; 95 | FCurrentToken.Line:= FLine; 96 | FCurrentToken.Row:= FRow; 97 | end; 98 | 99 | procedure TTokenizingTokenizer.FillTokenWithEOF; 100 | begin 101 | FCurrentToken.Error:= teNone; 102 | FCurrentToken.&Type:= ttEOF; 103 | FCurrentToken.Line:= FLine; 104 | FCurrentToken.Row:= FRow; 105 | FCurrentToken.Element:= UnicodeString(EmptyStr); 106 | end; 107 | 108 | function TTokenizingTokenizer.ProcessCharacter: TLoopFlow; 109 | begin 110 | Result:= lfNone; 111 | case FCurrentChar.Value of 112 | // White Spaces 113 | #9, ' ':begin 114 | if not (FStackTokens.Peek = tsWhiteSpace) then FStackTokens.Push(tsWhiteSpace); 115 | end; 116 | 117 | #10, #13:begin 118 | case FStackTokens.Peek of 119 | tsUndefined:begin 120 | if FCurrentChar.Value = #10 then 121 | begin 122 | FillTokenWithEOL; 123 | FCurrentToken.Element:= FCurrentChar.Value; 124 | Result:= lfBreak; 125 | end; 126 | if FCurrentChar.Value = #13 then 127 | begin 128 | FillTokenWithEOL(False); 129 | FCurrentToken.Element:= FCurrentChar.Value; 130 | FStackTokens.Push(tsMaybeCRLF); 131 | Result:= lfContinue; 132 | end; 133 | end; 134 | tsMaybeCRLF:begin 135 | if FCurrentChar.Value = #10 then 136 | begin 137 | FillTokenWithEOL; 138 | FCurrentToken.Element:= FCurrentToken.Element + FCurrentChar.Value; 139 | FStackTokens.Pop; 140 | Result:= lfBreak; 141 | end; 142 | end; 143 | otherwise 144 | // Do Nothing ?!?!?! 145 | end; 146 | end; 147 | 148 | // If everything else does not match 149 | otherwise 150 | FStackTokens.Pop; 151 | end; 152 | end; 153 | 154 | function TTokenizingTokenizer.GetNextToken: TToken; 155 | begin 156 | FillTokenWithReset; 157 | 158 | // Exit early if nothing to do 159 | if FSSourceFile.Size = 0 then 160 | begin 161 | FillTokenWithEOF; 162 | Result:= FCurrentToken; 163 | exit; 164 | end; 165 | 166 | FStackTokens.Push(tsUndefined); 167 | repeat 168 | FCurrentChar:= FSSourceFile.GetNextChar; 169 | 170 | // This is EOF 171 | if FCurrentChar.EOF then 172 | begin 173 | case FStackTokens.Peek of 174 | tsUndefined:begin 175 | FillTokenWithEOF; 176 | break; 177 | end; 178 | tsWhiteSpace:begin 179 | FStackTokens.Pop; 180 | FillTokenWithEOF; 181 | break; 182 | end; 183 | tsMaybeCRLF:begin 184 | FStackTokens.Pop; 185 | FillTokenWithEOL; 186 | break; 187 | end; 188 | otherwise 189 | // Do Nothing 190 | end; 191 | end 192 | else 193 | begin 194 | // We read something so we increase the row 195 | Inc(FRow); 196 | end; 197 | 198 | // We read something witout error, and we initialize the Line number 199 | if FLine = 0 then FLine:= 1; 200 | 201 | case FCurrentChar.&Type of 202 | tctUnknown:begin 203 | raise ETokenizingTokenizerUnknownCharType.Create(rsETokenizingTokenizerUnknownCharType); 204 | end; 205 | tctAnsi:begin 206 | case ProcessCharacter of 207 | lfNone:begin 208 | // Do Nothing 209 | end; 210 | lfBreak:begin 211 | break; 212 | end; 213 | lfContinue:begin 214 | continue; 215 | end; 216 | end; 217 | end; 218 | tctCodePoint:begin 219 | case ProcessCharacter of 220 | lfNone:begin 221 | { #todo 999 -ogcarreno : This needs to be re-evaluated with state } 222 | FCurrentToken.Element:= FCurrentToken.Element + FCurrentChar.Value; 223 | continue; 224 | end; 225 | lfBreak:begin 226 | break; 227 | end; 228 | lfContinue:begin 229 | continue; 230 | end; 231 | end; 232 | end; 233 | end; 234 | 235 | 236 | until FStackTokens.Peek = tsUndefined; 237 | if FStackTokens.Count > 1 then 238 | raise ETokenizingTokenizerStackNotEmpty.Create(rsETokenizingTokenizerStackNotEmpty); 239 | FStackTokens.Pop; 240 | Result:= FCurrentToken; 241 | end; 242 | 243 | end. 244 | 245 | -------------------------------------------------------------------------------- /tests/TestObjectPascalParserCLI.lpi: -------------------------------------------------------------------------------- 1 | <?xml version="1.0" encoding="UTF-8"?> 2 | <CONFIG> 3 | <ProjectOptions> 4 | <Version Value="12"/> 5 | <General> 6 | <Flags> 7 | <MainUnitHasCreateFormStatements Value="False"/> 8 | <MainUnitHasTitleStatement Value="False"/> 9 | <MainUnitHasScaledStatement Value="False"/> 10 | <CompatibilityMode Value="True"/> 11 | </Flags> 12 | <SessionStorage Value="InProjectDir"/> 13 | <Title Value="TestObjectPascalParserCLI"/> 14 | <UseAppBundle Value="False"/> 15 | <ResourceType Value="res"/> 16 | </General> 17 | <BuildModes Count="3"> 18 | <Item1 Name="Default" Default="True"/> 19 | <Item2 Name="Debug"> 20 | <CompilerOptions> 21 | <Version Value="11"/> 22 | <Target> 23 | <Filename Value="../bin/TestObjectPascalParserCLI"/> 24 | </Target> 25 | <SearchPaths> 26 | <IncludeFiles Value="../src;$(ProjOutDir)"/> 27 | <OtherUnitFiles Value="tests;text;../src/text;states;../src/states;tokenizing;../src/tokenizing;parser;../src/parser"/> 28 | <UnitOutputDirectory Value="../bin/lib/$(TargetCPU)-$(TargetOS)"/> 29 | </SearchPaths> 30 | <Parsing> 31 | <SyntaxOptions> 32 | <IncludeAssertionCode Value="True"/> 33 | </SyntaxOptions> 34 | </Parsing> 35 | <CodeGeneration> 36 | <Checks> 37 | <IOChecks Value="True"/> 38 | <RangeChecks Value="True"/> 39 | <OverflowChecks Value="True"/> 40 | <StackChecks Value="True"/> 41 | </Checks> 42 | <VerifyObjMethodCallValidity Value="True"/> 43 | </CodeGeneration> 44 | <Linking> 45 | <Debugging> 46 | <DebugInfoType Value="dsDwarf3"/> 47 | <UseHeaptrc Value="True"/> 48 | <TrashVariables Value="True"/> 49 | <UseExternalDbgSyms Value="True"/> 50 | </Debugging> 51 | </Linking> 52 | </CompilerOptions> 53 | </Item2> 54 | <Item3 Name="Release"> 55 | <CompilerOptions> 56 | <Version Value="11"/> 57 | <Target> 58 | <Filename Value="../bin/TestObjectPascalParserCLI"/> 59 | </Target> 60 | <SearchPaths> 61 | <IncludeFiles Value="../src;$(ProjOutDir)"/> 62 | <OtherUnitFiles Value="tests;text;../src/text;states;../src/states;tokenizing;../src/tokenizing;parser;../src/parser"/> 63 | <UnitOutputDirectory Value="../bin/lib/$(TargetCPU)-$(TargetOS)"/> 64 | </SearchPaths> 65 | <CodeGeneration> 66 | <SmartLinkUnit Value="True"/> 67 | <Optimizations> 68 | <OptimizationLevel Value="3"/> 69 | </Optimizations> 70 | </CodeGeneration> 71 | <Linking> 72 | <Debugging> 73 | <GenerateDebugInfo Value="False"/> 74 | </Debugging> 75 | <LinkSmart Value="True"/> 76 | </Linking> 77 | </CompilerOptions> 78 | </Item3> 79 | </BuildModes> 80 | <PublishOptions> 81 | <Version Value="2"/> 82 | <UseFileFilters Value="True"/> 83 | </PublishOptions> 84 | <RunParams> 85 | <FormatVersion Value="2"/> 86 | </RunParams> 87 | <RequiredPackages Count="1"> 88 | <Item1> 89 | <PackageName Value="FCL"/> 90 | </Item1> 91 | </RequiredPackages> 92 | <Units Count="16"> 93 | <Unit0> 94 | <Filename Value="TestObjectPascalParserCLI.lpr"/> 95 | <IsPartOfProject Value="True"/> 96 | </Unit0> 97 | <Unit1> 98 | <Filename Value="tests/opp.tests.pas"/> 99 | <IsPartOfProject Value="True"/> 100 | <UnitName Value="OPP.Tests"/> 101 | </Unit1> 102 | <Unit2> 103 | <Filename Value="text/testobjectpascalparsertextsourcefile.pas"/> 104 | <IsPartOfProject Value="True"/> 105 | <UnitName Value="TestObjectPascalParserTextSourceFile"/> 106 | </Unit2> 107 | <Unit3> 108 | <Filename Value="../src/text/opp.text.pas"/> 109 | <IsPartOfProject Value="True"/> 110 | <UnitName Value="OPP.Text"/> 111 | </Unit3> 112 | <Unit4> 113 | <Filename Value="../src/text/opp.text.sourcefile.pas"/> 114 | <IsPartOfProject Value="True"/> 115 | <UnitName Value="OPP.Text.SourceFile"/> 116 | </Unit4> 117 | <Unit5> 118 | <Filename Value="states/testobjectpascalparserstatesstack.pas"/> 119 | <IsPartOfProject Value="True"/> 120 | <UnitName Value="TestObjectPascalParserStatesStack"/> 121 | </Unit5> 122 | <Unit6> 123 | <Filename Value="../src/states/opp.states.pas"/> 124 | <IsPartOfProject Value="True"/> 125 | <UnitName Value="OPP.States"/> 126 | </Unit6> 127 | <Unit7> 128 | <Filename Value="../src/states/opp.states.stack.pas"/> 129 | <IsPartOfProject Value="True"/> 130 | <UnitName Value="OPP.States.Stack"/> 131 | </Unit7> 132 | <Unit8> 133 | <Filename Value="states/testobjectpascalparserstatesstacktokens.pas"/> 134 | <IsPartOfProject Value="True"/> 135 | <UnitName Value="TestObjectPascalParserStatesStackTokens"/> 136 | </Unit8> 137 | <Unit9> 138 | <Filename Value="../src/states/opp.states.stacktokens.pas"/> 139 | <IsPartOfProject Value="True"/> 140 | <UnitName Value="OPP.States.StackTokens"/> 141 | </Unit9> 142 | <Unit10> 143 | <Filename Value="tokenizing/testobjectpascalparsertokenizingtokenizer.pas"/> 144 | <IsPartOfProject Value="True"/> 145 | <UnitName Value="TestObjectPascalParserTokenizingTokenizer"/> 146 | </Unit10> 147 | <Unit11> 148 | <Filename Value="../src/tokenizing/opp.tokenizing.tokens.pas"/> 149 | <IsPartOfProject Value="True"/> 150 | <UnitName Value="OPP.Tokenizing.Tokens"/> 151 | </Unit11> 152 | <Unit12> 153 | <Filename Value="../src/tokenizing/opp.tokenizing.tokenizer.pas"/> 154 | <IsPartOfProject Value="True"/> 155 | <UnitName Value="OPP.Tokenizing.Tokenizer"/> 156 | </Unit12> 157 | <Unit13> 158 | <Filename Value="tokenizing/testobjectpascalparsertokenizingtokenizereof.pas"/> 159 | <IsPartOfProject Value="True"/> 160 | <UnitName Value="TestObjectPascalParserTokenizingTokenizerEOF"/> 161 | </Unit13> 162 | <Unit14> 163 | <Filename Value="parser/testobjectpascalparser.pas"/> 164 | <IsPartOfProject Value="True"/> 165 | <UnitName Value="TestObjectPascalParser"/> 166 | </Unit14> 167 | <Unit15> 168 | <Filename Value="../src/parser/opp.parser.pas"/> 169 | <IsPartOfProject Value="True"/> 170 | <UnitName Value="OPP.Parser"/> 171 | </Unit15> 172 | </Units> 173 | </ProjectOptions> 174 | <CompilerOptions> 175 | <Version Value="11"/> 176 | <Target> 177 | <Filename Value="../bin/TestObjectPascalParserCLI"/> 178 | </Target> 179 | <SearchPaths> 180 | <IncludeFiles Value="../src;$(ProjOutDir)"/> 181 | <OtherUnitFiles Value="tests;text;../src/text;states;../src/states;tokenizing;../src/tokenizing;parser;../src/parser"/> 182 | <UnitOutputDirectory Value="../bin/lib/$(TargetCPU)-$(TargetOS)"/> 183 | </SearchPaths> 184 | </CompilerOptions> 185 | <Debugging> 186 | <Exceptions Count="4"> 187 | <Item1> 188 | <Name Value="EAbort"/> 189 | </Item1> 190 | <Item2> 191 | <Name Value="ECodetoolError"/> 192 | </Item2> 193 | <Item3> 194 | <Name Value="EFOpenError"/> 195 | </Item3> 196 | <Item4> 197 | <Name Value="ETextSourceFileDoesNotExist"/> 198 | </Item4> 199 | </Exceptions> 200 | </Debugging> 201 | </CONFIG> 202 | -------------------------------------------------------------------------------- /src/text/opp.text.sourcefile.pas: -------------------------------------------------------------------------------- 1 | unit OPP.Text.SourceFile; 2 | 3 | {$I objectpascalparser.inc} 4 | 5 | interface 6 | 7 | uses 8 | Classes 9 | , SysUtils 10 | , OPP.Text 11 | ; 12 | 13 | type 14 | { ETextSourceFileDoesNotExist } 15 | ETextSourceFileDoesNotExist = class(Exception); 16 | 17 | { ETextSourceFilePrematureEOF } 18 | ETextSourceFilePrematureEOF = class(Exception); 19 | 20 | { TTextSourceFile } 21 | TTextSourceFile = class(TObject) 22 | private 23 | FFilename: String; 24 | FSourceFileStream: TFileStream; 25 | FFileType: TTextFileType; 26 | FHasBOM: Boolean; 27 | 28 | function GetStreamSize: Int64; 29 | protected 30 | public 31 | constructor Create(const AFileName: String); 32 | destructor Destroy; override; 33 | 34 | function GetNextChar: TTextCharacter; 35 | 36 | property Filename: String 37 | read FFilename; 38 | property FileType: TTextFileType 39 | read FFileType; 40 | property Size: Int64 41 | read GetStreamSize; 42 | property HasBOM: Boolean 43 | read FHasBOM; 44 | published 45 | end; 46 | 47 | resourcestring 48 | rsETextSourceFileDoesNotExist = 'File "%s" does not exist'; 49 | rsETextSourceFilePrematureEOF = 'File "%s" reached premature EOF'; 50 | 51 | implementation 52 | 53 | { TTextSourceFile } 54 | 55 | constructor TTextSourceFile.Create(const AFileName: String); 56 | var 57 | buffer: TBytes; 58 | begin 59 | buffer:= nil; 60 | FSourceFileStream:= nil; 61 | if not FileExists(AFileName) then raise ETextSourceFileDoesNotExist.Create( 62 | Format( 63 | rsETextSourceFileDoesNotExist, 64 | [ AFileName ] 65 | ) 66 | ); 67 | 68 | FFilename:= AFileName; 69 | FSourceFileStream:= TFileStream.Create(AFileName, fmOpenRead); 70 | 71 | FFileType:= tftUnknown; 72 | FHasBOM:= False; 73 | 74 | // For UTF8 75 | if (FFileType = tftUnknown) and (FSourceFileStream.Size >= cBOMUTF8Len) then 76 | begin 77 | FSourceFileStream.Position:= 0; // Just in case 78 | 79 | SetLength(buffer, cBOMUTF8Len); 80 | FSourceFileStream.Read(buffer[0], cBOMUTF8Len); 81 | 82 | if CompareByte(buffer[0], cBOMUTF8[0], cBOMUTF8Len) = 0 then 83 | begin 84 | FFileType:= tftUTF8; 85 | FHasBOM:= True; 86 | end; 87 | end; 88 | 89 | // For UTF16 90 | if (FFileType = tftUnknown) and (FSourceFileStream.Size >= cBOMUTF16Len) then 91 | begin 92 | FSourceFileStream.Position:= 0; // Just in case 93 | 94 | SetLength(buffer, cBOMUTF16Len); 95 | FSourceFileStream.Read(buffer[0], cBOMUTF16Len); 96 | 97 | if CompareByte(buffer[0], cBOMUTF16BE[0], cBOMUTF16Len) = 0 then 98 | begin 99 | FFileType:= tftUTF16BE; 100 | FHasBOM:= True; 101 | end 102 | else 103 | if CompareByte(buffer[0], cBOMUTF16LE[0], cBOMUTF16Len) = 0 then 104 | begin 105 | FFileType:= tftUTF16LE; 106 | FHasBOM:= True; 107 | end; 108 | end; 109 | 110 | // For UTF32 111 | if (FFileType = tftUnknown) and (FSourceFileStream.Size >= cBOMUTF32Len) then 112 | begin 113 | FSourceFileStream.Position:= 0; 114 | 115 | SetLength(buffer, cBOMUTF32Len); 116 | FSourceFileStream.Read(buffer[0], cBOMUTF32Len); 117 | 118 | if CompareByte(buffer[0], cBOMUTF32BE[0], cBOMUTF32Len) = 0 then 119 | begin 120 | FFileType:= tftUTF32BE; 121 | FHasBOM:= True; 122 | end 123 | else 124 | if CompareByte(buffer[0], cBOMUTF32LE[0], cBOMUTF32Len) = 0 then 125 | begin 126 | FFileType:= tftUTF32LE; 127 | FHasBOM:= True; 128 | end; 129 | end; 130 | 131 | if FFileType = tftUnknown then 132 | begin 133 | // Since file has no BOM, we need to dig a bit more into it's contents 134 | end; 135 | 136 | case FFileType of 137 | tftUnknown: begin 138 | { #todo 999 -ogcarreno : We are assuming this for the time being } 139 | FFileType:= tftUTF8; 140 | FSourceFileStream.Position:= 0; 141 | end; 142 | tftUTF8: begin 143 | if FHasBOM then 144 | begin 145 | FSourceFileStream.Position:= cBOMUTF8Len; 146 | end 147 | else 148 | begin 149 | FSourceFileStream.Position:= 0; 150 | end; 151 | end; 152 | tftUTF16BE, tftUTF16LE: begin 153 | if FHasBOM then 154 | begin 155 | FSourceFileStream.Position:= cBOMUTF16Len; 156 | end 157 | else 158 | begin 159 | FSourceFileStream.Position:= 0; 160 | end; 161 | end; 162 | tftUTF32BE, tftUTF32LE: begin 163 | if FHasBOM then 164 | begin 165 | FSourceFileStream.Position:= cBOMUTF32Len; 166 | end 167 | else 168 | begin 169 | FSourceFileStream.Position:= 0; 170 | end; 171 | end; 172 | end; 173 | 174 | 175 | end; 176 | 177 | destructor TTextSourceFile.Destroy; 178 | begin 179 | if Assigned(FSourceFileStream) then FSourceFileStream.Free; 180 | inherited Destroy; 181 | end; 182 | 183 | function TTextSourceFile.GetStreamSize: Int64; 184 | begin 185 | Result:= FSourceFileStream.Size; 186 | end; 187 | 188 | function TTextSourceFile.GetNextChar: TTextCharacter; 189 | var 190 | buffer: TBytes; 191 | bytesRead: LongInt; 192 | begin 193 | buffer:= nil; 194 | 195 | Result.&Type:= tctUnknown; 196 | Result.Value := ''; 197 | Result.EOF:= False; 198 | 199 | 200 | SetLength(buffer, 1); 201 | bytesRead:= FSourceFileStream.Read(buffer[0], Length(buffer)); 202 | if bytesRead = 0 then 203 | begin 204 | Result.EOF:= True; 205 | end 206 | else 207 | begin 208 | case FFileType of 209 | tftUnknown:begin 210 | // ?!? 211 | end; 212 | tftAnsi:begin 213 | // ?!? 214 | end; 215 | tftUTF8:begin 216 | case buffer[0] of 217 | $00..$7F:begin 218 | Result.&Type:= tctAnsi; 219 | Result.Value := UnicodeString(StringOf(buffer)); 220 | end; 221 | $C2..$DF:begin 222 | Result.&Type:= tctCodePoint; 223 | SetLength(buffer, 2); 224 | FSourceFileStream.Position:= FSourceFileStream.Position - 1; 225 | bytesRead:= FSourceFileStream.Read(buffer[0], Length(buffer)); 226 | if bytesRead = 0 then raise ETextSourceFilePrematureEOF.Create(rsETextSourceFilePrematureEOF); 227 | Result.Value:= UnicodeString(StringOf(buffer)); 228 | end; 229 | $E0, $E1..$EF:begin 230 | Result.&Type:= tctCodePoint; 231 | SetLength(buffer, 3); 232 | FSourceFileStream.Position:= FSourceFileStream.Position - 1; 233 | bytesRead:= FSourceFileStream.Read(buffer[0], Length(buffer)); 234 | if bytesRead = 0 then raise ETextSourceFilePrematureEOF.Create(rsETextSourceFilePrematureEOF); 235 | Result.Value:= UnicodeString(StringOf(buffer)); 236 | end; 237 | $F0, $F1..$F3, $F4:begin 238 | Result.&Type:= tctCodePoint; 239 | SetLength(buffer, 4); 240 | FSourceFileStream.Position:= FSourceFileStream.Position - 1; 241 | bytesRead:= FSourceFileStream.Read(buffer[0], Length(buffer)); 242 | if bytesRead = 0 then raise ETextSourceFilePrematureEOF.Create(rsETextSourceFilePrematureEOF); 243 | Result.Value:= UnicodeString(StringOf(buffer)); 244 | end; 245 | otherwise 246 | Result.&Type:= tctAnsi; 247 | Result.Value := UnicodeString(StringOf(buffer)); 248 | end; 249 | end; 250 | tftUTF16BE:begin 251 | Result.&Type:= tctCodePoint; 252 | // Need to read the next byte of the character 253 | end; 254 | tftUTF16LE:begin 255 | Result.&Type:= tctCodePoint; 256 | // Need to read the next byte of the character 257 | end; 258 | tftUTF32BE:begin 259 | Result.&Type:= tctCodePoint; 260 | // Need to read the next 3 bytes of the character 261 | end; 262 | tftUTF32LE:begin 263 | Result.&Type:= tctCodePoint; 264 | // Need to read the next 3 bytes of the character 265 | end; 266 | end; 267 | 268 | end; 269 | end; 270 | 271 | end. 272 | 273 | -------------------------------------------------------------------------------- /tests/tokenizing/testobjectpascalparsertokenizingtokenizereof.pas: -------------------------------------------------------------------------------- 1 | unit TestObjectPascalParserTokenizingTokenizerEOF; 2 | 3 | {$I objectpascalparser.inc} 4 | 5 | interface 6 | 7 | uses 8 | Classes 9 | , SysUtils 10 | , fpcunit 11 | //, testutils 12 | , testregistry 13 | , OPP.Text.SourceFile 14 | //, OPP.States 15 | , OPP.Tokenizing.Tokens 16 | , OPP.Tokenizing.Tokenizer 17 | ; 18 | 19 | type 20 | 21 | { TTestObjectPascalParserTokenizingTokenizerEOF } 22 | 23 | TTestObjectPascalParserTokenizingTokenizerEOF= class(TTestCase) 24 | private 25 | FTokenisingTokenizer: TTokenizingTokenizer; 26 | FSourceFile: TTextSourceFile; 27 | FToken: TToken; 28 | published 29 | procedure TestTokenizingTokenizerEOFEmpty; 30 | procedure TestTokenizingTokenizerEOFSpace; 31 | procedure TestTokenizingTokenizerEOFTab; 32 | procedure TestTokenizingTokenizerEOFSpaceTab; 33 | procedure TestTokenizingTokenizerEOFTabSpace; 34 | procedure TestTokenizingTokenizerEOFLineFeed; 35 | procedure TestTokenizingTokenizerEOFCarriageReturn; 36 | procedure TestTokenizingTokenizerEOFCarriageReturnLineFeed; 37 | end; 38 | 39 | implementation 40 | 41 | uses 42 | OPP.Tests 43 | ; 44 | 45 | const 46 | cSpace = ' '; 47 | cTab = #9; 48 | cEOLCR = #13; 49 | cEOLLF = #10; 50 | cEOLCRLF = cEOLCR + cEOLLF; 51 | // cAlpha = 'a'; 52 | // cEndInstruction = ';'; 53 | 54 | procedure TTestObjectPascalParserTokenizingTokenizerEOF.TestTokenizingTokenizerEOFEmpty; 55 | begin 56 | FSourceFile:= TTextSourceFile.Create(DumpToTempFile(EmptyStr)); 57 | FTokenisingTokenizer:= TTokenizingTokenizer.Create(FSourceFile); 58 | try 59 | FToken:= FTokenisingTokenizer.GetNextToken; 60 | AssertEquals('Tokenizing Tokenizer Token Error is None', TokenErrorToString(teNone), TokenErrorToString(FToken.Error)); 61 | AssertEquals('Tokenizing Tokenizer Token Type is EOF', TokenTypeToString(ttEOF), TokenTypeToString(FToken.&Type)); 62 | AssertEquals('Tokenizing Tokenizer Token Line is 0', 0, FToken.Line); 63 | AssertEquals('Tokenizing Tokenizer Token Row is 0', 0, FToken.Row); 64 | AssertEquals('Tokenizing Tokenizer Token Element is Empty', UnicodeString(EmptyStr), FToken.Element); 65 | finally 66 | FTokenisingTokenizer.Free; 67 | DeleteFile(FSourceFile.Filename); 68 | FSourceFile.Free; 69 | end; 70 | end; 71 | 72 | procedure TTestObjectPascalParserTokenizingTokenizerEOF.TestTokenizingTokenizerEOFSpace; 73 | begin 74 | FSourceFile:= TTextSourceFile.Create(DumpToTempFile(cSpace)); 75 | FTokenisingTokenizer:= TTokenizingTokenizer.Create(FSourceFile); 76 | try 77 | FToken:= FTokenisingTokenizer.GetNextToken; 78 | AssertEquals('Tokenizing Tokenizer Token Error is None', TokenErrorToString(teNone), TokenErrorToString(FToken.Error)); 79 | AssertEquals('Tokenizing Tokenizer Token Type is EOF', TokenTypeToString(ttEOF), TokenTypeToString(FToken.&Type)); 80 | AssertEquals('Tokenizing Tokenizer Token Line is 1', 1, FToken.Line); 81 | AssertEquals('Tokenizing Tokenizer Token Row is 1', 1, FToken.Row); 82 | AssertEquals('Tokenizing Tokenizer Token Element is Empty', UnicodeString(EmptyStr), FToken.Element); 83 | finally 84 | FTokenisingTokenizer.Free; 85 | DeleteFile(FSourceFile.Filename); 86 | FSourceFile.Free; 87 | end; 88 | end; 89 | 90 | procedure TTestObjectPascalParserTokenizingTokenizerEOF.TestTokenizingTokenizerEOFTab; 91 | begin 92 | FSourceFile:= TTextSourceFile.Create(DumpToTempFile(cTab)); 93 | FTokenisingTokenizer:= TTokenizingTokenizer.Create(FSourceFile); 94 | try 95 | FToken:= FTokenisingTokenizer.GetNextToken; 96 | AssertEquals('Tokenizing Tokenizer Token Error is None', TokenErrorToString(teNone), TokenErrorToString(FToken.Error)); 97 | AssertEquals('Tokenizing Tokenizer Token Type is EOF', TokenTypeToString(ttEOF), TokenTypeToString(FToken.&Type)); 98 | AssertEquals('Tokenizing Tokenizer Token Line is 1', 1, FToken.Line); 99 | AssertEquals('Tokenizing Tokenizer Token Row is 1', 1, FToken.Row); 100 | AssertEquals('Tokenizing Tokenizer Token Element is Empty', UnicodeString(EmptyStr), FToken.Element); 101 | finally 102 | FTokenisingTokenizer.Free; 103 | DeleteFile(FSourceFile.Filename); 104 | FSourceFile.Free; 105 | end; 106 | end; 107 | 108 | procedure TTestObjectPascalParserTokenizingTokenizerEOF.TestTokenizingTokenizerEOFSpaceTab; 109 | begin 110 | FSourceFile:= TTextSourceFile.Create(DumpToTempFile(cSpace + cTab)); 111 | FTokenisingTokenizer:= TTokenizingTokenizer.Create(FSourceFile); 112 | try 113 | FToken:= FTokenisingTokenizer.GetNextToken; 114 | AssertEquals('Tokenizing Tokenizer Token Error is None', TokenErrorToString(teNone), TokenErrorToString(FToken.Error)); 115 | AssertEquals('Tokenizing Tokenizer Token Type is EOF', TokenTypeToString(ttEOF), TokenTypeToString(FToken.&Type)); 116 | AssertEquals('Tokenizing Tokenizer Token Line is 1', 1, FToken.Line); 117 | AssertEquals('Tokenizing Tokenizer Token Row is 2', 2, FToken.Row); 118 | AssertEquals('Tokenizing Tokenizer Token Element is Empty', UnicodeString(EmptyStr), FToken.Element); 119 | finally 120 | FTokenisingTokenizer.Free; 121 | DeleteFile(FSourceFile.Filename); 122 | FSourceFile.Free; 123 | end; 124 | end; 125 | 126 | procedure TTestObjectPascalParserTokenizingTokenizerEOF.TestTokenizingTokenizerEOFTabSpace; 127 | begin 128 | FSourceFile:= TTextSourceFile.Create(DumpToTempFile(cTab + cSpace)); 129 | FTokenisingTokenizer:= TTokenizingTokenizer.Create(FSourceFile); 130 | try 131 | FToken:= FTokenisingTokenizer.GetNextToken; 132 | AssertEquals('Tokenizing Tokenizer Token Error is None', TokenErrorToString(teNone), TokenErrorToString(FToken.Error)); 133 | AssertEquals('Tokenizing Tokenizer Token Type is EOF', TokenTypeToString(ttEOF), TokenTypeToString(FToken.&Type)); 134 | AssertEquals('Tokenizing Tokenizer Token Line is 1', 1, FToken.Line); 135 | AssertEquals('Tokenizing Tokenizer Token Row is 2', 2, FToken.Row); 136 | AssertEquals('Tokenizing Tokenizer Token Element is Empty', UnicodeString(EmptyStr), FToken.Element); 137 | finally 138 | FTokenisingTokenizer.Free; 139 | DeleteFile(FSourceFile.Filename); 140 | FSourceFile.Free; 141 | end; 142 | end; 143 | 144 | procedure TTestObjectPascalParserTokenizingTokenizerEOF.TestTokenizingTokenizerEOFLineFeed; 145 | begin 146 | FSourceFile:= TTextSourceFile.Create(DumpToTempFile(cEOLLF)); 147 | FTokenisingTokenizer:= TTokenizingTokenizer.Create(FSourceFile); 148 | try 149 | FToken:= FTokenisingTokenizer.GetNextToken; 150 | AssertEquals('Tokenizing Tokenizer Token Error is None', TokenErrorToString(teNone), TokenErrorToString(FToken.Error)); 151 | AssertEquals('Tokenizing Tokenizer Token Type is EOL', TokenTypeToString(ttEOL), TokenTypeToString(FToken.&Type)); 152 | AssertEquals('Tokenizing Tokenizer Token Line is 2', 2, FToken.Line); 153 | AssertEquals('Tokenizing Tokenizer Token Row is 0', 0, FToken.Row); 154 | AssertEquals('Tokenizing Tokenizer Token Element is LF', UnicodeString(cEOLLF), FToken.Element); 155 | FToken:= FTokenisingTokenizer.GetNextToken; 156 | AssertEquals('Tokenizing Tokenizer Token Error is None', TokenErrorToString(teNone), TokenErrorToString(FToken.Error)); 157 | AssertEquals('Tokenizing Tokenizer Token Type is EOF', TokenTypeToString(ttEOF), TokenTypeToString(FToken.&Type)); 158 | AssertEquals('Tokenizing Tokenizer Token Line is 2', 2, FToken.Line); 159 | AssertEquals('Tokenizing Tokenizer Token Row is 0', 0, FToken.Row); 160 | AssertEquals('Tokenizing Tokenizer Token Element is Empty', UnicodeString(EmptyStr), FToken.Element); 161 | finally 162 | FTokenisingTokenizer.Free; 163 | DeleteFile(FSourceFile.Filename); 164 | FSourceFile.Free; 165 | end; 166 | end; 167 | 168 | procedure TTestObjectPascalParserTokenizingTokenizerEOF.TestTokenizingTokenizerEOFCarriageReturn; 169 | begin 170 | FSourceFile:= TTextSourceFile.Create(DumpToTempFile(cEOLCR)); 171 | FTokenisingTokenizer:= TTokenizingTokenizer.Create(FSourceFile); 172 | try 173 | FToken:= FTokenisingTokenizer.GetNextToken; 174 | AssertEquals('Tokenizing Tokenizer Token Error is None', TokenErrorToString(teNone), TokenErrorToString(FToken.Error)); 175 | AssertEquals('Tokenizing Tokenizer Token Type is EOL', TokenTypeToString(ttEOL), TokenTypeToString(FToken.&Type)); 176 | AssertEquals('Tokenizing Tokenizer Token Line is 2', 2, FToken.Line); 177 | AssertEquals('Tokenizing Tokenizer Token Row is 0', 0, FToken.Row); 178 | AssertEquals('Tokenizing Tokenizer Token Element is CR', UnicodeString(cEOLCR), FToken.Element); 179 | FToken:= FTokenisingTokenizer.GetNextToken; 180 | AssertEquals('Tokenizing Tokenizer Token Error is None', TokenErrorToString(teNone), TokenErrorToString(FToken.Error)); 181 | AssertEquals('Tokenizing Tokenizer Token Type is EOF', TokenTypeToString(ttEOF), TokenTypeToString(FToken.&Type)); 182 | AssertEquals('Tokenizing Tokenizer Token Line is 2', 2, FToken.Line); 183 | AssertEquals('Tokenizing Tokenizer Token Row is 0', 0, FToken.Row); 184 | AssertEquals('Tokenizing Tokenizer Token Element is Empty', UnicodeString(EmptyStr), FToken.Element); 185 | finally 186 | FTokenisingTokenizer.Free; 187 | DeleteFile(FSourceFile.Filename); 188 | FSourceFile.Free; 189 | end; 190 | end; 191 | 192 | procedure TTestObjectPascalParserTokenizingTokenizerEOF.TestTokenizingTokenizerEOFCarriageReturnLineFeed; 193 | begin 194 | FSourceFile:= TTextSourceFile.Create(DumpToTempFile(cEOLCR + cEOLLF)); 195 | FTokenisingTokenizer:= TTokenizingTokenizer.Create(FSourceFile); 196 | try 197 | FToken:= FTokenisingTokenizer.GetNextToken; 198 | AssertEquals('Tokenizing Tokenizer Token Error is None', TokenErrorToString(teNone), TokenErrorToString(FToken.Error)); 199 | AssertEquals('Tokenizing Tokenizer Token Type is EOL', TokenTypeToString(ttEOL), TokenTypeToString(FToken.&Type)); 200 | AssertEquals('Tokenizing Tokenizer Token Line is 2', 2, FToken.Line); 201 | AssertEquals('Tokenizing Tokenizer Token Row is 0', 0, FToken.Row); 202 | AssertEquals('Tokenizing Tokenizer Token Element is CRLF', UnicodeString(cEOLCRLF), FToken.Element); 203 | FToken:= FTokenisingTokenizer.GetNextToken; 204 | AssertEquals('Tokenizing Tokenizer Token Error is None', TokenErrorToString(teNone), TokenErrorToString(FToken.Error)); 205 | AssertEquals('Tokenizing Tokenizer Token Type is EOF', TokenTypeToString(ttEOF), TokenTypeToString(FToken.&Type)); 206 | AssertEquals('Tokenizing Tokenizer Token Line is 2', 2, FToken.Line); 207 | AssertEquals('Tokenizing Tokenizer Token Row is 0', 0, FToken.Row); 208 | AssertEquals('Tokenizing Tokenizer Token Element is Empty', UnicodeString(EmptyStr), FToken.Element); 209 | finally 210 | FTokenisingTokenizer.Free; 211 | DeleteFile(FSourceFile.Filename); 212 | FSourceFile.Free; 213 | end; 214 | end; 215 | 216 | 217 | 218 | initialization 219 | 220 | RegisterTest(TTestObjectPascalParserTokenizingTokenizerEOF); 221 | end. 222 | 223 | -------------------------------------------------------------------------------- /tests/text/testobjectpascalparsertextsourcefile.pas: -------------------------------------------------------------------------------- 1 | unit TestObjectPascalParserTextSourceFile; 2 | 3 | {$I objectpascalparser.inc} 4 | 5 | interface 6 | 7 | uses 8 | Classes 9 | , SysUtils 10 | , fpcunit 11 | //, testutils 12 | , testregistry 13 | , OPP.Text 14 | , OPP.Text.SourceFile 15 | ; 16 | 17 | type 18 | 19 | { TTestObjectPascalParserTextSourceFile } 20 | 21 | TTestObjectPascalParserTextSourceFile= class(TTestCase) 22 | private 23 | FSourceFile: TTextSourceFile; 24 | 25 | 26 | procedure TestSourceFileCreateException; 27 | published 28 | procedure TestObjectPascalParserTextSourceFileCreate; 29 | procedure TestObjectPascalParserTextSourceFileCreateException; 30 | procedure TestObjectPascalParserTextSourceFileFilename; 31 | procedure TestObjectPascalParserTextSourceGetNextCharAnsi; 32 | procedure TestObjectPascalParserTextSourceGetNextCharUTF8; 33 | procedure TestObjectPascalParserTextSourceGetNextCharUTF16BE; 34 | procedure TestObjectPascalParserTextSourceGetNextCharUTF16LE; 35 | procedure TestObjectPascalParserTextSourceGetNextCharUTF32BE; 36 | procedure TestObjectPascalParserTextSourceGetNextCharUTF32LE; 37 | procedure TestObjectPascalParserTextSourceGetNextCharBOMUTF8; 38 | procedure TestObjectPascalParserTextSourceGetNextCharBOMUTF16BE; 39 | procedure TestObjectPascalParserTextSourceGetNextCharBOMUTF16LE; 40 | procedure TestObjectPascalParserTextSourceGetNextCharBOMUTF32BE; 41 | procedure TestObjectPascalParserTextSourceGetNextCharBOMUTF32LE; 42 | end; 43 | 44 | implementation 45 | 46 | uses 47 | OPP.Tests 48 | ; 49 | 50 | const 51 | cSourceFileContentAnsi = 'program'; 52 | cSourceFileContentUTF8 = 'program Test🌟'; 53 | // cSourceFileContentUTF16BE = #0'p'#0'r'#0'o'#0'g'#0'r'#0'a'#0'm'; 54 | // cSourceFileContentUTF16LE = 'p'#0'r'#0'o'#0'g'#0'r'#0'a'#0'm'#0; 55 | // cSourceFileContentUTF32BE = #0#0#0'p'#0#0#0'r'#0#0#0'o'#0#0#0'g'#0#0#0'r'#0#0#0'a'#0#0#0'm'; 56 | // cSourceFileContentUTF32LE = 'p'#0#0#0'r'#0#0#0'o'#0#0#0'g'#0#0#0'r'#0#0#0'a'#0#0#0'm'#0#0#0; 57 | 58 | cSourceFileContentBOMUTF8 = #$EF#$BB#$BF'program Test🌟'; 59 | cSourceFileContentBOMUTF16BE = #$FE#$FF; 60 | cSourceFileContentBOMUTF16LE = #$FF#$FE; 61 | cSourceFileContentBOMUTF32BE = #$00#$00#$FE#$FF; 62 | cSourceFileContentBOMUTF32LE = #$00#$00#$FF#$FE; 63 | 64 | procedure TTestObjectPascalParserTextSourceFile.TestSourceFileCreateException; 65 | begin 66 | FSourceFile:= TTextSourceFile.Create(''); 67 | end; 68 | 69 | procedure TTestObjectPascalParserTextSourceFile.TestObjectPascalParserTextSourceFileCreate; 70 | begin 71 | FSourceFile:= TTextSourceFile.Create(DumpToTempFile('')); 72 | try 73 | AssertNotNull('Text Source File is not null', FSourceFile); 74 | AssertEquals('Text Source File is UTF8', TextFileTypeToString(tftUTF8), TextFileTypeToString(FSourceFile.FileType)); 75 | AssertFalse('Text Source File Has BOM is False', FSourceFile.HasBOM); 76 | finally 77 | DeleteFile(FSourceFile.Filename); 78 | FSourceFile.Free; 79 | end; 80 | end; 81 | 82 | procedure TTestObjectPascalParserTextSourceFile.TestObjectPascalParserTextSourceFileCreateException; 83 | begin 84 | FSourceFile:= nil; 85 | AssertException( 86 | 'Text Source File Doesn Not Exists Exception', 87 | ETextSourceFileDoesNotExist, 88 | @TestSourceFileCreateException, 89 | Format( 90 | rsETextSourceFileDoesNotExist, 91 | [ '' ] 92 | ) 93 | ); 94 | if Assigned(FSourceFile) then FSourceFile.Free; 95 | end; 96 | 97 | procedure TTestObjectPascalParserTextSourceFile.TestObjectPascalParserTextSourceFileFilename; 98 | var 99 | tmpFilename: String; 100 | begin 101 | tmpFilename:= DumpToTempFile(''); 102 | FSourceFile:= TTextSourceFile.Create(tmpFilename); 103 | try 104 | AssertEquals('Text Source File is UTF8', TextFileTypeToString(tftUTF8), TextFileTypeToString(FSourceFile.FileType)); 105 | AssertFalse('Text Source File Has BOM is False', FSourceFile.HasBOM); 106 | AssertEquals('Text Source File Filename', tmpFilename, FSourceFile.Filename); 107 | finally 108 | FSourceFile.Free; 109 | end; 110 | end; 111 | 112 | procedure TTestObjectPascalParserTextSourceFile.TestObjectPascalParserTextSourceGetNextCharAnsi; 113 | var 114 | nextChar: TTextCharacter; 115 | begin 116 | FSourceFile:= TTextSourceFile.Create(DumpToTempFile(cSourceFileContentAnsi)); 117 | try 118 | AssertEquals('Text Source File is UTF8', TextFileTypeToString(tftUTF8), TextFileTypeToString(FSourceFile.FileType)); 119 | AssertFalse('Text Source File Has BOM is False', FSourceFile.HasBOM); 120 | 121 | nextChar:= FSourceFile.GetNextChar; 122 | AssertEquals('Text Source File Next Char Type is Ansi', TextCharTypeToString(tctAnsi), TextCharTypeToString(nextChar.&Type)); 123 | AssertEquals('Text Source File Next Char is p', UnicodeString('p'), nextChar.Value); 124 | AssertFalse('Text Source File Next Char Not EOF', nextChar.EOF); 125 | 126 | nextChar:= FSourceFile.GetNextChar; 127 | AssertEquals('Text Source File Next Char Type is Ansi', TextCharTypeToString(tctAnsi), TextCharTypeToString(nextChar.&Type)); 128 | AssertEquals('Text Source File Next Char is r', UnicodeString('r'), nextChar.Value); 129 | AssertFalse('Text Source File Next Char Not EOF', nextChar.EOF); 130 | 131 | nextChar:= FSourceFile.GetNextChar; 132 | AssertEquals('Text Source File Next Char Type is Ansi', TextCharTypeToString(tctAnsi), TextCharTypeToString(nextChar.&Type)); 133 | AssertEquals('Text Source File Next Char is o', UnicodeString('o'), nextChar.Value); 134 | AssertFalse('Text Source File Next Char Not EOF', nextChar.EOF); 135 | 136 | nextChar:= FSourceFile.GetNextChar; 137 | AssertEquals('Text Source File Next Char Type is Ansi', TextCharTypeToString(tctAnsi), TextCharTypeToString(nextChar.&Type)); 138 | AssertEquals('Text Source File Next Char is g', UnicodeString('g'), nextChar.Value); 139 | AssertFalse('Text Source File Next Char Not EOF', nextChar.EOF); 140 | 141 | nextChar:= FSourceFile.GetNextChar; 142 | AssertEquals('Text Source File Next Char Type is Ansi', TextCharTypeToString(tctAnsi), TextCharTypeToString(nextChar.&Type)); 143 | AssertEquals('Text Source File Next Char is r', UnicodeString('r'), nextChar.Value); 144 | AssertFalse('Text Source File Next Char Not EOF', nextChar.EOF); 145 | 146 | nextChar:= FSourceFile.GetNextChar; 147 | AssertEquals('Text Source File Next Char Type is Ansi', TextCharTypeToString(tctAnsi), TextCharTypeToString(nextChar.&Type)); 148 | AssertEquals('Text Source File Next Char is a', UnicodeString('a'), nextChar.Value); 149 | AssertFalse('Text Source File Next Char Not EOF', nextChar.EOF); 150 | 151 | nextChar:= FSourceFile.GetNextChar; 152 | AssertEquals('Text Source File Next Char Type is Ansi', TextCharTypeToString(tctAnsi), TextCharTypeToString(nextChar.&Type)); 153 | AssertEquals('Text Source File Next Char is m', UnicodeString('m'), nextChar.Value); 154 | AssertFalse('Text Source File Next Char Not EOF', nextChar.EOF); 155 | 156 | nextChar:= FSourceFile.GetNextChar; 157 | AssertEquals('Text Source File Next Char Type is Unknown', TextCharTypeToString(tctUnknown), TextCharTypeToString(nextChar.&Type)); 158 | AssertEquals('Text Source File Next Char is empty', Unicodestring(EmptyStr), nextChar.Value); 159 | AssertTrue('Text Source File Next Char is EOF', nextChar.EOF); 160 | finally 161 | FSourceFile.Free; 162 | end; 163 | end; 164 | 165 | procedure TTestObjectPascalParserTextSourceFile.TestObjectPascalParserTextSourceGetNextCharUTF8; 166 | var 167 | nextChar: TTextCharacter; 168 | begin 169 | FSourceFile:= TTextSourceFile.Create(DumpToTempFile(cSourceFileContentUTF8)); 170 | try 171 | AssertEquals('Text Source File is UTF8', TextFileTypeToString(tftUTF8), TextFileTypeToString(FSourceFile.FileType)); 172 | AssertFalse('Text Source File Has BOM is False', FSourceFile.HasBOM); 173 | 174 | nextChar:= FSourceFile.GetNextChar; 175 | AssertEquals('Text Source File Next Char Type is Ansi', Ord(tctAnsi), Ord(nextChar.&Type)); 176 | AssertEquals('Text Source File Next Char is p', UnicodeString('p'), nextChar.Value); 177 | AssertFalse('Text Source File Next Char Not EOF', nextChar.EOF); 178 | 179 | nextChar:= FSourceFile.GetNextChar; 180 | AssertEquals('Text Source File Next Char Type is Ansi', TextCharTypeToString(tctAnsi), TextCharTypeToString(nextChar.&Type)); 181 | AssertEquals('Text Source File Next Char is r', UnicodeString('r'), nextChar.Value); 182 | AssertFalse('Text Source File Next Char Not EOF', nextChar.EOF); 183 | 184 | nextChar:= FSourceFile.GetNextChar; 185 | AssertEquals('Text Source File Next Char Type is Ansi', TextCharTypeToString(tctAnsi), TextCharTypeToString(nextChar.&Type)); 186 | AssertEquals('Text Source File Next Char is o', UnicodeString('o'), nextChar.Value); 187 | AssertFalse('Text Source File Next Char Not EOF', nextChar.EOF); 188 | 189 | nextChar:= FSourceFile.GetNextChar; 190 | AssertEquals('Text Source File Next Char Type is Ansi', TextCharTypeToString(tctAnsi), TextCharTypeToString(nextChar.&Type)); 191 | AssertEquals('Text Source File Next Char is g', UnicodeString('g'), nextChar.Value); 192 | AssertFalse('Text Source File Next Char Not EOF', nextChar.EOF); 193 | 194 | nextChar:= FSourceFile.GetNextChar; 195 | AssertEquals('Text Source File Next Char Type is Ansi', TextCharTypeToString(tctAnsi), TextCharTypeToString(nextChar.&Type)); 196 | AssertEquals('Text Source File Next Char is r', UnicodeString('r'), nextChar.Value); 197 | AssertFalse('Text Source File Next Char Not EOF', nextChar.EOF); 198 | 199 | nextChar:= FSourceFile.GetNextChar; 200 | AssertEquals('Text Source File Next Char Type is Ansi', TextCharTypeToString(tctAnsi), TextCharTypeToString(nextChar.&Type)); 201 | AssertEquals('Text Source File Next Char is a', UnicodeString('a'), nextChar.Value); 202 | AssertFalse('Text Source File Next Char Not EOF', nextChar.EOF); 203 | 204 | nextChar:= FSourceFile.GetNextChar; 205 | AssertEquals('Text Source File Next Char Type is Ansi', TextCharTypeToString(tctAnsi), TextCharTypeToString(nextChar.&Type)); 206 | AssertEquals('Text Source File Next Char is m', UnicodeString('m'), nextChar.Value); 207 | AssertFalse('Text Source File Next Char Not EOF', nextChar.EOF); 208 | 209 | nextChar:= FSourceFile.GetNextChar; 210 | AssertEquals('Text Source File Next Char Type is Ansi', TextCharTypeToString(tctAnsi), TextCharTypeToString(nextChar.&Type)); 211 | AssertEquals('Text Source File Next Char is Space', UnicodeString(' '), nextChar.Value); 212 | AssertFalse('Text Source File Next Char Not EOF', nextChar.EOF); 213 | 214 | nextChar:= FSourceFile.GetNextChar; 215 | AssertEquals('Text Source File Next Char Type is Ansi', TextCharTypeToString(tctAnsi), TextCharTypeToString(nextChar.&Type)); 216 | AssertEquals('Text Source File Next Char is T', UnicodeString('T'), nextChar.Value); 217 | AssertFalse('Text Source File Next Char Not EOF', nextChar.EOF); 218 | 219 | nextChar:= FSourceFile.GetNextChar; 220 | AssertEquals('Text Source File Next Char Type is Ansi', TextCharTypeToString(tctAnsi), TextCharTypeToString(nextChar.&Type)); 221 | AssertEquals('Text Source File Next Char is e', UnicodeString('e'), nextChar.Value); 222 | AssertFalse('Text Source File Next Char Not EOF', nextChar.EOF); 223 | 224 | nextChar:= FSourceFile.GetNextChar; 225 | AssertEquals('Text Source File Next Char Type is Ansi', TextCharTypeToString(tctAnsi), TextCharTypeToString(nextChar.&Type)); 226 | AssertEquals('Text Source File Next Char is s', UnicodeString('s'), nextChar.Value); 227 | AssertFalse('Text Source File Next Char Not EOF', nextChar.EOF); 228 | 229 | nextChar:= FSourceFile.GetNextChar; 230 | AssertEquals('Text Source File Next Char Type is Ansi', TextCharTypeToString(tctAnsi), TextCharTypeToString(nextChar.&Type)); 231 | AssertEquals('Text Source File Next Char is t', UnicodeString('t'), nextChar.Value); 232 | AssertFalse('Text Source File Next Char Not EOF', nextChar.EOF); 233 | 234 | nextChar:= FSourceFile.GetNextChar; 235 | AssertEquals('Text Source File Next Char Type is CodePoint', TextCharTypeToString(tctCodePoint), TextCharTypeToString(nextChar.&Type)); 236 | AssertEquals('Text Source File Next Char is 🌟', '🌟', nextChar.Value); 237 | AssertFalse('Text Source File Next Char Not EOF', nextChar.EOF); 238 | 239 | nextChar:= FSourceFile.GetNextChar; 240 | AssertEquals('Text Source File Next Char Type is Unknown', TextCharTypeToString(tctUnknown), TextCharTypeToString(nextChar.&Type)); 241 | AssertEquals('Text Source File Next Char is empty', UnicodeString(EmptyStr), nextChar.Value); 242 | AssertTrue('Text Source File Next Char is EOF', nextChar.EOF); 243 | finally 244 | FSourceFile.Free; 245 | end; 246 | end; 247 | 248 | procedure TTestObjectPascalParserTextSourceFile.TestObjectPascalParserTextSourceGetNextCharUTF16BE; 249 | //var 250 | // nextChar: TTextCharacter; 251 | begin 252 | //Fail('Implement Next Char UTF16BE'); 253 | {FSourceFile:= TTextSourceFile.Create(DumpToTempFile(cSourceFileContentUTF16BE)); 254 | try 255 | AssertEquals('Text Source File is UTF16BE', TextFileTypeToString(tftUTF16BE), TextFileTypeToString(FSourceFile.FileType)); 256 | AssertFalse('Text Source File Has BOM is False', FSourceFile.HasBOM); 257 | 258 | nextChar:= FSourceFile.GetNextChar; 259 | AssertEquals('Text Source File Next Char Type is Ansi', Ord(tctAnsi), Ord(nextChar.&Type)); 260 | AssertEquals('Text Source File Next Char is p', 'p', nextChar.Value); 261 | AssertFalse('Text Source File Next Char Not EOF', nextChar.EOF); 262 | finally 263 | FSourceFile.Free; 264 | end;} 265 | end; 266 | 267 | procedure TTestObjectPascalParserTextSourceFile.TestObjectPascalParserTextSourceGetNextCharUTF16LE; 268 | begin 269 | //Fail('Implement Next Char UTF16LE'); 270 | end; 271 | 272 | procedure TTestObjectPascalParserTextSourceFile.TestObjectPascalParserTextSourceGetNextCharUTF32BE; 273 | begin 274 | //Fail('Implement Next Char UTF32BE'); 275 | end; 276 | 277 | procedure TTestObjectPascalParserTextSourceFile.TestObjectPascalParserTextSourceGetNextCharUTF32LE; 278 | begin 279 | //Fail('Implement Next Char UTF32LE'); 280 | end; 281 | 282 | procedure TTestObjectPascalParserTextSourceFile.TestObjectPascalParserTextSourceGetNextCharBOMUTF8; 283 | var 284 | nextChar: TTextCharacter; 285 | begin 286 | FSourceFile:= TTextSourceFile.Create(DumpToTempFile(cSourceFileContentBOMUTF8)); 287 | try 288 | AssertEquals('Text Source File is UTF8', TextFileTypeToString(tftUTF8), TextFileTypeToString(FSourceFile.FileType)); 289 | AssertTrue('Text Source File Has BOM', FSourceFile.HasBOM); 290 | 291 | nextChar:= FSourceFile.GetNextChar; 292 | AssertEquals('Text Source File Next Char Type is Ansi', TextCharTypeToString(tctAnsi), TextCharTypeToString(nextChar.&Type)); 293 | AssertEquals('Text Source File Next Char is p', UnicodeString('p'), nextChar.Value); 294 | AssertFalse('Text Source File Next Char Not EOF', nextChar.EOF); 295 | 296 | nextChar:= FSourceFile.GetNextChar; 297 | AssertEquals('Text Source File Next Char Type is Ansi', TextCharTypeToString(tctAnsi), TextCharTypeToString(nextChar.&Type)); 298 | AssertEquals('Text Source File Next Char is r', UnicodeString('r'), nextChar.Value); 299 | AssertFalse('Text Source File Next Char Not EOF', nextChar.EOF); 300 | 301 | nextChar:= FSourceFile.GetNextChar; 302 | AssertEquals('Text Source File Next Char Type is Ansi', TextCharTypeToString(tctAnsi), TextCharTypeToString(nextChar.&Type)); 303 | AssertEquals('Text Source File Next Char is o', UnicodeString('o'), nextChar.Value); 304 | AssertFalse('Text Source File Next Char Not EOF', nextChar.EOF); 305 | 306 | nextChar:= FSourceFile.GetNextChar; 307 | AssertEquals('Text Source File Next Char Type is Ansi', TextCharTypeToString(tctAnsi), TextCharTypeToString(nextChar.&Type)); 308 | AssertEquals('Text Source File Next Char is g', UnicodeString('g'), nextChar.Value); 309 | AssertFalse('Text Source File Next Char Not EOF', nextChar.EOF); 310 | 311 | nextChar:= FSourceFile.GetNextChar; 312 | AssertEquals('Text Source File Next Char Type is Ansi', TextCharTypeToString(tctAnsi), TextCharTypeToString(nextChar.&Type)); 313 | AssertEquals('Text Source File Next Char is r', UnicodeString('r'), nextChar.Value); 314 | AssertFalse('Text Source File Next Char Not EOF', nextChar.EOF); 315 | 316 | nextChar:= FSourceFile.GetNextChar; 317 | AssertEquals('Text Source File Next Char Type is Ansi', TextCharTypeToString(tctAnsi), TextCharTypeToString(nextChar.&Type)); 318 | AssertEquals('Text Source File Next Char is a', UnicodeString('a'), nextChar.Value); 319 | AssertFalse('Text Source File Next Char Not EOF', nextChar.EOF); 320 | 321 | nextChar:= FSourceFile.GetNextChar; 322 | AssertEquals('Text Source File Next Char Type is Ansi', TextCharTypeToString(tctAnsi), TextCharTypeToString(nextChar.&Type)); 323 | AssertEquals('Text Source File Next Char is m', UnicodeString('m'), nextChar.Value); 324 | AssertFalse('Text Source File Next Char Not EOF', nextChar.EOF); 325 | 326 | nextChar:= FSourceFile.GetNextChar; 327 | AssertEquals('Text Source File Next Char Type is Ansi', TextCharTypeToString(tctAnsi), TextCharTypeToString(nextChar.&Type)); 328 | AssertEquals('Text Source File Next Char is Space', UnicodeString(' '), nextChar.Value); 329 | AssertFalse('Text Source File Next Char Not EOF', nextChar.EOF); 330 | 331 | nextChar:= FSourceFile.GetNextChar; 332 | AssertEquals('Text Source File Next Char Type is Ansi', TextCharTypeToString(tctAnsi), TextCharTypeToString(nextChar.&Type)); 333 | AssertEquals('Text Source File Next Char is T', UnicodeString('T'), nextChar.Value); 334 | AssertFalse('Text Source File Next Char Not EOF', nextChar.EOF); 335 | 336 | nextChar:= FSourceFile.GetNextChar; 337 | AssertEquals('Text Source File Next Char Type is Ansi', TextCharTypeToString(tctAnsi), TextCharTypeToString(nextChar.&Type)); 338 | AssertEquals('Text Source File Next Char is e', UnicodeString('e'), nextChar.Value); 339 | AssertFalse('Text Source File Next Char Not EOF', nextChar.EOF); 340 | 341 | nextChar:= FSourceFile.GetNextChar; 342 | AssertEquals('Text Source File Next Char Type is Ansi', TextCharTypeToString(tctAnsi), TextCharTypeToString(nextChar.&Type)); 343 | AssertEquals('Text Source File Next Char is s', UnicodeString('s'), nextChar.Value); 344 | AssertFalse('Text Source File Next Char Not EOF', nextChar.EOF); 345 | 346 | nextChar:= FSourceFile.GetNextChar; 347 | AssertEquals('Text Source File Next Char Type is Ansi', TextCharTypeToString(tctAnsi), TextCharTypeToString(nextChar.&Type)); 348 | AssertEquals('Text Source File Next Char is t', UnicodeString('t'), nextChar.Value); 349 | AssertFalse('Text Source File Next Char Not EOF', nextChar.EOF); 350 | 351 | nextChar:= FSourceFile.GetNextChar; 352 | AssertEquals('Text Source File Next Char Type is UTF8', TextCharTypeToString(tctCodePoint), TextCharTypeToString(nextChar.&Type)); 353 | AssertEquals('Text Source File Next Char is 🌟', '🌟', nextChar.Value); 354 | AssertFalse('Text Source File Next Char Not EOF', nextChar.EOF); 355 | 356 | nextChar:= FSourceFile.GetNextChar; 357 | AssertEquals('Text Source File Next Char Type is Unknown', TextCharTypeToString(tctUnknown), TextCharTypeToString(nextChar.&Type)); 358 | AssertEquals('Text Source File Next Char is empty', UnicodeString(EmptyStr), nextChar.Value); 359 | AssertTrue('Text Source File Next Char is EOF', nextChar.EOF); 360 | finally 361 | FSourceFile.Free; 362 | end; 363 | end; 364 | 365 | procedure TTestObjectPascalParserTextSourceFile.TestObjectPascalParserTextSourceGetNextCharBOMUTF16BE; 366 | var 367 | nextChar: TTextCharacter; 368 | begin 369 | FSourceFile:= TTextSourceFile.Create(DumpToTempFile(cSourceFileContentBOMUTF16BE)); 370 | try 371 | AssertEquals('Text Source File is UTF16BE', TextFileTypeToString(tftUTF16BE), TextFileTypeToString(FSourceFile.FileType)); 372 | AssertTrue('Text Source File Has BOM', FSourceFile.HasBOM); 373 | 374 | nextChar:= FSourceFile.GetNextChar; 375 | AssertEquals('Text Source File Next Char Type is Unknown', TextCharTypeToString(tctUnknown), TextCharTypeToString(nextChar.&Type)); 376 | AssertEquals('Text Source File Next Char is empty', UnicodeString(EmptyStr), nextChar.Value); 377 | AssertTrue('Text Source File Next Char is EOF', nextChar.EOF); 378 | finally 379 | FSourceFile.Free; 380 | end; 381 | end; 382 | 383 | procedure TTestObjectPascalParserTextSourceFile.TestObjectPascalParserTextSourceGetNextCharBOMUTF16LE; 384 | var 385 | nextChar: TTextCharacter; 386 | begin 387 | FSourceFile:= TTextSourceFile.Create(DumpToTempFile(cSourceFileContentBOMUTF16LE)); 388 | try 389 | AssertEquals('Text Source File is UTF16LE', TextFileTypeToString(tftUTF16LE), TextFileTypeToString(FSourceFile.FileType)); 390 | AssertTrue('Text Source File Has BOM', FSourceFile.HasBOM); 391 | 392 | nextChar:= FSourceFile.GetNextChar; 393 | AssertEquals('Text Source File Next Char Type is Unknown', TextCharTypeToString(tctUnknown), TextCharTypeToString(nextChar.&Type)); 394 | AssertEquals('Text Source File Next Char is empty', UnicodeString(EmptyStr), nextChar.Value); 395 | AssertTrue('Text Source File Next Char is EOF', nextChar.EOF); 396 | finally 397 | FSourceFile.Free; 398 | end; 399 | end; 400 | 401 | procedure TTestObjectPascalParserTextSourceFile.TestObjectPascalParserTextSourceGetNextCharBOMUTF32BE; 402 | var 403 | nextChar: TTextCharacter; 404 | begin 405 | FSourceFile:= TTextSourceFile.Create(DumpToTempFile(cSourceFileContentBOMUTF32BE)); 406 | try 407 | AssertEquals('Text Source File is UTF32BE', TextFileTypeToString(tftUTF32BE), TextFileTypeToString(FSourceFile.FileType)); 408 | AssertTrue('Text Source File Has BOM', FSourceFile.HasBOM); 409 | 410 | nextChar:= FSourceFile.GetNextChar; 411 | AssertEquals('Text Source File Next Char Type is Unknown', TextCharTypeToString(tctUnknown), TextCharTypeToString(nextChar.&Type)); 412 | AssertEquals('Text Source File Next Char is empty', UnicodeString(EmptyStr), nextChar.Value); 413 | AssertTrue('Text Source File Next Char is EOF', nextChar.EOF); 414 | finally 415 | FSourceFile.Free; 416 | end; 417 | end; 418 | 419 | procedure TTestObjectPascalParserTextSourceFile.TestObjectPascalParserTextSourceGetNextCharBOMUTF32LE; 420 | var 421 | nextChar: TTextCharacter; 422 | begin 423 | FSourceFile:= TTextSourceFile.Create(DumpToTempFile(cSourceFileContentBOMUTF32LE)); 424 | try 425 | AssertEquals('Text Source File is UTF32LE', TextFileTypeToString(tftUTF32LE), TextFileTypeToString(FSourceFile.FileType)); 426 | AssertTrue('Text Source File Has BOM', FSourceFile.HasBOM); 427 | 428 | nextChar:= FSourceFile.GetNextChar; 429 | AssertEquals('Text Source File Next Char Type is Unknown', TextCharTypeToString(tctUnknown), TextCharTypeToString(nextChar.&Type)); 430 | AssertEquals('Text Source File Next Char is empty', UnicodeString(EmptyStr), nextChar.Value); 431 | AssertTrue('Text Source File Next Char is EOF', nextChar.EOF); 432 | finally 433 | FSourceFile.Free; 434 | end; 435 | end; 436 | 437 | initialization 438 | 439 | RegisterTest(TTestObjectPascalParserTextSourceFile); 440 | end. 441 | 442 | --------------------------------------------------------------------------------