Programming-Idioms.org

WriteLn('Hello, world!');

var
  i: integer;
begin
  for i:=1 to 10 do
    WriteLn('Hello');
end;

Procedure finish(name: String);
Begin
  WriteLn('My job here is done. Goodbye ', name);
End;

Function square(x: Integer): Integer;
Begin
  Result := x*x;
End;

Type
  TPoint = Record
    x : Double;
    y : Double;
  End;

for x in items do ;

var I:Integer;
    Items: array of String;
[..]
  for I := 0 to high(Items) do
    WriteLn('Item ', I, ' = ', Items[I]);

var I:Integer;
    Items: array of TObject;
[...]
  for I := 0 to high(Items) do
    if assigned(Items[I]) then
      WriteLn(Format('Item %d = %s', [I, Items[I].ToString]));

type TMap = specialize TFPGMap<String, Integer>;
var x: TMap;

begin
  x := TMap.Create;
  x['one'] := 1;
  x['two'] := 2;  
end.

type
  generic BinTree<T> = class
    Value: T;
    Left, Right: BinTree;
  end;   

var Iter,rr: integer; 
[...]
  for Iter := 0 to high(x) do
    begin
      rr := random(high(x))+1;
      tmp := x[Iter];
      x[Iter] := x[rr];
      x[rr] := tmp;
    end;

element := x[random(length(x))];

element := x.Items[random(x.count)];

result := false;
for e in list do 
	if e=x then
		begin
			result := true;
			break;
		end

result := list.IndexOf(x) <> -1;

p := list;
while (p <> nil) and (p^.key = x) do p := p^.next;
found := p.key = x

for i := 1 to mymap.Count 		do
  WriteLn(mymap.Keys[i], '=', mymap.Data[i]);

function pick(a, b:real): real;
begin
  result := a + random * (b - a);
end;

var
  _a, _b, _r: Integer;
begin
  _r := RandomRange(_a, _b);
end; 

type
  TTree = class
    Children: array of TTree;
    Data: TObject;
  end;     

type
generic
  TTree<_T> = class(TObject)
    Children: array of TObject;
    Data: _T;
  end;

type
  TStringTree = specialize TTree<String>;

var n,i: integer;
[...]
n:= length(x);
setlength(x, n+1);
for i := 0 to (n div 2)-1 do
	begin
		x[n] := x[i];
		x[i] := x[n-i-1];
		x[n-i-1] := x[n];
	end;
setlength(x, n);

var n,i: integer;
	tmp:TElement;
[...]
n:= length(x);
for i := 0 to (n div 2)-1 do
	begin
		tmp := x[i];
		x[i] := x[n-i-1];
		x[n-i-1] := tmp;
	end;

procedure search(m:T2dMatrix; x:TElement; out i,j:integer);
begin
   for i := 0 to high(m) do
	for j := 0 to high(m[i]) do
            if m[i,j] = x then
               exit;
   i := -1;
   j := -1;
end;

tmp := a;
a := b;
b := tmp;

i := StrToInt(S);

s := format('%.2f',[ x]);

{$codepage utf8}
s := "ネコ";

var Queue: TIdThreadSafeStringList;

type

TTask = class(TThread)
  procedure Execute; override;
end;

procedure TTask.Execute;
begin
  while not Terminated do begin
    Sleep(10);
    with Queue.Lock do try
      while Count > 0 do begin
        WriteLn('Hello, ', Strings[0]);
        Delete(0);
      end;
    finally
      Queue.Unlock;
    end;
  end;
end;

begin
  Queue := TIdThreadSafeStringList.Create;
  TTask.Create(False);
  Queue.Add('Alan');
  Sleep(5000);
end. 

var _x: array[_m,_n] of Double;

var x: array [m,n,p] of double;

type

  TItem = class p: Integer; end;
  TItems = specialize TFPGObjectList<TItem>;

var items: TItems;

  function compare(const a, b: TItem): Integer;
  begin
    Result := a.p - b.p;
  end;

begin
  items := TItems.Create;
  // Add items here.
  items.Sort(@compare);
end.  

list[i] := list[high(list)];
setlength(list,high(list));

type

TThreadF = class(TThread)
  i: Integer;
  constructor Create(const _i: Integer);
  procedure Execute; override;
end;

constructor TThreadF.Create(const _i: Integer);
begin
  i := _i;
  FreeOnTerminate := True;
  inherited Create(False);
end;

procedure TThreadF.Execute;
begin
  f(i);
end;

var i: Integer;

begin
  for i := 1 to 1000 do begin TThreadF.Create(i);
  ReadLn;
end.  

type
  TPositiveInt = 0..MaxInt;

function _f(_i: TPositiveInt): Integer;
begin
  if (_i < 2) then
    Result := 1
  else
    Result := _f(_i - 1);
end; 

function exp(x: integer; n: integer): integer;

begin
  if n = 0 then
    Result := 1
  else if n = 1 then
    Result := x
  else if (n and 1) = 0 then
    Result := exp(x * x, n div 2)
  else
    Result := x * exp(x * x, n div 2);
