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.