fpc/tests/test/tstrutils1.pp

program tstrutils1;

// tests MBCS compatibility of strutils ansistartsstr and -endsstr.

{$mode objfpc}
{$h+}
{$ifdef go32v2}
  {$define USE_INTERNAL_UNICODE}
{$endif}

{$ifdef USE_INTERNAL_UNICODE}
  {$define USE_FPWIDESTRING_UNIT}
  {$define USE_UNICODEDUCET_UNIT}
  {$define USE_CPALL_UNIT}
{$endif}

uses
  {SysUtils, }
{$ifndef USE_INTERNAL_UNICODE}
{$ifdef unix}
  {$ifdef darwin}iosxwstr{$else}cwstring{$endif},
{$endif unix}
{$else USE_INTERNAL_UNICODE}
 {$ifdef USE_UNICODEDUCET_UNIT}
  unicodeducet,
 {$endif}
 {$ifdef USE_FPWIDESTRING_UNIT}
  fpwidestring,
 {$endif}
 {$ifdef USE_CPALL_UNIT}
  cpall,
 {$endif}
{$endif def USE_INTERNAL_UNICODE}
  StrUtils;

var
  ResultCounter: Integer = 0;

function TestValue(const Value: Boolean): Boolean;
begin
  Result := Value;
  if not Value then
    WriteLn('Failed: ', ResultCounter);
  Inc(ResultCounter);
end;

function TestOK: Boolean;
begin
  TestOK :=
    // AnsiStartsStr
    TestValue( AnsiStartsStr('', ''))
    and TestValue(AnsiStartsStr('', 'ab'))
    and TestValue(not AnsiStartsStr('ab', ''))
    and TestValue(AnsiStartsStr('abc', 'abc'))
    and TestValue(not AnsiStartsStr('abc', 'def'))
    and TestValue(AnsiStartsStr('abc', 'abcedfg'))
    and TestValue(not AnsiStartsStr('abc', 'ab'))
    and TestValue(AnsiStartsStr('áéíç', 'áéíç'))
    and TestValue(AnsiStartsStr('áé', 'áéíç'))
    and TestValue(not AnsiStartsStr('áéíç', 'áé'))
    and TestValue(not AnsiStartsStr('áéíç', 'áéio'))
    // AnsiEndsStr
    and TestValue(AnsiEndsStr('', ''))
    and TestValue(AnsiEndsStr('', 'ab'))
    and TestValue(not AnsiEndsStr('ab', ''))
    and TestValue(AnsiEndsStr('abc', 'abc'))
    and TestValue(not AnsiEndsStr('abc', 'def'))
    and TestValue(AnsiEndsStr('dfg', 'abcedfg'))
    and TestValue(not AnsiEndsStr('dfg', 'df'))
    and TestValue(AnsiEndsStr('áéíç', 'áéíç'))
    and TestValue(AnsiEndsStr('áé', 'íçáé'))
    and TestValue(not AnsiEndsStr('áéíç', 'áé'))
    and TestValue(not AnsiEndsStr('íçáé', 'ioáé'));
end;

begin
  if TestOK() then
  begin
    WriteLn('Test OK');
    halt(0);
  end
  else
    begin
      WriteLn('Test Failure!');
      halt(1);
    end;
end.