{ This file is part of the Free Component Library (FCL) Copyright (c) 2025 by Michael Van Canneyt HTML highlighter unit test See the file COPYING.FPC, included in this distribution, for details about the copyright. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. **********************************************************************} unit unittest.html; interface {$mode objfpc}{$H+} uses Classes, SysUtils, fpcunit, testregistry, syntax.highlighter, syntax.html; type TTestHtmlHighlighter = class(TTestCase) protected procedure SetUp; override; procedure TearDown; override; private function DoHtmlHighlighting(const source: string): TSyntaxTokenArray; published procedure TestHtmlBasicTags; procedure TestHtmlAttributes; procedure TestHtmlComments; procedure TestHtmlEntities; procedure TestHtmlEmbeddedCSS; procedure TestHtmlEmbeddedJavaScript; procedure TestHtmlDoctype; procedure TestHtmlSelfClosingTags; procedure TestHtmlNestedTags; procedure TestComplexHtmlDocument; procedure TestHtmlCDATA; procedure TestCategorySystem; end; implementation procedure TTestHtmlHighlighter.SetUp; begin end; procedure TTestHtmlHighlighter.TearDown; begin // Nothing to do end; function TTestHtmlHighlighter.DoHtmlHighlighting(const source: string): TSyntaxTokenArray; var highlighter: THtmlSyntaxHighlighter; begin highlighter := THtmlSyntaxHighlighter.Create; try Result := highlighter.Execute(source); finally highlighter.Free; end; end; procedure TTestHtmlHighlighter.TestHtmlBasicTags; var tokens: TSyntaxTokenArray; begin // Test simple div tag tokens := DoHtmlHighlighting('
'); AssertTrue('Should have at least 3 tokens', Length(tokens) >= 3); AssertEquals('First token should be opening bracket', '<', tokens[0].Text); AssertEquals('Opening bracket should be symbol', Ord(shSymbol), Ord(tokens[0].Kind)); AssertEquals('Tag name should be div', 'div', tokens[1].Text); AssertEquals('Tag name should be keyword', Ord(shKeyword), Ord(tokens[1].Kind)); AssertEquals('Closing bracket should be >', '>', tokens[2].Text); AssertEquals('Closing bracket should be symbol', Ord(shSymbol), Ord(tokens[2].Kind)); // Test closing tag tokens := DoHtmlHighlighting('
'); AssertTrue('Should have at least 3 tokens', Length(tokens) >= 3); AssertEquals('First token should be opening bracket with slash', '', '>', tokens[2].Text); // Test self-closing tag tokens := DoHtmlHighlighting('
'); AssertTrue('Should have at least 4 tokens', Length(tokens) >= 4); AssertEquals('First token should be <', '<', tokens[0].Text); AssertEquals('Tag name should be br', 'br', tokens[1].Text); AssertEquals('Slash should be symbol', Ord(shSymbol), Ord(tokens[2].Kind)); AssertEquals('Closing bracket should be >', '>', tokens[3].Text); end; procedure TTestHtmlHighlighter.TestHtmlAttributes; var tokens: TSyntaxTokenArray; i: Integer; hasAttribute, hasValue: Boolean; begin tokens := DoHtmlHighlighting('
'); AssertTrue('Should have multiple tokens', Length(tokens) > 5); hasAttribute := False; hasValue := False; for i := 0 to High(tokens) do begin if tokens[i].Text = 'class' then hasAttribute := True; if tokens[i].Text = '"container"' then hasValue := True; end; AssertTrue('Should contain class attribute', hasAttribute); AssertTrue('Should contain attribute value', hasValue); end; procedure TTestHtmlHighlighter.TestHtmlComments; var tokens: TSyntaxTokenArray; foundComment: Boolean; i: Integer; begin tokens := DoHtmlHighlighting(''); foundComment := False; for i := 0 to High(tokens) do if (tokens[i].Kind = shComment) or (tokens[i].Kind = shSymbol) then foundComment := True; AssertTrue('Should contain comment tokens', foundComment); AssertTrue('Should have multiple tokens', Length(tokens) >= 1); end; procedure TTestHtmlHighlighter.TestHtmlEntities; var tokens: TSyntaxTokenArray; foundEntity: Boolean; i: Integer; begin tokens := DoHtmlHighlighting('&'); foundEntity := False; for i := 0 to High(tokens) do begin if (tokens[i].Text = '&') and (tokens[i].Kind = shEscape) then foundEntity := True; end; AssertTrue('Should recognize HTML entity', foundEntity); // Test numeric entity tokens := DoHtmlHighlighting('{'); foundEntity := False; for i := 0 to High(tokens) do begin if (tokens[i].Text = '{') and (tokens[i].Kind = shEscape) then foundEntity := True; end; AssertTrue('Should recognize numeric HTML entity', foundEntity); end; procedure TTestHtmlHighlighter.TestHtmlEmbeddedCSS; var tokens: TSyntaxTokenArray; lToken : TSyntaxToken; hasStyleTag, hasCSS: Boolean; i: Integer; begin tokens := DoHtmlHighlighting(''); hasStyleTag := False; hasCSS := False; for i := 0 to High(tokens) do begin lToken:=tokens[i]; if (lToken.Text = 'style') and (lToken.Kind = shKeyword) then hasStyleTag := True; if (lToken.CategoryCount> 0) and (lToken.Text = 'body') then hasCSS := True; end; AssertTrue('Should contain style tag', hasStyleTag); AssertTrue('Should have multiple tokens', Length(tokens) > 5); AssertTrue('Should have CSS', hasCSS); // Note: CSS parsing depends on embedded highlighter end; procedure TTestHtmlHighlighter.TestHtmlEmbeddedJavaScript; var tokens: TSyntaxTokenArray; hasScriptTag: Boolean; i: Integer; begin tokens := DoHtmlHighlighting(''); hasScriptTag := False; for i := 0 to High(tokens) do if (tokens[i].Text = 'script') and (tokens[i].Kind = shKeyword) then hasScriptTag := True; AssertTrue('Should contain script tag', hasScriptTag); AssertTrue('Should have multiple tokens', Length(tokens) > 5); // Note: JavaScript parsing depends on embedded highlighter end; procedure TTestHtmlHighlighter.TestHtmlDoctype; var tokens: TSyntaxTokenArray; foundDoctype: Boolean; i: Integer; begin tokens := DoHtmlHighlighting(''); foundDoctype := False; for i := 0 to High(tokens) do if (tokens[i].Kind = shDirective) and (Pos('DOCTYPE', tokens[i].Text) > 0) then foundDoctype := True; AssertTrue('Should recognize DOCTYPE as directive', foundDoctype); end; procedure TTestHtmlHighlighter.TestHtmlSelfClosingTags; var tokens: TSyntaxTokenArray; hasImg, hasSlash: Boolean; i: Integer; begin tokens := DoHtmlHighlighting(''); hasImg := False; hasSlash := False; for i := 0 to High(tokens) do begin if (tokens[i].Text = 'img') and (tokens[i].Kind = shKeyword) then hasImg := True; if (tokens[i].Text = '/') and (tokens[i].Kind = shSymbol) then hasSlash := True; end; AssertTrue('Should contain img tag', hasImg); AssertTrue('Should contain closing slash', hasSlash); end; procedure TTestHtmlHighlighter.TestHtmlNestedTags; var tokens: TSyntaxTokenArray; tagCount: Integer; i: Integer; begin tokens := DoHtmlHighlighting('

Hello

'); tagCount := 0; for i := 0 to High(tokens) do begin if tokens[i].Kind = shKeyword then Inc(tagCount); end; AssertTrue('Should contain multiple tags', tagCount >= 4); // div, p, p, div AssertTrue('Should have many tokens', Length(tokens) > 10); end; procedure TTestHtmlHighlighter.TestComplexHtmlDocument; var tokens: TSyntaxTokenArray; document: string; hasHtml, hasHead, hasBody, hasTitle: Boolean; i: Integer; begin document := 'Test

Hello

'; tokens := DoHtmlHighlighting(document); hasHtml := False; hasHead := False; hasBody := False; hasTitle := False; for i := 0 to High(tokens) do begin if (tokens[i].Text = 'html') and (tokens[i].Kind = shKeyword) then hasHtml := True; if (tokens[i].Text = 'head') and (tokens[i].Kind = shKeyword) then hasHead := True; if (tokens[i].Text = 'body') and (tokens[i].Kind = shKeyword) then hasBody := True; if (tokens[i].Text = 'title') and (tokens[i].Kind = shKeyword) then hasTitle := True; end; AssertTrue('Should contain html tag', hasHtml); AssertTrue('Should contain head tag', hasHead); AssertTrue('Should contain body tag', hasBody); AssertTrue('Should contain title tag', hasTitle); AssertTrue('Should have many tokens for complex document', Length(tokens) > 20); end; procedure TTestHtmlHighlighter.TestHtmlCDATA; var tokens: TSyntaxTokenArray; foundCDATA: Boolean; i: Integer; begin tokens := DoHtmlHighlighting(''); foundCDATA := False; for i := 0 to High(tokens) do if (tokens[i].Kind = shRawString) or ((tokens[i].Kind = shSymbol) and (tokens[i].Text = 'text
'); htmlCategoryFound := False; for i := 0 to High(tokens) do if tokens[i].HasCategory(THtmlSyntaxHighlighter.CategoryHTML) then htmlCategoryFound := True; AssertTrue('Should have HTML category tokens', htmlCategoryFound); // Test embedded CSS category tokens := DoHtmlHighlighting(''); cssCategoryFound := False; lCat:=TSyntaxHighLighter.GetRegisteredCategoryID('EmbeddedCSS'); for i := 0 to High(tokens) do if tokens[i].HasCategory(lCat) then cssCategoryFound := True; AssertTrue('Should have category tokens for CSS', cssCategoryFound); // Test embedded JavaScript category tokens := DoHtmlHighlighting(''); jsCategoryFound := False; lCat:=TSyntaxHighlighter.GetRegisteredCategoryID('EmbeddedJS'); for i := 0 to High(tokens) do if tokens[i].HasCategory(lCat) then jsCategoryFound := True; AssertTrue('Should have category tokens for JavaScript', jsCategoryFound); end; initialization RegisterTest(TTestHtmlHighlighter); end.