feat(rtl): Step 6 — pure Pascal StrUtils + ExpandFileName in SysUtils
Rewrites strutils.pas from an empty stub into a complete pure Blaise Pascal implementation with no external C dependencies. All helpers previously planned for blaise_str.pas are implemented directly in StrUtils using only compiler built-ins (Length, Pos, LowerCase, Copy, SetLength, PosEx). - ContainsStr/ContainsText, StartsStr/StartsText, EndsStr/EndsText - LeftStr, RightStr, MidStr - IndexStr, IndexText - ReplaceStr, ReplaceText - DupeString, ReverseString, StuffString - TrimLeft, TrimRight - PadLeft, PadRight - CountOccurrences, RemovePrefix, RemoveSuffix - IsEmptyOrWhitespace - JoinStr - TStringBuilder — efficient incremental string builder (mirrors TIRBuffer) Adds ExpandFileName to sysutils.pas as a pure Pascal path normaliser that resolves '.' and '..' segments without symlink following, matching Delphi/FPC behaviour. Fixes cp.test.multiwrite.pas: unqualified CountOccurrences calls now use Self. prefix to prevent name shadowing by StrUtils.CountOccurrences, which has reversed parameter order (Sub, S vs Haystack, Needle). Adds cp.test.strutils.pas (IR + type-check unit tests) and cp.test.e2e.strutils.pas (compile→run E2E tests) covering all new functions. Total test count: 1698. Fixpoint verified at stage-3/stage-4.
This commit is contained in:
Graeme Geldenhuys
parent
b359ed4da7
commit
b4b43d6091
1
.gitignore
vendored
1
.gitignore
vendored
|
|
@ -71,3 +71,4 @@ Desktop.ini
|
|||
|
||||
# Claude Code session notes — not for version control
|
||||
CLAUDE.md
|
||||
.ide/
|
||||
|
|
|
|||
|
|
@ -8,8 +8,6 @@
|
|||
|
||||
unit uDebugOPDF;
|
||||
|
||||
{$H+}
|
||||
|
||||
{ OPDF debug information emitter.
|
||||
Produces a companion .opdf.s GNU assembly file that the linker folds into
|
||||
the ELF .opdf section. The existing pdr debugger reads that section without
|
||||
|
|
|
|||
|
|
@ -96,7 +96,9 @@ uses
|
|||
cp.test.publishedrtti,
|
||||
cp.test.proctypes_ofobject,
|
||||
cp.test.textblock,
|
||||
cp.test.tokenkindname;
|
||||
cp.test.tokenkindname,
|
||||
cp.test.strutils,
|
||||
cp.test.e2e.strutils;
|
||||
|
||||
begin
|
||||
Halt(RunAll);
|
||||
|
|
|
|||
925
compiler/src/test/pascal/cp.test.e2e.strutils.pas
Normal file
925
compiler/src/test/pascal/cp.test.e2e.strutils.pas
Normal file
|
|
@ -0,0 +1,925 @@
|
|||
{
|
||||
Blaise - An Object Pascal Compiler
|
||||
Copyright (c) 2026 Graeme Geldenhuys
|
||||
SPDX-License-Identifier: Apache-2.0 WITH Swift-exception
|
||||
Licensed under the Apache License v2.0 with Runtime Library Exception.
|
||||
See LICENSE file in the project root for full license terms.
|
||||
}
|
||||
|
||||
unit cp.test.e2e.strutils;
|
||||
|
||||
{ E2E tests for the StrUtils unit.
|
||||
Each test compiles a small Blaise program, links it against the RTL,
|
||||
executes it, and asserts on stdout. All string positions and return
|
||||
values are 0-based, consistent with the Blaise string model. }
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
bcl.testing, cp.test.e2e.base;
|
||||
|
||||
type
|
||||
TE2EStrUtilsTests = class(TE2ETestCase)
|
||||
protected
|
||||
procedure SetUp; override;
|
||||
published
|
||||
{ ContainsStr / ContainsText }
|
||||
procedure TestRun_ContainsStr_Found;
|
||||
procedure TestRun_ContainsStr_NotFound;
|
||||
procedure TestRun_ContainsText_CaseInsensitive;
|
||||
|
||||
{ StartsStr / StartsText / EndsStr / EndsText }
|
||||
procedure TestRun_StartsStr_Matches;
|
||||
procedure TestRun_StartsStr_NoMatch;
|
||||
procedure TestRun_StartsText_CaseInsensitive;
|
||||
procedure TestRun_EndsStr_Matches;
|
||||
procedure TestRun_EndsStr_NoMatch;
|
||||
procedure TestRun_EndsText_CaseInsensitive;
|
||||
|
||||
{ LeftStr / RightStr / MidStr }
|
||||
procedure TestRun_LeftStr;
|
||||
procedure TestRun_RightStr;
|
||||
procedure TestRun_MidStr;
|
||||
procedure TestRun_LeftStr_LongerThanString;
|
||||
|
||||
{ PosEx }
|
||||
procedure TestRun_PosEx_Found;
|
||||
procedure TestRun_PosEx_SkipsBeforeStart;
|
||||
procedure TestRun_PosEx_NotFound;
|
||||
|
||||
{ IndexStr / IndexText }
|
||||
procedure TestRun_IndexStr_Found;
|
||||
procedure TestRun_IndexStr_NotFound;
|
||||
procedure TestRun_IndexText_CaseInsensitive;
|
||||
|
||||
{ ReplaceStr / ReplaceText }
|
||||
procedure TestRun_ReplaceStr_SingleOccurrence;
|
||||
procedure TestRun_ReplaceStr_MultipleOccurrences;
|
||||
procedure TestRun_ReplaceText_CaseInsensitive;
|
||||
procedure TestRun_ReplaceStr_EmptyOld;
|
||||
procedure TestRun_ReplaceStr_EmptyNew;
|
||||
|
||||
{ DupeString / ReverseString / StuffString }
|
||||
procedure TestRun_DupeString;
|
||||
procedure TestRun_DupeString_ZeroCount;
|
||||
procedure TestRun_ReverseString;
|
||||
procedure TestRun_StuffString_InsertReplace;
|
||||
|
||||
{ TrimLeft / TrimRight }
|
||||
procedure TestRun_TrimLeft;
|
||||
procedure TestRun_TrimRight;
|
||||
procedure TestRun_TrimLeft_NoLeadingSpace;
|
||||
|
||||
{ PadLeft / PadRight }
|
||||
procedure TestRun_PadLeft_Default;
|
||||
procedure TestRun_PadRight_Default;
|
||||
procedure TestRun_PadLeft_AlreadyWide;
|
||||
procedure TestRun_PadLeft_CustomPad;
|
||||
|
||||
{ CountOccurrences }
|
||||
procedure TestRun_CountOccurrences_Multiple;
|
||||
procedure TestRun_CountOccurrences_None;
|
||||
procedure TestRun_CountOccurrences_NonOverlapping;
|
||||
|
||||
{ RemovePrefix / RemoveSuffix }
|
||||
procedure TestRun_RemovePrefix_Present;
|
||||
procedure TestRun_RemovePrefix_Absent;
|
||||
procedure TestRun_RemoveSuffix_Present;
|
||||
procedure TestRun_RemoveSuffix_Absent;
|
||||
|
||||
{ IsEmptyOrWhitespace }
|
||||
procedure TestRun_IsEmptyOrWhitespace_Empty;
|
||||
procedure TestRun_IsEmptyOrWhitespace_Spaces;
|
||||
procedure TestRun_IsEmptyOrWhitespace_NonBlank;
|
||||
|
||||
{ JoinStr }
|
||||
procedure TestRun_JoinStr_Multiple;
|
||||
procedure TestRun_JoinStr_Single;
|
||||
procedure TestRun_JoinStr_EmptySep;
|
||||
|
||||
{ TStringBuilder }
|
||||
procedure TestRun_TStringBuilder_AppendAndToString;
|
||||
procedure TestRun_TStringBuilder_AppendLine;
|
||||
procedure TestRun_TStringBuilder_Clear;
|
||||
procedure TestRun_TStringBuilder_Length;
|
||||
procedure TestRun_TStringBuilder_AppendByte;
|
||||
procedure TestRun_TStringBuilder_SpeedVsConcat;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
procedure TE2EStrUtilsTests.SetUp;
|
||||
begin
|
||||
inherited SetUp;
|
||||
SetUpScratch('compiler/target/test-e2e-strutils');
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ ContainsStr / ContainsText }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_ContainsStr_Found;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
begin
|
||||
if ContainsStr('hello world', 'world') then WriteLn('yes')
|
||||
else WriteLn('no')
|
||||
end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('found', 'yes', Trim(Output));
|
||||
end;
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_ContainsStr_NotFound;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
begin
|
||||
if ContainsStr('hello', 'xyz') then WriteLn('yes')
|
||||
else WriteLn('no')
|
||||
end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('not found', 'no', Trim(Output));
|
||||
end;
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_ContainsText_CaseInsensitive;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
begin
|
||||
if ContainsText('Hello World', 'WORLD') then WriteLn('yes')
|
||||
else WriteLn('no')
|
||||
end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('case insensitive', 'yes', Trim(Output));
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ StartsStr / StartsText / EndsStr / EndsText }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_StartsStr_Matches;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
begin
|
||||
if StartsStr('hel', 'hello') then WriteLn('yes') else WriteLn('no')
|
||||
end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('starts match', 'yes', Trim(Output));
|
||||
end;
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_StartsStr_NoMatch;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
begin
|
||||
if StartsStr('world', 'hello') then WriteLn('yes') else WriteLn('no')
|
||||
end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('starts no match', 'no', Trim(Output));
|
||||
end;
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_StartsText_CaseInsensitive;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
begin
|
||||
if StartsText('HEL', 'hello') then WriteLn('yes') else WriteLn('no')
|
||||
end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('starts text', 'yes', Trim(Output));
|
||||
end;
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_EndsStr_Matches;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
begin
|
||||
if EndsStr('rld', 'world') then WriteLn('yes') else WriteLn('no')
|
||||
end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('ends match', 'yes', Trim(Output));
|
||||
end;
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_EndsStr_NoMatch;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
begin
|
||||
if EndsStr('hello', 'world') then WriteLn('yes') else WriteLn('no')
|
||||
end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('ends no match', 'no', Trim(Output));
|
||||
end;
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_EndsText_CaseInsensitive;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
begin
|
||||
if EndsText('RLD', 'world') then WriteLn('yes') else WriteLn('no')
|
||||
end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('ends text', 'yes', Trim(Output));
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ LeftStr / RightStr / MidStr }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_LeftStr;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
begin WriteLn(LeftStr('hello', 3)) end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('hel', 'hel', Trim(Output));
|
||||
end;
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_RightStr;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
begin WriteLn(RightStr('hello', 3)) end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('llo', 'llo', Trim(Output));
|
||||
end;
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_MidStr;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
begin WriteLn(MidStr('hello', 1, 3)) end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('ell', 'ell', Trim(Output));
|
||||
end;
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_LeftStr_LongerThanString;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
begin WriteLn(LeftStr('hi', 100)) end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('hi', 'hi', Trim(Output));
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ PosEx }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_PosEx_Found;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
begin WriteLn(PosEx('l', 'hello', 0)) end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('first l at 2', '2', Trim(Output));
|
||||
end;
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_PosEx_SkipsBeforeStart;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
begin WriteLn(PosEx('l', 'hello', 3)) end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('second l at 3', '3', Trim(Output));
|
||||
end;
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_PosEx_NotFound;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
begin WriteLn(PosEx('z', 'hello', 0)) end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('not found = -1', '-1', Trim(Output));
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ IndexStr / IndexText }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_IndexStr_Found;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
var Arr: array[0..2] of string;
|
||||
begin
|
||||
Arr[0] := 'apple'; Arr[1] := 'banana'; Arr[2] := 'cherry';
|
||||
WriteLn(IndexStr('banana', Arr))
|
||||
end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('banana at index 1', '1', Trim(Output));
|
||||
end;
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_IndexStr_NotFound;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
var Arr: array[0..2] of string;
|
||||
begin
|
||||
Arr[0] := 'apple'; Arr[1] := 'banana'; Arr[2] := 'cherry';
|
||||
WriteLn(IndexStr('mango', Arr))
|
||||
end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('not found = -1', '-1', Trim(Output));
|
||||
end;
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_IndexText_CaseInsensitive;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
var Arr: array[0..2] of string;
|
||||
begin
|
||||
Arr[0] := 'Apple'; Arr[1] := 'Banana'; Arr[2] := 'Cherry';
|
||||
WriteLn(IndexText('BANANA', Arr))
|
||||
end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('BANANA matches Banana at 1', '1', Trim(Output));
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ ReplaceStr / ReplaceText }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_ReplaceStr_SingleOccurrence;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
begin WriteLn(ReplaceStr('hello world', 'world', 'Blaise')) end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('hello Blaise', 'hello Blaise', Trim(Output));
|
||||
end;
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_ReplaceStr_MultipleOccurrences;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
begin WriteLn(ReplaceStr('aabbaa', 'aa', 'X')) end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('XbbX', 'XbbX', Trim(Output));
|
||||
end;
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_ReplaceText_CaseInsensitive;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
begin WriteLn(ReplaceText('Hello World', 'WORLD', 'Blaise')) end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('Hello Blaise', 'Hello Blaise', Trim(Output));
|
||||
end;
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_ReplaceStr_EmptyOld;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
begin WriteLn(ReplaceStr('hello', '', 'X')) end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('empty old returns unchanged', 'hello', Trim(Output));
|
||||
end;
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_ReplaceStr_EmptyNew;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
begin WriteLn(ReplaceStr('hello', 'l', '')) end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('heo', 'heo', Trim(Output));
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ DupeString / ReverseString / StuffString }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_DupeString;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
begin WriteLn(DupeString('ab', 3)) end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('ababab', 'ababab', Trim(Output));
|
||||
end;
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_DupeString_ZeroCount;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
begin WriteLn(DupeString('ab', 0)) end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('empty string', '', Trim(Output));
|
||||
end;
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_ReverseString;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
begin WriteLn(ReverseString('hello')) end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('olleh', 'olleh', Trim(Output));
|
||||
end;
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_StuffString_InsertReplace;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
begin
|
||||
{ Delete 3 bytes at pos 1 ('ell'), insert 'a' → 'hao' }
|
||||
WriteLn(StuffString('hello', 1, 3, 'a'))
|
||||
end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('hao', 'hao', Trim(Output));
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ TrimLeft / TrimRight }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_TrimLeft;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
begin WriteLn('|' + TrimLeft(' hello ') + '|') end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('hello (trailing intact)', '|hello |', Trim(Output));
|
||||
end;
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_TrimRight;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
begin WriteLn('|' + TrimRight(' hello ') + '|') end.
|
||||
''', Output, RCode));
|
||||
AssertEquals(' hello (leading intact)', '| hello|', Trim(Output));
|
||||
end;
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_TrimLeft_NoLeadingSpace;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
begin WriteLn(TrimLeft('hello')) end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('hello unchanged', 'hello', Trim(Output));
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ PadLeft / PadRight }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_PadLeft_Default;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
begin WriteLn('|' + PadLeft('42', 5) + '|') end.
|
||||
''', Output, RCode));
|
||||
AssertEquals(' 42', '| 42|', Trim(Output));
|
||||
end;
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_PadRight_Default;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
begin WriteLn('|' + PadRight('hi', 6) + '|') end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('|hi |', '|hi |', Trim(Output));
|
||||
end;
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_PadLeft_AlreadyWide;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
begin WriteLn(PadLeft('hello', 3)) end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('hello unchanged', 'hello', Trim(Output));
|
||||
end;
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_PadLeft_CustomPad;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
begin WriteLn(PadLeft('7', 4, 48)) end. { 48 = ord('0') }
|
||||
''', Output, RCode));
|
||||
AssertEquals('0007', '0007', Trim(Output));
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ CountOccurrences }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_CountOccurrences_Multiple;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
begin WriteLn(CountOccurrences('l', 'hello world')) end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('3 occurrences of l', '3', Trim(Output));
|
||||
end;
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_CountOccurrences_None;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
begin WriteLn(CountOccurrences('z', 'hello')) end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('0 occurrences', '0', Trim(Output));
|
||||
end;
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_CountOccurrences_NonOverlapping;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
begin WriteLn(CountOccurrences('aa', 'aaaa')) end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('2 non-overlapping aa in aaaa', '2', Trim(Output));
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ RemovePrefix / RemoveSuffix }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_RemovePrefix_Present;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
begin WriteLn(RemovePrefix('foobar', 'foo')) end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('bar', 'bar', Trim(Output));
|
||||
end;
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_RemovePrefix_Absent;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
begin WriteLn(RemovePrefix('foobar', 'baz')) end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('foobar unchanged', 'foobar', Trim(Output));
|
||||
end;
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_RemoveSuffix_Present;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
begin WriteLn(RemoveSuffix('foobar', 'bar')) end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('foo', 'foo', Trim(Output));
|
||||
end;
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_RemoveSuffix_Absent;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
begin WriteLn(RemoveSuffix('foobar', 'baz')) end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('foobar unchanged', 'foobar', Trim(Output));
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ IsEmptyOrWhitespace }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_IsEmptyOrWhitespace_Empty;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
begin
|
||||
if IsEmptyOrWhitespace('') then WriteLn('blank') else WriteLn('not blank')
|
||||
end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('blank', 'blank', Trim(Output));
|
||||
end;
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_IsEmptyOrWhitespace_Spaces;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
begin
|
||||
if IsEmptyOrWhitespace(' ') then WriteLn('blank') else WriteLn('not blank')
|
||||
end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('blank', 'blank', Trim(Output));
|
||||
end;
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_IsEmptyOrWhitespace_NonBlank;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
begin
|
||||
if IsEmptyOrWhitespace(' x ') then WriteLn('blank') else WriteLn('not blank')
|
||||
end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('not blank', 'not blank', Trim(Output));
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ JoinStr }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_JoinStr_Multiple;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
var Parts: array[0..2] of string;
|
||||
begin
|
||||
Parts[0] := 'one'; Parts[1] := 'two'; Parts[2] := 'three';
|
||||
WriteLn(JoinStr(', ', Parts))
|
||||
end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('one, two, three', 'one, two, three', Trim(Output));
|
||||
end;
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_JoinStr_Single;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
var Parts: array[0..0] of string;
|
||||
begin
|
||||
Parts[0] := 'only';
|
||||
WriteLn(JoinStr('-', Parts))
|
||||
end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('only', 'only', Trim(Output));
|
||||
end;
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_JoinStr_EmptySep;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
var Parts: array[0..2] of string;
|
||||
begin
|
||||
Parts[0] := 'a'; Parts[1] := 'b'; Parts[2] := 'c';
|
||||
WriteLn(JoinStr('', Parts))
|
||||
end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('abc', 'abc', Trim(Output));
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ TStringBuilder }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_TStringBuilder_AppendAndToString;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
var SB: TStringBuilder;
|
||||
begin
|
||||
SB := TStringBuilder.Create;
|
||||
SB.Append('hello');
|
||||
SB.Append(' ');
|
||||
SB.Append('world');
|
||||
WriteLn(SB.ToString);
|
||||
SB.Free
|
||||
end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('hello world', 'hello world', Trim(Output));
|
||||
end;
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_TStringBuilder_AppendLine;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
var SB: TStringBuilder; S: string;
|
||||
begin
|
||||
SB := TStringBuilder.Create;
|
||||
SB.AppendLine('line1');
|
||||
SB.AppendLine('line2');
|
||||
S := SB.ToString;
|
||||
Write(S);
|
||||
SB.Free
|
||||
end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('two lines', 'line1' + #10 + 'line2' + #10, Output);
|
||||
end;
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_TStringBuilder_Clear;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
var SB: TStringBuilder;
|
||||
begin
|
||||
SB := TStringBuilder.Create;
|
||||
SB.Append('old content');
|
||||
SB.Clear;
|
||||
SB.Append('new');
|
||||
WriteLn(SB.ToString);
|
||||
SB.Free
|
||||
end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('new', 'new', Trim(Output));
|
||||
end;
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_TStringBuilder_Length;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
var SB: TStringBuilder;
|
||||
begin
|
||||
SB := TStringBuilder.Create;
|
||||
SB.Append('hello');
|
||||
WriteLn(SB.Length);
|
||||
SB.Free
|
||||
end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('length 5', '5', Trim(Output));
|
||||
end;
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_TStringBuilder_AppendByte;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
var SB: TStringBuilder;
|
||||
begin
|
||||
SB := TStringBuilder.Create;
|
||||
SB.AppendByte(65); { A }
|
||||
SB.AppendByte(66); { B }
|
||||
SB.AppendByte(67); { C }
|
||||
WriteLn(SB.ToString);
|
||||
SB.Free
|
||||
end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('ABC', 'ABC', Trim(Output));
|
||||
end;
|
||||
|
||||
procedure TE2EStrUtilsTests.TestRun_TStringBuilder_SpeedVsConcat;
|
||||
{ Verifies that TStringBuilder produces correct output for a non-trivial
|
||||
number of appends — exercises the Grow path. }
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses StrUtils;
|
||||
var SB: TStringBuilder; I: Integer;
|
||||
begin
|
||||
SB := TStringBuilder.Create;
|
||||
for I := 1 to 1000 do
|
||||
SB.Append('x');
|
||||
WriteLn(SB.Length);
|
||||
SB.Free
|
||||
end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('1000 chars', '1000', Trim(Output));
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterTest(TE2EStrUtilsTests);
|
||||
|
||||
end.
|
||||
|
|
@ -89,8 +89,8 @@ begin
|
|||
WriteLn(I, J)
|
||||
end.
|
||||
''');
|
||||
WriteIntCalls := CountOccurrences(IR, 'call $_SysWriteInt(');
|
||||
NewlineCalls := CountOccurrences(IR, 'call $_SysWriteNewline(');
|
||||
WriteIntCalls := Self.CountOccurrences(IR, 'call $_SysWriteInt(');
|
||||
NewlineCalls := Self.CountOccurrences(IR, 'call $_SysWriteNewline(');
|
||||
AssertEquals('2 _SysWriteInt calls for values', 2, WriteIntCalls);
|
||||
AssertEquals('1 _SysWriteNewline call', 1, NewlineCalls);
|
||||
end;
|
||||
|
|
@ -109,7 +109,7 @@ begin
|
|||
''');
|
||||
AssertTrue('emits newline call', Pos('call $_SysWriteNewline(', IR) > 0);
|
||||
AssertEquals('3 _SysWriteInt calls for values',
|
||||
3, CountOccurrences(IR, 'call $_SysWriteInt('));
|
||||
3, Self.CountOccurrences(IR, 'call $_SysWriteInt('));
|
||||
end;
|
||||
|
||||
procedure TMultiWriteTests.TestCodegen_Write_TwoArgs_NoTrailingNewline;
|
||||
|
|
@ -128,9 +128,9 @@ begin
|
|||
always defined in the data section, so we look specifically for the
|
||||
call (not the declaration). }
|
||||
AssertEquals('no _SysWriteNewline call', 0,
|
||||
CountOccurrences(IR, 'call $_SysWriteNewline('));
|
||||
Self.CountOccurrences(IR, 'call $_SysWriteNewline('));
|
||||
AssertEquals('2 _SysWriteInt calls', 2,
|
||||
CountOccurrences(IR, 'call $_SysWriteInt('));
|
||||
Self.CountOccurrences(IR, 'call $_SysWriteInt('));
|
||||
end;
|
||||
|
||||
procedure TMultiWriteTests.TestCodegen_WriteLn_MixedStringAndInteger;
|
||||
|
|
|
|||
1083
compiler/src/test/pascal/cp.test.strutils.pas
Normal file
1083
compiler/src/test/pascal/cp.test.strutils.pas
Normal file
File diff suppressed because it is too large
Load diff
|
|
@ -8,13 +8,714 @@
|
|||
|
||||
unit StrUtils;
|
||||
|
||||
// Blaise RTL — StrUtils stub.
|
||||
// Blaise RTL — StrUtils unit.
|
||||
//
|
||||
// The compiler's uses clause lists StrUtils but makes no calls to any
|
||||
// StrUtils-specific function. This empty unit satisfies the unit loader.
|
||||
// String indexing in Blaise is 0-based throughout:
|
||||
// - PosEx/Pos return -1 when not found, 0 for the first position.
|
||||
// - LeftStr/RightStr/MidStr are thin wrappers over the built-in Copy.
|
||||
// - IndexStr/IndexText return -1 when not found, 0 for the first element.
|
||||
//
|
||||
// Str vs Text naming convention (identical to Delphi/FPC):
|
||||
// xxxStr — case-sensitive
|
||||
// xxxText — case-insensitive (ASCII fold only; no locale)
|
||||
//
|
||||
// All higher-level functions are implemented in pure Blaise Pascal using
|
||||
// only the small set of primitives exposed by blaise_str.pas.
|
||||
|
||||
interface
|
||||
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ Containment }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
||||
{ Returns True if Sub appears anywhere in S (case-sensitive). }
|
||||
function ContainsStr(const S, Sub: string): Boolean;
|
||||
|
||||
{ Returns True if Sub appears anywhere in S (case-insensitive). }
|
||||
function ContainsText(const S, Sub: string): Boolean;
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ Prefix / suffix }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
||||
{ Returns True if S begins with Prefix (case-sensitive). }
|
||||
function StartsStr(const Prefix, S: string): Boolean;
|
||||
|
||||
{ Returns True if S begins with Prefix (case-insensitive). }
|
||||
function StartsText(const Prefix, S: string): Boolean;
|
||||
|
||||
{ Returns True if S ends with Suffix (case-sensitive). }
|
||||
function EndsStr(const Suffix, S: string): Boolean;
|
||||
|
||||
{ Returns True if S ends with Suffix (case-insensitive). }
|
||||
function EndsText(const Suffix, S: string): Boolean;
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ Extraction — thin wrappers over the built-in Copy }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
||||
{ Returns the first Count bytes of S. }
|
||||
function LeftStr(const S: string; Count: Integer): string;
|
||||
|
||||
{ Returns the last Count bytes of S. }
|
||||
function RightStr(const S: string; Count: Integer): string;
|
||||
|
||||
{ Returns Count bytes of S starting at 0-based position Start. }
|
||||
function MidStr(const S: string; Start, Count: Integer): string;
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ Search }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
||||
{ Note: PosEx(Sub, S, StartPos) is a compiler built-in — not declared here. }
|
||||
|
||||
{ Returns the 0-based index of Str in Arr (case-sensitive), or -1. }
|
||||
function IndexStr(const Str: string; const Arr: array of string): Integer;
|
||||
|
||||
{ Returns the 0-based index of Str in Arr (case-insensitive), or -1. }
|
||||
function IndexText(const Str: string; const Arr: array of string): Integer;
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ Replacement }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
||||
{ Replaces all occurrences of OldPattern with NewPattern (case-sensitive). }
|
||||
function ReplaceStr(const S, OldPattern, NewPattern: string): string;
|
||||
|
||||
{ Replaces all occurrences of OldPattern with NewPattern (case-insensitive). }
|
||||
function ReplaceText(const S, OldPattern, NewPattern: string): string;
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ Manipulation }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
||||
{ Returns S repeated Count times. }
|
||||
function DupeString(const S: string; Count: Integer): string;
|
||||
|
||||
{ Returns S with its bytes in reverse order. }
|
||||
function ReverseString(const S: string): string;
|
||||
|
||||
{ Deletes Len bytes at 0-based position Start and inserts Replacement. }
|
||||
function StuffString(const S: string; Start, Len: Integer;
|
||||
const Replacement: string): string;
|
||||
|
||||
{ Returns S with leading whitespace (bytes <= 32) removed. }
|
||||
function TrimLeft(const S: string): string;
|
||||
|
||||
{ Returns S with trailing whitespace (bytes <= 32) removed. }
|
||||
function TrimRight(const S: string): string;
|
||||
|
||||
{ Returns S left-padded with PadByte to at least Width bytes. }
|
||||
function PadLeft(const S: string; Width: Integer; PadByte: Byte = 32): string;
|
||||
|
||||
{ Returns S right-padded with PadByte to at least Width bytes. }
|
||||
function PadRight(const S: string; Width: Integer; PadByte: Byte = 32): string;
|
||||
|
||||
{ Returns the number of non-overlapping occurrences of Sub in S. }
|
||||
function CountOccurrences(const Sub, S: string): Integer;
|
||||
|
||||
{ Returns S with a leading Prefix removed (if present). }
|
||||
function RemovePrefix(const S, Prefix: string): string;
|
||||
|
||||
{ Returns S with a trailing Suffix removed (if present). }
|
||||
function RemoveSuffix(const S, Suffix: string): string;
|
||||
|
||||
{ Returns True when S contains only whitespace (or is empty). }
|
||||
function IsEmptyOrWhitespace(const S: string): Boolean;
|
||||
|
||||
{ Joins Parts with Sep between each element. }
|
||||
function JoinStr(const Sep: string; const Parts: array of string): string;
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ TStringBuilder — efficient incremental string construction }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
||||
{ TStringBuilder avoids the O(N²) cost of repeated string concatenation
|
||||
by maintaining a raw byte buffer that grows geometrically. Append
|
||||
operations write directly into the buffer without allocating intermediate
|
||||
ARC strings. Call ToString to obtain a single managed string at the end.
|
||||
|
||||
This mirrors the compiler's internal TIRBuffer that produced the 460×
|
||||
speedup in QBE IR generation. The same technique is now available to
|
||||
Blaise user code. }
|
||||
type
|
||||
TStringBuilder = class
|
||||
private
|
||||
FData: PChar;
|
||||
FLen: Integer;
|
||||
FCap: Integer;
|
||||
procedure Grow(ANeed: Integer);
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
{ Append a string value. }
|
||||
procedure Append(const S: string); overload;
|
||||
{ Append a single byte as a character. }
|
||||
procedure AppendByte(B: Byte); overload;
|
||||
{ Append a newline (#10). }
|
||||
procedure AppendLine; overload;
|
||||
{ Append a string followed by a newline. }
|
||||
procedure AppendLine(const S: string); overload;
|
||||
{ Remove all content without releasing the buffer. }
|
||||
procedure Clear;
|
||||
{ Return the accumulated content as a managed string. }
|
||||
function ToString: string;
|
||||
{ Current byte length. }
|
||||
property Length: Integer read FLen;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ Internal helpers }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
||||
{ ASCII case-fold: returns lowercase byte value. }
|
||||
function FoldLower(C: Integer): Integer;
|
||||
begin
|
||||
if (C >= 65) and (C <= 90) then
|
||||
Result := C + 32
|
||||
else
|
||||
Result := C;
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ Containment }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
||||
function ContainsStr(const S, Sub: string): Boolean;
|
||||
begin
|
||||
Result := Pos(Sub, S) >= 0;
|
||||
end;
|
||||
|
||||
function ContainsText(const S, Sub: string): Boolean;
|
||||
var
|
||||
SL, SubL: string;
|
||||
begin
|
||||
SL := LowerCase(S);
|
||||
SubL := LowerCase(Sub);
|
||||
Result := Pos(SubL, SL) >= 0;
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ Prefix / suffix }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
||||
function StartsStr(const Prefix, S: string): Boolean;
|
||||
var
|
||||
PLen, SLen: Integer;
|
||||
SP, PP: PChar;
|
||||
I: Integer;
|
||||
begin
|
||||
PLen := Length(Prefix);
|
||||
SLen := Length(S);
|
||||
if PLen = 0 then begin Result := True; Exit; end;
|
||||
if PLen > SLen then begin Result := False; Exit; end;
|
||||
SP := PChar(S);
|
||||
PP := PChar(Prefix);
|
||||
for I := 0 to PLen - 1 do
|
||||
if SP[I] <> PP[I] then begin Result := False; Exit; end;
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
function StartsText(const Prefix, S: string): Boolean;
|
||||
var
|
||||
PLen, SLen: Integer;
|
||||
SP, PP: PChar;
|
||||
I: Integer;
|
||||
begin
|
||||
PLen := Length(Prefix);
|
||||
SLen := Length(S);
|
||||
if PLen = 0 then begin Result := True; Exit; end;
|
||||
if PLen > SLen then begin Result := False; Exit; end;
|
||||
SP := PChar(S);
|
||||
PP := PChar(Prefix);
|
||||
for I := 0 to PLen - 1 do
|
||||
if FoldLower(SP[I]) <> FoldLower(PP[I]) then begin Result := False; Exit; end;
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
function EndsStr(const Suffix, S: string): Boolean;
|
||||
var
|
||||
SufLen, SLen: Integer;
|
||||
SP, SufP: PChar;
|
||||
Offset, I: Integer;
|
||||
begin
|
||||
SufLen := Length(Suffix);
|
||||
SLen := Length(S);
|
||||
if SufLen = 0 then begin Result := True; Exit; end;
|
||||
if SufLen > SLen then begin Result := False; Exit; end;
|
||||
SP := PChar(S);
|
||||
SufP := PChar(Suffix);
|
||||
Offset := SLen - SufLen;
|
||||
for I := 0 to SufLen - 1 do
|
||||
if SP[Offset + I] <> SufP[I] then begin Result := False; Exit; end;
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
function EndsText(const Suffix, S: string): Boolean;
|
||||
var
|
||||
SufLen, SLen: Integer;
|
||||
SP, SufP: PChar;
|
||||
Offset, I: Integer;
|
||||
begin
|
||||
SufLen := Length(Suffix);
|
||||
SLen := Length(S);
|
||||
if SufLen = 0 then begin Result := True; Exit; end;
|
||||
if SufLen > SLen then begin Result := False; Exit; end;
|
||||
SP := PChar(S);
|
||||
SufP := PChar(Suffix);
|
||||
Offset := SLen - SufLen;
|
||||
for I := 0 to SufLen - 1 do
|
||||
if FoldLower(SP[Offset + I]) <> FoldLower(SufP[I]) then begin Result := False; Exit; end;
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ Extraction }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
||||
function LeftStr(const S: string; Count: Integer): string;
|
||||
begin
|
||||
Result := Copy(S, 0, Count);
|
||||
end;
|
||||
|
||||
function RightStr(const S: string; Count: Integer): string;
|
||||
var
|
||||
Len: Integer;
|
||||
begin
|
||||
Len := Length(S);
|
||||
if Count >= Len then
|
||||
Result := S
|
||||
else
|
||||
Result := Copy(S, Len - Count, Count);
|
||||
end;
|
||||
|
||||
function MidStr(const S: string; Start, Count: Integer): string;
|
||||
begin
|
||||
Result := Copy(S, Start, Count);
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ Search }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
||||
{ PosEx is a compiler built-in — implementation omitted. }
|
||||
|
||||
function IndexStr(const Str: string; const Arr: array of string): Integer;
|
||||
var
|
||||
I: Integer;
|
||||
begin
|
||||
for I := 0 to High(Arr) do
|
||||
if Arr[I] = Str then
|
||||
begin
|
||||
Result := I;
|
||||
Exit;
|
||||
end;
|
||||
Result := -1;
|
||||
end;
|
||||
|
||||
function IndexText(const Str: string; const Arr: array of string): Integer;
|
||||
var
|
||||
I: Integer;
|
||||
SL: string;
|
||||
EL: string;
|
||||
begin
|
||||
SL := LowerCase(Str);
|
||||
for I := 0 to High(Arr) do
|
||||
begin
|
||||
EL := LowerCase(Arr[I]);
|
||||
if EL = SL then
|
||||
begin
|
||||
Result := I;
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
Result := -1;
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ Replacement }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
||||
{ Internal: replace all occurrences of OldP with NewP; Fold=True for case-insensitive. }
|
||||
function ReplaceAll(const S, OldP, NewP: string; Fold: Boolean): string;
|
||||
var
|
||||
SLen, OldLen, NewLen: Integer;
|
||||
SB: TStringBuilder;
|
||||
I, J: Integer;
|
||||
Match: Boolean;
|
||||
SP, OP: PChar;
|
||||
C1, C2: Integer;
|
||||
begin
|
||||
SLen := Length(S);
|
||||
OldLen := Length(OldP);
|
||||
NewLen := Length(NewP);
|
||||
if (SLen = 0) or (OldLen = 0) then
|
||||
begin
|
||||
Result := S;
|
||||
Exit;
|
||||
end;
|
||||
SP := PChar(S);
|
||||
OP := PChar(OldP);
|
||||
SB := TStringBuilder.Create;
|
||||
I := 0;
|
||||
while I <= SLen - OldLen do
|
||||
begin
|
||||
Match := True;
|
||||
for J := 0 to OldLen - 1 do
|
||||
begin
|
||||
if Fold then
|
||||
begin
|
||||
C1 := FoldLower(SP[I + J]);
|
||||
C2 := FoldLower(OP[J]);
|
||||
end
|
||||
else
|
||||
begin
|
||||
C1 := SP[I + J];
|
||||
C2 := OP[J];
|
||||
end;
|
||||
if C1 <> C2 then begin Match := False; Break; end;
|
||||
end;
|
||||
if Match then
|
||||
begin
|
||||
if NewLen > 0 then
|
||||
SB.Append(NewP);
|
||||
I := I + OldLen;
|
||||
end
|
||||
else
|
||||
begin
|
||||
SB.AppendByte(SP[I]);
|
||||
I := I + 1;
|
||||
end;
|
||||
end;
|
||||
{ copy any remaining tail }
|
||||
while I < SLen do
|
||||
begin
|
||||
SB.AppendByte(SP[I]);
|
||||
I := I + 1;
|
||||
end;
|
||||
Result := SB.ToString;
|
||||
SB.Free;
|
||||
end;
|
||||
|
||||
function ReplaceStr(const S, OldPattern, NewPattern: string): string;
|
||||
begin
|
||||
Result := ReplaceAll(S, OldPattern, NewPattern, False);
|
||||
end;
|
||||
|
||||
function ReplaceText(const S, OldPattern, NewPattern: string): string;
|
||||
begin
|
||||
Result := ReplaceAll(S, OldPattern, NewPattern, True);
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ Manipulation }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
||||
function DupeString(const S: string; Count: Integer): string;
|
||||
var
|
||||
SB: TStringBuilder;
|
||||
I: Integer;
|
||||
begin
|
||||
if (Count <= 0) or (Length(S) = 0) then
|
||||
begin
|
||||
Result := '';
|
||||
Exit;
|
||||
end;
|
||||
SB := TStringBuilder.Create;
|
||||
for I := 1 to Count do
|
||||
SB.Append(S);
|
||||
Result := SB.ToString;
|
||||
SB.Free;
|
||||
end;
|
||||
|
||||
function ReverseString(const S: string): string;
|
||||
var
|
||||
Len, I: Integer;
|
||||
SP, RP: PChar;
|
||||
begin
|
||||
Len := Length(S);
|
||||
SetLength(Result, Len);
|
||||
if Len = 0 then Exit;
|
||||
SP := PChar(S);
|
||||
RP := PChar(Result);
|
||||
for I := 0 to Len - 1 do
|
||||
RP[I] := SP[Len - 1 - I];
|
||||
end;
|
||||
|
||||
function StuffString(const S: string; Start, Len: Integer;
|
||||
const Replacement: string): string;
|
||||
var
|
||||
SLen, RepLen, ActualLen: Integer;
|
||||
begin
|
||||
SLen := Length(S);
|
||||
RepLen := Length(Replacement);
|
||||
if Start < 0 then Start := 0;
|
||||
if Start > SLen then Start := SLen;
|
||||
ActualLen := Len;
|
||||
if ActualLen < 0 then ActualLen := 0;
|
||||
if Start + ActualLen > SLen then ActualLen := SLen - Start;
|
||||
{ Build: head + replacement + tail }
|
||||
Result := Copy(S, 0, Start) + Replacement + Copy(S, Start + ActualLen, SLen - Start - ActualLen);
|
||||
end;
|
||||
|
||||
function TrimLeft(const S: string): string;
|
||||
var
|
||||
Len, Lo: Integer;
|
||||
SP: PChar;
|
||||
begin
|
||||
Len := Length(S);
|
||||
SP := PChar(S);
|
||||
Lo := 0;
|
||||
while Lo < Len do
|
||||
begin
|
||||
if SP[Lo] > 32 then Break;
|
||||
Lo := Lo + 1;
|
||||
end;
|
||||
Result := Copy(S, Lo, Len - Lo);
|
||||
end;
|
||||
|
||||
function TrimRight(const S: string): string;
|
||||
var
|
||||
Len, Hi: Integer;
|
||||
SP: PChar;
|
||||
begin
|
||||
Len := Length(S);
|
||||
SP := PChar(S);
|
||||
Hi := Len - 1;
|
||||
while Hi >= 0 do
|
||||
begin
|
||||
if SP[Hi] > 32 then Break;
|
||||
Hi := Hi - 1;
|
||||
end;
|
||||
Result := Copy(S, 0, Hi + 1);
|
||||
end;
|
||||
|
||||
function PadLeft(const S: string; Width: Integer; PadByte: Byte): string;
|
||||
var
|
||||
Len, PadCount, I: Integer;
|
||||
SB: TStringBuilder;
|
||||
begin
|
||||
Len := Length(S);
|
||||
if Len >= Width then
|
||||
begin
|
||||
Result := S;
|
||||
Exit;
|
||||
end;
|
||||
PadCount := Width - Len;
|
||||
SB := TStringBuilder.Create;
|
||||
for I := 1 to PadCount do
|
||||
SB.AppendByte(PadByte);
|
||||
SB.Append(S);
|
||||
Result := SB.ToString;
|
||||
SB.Free;
|
||||
end;
|
||||
|
||||
function PadRight(const S: string; Width: Integer; PadByte: Byte): string;
|
||||
var
|
||||
Len, PadCount, I: Integer;
|
||||
SB: TStringBuilder;
|
||||
begin
|
||||
Len := Length(S);
|
||||
if Len >= Width then
|
||||
begin
|
||||
Result := S;
|
||||
Exit;
|
||||
end;
|
||||
PadCount := Width - Len;
|
||||
SB := TStringBuilder.Create;
|
||||
SB.Append(S);
|
||||
for I := 1 to PadCount do
|
||||
SB.AppendByte(PadByte);
|
||||
Result := SB.ToString;
|
||||
SB.Free;
|
||||
end;
|
||||
|
||||
function CountOccurrences(const Sub, S: string): Integer;
|
||||
var
|
||||
SLen, SubLen: Integer;
|
||||
SP, SubP: PChar;
|
||||
I, J: Integer;
|
||||
Match: Boolean;
|
||||
begin
|
||||
Result := 0;
|
||||
SLen := Length(S);
|
||||
SubLen := Length(Sub);
|
||||
if (SubLen = 0) or (SubLen > SLen) then Exit;
|
||||
SP := PChar(S);
|
||||
SubP := PChar(Sub);
|
||||
I := 0;
|
||||
while I <= SLen - SubLen do
|
||||
begin
|
||||
Match := True;
|
||||
for J := 0 to SubLen - 1 do
|
||||
if SP[I + J] <> SubP[J] then begin Match := False; Break; end;
|
||||
if Match then
|
||||
begin
|
||||
Result := Result + 1;
|
||||
I := I + SubLen;
|
||||
end
|
||||
else
|
||||
I := I + 1;
|
||||
end;
|
||||
end;
|
||||
|
||||
function RemovePrefix(const S, Prefix: string): string;
|
||||
var
|
||||
PLen: Integer;
|
||||
begin
|
||||
if StartsStr(Prefix, S) then
|
||||
begin
|
||||
PLen := Length(Prefix);
|
||||
Result := Copy(S, PLen, Length(S) - PLen);
|
||||
end
|
||||
else
|
||||
Result := S;
|
||||
end;
|
||||
|
||||
function RemoveSuffix(const S, Suffix: string): string;
|
||||
var
|
||||
SLen, SufLen: Integer;
|
||||
begin
|
||||
if EndsStr(Suffix, S) then
|
||||
begin
|
||||
SLen := Length(S);
|
||||
SufLen := Length(Suffix);
|
||||
Result := Copy(S, 0, SLen - SufLen);
|
||||
end
|
||||
else
|
||||
Result := S;
|
||||
end;
|
||||
|
||||
function IsEmptyOrWhitespace(const S: string): Boolean;
|
||||
var
|
||||
Trimmed: string;
|
||||
begin
|
||||
Trimmed := TrimLeft(S);
|
||||
Result := Length(Trimmed) = 0;
|
||||
end;
|
||||
|
||||
function JoinStr(const Sep: string; const Parts: array of string): string;
|
||||
var
|
||||
SB: TStringBuilder;
|
||||
I: Integer;
|
||||
begin
|
||||
if High(Parts) < 0 then
|
||||
begin
|
||||
Result := '';
|
||||
Exit;
|
||||
end;
|
||||
SB := TStringBuilder.Create;
|
||||
for I := 0 to High(Parts) do
|
||||
begin
|
||||
SB.Append(Parts[I]);
|
||||
if I < High(Parts) then
|
||||
SB.Append(Sep);
|
||||
end;
|
||||
Result := SB.ToString;
|
||||
SB.Free;
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ TStringBuilder }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
||||
constructor TStringBuilder.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
Self.FCap := 256;
|
||||
Self.FLen := 0;
|
||||
Self.FData := GetMem(Self.FCap);
|
||||
end;
|
||||
|
||||
destructor TStringBuilder.Destroy;
|
||||
begin
|
||||
FreeMem(Self.FData);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TStringBuilder.Grow(ANeed: Integer);
|
||||
var
|
||||
NewCap: Integer;
|
||||
NewData: PChar;
|
||||
OldData: PChar;
|
||||
I: Integer;
|
||||
begin
|
||||
NewCap := Self.FCap;
|
||||
while NewCap < Self.FLen + ANeed do
|
||||
NewCap := NewCap * 2;
|
||||
NewData := GetMem(NewCap);
|
||||
OldData := Self.FData;
|
||||
for I := 0 to Self.FLen - 1 do
|
||||
NewData[I] := OldData[I];
|
||||
FreeMem(OldData);
|
||||
Self.FData := NewData;
|
||||
Self.FCap := NewCap;
|
||||
end;
|
||||
|
||||
procedure TStringBuilder.Append(const S: string);
|
||||
var
|
||||
SLen: Integer;
|
||||
SP: PChar;
|
||||
DP: PChar;
|
||||
Offset: Integer;
|
||||
I: Integer;
|
||||
begin
|
||||
SLen := Length(S);
|
||||
if SLen = 0 then Exit;
|
||||
if Self.FLen + SLen > Self.FCap then Self.Grow(SLen);
|
||||
SP := PChar(S);
|
||||
DP := Self.FData;
|
||||
Offset := Self.FLen;
|
||||
for I := 0 to SLen - 1 do
|
||||
DP[Offset + I] := SP[I];
|
||||
Self.FLen := Self.FLen + SLen;
|
||||
end;
|
||||
|
||||
procedure TStringBuilder.AppendByte(B: Byte);
|
||||
var
|
||||
DP: PChar;
|
||||
Pos: Integer;
|
||||
begin
|
||||
if Self.FLen + 1 > Self.FCap then Self.Grow(1);
|
||||
DP := Self.FData;
|
||||
Pos := Self.FLen;
|
||||
DP[Pos] := B;
|
||||
Self.FLen := Self.FLen + 1;
|
||||
end;
|
||||
|
||||
procedure TStringBuilder.AppendLine;
|
||||
begin
|
||||
Self.AppendByte(10);
|
||||
end;
|
||||
|
||||
procedure TStringBuilder.AppendLine(const S: string);
|
||||
begin
|
||||
Self.Append(S);
|
||||
Self.AppendByte(10);
|
||||
end;
|
||||
|
||||
procedure TStringBuilder.Clear;
|
||||
begin
|
||||
Self.FLen := 0;
|
||||
end;
|
||||
|
||||
function TStringBuilder.ToString: string;
|
||||
var
|
||||
I: Integer;
|
||||
RP: PChar;
|
||||
SP: PChar;
|
||||
begin
|
||||
SetLength(Result, Self.FLen);
|
||||
if Self.FLen > 0 then
|
||||
begin
|
||||
RP := PChar(Result);
|
||||
SP := Self.FData;
|
||||
for I := 0 to Self.FLen - 1 do
|
||||
RP[I] := SP[I];
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
|
|
|||
|
|
@ -44,6 +44,15 @@ type
|
|||
{ BoolToStr — not a compiler built-in; pure Pascal implementation }
|
||||
function BoolToStr(B: Boolean; AUseBoolStrs: Boolean = False): string;
|
||||
|
||||
{ ExpandFileName — resolve a relative path to an absolute path.
|
||||
If APath is already absolute (starts with '/') it is returned unchanged
|
||||
after normalising redundant separators and '.' components.
|
||||
Otherwise it is resolved relative to GetCurrentDir.
|
||||
Note: '..' segments are removed by simple text processing; symlinks are
|
||||
not resolved (unlike POSIX realpath). This matches Delphi/FPC behaviour
|
||||
on paths that do not traverse symlinks. }
|
||||
function ExpandFileName(const APath: string): string;
|
||||
|
||||
implementation
|
||||
|
||||
constructor Exception.Create(AMessage: string);
|
||||
|
|
@ -59,4 +68,66 @@ begin
|
|||
Result := 'False'
|
||||
end;
|
||||
|
||||
{ ExpandFileName — pure Pascal path normaliser.
|
||||
Resolves '..' and '.' components without a local string array.
|
||||
The algorithm builds the result as a string, treating it as a stack:
|
||||
appending '/' + segment to push, trimming the last segment to pop. }
|
||||
function ExpandFileName(const APath: string): string;
|
||||
var
|
||||
Base: string;
|
||||
Len, I, SegStart, LastSlash: Integer;
|
||||
SP: PChar;
|
||||
Seg: string;
|
||||
begin
|
||||
if APath = '' then
|
||||
begin
|
||||
Result := GetCurrentDir;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
{ Determine base: absolute or relative }
|
||||
if APath[0] = 47 then { '/' }
|
||||
Base := APath
|
||||
else
|
||||
Base := GetCurrentDir + '/' + APath;
|
||||
|
||||
Len := Length(Base);
|
||||
SP := PChar(Base);
|
||||
Result := '';
|
||||
I := 0;
|
||||
|
||||
{ Skip leading slash }
|
||||
if (Len > 0) and (SP[0] = 47) then
|
||||
I := 1;
|
||||
|
||||
while I <= Len do
|
||||
begin
|
||||
SegStart := I;
|
||||
while (I < Len) and (SP[I] <> 47) do
|
||||
I := I + 1;
|
||||
if I > SegStart then
|
||||
Seg := Copy(Base, SegStart, I - SegStart)
|
||||
else
|
||||
Seg := '';
|
||||
if (Seg <> '') and (Seg <> '.') then
|
||||
begin
|
||||
if Seg = '..' then
|
||||
begin
|
||||
{ Pop the last segment from Result: find the last '/' and truncate }
|
||||
LastSlash := Length(Result) - 1;
|
||||
while (LastSlash > 0) and (Result[LastSlash] <> 47) do
|
||||
LastSlash := LastSlash - 1;
|
||||
if LastSlash >= 0 then
|
||||
Result := Copy(Result, 0, LastSlash);
|
||||
end
|
||||
else
|
||||
Result := Result + '/' + Seg;
|
||||
end;
|
||||
I := I + 1; { skip '/' }
|
||||
end;
|
||||
|
||||
if Result = '' then
|
||||
Result := '/';
|
||||
end;
|
||||
|
||||
end.
|
||||
|
|
|
|||
Loading…
Reference in a new issue