end;

function exp(x: QWord; n: integer): QWord;

begin
  if n = 0 then
    Result := 1
  else if n = 1 then
    Result := x
  else if (n and 1) = 0 then
    Result := exp(x * x, n div 2)
  else
    Result := x * exp(x * x, n div 2);
end;

var
  loc: TCriticalSection;
begin
  loc.Enter;
  try
    x := f(x);
  finally
    loc.Leave;
  end;
end.

t := copy(s,i+1,j-i);

t := s.Substring(i,j-i);

ok := pos(word,s)<>0;

Function ReverseString(const AText: string): string;
var
    i,j:longint;
begin
  setlength(result,length(atext));
  i:=1; j:=length(atext);
  while (i<=j) do
    begin
      result[i]:=atext[j-i+1];
      inc(i);
    end;
end;

function reverse(const str: string): string;
var
  i, j: Integer;
begin
  j := length(str);
  setlength(reverse, j);
  for i := 1 to j do
    reverse[i] := str[j - i + 1];
end;

  for v in a do
    begin
      for  w in b do
        if (v = w) then
          break;
      if (v = w) then
        Continue;
      writeln(v);
    end;              

var i,j: integer;
   flag:boolean;
[...]
for i := 0 to length(m) * length(m[0]) - 1 do
begin
  v := m[i mod length(m), i div length(m)];
  if v < 0 then
  begin
    writeln(v);
    break;
  end;
end;

for i := 0 to high(m) do
begin
  for v in m[i] do
  begin
    flag := (v < 0);
    if flag then
    begin
      writeln(v);
      break;
    end;
  end;
  if flag then
    break;
end;

s.Insert(i, x)

sleep(5000);

_t := Copy(_s, 1, 5);

Function RightStr(const AText: AnsiString; const ACount: Integer): AnsiString;
var j,l:integer;
begin
  l:=length(atext);
  j:=ACount;
  if j>l then j:=l;
  Result:=Copy(AText,l-j+1,j);
end;

var 
  _s: String;
begin
  _s := 'one' + LineEnding + 'two' + LineEnding + 'three'
end.

var 
  s: String;
begin
  s := 'one' + sLineBreak + 'two' + sLineBreak + 'three'
end.

var 
  s: String;
begin
  s := '''
one
two
three
''';
end.

chunks.StrictDelimiter := True;
chunks.Delimiter := ' ';
chunks.DelimitedText := s;

While True do { nothing };

repeat until false;

m.IndexOf(k) >= 0

m.IndexOfData(v) >= 0

var
  _x: Array of string;
  _y: String;
  i: Integer;
begin
  _y := ''; //initialize result to an empy string
  // assume _x is initialized to contain some values
  for i := Low(_x) to High(_x) do
  begin
    _y := _y + _x[i];
    if i < High(_x) then _y := _y + ';';
  end;
end;

var
  _x: Array of integer;
  _s, i: Integer;
begin
  _s := 0;
  //assume _x contains some values
  for i := Low(_x) to High(_x) do _s := _s + _x[i];
end;

var
  _s: String;
  _i: Integer;
begin
  _s := IntToStr(_i);
end.

Str(i,s);

function Filter(vv:integer):boolean;

begin
  result :=  vv mod 2= 0;
end;

type TFilter=function(v:integer):boolean;

function FilteredArray(const x:TBoundArray;p:TFilter):TBoundArray;
var
  Idx: Integer;
  v : Integer;

begin
  setlength(result,high(x)+1);
  Idx := 0;
  for v in x do
    if p(v) then
    begin
      result[Idx] := v;
      inc(Idx);
    end;
  setlength(result,Idx);
end;
[...]
  y := FilteredArray(x,@Filter);

var
 _lines, _f: String;
 SL: TStringList;
begin
  SL := TStringList.Create;
  SL.LoadFromFile(_f);
  _lines := SL.Text;
  SL.Free;
end;

writeln(StdErr, Format('%d is negative',[-2]));

writeln(StdErr , x , ' is negative');

var
  _x: String;
begin
  _x := ParamString(1);
end.

var
  _d: TDateTime;
begin
  _d := Now;
end.

i := Pos(y, x);

x2 := StringReplace(x, y, z, [rfReplaceAll]);

var
  X: TValue;
begin
  X := Exp(3, 247);
end.

s :=format('%.1f%%', [100.0*x]);  

var
  N, K, Res: TValue;
begin
  Res := BinomN(N, K);
end.

procedure task;
var 
  x: TBits;
  n: integer;
begin 
  n := $FFF;
  x := TBits.Create(n);
end;

procedure Task;
var
  x: Set Of Byte;
begin
  x:= [2,4,8,16,32,64,256];  
end;

var
  SomeInteger: Integer;
  Value: double;
begin
  ...
   //initializes the PRNG's seed with a value depensing on system time
  Randomize; 
  Value := random;
  ...
   //Output will be the same eacht time the program runs
  RandSeed := SomeInteger; 
  Value := random;
