fpcsrc/tests/test/cg/taddset4.pp


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29

type
  TCompilerIntfFlag = (ifHasGuid,ifDispInterface,ifDispatch,ifHasStrGUID);
  TCompilerIntfFlags = set of TCompilerIntfFlag;

procedure t(l: longint);
begin
  writeln(hexstr(l,8));
  { exactly 3 bits must be set }
  l:=l and (l-1);
  if (l = 0) then
    halt(1);
  l:=l and (l-1);
  if (l = 0) then
    halt(2);
  l:=l and (l-1);
  if (l <> 0) then
    halt(3);
end;

var
  b:boolean;
begin
  b:=true;
  t(longint([
      TCompilerIntfFlag(ord(ifHasGuid)*ord(b)),
      TCompilerIntfFlag(ord(ifHasStrGUID)*ord(b)),
      TCompilerIntfFlag(ord(ifDispInterface)*ord(b))
    ]));
end.