function TextRecValid(var t: Text; testHandle: boolean= true): boolean;
var
a, b, c, d: ptruint;
begin
result := false;
(* If we're not actually being asked to test this then return true. *)
if not Assigned(@t) then
exit(true);
(* If the parameter is INPUT or OUTPUT then we can reasonably test the mode and *)
(* possibly handle. *)
if @t = @INPUT then begin
if TextRec(t).mode <> fmInput then
exit;
if testHandle and (TextRec(t).Handle <> 0) then
exit
end;
if @t = @OUTPUT then begin
if TextRec(t).mode <> fmOutput then
exit;
if testHandle and (TextRec(t).Handle <> 1) then
exit
end;
(* By default, expect the buffer to be internal to the TextRec. *)
if TextRec(t).bufPtr <> @(TextRec(t).buffer) then
exit;
a := ptruint(@(TextRec(t).buffer));
b := ptruint(@(TextRec(t).bufPtr));
c := a - b;
{ define DUMP_TEXTREC }
{$ifdef DUMP_TEXTREC }
with TextRec(t) do begin
d := ptruint(@bufptr);
WriteLn(ERROUTPUT, (d - b):5, ' ', HexStr(d, 16), ' ', HexStr(ptruint(bufptr), 16));
d := ptruint(@openfunc);
WriteLn(ERROUTPUT, (d - b):5, ' ', HexStr(d, 16));
d := ptruint(@inoutfunc);
WriteLn(ERROUTPUT, (d - b):5, ' ', HexStr(d, 16));
d := ptruint(@flushfunc);
WriteLn(ERROUTPUT, (d - b):5, ' ', HexStr(d, 16));
d := ptruint(@closefunc);
WriteLn(ERROUTPUT, (d - b):5, ' ', HexStr(d, 16));
d := ptruint(@userdata);
WriteLn(ERROUTPUT, (d - b):5, ' ', HexStr(d, 16));
d := ptruint(@name);
WriteLn(ERROUTPUT, (d - b):5, ' ', HexStr(d, 16));
d := ptruint(@LineEnd);
WriteLn(ERROUTPUT, (d - b):5, ' ', HexStr(d, 16));
d := ptruint(@buffer);
WriteLn(ERROUTPUT, (d - b):5, ' ', HexStr(d, 16));
WriteLn(ERROUTPUT)
end;
{$endif DUMP_TEXTREC }
(* If we believe we have a good understanding of the fields between the buffer *)
(* pointer and the buffer itself, then it is likely that the overall data *)
(* structure- and in particular the code pointers- behaves much as we expect. *)
d := SizeOf(Pointer); // bufptr
d += 4 * SizeOf(Pointer); // codepointers
d += 32; // userdata
d += textrecnamelength * SizeOf(TFileTextRecChar); // name
d += 1 + 3; // lineend
result := c = d (* Good place for a breakpoint *)
end { TextRecValid } ;
type
PText= ^Text;
begin
if TextRecValid(INPUT) then
WriteLn(ERROUTPUT, 'INPUT OK')
else
WriteLn(ERROUTPUT, 'Bad INPUT TextRec');
if TextRecValid(OUTPUT) then
WriteLn(ERROUTPUT, 'OUTPUT OK')
else
WriteLn(ERROUTPUT, 'Bad OUTPUT TextRec');
if not TextRecValid(PText(Nil)^) then
WriteLn(ERROUTPUT, 'Bad nil TextRec');
end.