...
end.

Randomize;

PROGRAM Echo;

VAR
    I: Integer;
BEGIN
    for I := 1 to ParamCount - 1 do
        Write(ParamStr(I), ' ');
    if (ParamCount > 0) then
        Write(ParamStr(ParamCount));
    WriteLn();
END.

type Parent = class
  constructor create(const str: string);
end;

type ClassOfParent = class of Parent;

function fact(ClassType: ClassOfParent; const str: string): Parent;
begin
  result := ClassType.Create(str);
end;

function GCD(a,b:int64):int64;

var t:int64;

begin
  while b <> 0 do
    begin
       t := b;
       b := a mod b;
       a := t;
    end;
    result := a;
end;

var Iter,n:integer;
[...]
  S := '';
  for Iter := 0 to n do
    s:= Char(Ord('0')+(x shr Iter) and 1) + S;   

var
  _x: Integer;
  _s: String;
begin
  _s := IntToBin(_x,8*SizeOf(Integer));
end.

var
  C: Complex;
begin
  C := 3*i - 2;
end.

repeat
  Something;
  SomethingElse;
until
  c;

repeat
  Something;
  SomethingElse;
until not c;

var
  y: single;
begin
  y := x;
end;

var
  y: integer;
  x: single = -0.8;
begin
  y := trunc(x);
end;

var
  y: integer;
  x: double;
begin
  y := round(x);
end.

function Count(t, s: String): Integer;
var
  Offset, P: Integer;
begin
  Result := 0;
  Offset := 1;
  P := PosEx(t, s, Offset);
  while P > 0 do
  begin
    Inc(Result);
    P := PosEx(t, s, P + 1);
  end;
end;

with TRegExpr.Create('htt+p') do try
finally
  free;
end;

function BitCount(N: Int64): Integer;
var
  Q: QWord;
  i: Integer;
begin
  Result := 0;
  Q := QWord(N);
  for i := 0 to (8 * SizeOf(N) - 1) do
  begin
    if ((Q and 1) = 1) then Inc(Result);
    Q := Q shr 1;
  end;
end;

c := PopCnt(i);

function AddingWillOverFlow(x,y: Integer): Boolean;
begin
  Result := (x > 0) and (y > 0) and (x > (MaxInt-y));
end;

function AddingWillOverFlow(x,y: Integer): Boolean;
begin
  Result := ((x > 0) and (y > 0) and (x > (High(Integer)-y))) or
            ((x < 0) and (y < 0) and ((Low(Integer)-x) > y));
end;

function MultiplyWillOverflow(x, y: Integer): Boolean;
begin
  if ((x and y) = 0) then
    Result := False
  else
  begin
    if ((x > 0) and (y > 0)) or ((x < 0) and (y < 0)) then
      Result := ((High(Integer) div Abs(x)) > Abs(y))
    else
      Result := Abs(Low(Integer) div Abs(x)) > Abs(y);
  end;
end; 

halt(0);

var
  buf: Pointer;
begin
  buf := GetMem(1000000);
end;    

Raise EInvalidArgument.CreatFmt('Invalid value: %d',[x]);

type Foo = class
  private fx: integer;
  public property x: integer read fx;
end;

var
  str: TMemoryStream;
  jss: string;
begin
  with TJSONStreamer.Create(nil) do try
    str := TMemoryStream.Create;
    try
      jss := ObjectToJSONString(x);
      str.Write(jss[1], length(jss));
      str.SaveToFile('data.json');
    finally
      str.Free;
    end;
  finally
    Free;
  end;
end.

procedure control(f: tprocedure);
begin
  if Assigned(f) then f;
end; 

{$mode objfpc}{$H+}
{$ModeSwitch ImplicitFunctionSpecialization }
 
generic procedure PrintTypeOfX<T>(const X: T);
var
  tk: TTypeKind;
begin
  tk := System.GetTypeKind(X);
  writeln(tk);
end;

x := filesize(path);

b := pos(prefix, s) = 1;

b := AnsiEndsStr(suffix, s);

var
  D: TDateTime;
  TS: TTimeStamp;
begin
  D := TimeStampToDateTime(TS);
end.

DefaultFormatSettings.ShortDateFormat := 'yyyy-mm-dd';
X := DateToStr(D);

with TList.Create do try
  Sort(c);
finally
  Free;
end;

with TFPHTTPClient.Create(nil) do try
  s := get(u);
finally
  Free;
end;

var
  str: TMemorystream;
begin
  with TFPHTTPClient.create(nil) do 
  try
    str := TMemoryStream.create;
    try
      get(u, str);
      str.saveToFile('result.txt');
    finally
      str.free;
    end;
  finally
    free;
  end;
end;

s := ExtractFileName(ParamStr(0));

dir := expandfilename('.');

dir := extractfilepath(paramstr(0));

dir := GetCurrentDir;

{$if DECLARED(x)}
writeln(x);
{$endif}

