kam-mobile/code/ProbePlatform.pas

unit ProbePlatform;
{$mode objfpc}{$H+}{$codepage utf8}
{$ifndef ANDROID}{$fatal This probe may only be compiled for Android}{$endif}
interface
uses Classes, SysUtils, ProbeReport;
function ProbeDirectory: string;
procedure RunPlatformChecks(Report: TProbeReport; const WorkDir: string);
procedure WriteTestTone(const FileName: string);
implementation
uses Math, ZStream, CastleUriUtils, ProbeBuild;
type
  TSumThread = class(TThread)
  public
    Sum: Int64;
    procedure Execute; override;
  end;
procedure TSumThread.Execute;
var I: Integer;
begin
  Sum := 0;
  for I := 1 to 10000 do Sum := Sum + I;
end;
function ProbeDirectory: string;
begin
  Result := UriToFilenameSafe(ResolveCastleConfigUrl('castle-config:/kam-architecture-probe/'));
  if Result = '' then raise Exception.Create('No native path for castle-config');
  Result := IncludeTrailingPathDelimiter(Result);
  if not ForceDirectories(Result) then raise Exception.Create('Cannot create private probe directory');
end;
procedure RunPlatformChecks(Report: TProbeReport; const WorkDir: string);
var
  B: array[0..4095] of Byte;
  ReadBack: array[0..4095] of Byte;
  I: Integer; N: LongInt; LE: Cardinal;
  Name, S: string;
  FileStream: TFileStream;
  Raw, Compressed: TMemoryStream;
  C: TCompressionStream; D: TDecompressionStream;
  W: TSumThread;
  Counter: TStringList;
  Launch: Integer;
begin
  LE := $04030201;
  Report.Check('abi.pointer', SizeOf(Pointer) = ProbePointerBytes,
    Format('pointer=%d integer=%d nativeint=%d extended=%d',
      [SizeOf(Pointer),SizeOf(Integer),SizeOf(NativeInt),SizeOf(Extended)]));
  Report.Check('abi.scalar_layout', (SizeOf(Integer)=4) and (SizeOf(Single)=4)
    and (SizeOf(Double)=8) and (SizeOf(Int64)=8), 'Fixed-width scalar assumptions');
  Report.Check('abi.endianness', PByte(@LE)^=1, 'Little-endian native byte order');
  for I := 0 to High(B) do B[I] := Byte(I mod 251);
  try
    Name := WorkDir + 'native-I-O-тест.bin';
    FileStream := TFileStream.Create(Name, fmCreate);
    try FileStream.WriteBuffer(B, SizeOf(B)); finally FileStream.Free; end;
    FillChar(ReadBack, SizeOf(ReadBack), 0);
    FileStream := TFileStream.Create(Name, fmOpenRead or fmShareDenyWrite);
    try
      FileStream.Seek(1024, soBeginning);
      FileStream.ReadBuffer(ReadBack[1024], 32);
      Report.Check('files.seek', CompareMem(@B[1024],@ReadBack[1024],32), 'Native TFileStream seek/read');
      FileStream.Position := 0; FileStream.ReadBuffer(ReadBack,SizeOf(ReadBack));
      Report.Check('files.native_utf8', CompareMem(@B,@ReadBack,SizeOf(B)), 'UTF-8 path / native filename round trip');
    finally FileStream.Free; end;
    Name := WorkDir + 'CaseProbe.txt';
    FileStream := TFileStream.Create(Name,fmCreate); FileStream.Free;
    Report.Check('files.case_sensitive', not FileExists(WorkDir+'caseprobe.txt'), 'Android case-sensitive lookup; asset names must match');
  except on E:Exception do Report.Add('files.native','FAIL',E.ClassName+': '+E.Message); end;
  try
    Raw := TMemoryStream.Create; Compressed := TMemoryStream.Create;
    try
      C := TCompressionStream.Create(clDefault, Compressed);
      try C.WriteBuffer(B,SizeOf(B)); finally C.Free; end;
      Compressed.Position := 0;
      D := TDecompressionStream.Create(Compressed);
      try
        repeat
          N := D.Read(ReadBack,SizeOf(ReadBack));
          if N>0 then Raw.WriteBuffer(ReadBack,N);
        until N=0;
      finally D.Free; end;
      Report.Check('fpc.zstream', (Raw.Size=SizeOf(B)) and CompareMem(Raw.Memory,@B,SizeOf(B)),
        'Real FPC zlib stream round trip; not a KaM resource decoder test');
    finally Raw.Free; Compressed.Free; end;
  except on E:Exception do Report.Add('fpc.zstream','FAIL',E.ClassName+': '+E.Message); end;
  try
    W := TSumThread.Create(True);
    try
      W.FreeOnTerminate := False; W.Start; W.WaitFor;
      Report.Check('fpc.thread',W.Sum=50005000,'Native worker thread joined; no GUI/simulation callbacks');
    finally W.Free; end;
  except on E:Exception do Report.Add('fpc.thread','FAIL',E.ClassName+': '+E.Message); end;
  try
    Counter := TStringList.Create;
    try
      Name := WorkDir + 'launch-counter.txt'; Launch := 1;
      if FileExists(Name) then begin
        Counter.LoadFromFile(Name);
        Launch := StrToInt(Trim(Counter.Text))+1;
      end;
      Counter.Text := IntToStr(Launch); Counter.SaveToFile(Name);
      S := 'launch_count='+IntToStr(Launch)+'; compare after force-stop/relaunch';
      if Launch>1 then Report.Add('files.persisted_counter','OBSERVED',S)
      else Report.Add('files.persisted_counter','NOT_RUN',S);
    finally Counter.Free; end;
  except on E:Exception do Report.Add('files.persisted_counter','FAIL',E.ClassName+': '+E.Message); end;
end;
procedure WriteTestTone(const FileName: string);
const SampleRate=22050; Samples=5512;
var F:TFileStream; I:Integer; V:SmallInt;
  procedure U16(Value:Word);
  var B:array[0..1] of Byte;
  begin B[0]:=Value and 255; B[1]:=Value shr 8; F.WriteBuffer(B,2); end;
  procedure U32(Value:Cardinal);
  var B:array[0..3] of Byte;
  begin B[0]:=Value and 255; B[1]:=(Value shr 8) and 255;
    B[2]:=(Value shr 16) and 255; B[3]:=Value shr 24; F.WriteBuffer(B,4); end;
  procedure FourCC(const S:AnsiString);
  begin F.WriteBuffer(S[1],4); end;
begin
  F:=TFileStream.Create(FileName,fmCreate);
  try
    FourCC('RIFF');U32(36+Samples*2);FourCC('WAVE');FourCC('fmt ');
    U32(16);U16(1);U16(1);U32(SampleRate);U32(SampleRate*2);U16(2);U16(16);
    FourCC('data');U32(Samples*2);
    for I:=0 to Samples-1 do begin
      V:=Round(3000*Sin(2*Pi*440*I/SampleRate));
      U16(Word(Integer(V) and $FFFF));
    end;
  finally F.Free; end;
end;
end.