{$ifndef fpc}
{$mode pascal}
{$endif}
{$ifdef fpc}
{$codepage utf8}
{$endif}
program test1;
uses
{$ifndef fpc}
rtl_fpccompatibility;
{$else}
cwstring,sysutils;
{$endif}
type
{$ifdef fpc}
card8 = byte;
card16 = word;
char8 = ansichar;
char16 = unicodechar;
string8 = utf8string;
string16 = unicodestring;
{$endif}
pcard8 = ^card8;
pcard16 = ^card16;
card16aty = array[0..0] of card16;
pcard16aty = ^card16aty;
card8aty = array[0..0] of card8;
pcard8aty = ^card8aty;
testfuncty = function(const inp: string8): string16;
const
strlen = 10000;
loopcount = 20000;
function conv1(const inp: string8): string16;
begin
result:= inp;
end;
function conv2(const inp: string8): string16;
var
i1: int32;
begin
setlength(result,length(inp));
for i1:= 1 to length(result) do begin
card16(result[i1]):= card8(inp[i1]);
end;
end;
function conv3(const inp: string8): string16;
var
i1: int32;
begin
setlength(result,length(inp));
for i1:= 0 to length(result)-1 do begin
pcard16aty(pointer(result))^[i1]:= pcard8aty(pointer(inp))^[i1];
//no uniqestring check
end;
end;
function conv4(const inp: string8): string16;
var
ps,pe: pcard8;
pd: pcard16;
begin
setlength(result,length(inp));
ps:= pointer(inp);
pe:= ps + length(result);
pd:= pointer(result);
while ps < pe do begin
pd^:= ps^;
inc(ps);
inc(pd);
end;
end;
var
s1: string8;
s2: string16;
procedure test(const alabel: string8; const afunc: testfuncty);
var
i1: int32;
t1,t2: tdatetime;
begin
s2:= '';
t1:= now();
for i1:= 0 to loopcount-1 do begin
s2:= afunc(s1);
end;
t2:= now();
if s1 <> s2 then begin
writeln(alabel,':****error****');
end
else begin
{$ifdef fpc}
writeln(alabel,': ',(t2-t1)*24*60*60:0:6,'s');
{$else}
writeln(alabel,': ',(t2-t1)*24*60*60,'s');
{$endif}
end;
end;
var
i1: int32;
begin
setlength(s1,strlen);
for i1:= 1 to length(s1) do begin
s1[i1]:= char8(card8((i1+32) and $7f));
end;
{$ifdef fpc}
writeln('Free Pascal:');
{$else}
writeln('MSElang:');
{$endif}
test('conv1',@conv1);
test('conv2',@conv2);
test('conv3',@conv3);
test('conv4',@conv4);
end.