n := SizeOf(T);

blank := trim(s) = '';

var
  p: tprocess;
begin
  p.Executable := 'program_x';
  p.Parameters.Add('a');
  p.Parameters.Add('b');
  p.Execute;
end.

b := (CompareDateTime(d1,d2) = -1);

s2 := stringreplace(s1, w, '', [rfReplaceAll]);

s2 := s1.Replace(w,'');

s2 := s1.Replace(w,''.Empty);

n := length(x);

for i := Low(X) to High(X) do Include(Y,X[i]);

var
  x: TList;
begin
  for i:= x.count-1 downto 0 do
    if x.indexOf(x.items[i]) <> -1 then
      x.delete(i);
end;

read(n);

Type
  Suit = (Spades, Hearts, Diamonds, Clubs);

{$ASSERTIONS ON}
Assert(isConsistent,'isConsistent assertion failed.');

function BinarySearch(X: Integer; A: Array of Integer): Integer;
var
  L, R, I, Cur, answer: Integer;
  isIt :boolean;
begin
  isIt := false;
  answer := -1;
  if Length(A) = 0 then Exit;
  L := Low(A);
  R := High(A);
  while ((L <= R) AND (isIt = false)) do
  begin
    I := L + ((R - L) div 2); 
    Cur := A[I];
    if (X = Cur) then begin
	answer := i;  {cur;}
	isIt := true;
    end;
    if (X > Cur) then
       L := I + 1
    else
      R := I - 1
  end;
  BinarySearch := answer;
end;

function binarySearch (x: integer; a: array of integer): integer;
var  L, R, M: integer;  // left, right, middle
begin
  if Length(a)=0 then Exit(-1);
  L := Low (a);
  R := High(a);
  while (L <= R) do begin
    M := (L + R) div 2;
    if (x = a[M]) then Exit(M);  // found x in a
    if (x > a[M]) 
    then L := Succ(M)
    else R := Pred(M);
  end;
  Exit(-1) // did not found x in a
end;

var
  t1, t: QWord;
begin
  t1 := GetTickCount64;
  foo;
  t := (GetTickCount64 - t1) * 1000000;
  writeln(t);
end.

type
  TFooRec = record
    S: String;
    B: Boolean;
  end;

function Foo: TFooRec;
begin
  Result.S := 'Some string';
  Result.B := False;
end;

procedure foo;
begin
  {$I foobody.txt}
end;

if c1 then f1 else if c2 then f2 else if c3 then f3;

var
  Start, Duration: DWord;  // replaces TDateTime
begin
  Start := GetTickCount64;  // better than Now
  f;
  Duration := GetTickCount64 - Start;
end.

OK := Pos(LowerCase(AWord), LowerCase(S)) > 0;

var
  Items: TList;
  a,b,c: pointer;
begin
  Items := TList.Create;
  Items.Add(a);
  Items.Add(b);
  Items.Add(c);
end.

i := items.IndexOf(x);
if i <> -1 then
  items.delete(i);

var
  i: integer;

for i:= items.count-1 downto 0 do
  if items[i] = x then
    items.delete(i);

var
  S: String;
  C: Char;
  B: Boolean;

  for C in S do
  begin
    B := C in ['0'..'9'];
    if not B then Break;
  end;

var
  H: THandle;
begin
  H := FileCreate(GetTempFileName);
end.

var
  GUID: TGUID;
  Succes: Boolean;

begin
  CreateGUID(GUID);
  Succes := CreateDir(GetTempDir + GUIDToString(GUID));
end.

m.delete(k);

for i := 0 to items1.Count-1 do writeln(items1[i]);
for i := 0 to items2.Count-1 do writeln(items2[i]);

s := IntToHex(x);

S := Format("%x", [x]);

for i := 0 to Min(items1.Count-1,items2.Count-1) do 
  writeln(items1[i],', ',items2[i]);

b := FileExists(fp);

