{$mode objfpc} {$longstrings on} {$coperators on} {$modeswitch arrayoperators} generic procedure SetArray(out a: specialize TArray; const data: array of T); begin a := Copy(data); end; generic function ArraysEqual(const a, b: array of T): boolean; var i: SizeInt; begin if length(a) <> length(b) then exit(false); for i := 0 to High(a) do if a[i] <> b[i] then exit(false); result := true; end; generic function ToString(const a: array of T): string; var i: SizeInt; es: string; begin result := '('; for i := 0 to High(a) do begin if i > 0 then result += ', '; WriteStr(es, a[i]); result += es; end; result += ')'; end; var somethingFailed: boolean = false; generic function Verify(const a, ref: array of T; const what: string): boolean; begin result := specialize ArraysEqual(a, ref); if not result then begin writeln(what + ':' + LineEnding + specialize ToString(a) + ',' + LineEnding + 'expected:' + LineEnding + specialize ToString(ref) + '.' + LineEnding); somethingFailed := true; end; end; generic procedure SetConcat(var a: specialize TArray; const p0, p1: specialize TArray); begin a := p0 + p1; end; generic procedure SetConcat(var a: specialize TArray; const p0, p1, p2: specialize TArray); begin a := p0 + p1 + p2; end; generic procedure Test(const vs: array{[0 .. 5]} of T; const typename: string); var a, b, c, d, ref: array of T; preva: pointer; i, tries: int32; begin // Back in the day, delete() with huge count could crash, or corrupt some memory and produce an invalid array with negative length. specialize SetArray(a, vs[0 .. 3]); delete(a, 2, High(SizeInt)); if length(a) = 2 then specialize Verify(a, vs[0 .. 1], 'delete(' + specialize ToString(vs[0 .. 3]) + ', start = 2, count = High(SizeInt))') else begin writeln('Length after delete(' + specialize ToString(vs[0 .. 3]) + ', start = 2, count = High(SizeInt)) is ', length(a), ', expected 2.', LineEnding); somethingFailed := true; end; specialize SetArray(a, vs[0 .. 3]); specialize SetArray(b, [vs[4]]); specialize SetArray(c, [vs[5]]); tries := 0; repeat if tries >= 100 then begin writeln('dynarray_concat_multi(' + typename + ') has no append optimization.', LineEnding); somethingFailed := true; break; end; preva := pointer(a); specialize SetConcat(a, a, b, c); ref := Copy(vs, 0, 4); SetLength(ref, 4 + 2 * (1 + tries)); for i := 4 to High(ref) do ref[i] := vs[4 + i and 1]; inc(tries); until not specialize Verify(a, ref, 'dynarray_concat_multi(' + typename + ')') or (pointer(a) = preva); specialize SetArray(a, vs[0 .. 3]); specialize SetArray(b, [vs[4]]); tries := 0; repeat if tries >= 100 then begin writeln('dynarray_concat(' + typename + ') has no append optimization.', LineEnding); somethingFailed := true; break; end; preva := pointer(a); specialize SetConcat(a, a, b); ref := Copy(vs, 0, 4); SetLength(ref, 4 + (1 + tries)); for i := 4 to High(ref) do ref[i] := vs[4]; inc(tries); until not specialize Verify(a, ref, 'dynarray_concat(' + typename + ')') or (pointer(a) = preva); specialize SetArray(a, [vs[0]]); specialize SetArray(b, []); specialize SetArray(c, vs[1 .. 2]); specialize SetArray(d, []); specialize SetConcat(a, b, c, d); if specialize Verify(a, vs[1 .. 2], '() + ' + specialize ToString(vs[1 .. 2]) + ' + ()') and (pointer(a) <> pointer(c)) then begin writeln('dynarray_concat_multi(' + typename + ') does not reuse the only nonempty input.', LineEnding); somethingFailed := true; end; specialize SetArray(a, [vs[0]]); specialize SetArray(b, vs[1 .. 2]); specialize SetArray(c, []); specialize SetConcat(a, b, c); if specialize Verify(a, vs[1 .. 2], specialize ToString(vs[1 .. 2]) + ' + ()') and (pointer(a) <> pointer(b)) then begin writeln('dynarray_concat(' + typename + ') does not reuse the only nonempty input #1.', LineEnding); somethingFailed := true; end; specialize SetArray(a, [vs[0]]); specialize SetArray(b, []); specialize SetArray(c, vs[1 .. 2]); specialize SetConcat(a, b, c); if specialize Verify(a, vs[1 .. 2], '() + ' + specialize ToString(vs[1 .. 2])) and (pointer(a) <> pointer(c)) then begin writeln('dynarray_concat(' + typename + ') does not reuse the only nonempty input #2.', LineEnding); somethingFailed := true; end; end; function CopyStr(const src: string): string; begin result := System.Copy(src, 1, length(src)); end; begin specialize Test([1, 2, 3, 4, 5, 6], 'int32'); specialize Test([CopyStr('S1'), CopyStr('S2'), CopyStr('S3'), CopyStr('S4'), CopyStr('S5'), CopyStr('S6')], 'string'); if not somethingFailed then writeln('ok'); if somethingFailed then halt(1); end.