[fpc-pascal] ShortString still relevant today?

Hairy Pixels genericptr at gmail.com
Tue Jul 4 06:46:42 CEST 2023


Here is my test unit I'm playing with. It's crude but can anyone suggest what other things I could test? 

I'm playing with a string pointer also to see how ref counting/finalization plays in. Making your own managed typed using management operators is not tested but I'm sure it will be terrible compared to everything else.

* test_short_string time: 143ms
* test_ansi_string time: 115ms
* test_mem_string time: 115ms

* test_short_string_record time: 165ms
* test_ansi_string_record time: 75ms
* test_mem_string_record time: 47ms

* test_short_string_mutate time: 203ms
* test_ansi_string_mutate time: 181ms

=======================================================================================

{$mode objfpc}

program string_test;
uses
  SysUtils, DateUtils;

const
  ITERATIONS = 1000 * 1000;
  TEST_STRING = 'Lorem ipsum dolor sit amet, consectetur adipiscing elit';

type
  TTestProc = procedure;

procedure test_mem_string;

  procedure do_pass(const s: PString; len: Integer);
  var
    c: Char;
    i: Integer;
  begin
    for i := 0 to len - 1 do
      c := s^[i];
  end;

var
  s: PString;
  i, len: Integer;
begin
  for i := 0 to ITERATIONS - 1 do
    begin
      len := Length(TEST_STRING);
      s := GetMem(len);
      s^ := TEST_STRING;
      do_pass(s, len);
      FreeMem(s);
    end;
end;

procedure test_short_string;

  procedure do_pass(const s: ShortString);
  var
    c: Char;
    i: Integer;
  begin
    for i := 0 to length(s) - 1 do
      c := s[i];
  end;

var
  s: Shortstring;
  i: Integer;
begin
  for i := 0 to ITERATIONS - 1 do
    begin
      s := TEST_STRING;
      do_pass(s);
    end;
end;

procedure test_ansi_string;

  procedure ansi_string_pass(const s: AnsiString);
  var
    c: Char;
    i: Integer;
  begin
    for i := 0 to length(s) - 1 do
      c := s[i];
  end;

var
  s: AnsiString;
  i: Integer;
begin
  for i := 0 to ITERATIONS - 1 do
    begin
      s := TEST_STRING;
      ansi_string_pass(s);
    end;
end;

procedure test_ansi_string_mutate;
var
  i, j: Integer;
  s1, s2: AnsiString;
begin
  for i := 0 to ITERATIONS - 1 do
    begin
      s1 := TEST_STRING;
      s2 := s1 + IntToStr(i);
      for j := 1 to length(s2) - 1 do
        s2[j] := 'x';
    end;
end;

procedure test_short_string_mutate;
var
  i, j: Integer;
  s1, s2: ShortString;
begin
  for i := 0 to ITERATIONS - 1 do
    begin
      s1 := TEST_STRING;
      s2 := s1 + IntToStr(i);
      for j := 1 to length(s2) - 1 do
        s2[j] := 'x';
    end;
end;

procedure test_short_string_record;

type
  TMyRecord = record
    a: ShortString;
    b: ShortString;
    c: ShortString;
  end;

function do_pass(rec: TMyRecord): TMyRecord;
begin
  result := rec;
end;

var
  i: Integer;
  r: TMyRecord;
begin
  for i := 0 to ITERATIONS - 1 do
    begin
      r.a := TEST_STRING;
      r.b := TEST_STRING;
      r.c := TEST_STRING;
      do_pass(r);
    end;
end;


procedure test_ansi_string_record;

type
  TMyRecord = record
    a: AnsiString;
    b: AnsiString;
    c: AnsiString;
  end;

function do_pass(rec: TMyRecord): TMyRecord;
begin
  result := rec;
end;

var
  i: Integer;
  r: TMyRecord;
begin
  for i := 0 to ITERATIONS - 1 do
    begin
      r.a := TEST_STRING;
      r.b := TEST_STRING;
      r.c := TEST_STRING;

      do_pass(r);
    end;
end;

procedure test_mem_string_record;

type
  TMyRecord = record
    a: PString;
    b: PString;
    c: PString;
  end;

function do_pass(rec: TMyRecord): TMyRecord;
begin
  result := rec;
end;

var
  i: Integer;
  r: TMyRecord;
  len: Integer;
begin
  len := Length(TEST_STRING);

  for i := 0 to ITERATIONS - 1 do
    begin
      r.a := GetMem(len);
      r.b := GetMem(len);
      r.c := GetMem(len);

      r.a^ := TEST_STRING;
      r.b^ := TEST_STRING;
      r.c^ := TEST_STRING;

      do_pass(r);
    end;
end;


procedure run_test(name: String; test: TTestProc);
var
  startTime: Double;
begin
  startTime := Now;
  test;
  writeln('* ', name,' time: ', MilliSecondsBetween(Now, StartTime), 'ms');
end;

begin
  run_test('test_short_string', @test_short_string);
  run_test('test_ansi_string', @test_ansi_string);
  run_test('test_mem_string', @test_ansi_string);

  run_test('test_short_string_record', @test_short_string_record);
  run_test('test_ansi_string_record', @test_ansi_string_record);
  run_test('test_mem_string_record', @test_mem_string_record);

  run_test('test_short_string_mutate', @test_short_string_mutate);
  run_test('test_ansi_string_mutate', @test_ansi_string_mutate);
end.

Regards,
Ryan Joseph



More information about the fpc-pascal mailing list