writeln(DateToStr(Now), #32, msg);

f := StrToFloat(s);

f := s.ToExtended;

var
  i: integer;
begin
  t := '';
  for i := 1 to length(s) do
    if s[i] < #128 then t := t + s[i];
end.

var
  s,t: string;
begin
  t := ReplaceRegExpr('[^\u0000-\u007F]+', s, '', False);
end.

type
  TFloatList = specialize TFPGList<Double>;
var
  List: TFloatList;
  D: Double;

begin
  List := TFloatList.Create;
  while not Eof do
  begin
    Read(D);
    List.Add(D);
  end;
  List.Free;
end.

begin
  AllowDirectorySeparators := AllowDirectorySeparators + ['/'];
  p := ExcludeTrailingPathDelimiter(p);
end;

var
  Len: Integer;
begin
  Len := Length(p);
  if (Len > 0) and (p[Len] = '/') then Delete(P, Len, 1);
end;

begin
  p := ExcludeTrailingPathDelimiter(p);
end.

begin
  p := ChompPathDelim(p);
end.

var
  s: string;
begin
  s := 'c';
end.

t := s + IntToStr(i);

t := s + i.ToString;

var
  c1, c2: string;
  RGB1, RGB2: LongInt;
  R1, G1, B1, R2, G2, B2: Byte;
  c: TColor;
begin
  RGB1 := ColorToRGB(StrToInt(StringReplace(c1,'#','$',[])));
  RGB1 := ColorToRGB(StrToInt(StringReplace(c2,'#','$',[])));
  RedGreenBlue(RGB1, R1, G1, B1);
  RedGreenBlue(RGB2, R2, G2, B2);
  c := RGBToColor(R1+R2 div 2, G1+G2 div 2, B1+B2 div 2);
end.

begin
  if DeleteFile(filepath) then
    writeln(filepath,' succesfully deleted.')
  else
    writeln('Error deleting ',filepath);
end.

s := format('%.3d',[i]);

const
  planet = 'Earth';

function RandArr(Max: Integer): TIntegerDynArray;
var
  i, j, temp: Integer;
begin
  SetLength(Result, Max+1);
  for i := Low(Result) to High(Result) do Result[i] := i;
  i := Length(Result);
  while i > 0 do
  begin
    Dec(i);
    j := RandomRange(0,i);
    temp := Result[i];
    Result[i] := Result[j];
    Result[j] := temp;
  end;
end;
  
var
  Idx: TIntegerDynArray;
begin
  Idx := RandArr(High(X));
  SetLength(Y, k);
  for i := 0 to k-1 do Y[i] := X[Idx];
end.

begin
  {$ifdef cpu64}
  f64;
  {$endif}
  {$ifdef cpu32}
  f32;
  {$endif}
end.

for i := Low(elements) to High(elements) do 
  elements[i] := elements[i] * c;

function HasOption(c: char): Boolean;
var
  i: integer;
begin
  Result := False;
  for i := 1 to ParamCount do
    if (ParamStr(i) = ('-' + c)) then Exit(True);
end;  

begin
  if HasOption('b') then Bat;
  if HasOption('f') then Fox;
end.

i := Low(L);
while (i < High(L)) do
begin
  writeln(L[i],', ', L[i+1]);
  Inc(i,2);
end;

b := OpenUrl(s);

x := items[high(items)];

var
  a,b,ab: TList;

...
  ab := TList.Create;
  ab.Assign(a);
  ab.AddList(b);
...

if AnsiStartsStr(p, s) then 
  t := copy(s, length(p)+1, length(s)-length(p))
else
  s := t;

if AnsiEndsStr(w, s) then
  t := copy(s, 1, length(s) - length(w))
else
  t :=s;

n := length(s);

n := Utf8Length(s);

n := s.length;

n := MyMap.Count;

var
  L: TList;
  Item: Pointer;
...
  L.Add(Item);
...

m.KeyData[k] := v;

writeln(format('%.0n',[double(10000)]));   

with TFPHTTPClient.Create(nil) do
begin
 Post(u);
 Free;
end;

s := '';
for b in a do s := s + IntToHex(b,2);

for i := 0 to length(s) div 2 - 1 do
  a[i] := StrToInt('$'+Copy(s,2*(i)+1,2));

L := FindAllFiles(D, '*.jpg;*.jpeg;*.png', True);

b := PtInRect(Rect(x1,y1,x2,y2), Point(x,y));

c := CenterPoint(Rect(x1,y1,x2,y2));

x := FindAllFiles(d, '*', False);

if FindFirst(IncludeTrailingPathDelimiter(d) + '*', 
               faAnyFile and (not faDirectory), SR) = 0 then
repeat
  x.Add(SR.Name);
until FindNext(SR) <> 0;
FindClose(SR);

program Quine(Output);const A='program Quine(Output);const A=';B='begin writeln(A,char(39),A,char(39),char(59),char(66),char(61),char(39),B,char(39),char(59),B)end.';begin writeln(A,char(39),A,char(39),char(59),char(66),char(61),char(39),B,char(39),char(59),B)end.

with TFPHTTPClient.Create(nil) do
begin
 Put(u);
 Free;
end;

t := DateToStr(Now+1.0);

Halt;

Application.Terminate;

var
  A: array[1..m, 1..n] of ArbFloat;
  B: array[1..n, 1..p] of ArbFloat;
  C: array[1..m, 1..p] of ArbFloat;

...

omvmmm(
    A[1,1], m, n, n,
    B[1,1], p, p,
    C[1,1], p
  );

type
  TListPredicate = function(e: pointer): Boolean;
  TListElementFunc = function(e: pointer): pointer;

function NewList(X: TList; P: TListPredicate; T: TListElementFunc): TList;
var
  e: pointer;
begin
  Result := TList.Create;
  for e in X do
  begin
    if P(e) then
      Result.Add(T(e));
  end;
end;

procedure foo(a: pdouble; n: integer); external 'some_c_dll' name 'foo'; cdecl;

for v in a do if v > x then f;

var
  A: array[1..m, 1..n] of ArbFloat;
  B: array[1..n, 1..m] of ArbFloat;
begin
  ... some code to fill A
  omvtrm(
    A[1,1], m, n, n,
    B[1,1], m
  );
end.

type
  TSomeType = Integer;
  TArr = array of array of TSomeType; 

...
procedure ShiftArr(src: TArr; var dest: TArr; n: Integer);
var
  i,j,j2: integer;
begin
  SetLength(dest, length(src), length(src[0]));
  n := n mod length(src[0]);
  for i := low(src) to high(src) do
  begin
    for j := low(src[0]) to high(src[0]) do
    begin
      j2 := j + n;
      if j2 > high(src[0]) then
        j2 := j2 - high(src[0]) - 1;
      dest[i,j2] := src[i,j];
    end;
  end;
end;

...
ShiftArr(a,b,n);
...

procedure foo(a: array of double);
var
  sum: double;
  i: Integer;
begin
  for i := low(a) to high(a) do
    sum := sum + (i+1)*a[i];
  writeln('Size = ',Length(a),', Sum = ',sum:6:5);
end;

...
  foo(a);
...

procedure foo(var L: Integer);
begin
  L := 42;
end;

begin
  for i := 0 to Min(m, n-1) do
    if not odd(i) then foo(a[i]);
end.

var
  Lines: TStringList;
...
  Lines := TStringList.Create;
  Lines.LoadFromFile(Path);

Runerror(x);

Truncate(F);

h := hypot(x,y);

var
  data: array of double;
...
  n := norm(data);
...

var
  data: array of double;
...
  s := SumOfSquares(data);
...

var
  m, s: double;
  data: array of double;
...
  MeanAndStdDev(data, m, s);
...

var
  d: double;
  Mantissa: double;
  Exponent: integer;
begin
  d := 3.14;
  frexp(d, Mantissa, Exponent);
  writeln('Mantissa: ',Mantissa:6:5,', Exponent: ',Exponent);
end.

var
  foo: string;
begin
  foo := GetEnvironmentVariable('FOO');
  if (foo = '') then foo := 'none';
end.

case str of
  'foo': foo;
  'bar': bar;
  'baz': baz;
  'barfl': barfl;
end;

var
  a: array of some_type;
...
  SetLength(a, n);
...

for i := 0 to High(a) do
    a[i] = e*(a[i]+b[i]*c[i]+cos(d[i]);

type
  TDynIntArray = array of integer;
  TT = record
    s: string;
    n: TDynIntArray;
  end;
  PTT = ^TT;

var
  v: PTT;
begin
  v := New(PTT);
  v^.s := 'Hello world';
  v^.n := TDynIntArray.Create(1,4,9,16,25);
  Dispose(v);
end.

writeln({$I %fpcversion%});

MkDir(path);

b := DirectoryExists(path);

//no code here: see comments

s := UTF8PadRight(s,m,c);

s := UTF8PadLeft(s,m,c);

s := UTF8PadCenter(s,m,c);

Zip := TZipper.Create;
Zip.FileName := name;
Zip.Entries.AddFileEntries(list);
Zip.ZipAllFiles;
Zip.Free;

for elem in a do
  if (b.indexof(elem) >= 0) and (c.indexof(elem) = -1) then
    c.add(elem);

var
  i, j: integer;
  t,s: string;
const
  whitespace = [#32,#13,#10,#9];
begin
  ....
  t := '';
  j := 0;
  setlength(t, length(s));
  for i := 1 to length(s) do
    if not ((s[i] in whitespace) and 
            ((i < length(s)) and (s[i+1] in whitespace))) then
    begin
      inc(j);
      t[j] := s[i];
    end;
  setlength(t,j);
end.

  t := s;
  while Pos('  ',t) > 0 do
    t := StringReplace(t, '  ', ' ', [rfReplaceAll]);

  t := ReplaceRegExpr('\s+',s,' ',False);

type
  Tuple = record
    a: integer;
    b: string;
    c: boolean;
  end;
var
  t: Tuple;
begin
  t := Default(Tuple);
end.

t := ReplaceRegExpr('[^\d]', s, ''); 

for i := 1 to length(s) do
    if s[i] in ['0'..'9'] then
        t := t + s[i];

i := Items.IndexOf(x);

Found := False;
for Item in Items do
begin
  if Item.MatchesCondition then
  begin
    Found := True;
    Break;
  end;
end;
if not Found then 
  DoSomethingElse;

items.insert(0,x);

procedure f; overload;
begin
  writeln('not present');
end;

procedure f(x: integer); overload;
begin
  writeln('present');
end;

items.delete(items.count-1);

y.assign(x);

Success := CopyFile(src, dst);

var
  P: TProcess;
begin
  ...
  P.Execute;
  //do something else
  P.Terminate(0);
end.

var
  P: TProcess;
begin
  ...
  P.Execute;
  if not P.WaitOnExit(5000) then P.Terminate(0);
end.

b := FindInvalidUTF8Codepoint(s) = -1;

for i in paramcount do
begin
  if paramstr(i)='-v' then 
  begin
    verbose := true;
    break;
  end;
 writeln('verbose is ',verbose);
end.

S := Application.GetOptionValue('country');
if S = '' then S := 'Canada';
writeln('Country = ',S);

s := EncodeStringBase64(data);

data := DecodeStringBase64(s, true);

c := a xor b;

SetLength(c, Length(a));
for i := Low(a) to High(a) do c[i] := a[i] xor b[i];

  with TRegExpr.Create do
  begin
    Expression := '\b\d\d\d\b';
    Exec(s);
    x := Match[0];
    Free;
  end;

type
  TPairedList = class(TStringList)
  private
    FBuddy: TStrings;
  protected
    procedure ExchangeItems(Id1, Id2: Integer); override;
  public
    procedure Sort(Buddy: TStrings); overload;
  end;

procedure TPairedList.ExchangeItems(Id1, Id2: Integer);
begin
  inherited Exchange(Id1, Id2);
  if Assigned(FBuddy) then
    FBuddy.Exchange(Id1, Id2);
end;

procedure TPairedList.Sort(Buddy: TStrings);
begin
  FBuddy := Buddy;
  Sort;
end;

begin
  ...
  a.sort(b);
end.

TThread.Yield;
busywork;

for e in x do f(e);

for el in a do writeln(el);

for APair in m do writeln(APair.Key, APair.Value);

writeln(x.T);

function CountUniqueItems(Items: TStrings): Integer;
var
  List: TStringList;
begin
  List := TStringList.Create;
  List.Duplicates := dupIgnore;
  List.Sorted := True;
  List.AddStrings(Items);
  Result := List.Count;
  List.Free;
end;

begin
 ...
 c := CountUniqueItems(items);
 ...
end.

for i := x.count-1 downto 0 do
  if not p(x.items[i]) then x.delete(i);

d.buildup(s, m, e);

x := m.Data[Random(m.Count)]);

i := StrToInt('%'+s);

if condition then
  x := a
else
  x := b;

x := ifthen(condition, a, b);

dump_stack(stdout,0);

for i := 0 to x.count - 1 do
  if x[i] = 'foo' then
    x[i] := 'bar';

for el in x do writeln(el);

for i := 5 downto 0 do writeln(i);

for i := items.count-1 downto 0 do writeln(i,' ',items[i]);

var
  a: TStringList;
  b: specialize TList<Integer>;
...
for i := 0 to a.count-1 do b.add(IntToStr(a[i]));

parts := s.split([',','_','-']);

items := TStringList.Create;

DefaultFormatSettings.TimeSeparator := ':';
DefaultFormatSettings.ShortTimeFormat := 'hh:mm:ss';
x := TimeToStr(d);

function Trail(n: Integer): Integer;
var
  Mask: Integer;
begin
  T := 0;
  while (T < SizeOf(Integer)*8) do
  begin
    Mask := 1 shl T;
    if (n and Mask) <> 0 then Exit;
    Inc(T);
  end;
end;

begin
  writeln(Trail(112),' (should be 4)');
end.

function log2d(n: uint32): integer;
var
  temp: uint32;
begin
  Result := 0;
  temp := 1;
  while (temp < n) do
  begin
    Inc(Result);
    temp := 1 shl Result;
  end;
  if (temp > n) then
    Dec(Result);
end;

function log2u(n: uint32): integer;
begin
  Result := log2d(n);
  if (1 shl Result < n) then
    Inc(Result);
end;

var
  i: integer;
begin
  for i := 1 to 16 do
    writeln(i,': log2d = ',log2d(i),', log2u = ',log2u(i));
end.

type
  T2DArray = array of array of Integer;

procedure foo(A: T2DArray);
begin
  writeln(Length(A),', ', Length(A[0]));
end;

var A: T2DArray;

begin
  A := T2DArray.Create([1,2,3],[1,2,3]);
  foo(A);  //prints 2, 3
end.

function Parity(n: Integer): Integer;
var
  Mask, I, Bits: Integer;
begin
  Bits := 0;
  for I := 0 to SizeOf(Integer)*8 - 1 do
  begin
    Mask := 1 shl I;
    if ((n and Mask) <> 0) then Inc(Bits);
  end;
  Result := Ord(Odd(Bits));
end;

begin
  writeln(Parity(42));
end.

function Parity(n: Int32): Integer;
begin
  Result := Ord(Odd(PopCnt(DWORD(n))));
end;

var
  i: Int32;
begin
  i := 42;
  writeln('Parity(42) = ',Parity(i));
end.

s:= '';
for i := 1 to n do s := s + v;
writeln(s);

s := DupeString(v, n);
writeln(s);

procedure foo(const x: variant);
begin
  case (TVarData(x).vType and varTypeMask) of
    varOleStr, varUString, varString: writeln(x);
    otherwise writeln('Nothing');
  end;
end;

begin
  foo('Hello World');
  foo(42);
end.

  e := horse;
  writestr(s, e);
  writeln(e);

  if r1.IsNan then
  begin
   if (TDoubleRec(r1).Data and $4000000000000000) = $4000000000000000 then
     writeln('This is a quiet NaN')
   else
     writeln('This is a signalling NaN');
  end
  else
    writeln('This is a number: ',r1);

procedure tst(x: tobject);
begin
  if x.ClassType = foo then
    writeln('Same type')
  else if x is foo then
    writeln('Extends type')
  else
    writeln('Not related');
end; 

for i := 1 to 100 do
begin
  Fizz := (i mod 3) = 0;
  Buzz := (i mod 5) = 0;
  if Fizz then write('Fizz');
  if Buzz then write('Buzz');
  if not (Fizz or Buzz) then write(i);
  write(' ');
end.

program fizzbuzz;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils;
var i: Integer;
begin
for i := 1 to 100 do
begin
if (i mod 3 = 0) and (i mod 5 = 0) then WriteLn(IntToStr(i) + ' = FizzBuzz')
else if (i mod 3 = 0) then WriteLn(IntToStr(i) + ' = Fizz')
else if (i mod 5 = 0) then WriteLn(IntToStr(i) + ' = Buzz')
else WriteLn(IntToStr(i));
end;
readln;
end.

with FindAllFiles(p, AllFilesMask, False) do
try
  b := DirectoryExists(p) and (Count = 0);
finally
  Free;
end;

t := ReplaceRegExpr('\s', s, '');

  SetLength(t, Length(s));
  i := 0;
  for Ch in S do
    if (Ch > #32) then
    begin
      Inc(i);
      t[i] := Ch;
    end;
  SetLength(t, i);

  Size := Length(S) div 8;
  SetLength(a, Size);
  for i := 0 to Size - 1 do
  begin
    SBin := '%' + Copy(S, 1+(i*8), 8);
    Val(SBin, a[i], Err);
    if (Err <> 0) then
      RunError(106);  
  end;

Include(x,e);

x := x + [e];

Exclude(x,e);

x := x - [e];

readln(line);

while not EOF do
begin
  readln(s);
  lines.Add(s);
end;

for i := m.count-1 downto 0 do
  if not p(m.items[i]) then m.delete(i);

type
  TKey = record
    x, y: Integer;
    class operator =(L,R: TKey): Boolean;
    class operator <(L,R: TKey): Boolean;
    class operator >(L,R: TKey): Boolean;
  end;
  TMap = specialize TFPGMap<TKey, String>;

var
  m: TMap;
  Key: TKey;
begin
  Key.x := 42;
  Key.y := 5;
  m := TMap.Create;
  m.Add(Key, 'Hello World');
  m.Free;
end.

parts := s.split([sep]); 

a := nil;
setlength(a, n);

a := NaN;

for i := 1 to utf8length(s) do
  writeln(format('Char %d is %s',[i, utf8copy(s,i,1)]));

n := length(s);

b := e in x;

s := a + b;

for index := j-1 downto i do
  items.delete(index);

  {$IFDEF WINDOWS}
  SetTextCodePage(Output, CP_UTF8);
  SetConsoleOutputCP(CP_UTF8);
  {$ENDIF}
  writeln('Hello World and 你好');

s := TStack.Create;
s.Push(x);
y := s.Pop;

var
  a: array of integer;
  i: Integer;
begin
  a := [1,12,42];
  for i := Low(a) to High(a) do
  begin
    write(a[i]);
    if i <> High(a) then write(', ');
  end;
end.

function TryEnumToStr(const s: string; out enum: T): Boolean;
var
  code: integer;
begin
  Val(s, enum, code);
  Result := (code = 0);
end;

  x2 := x;
  p := RPos(y, x);
  if (p > 0) then
  begin
    Delete(x2, p, Length(y));
    Insert(z, x2, p);
  end;

  x2 := ReverseString(StringReplace(ReverseString(x), ReverseString(y), ReverseString(z), []));

data.sort;

// a line of comments, this line will not be compiled or executed.

function fib(n: word): uint64;
begin
  if (n in [0,1]) then
    result := n
  else
    result := fib(n-2) + fib(n-1);
end; 

s := Format('Our sun has %d planets',[x]);

s := 'Our sun has '+IntToStr(x)+' planets';

s := 'Our sun has '+x.ToString+' planets';

var
  a: array[42..47] of integer;

var
  data: pbyte absolute s;

writeln('a^b=',power(a,b));
writeln('a^n=',power(a,n));

x.capacity := 200;

SetLength(a, 200);

encrypted := xorstring(key, original);

function IntToBaseStr(n: longword; const b: cardinal): string;
const
  digits = '0123456789abcdefghijklmnopqrstuvwxyz';
var
  remainder: longword;
begin
  Result := '';
  repeat
    DivMod(n, b, n, remainder);
    result := digits[remainder + 1] + result;
  until n = 0;
end;

s := IntToStrBase(n,b);