On 11/09/2011 18:23, Martin wrote:
On 11/09/2011 16:44, Mark Morgan Lloyd wrote:
Lazarus is still building for ARM, I'll report back when I know how
that looks. I'll also check the exact kernel versions that the test
systems have running, in case there's some problem.
I'll see if I find the time => it should be simple to copy the code
from unit GDBMIClasses) TPseoudoTerminal.Open /Read and make a small
test app, that will open a pseudo terminal, set the handle to
none-blocking read, and call read on it => and test if read will block
or not.
Ok, the below code, imualtes the pseudoterminal handling => the read is
supposed to bne none blocking.
maybe some of the constants are indeed wrong for your system (endianess)?
program Project1;
{$mode objfpc}{$H+}
{$packrecords c}
// from unit IDEMiniLibC
uses
ctypes
//,libc
;
const
clib = 'c';
InvalHandle = -1;
ICANON = $0000002;
ECHO = $0000008;
VMIN = 6;
VTIME = 5;
TCSANOW = 0;
F_DUPFD = 0;
F_GETFD = 1;
F_SETFD = 2;
F_GETFL = 3;
F_SETFL = 4;
O_NONBLOCK = &04000;
EINTR = 4;
NCCS = 32;
type
error_t = cint;
tcflag_t = cuint;
cc_t = cchar;
speed_t = cuint;
size_t = cuint;
ssize_t = cint;
Ptermios = ^termios;
termios = record
c_iflag : tcflag_t;
c_oflag : tcflag_t;
c_cflag : tcflag_t;
c_lflag : tcflag_t;
c_line : cc_t;
c_cc : array[0..(NCCS)-1] of cc_t;
c_ispeed : speed_t;
c_ospeed : speed_t;
end;
function __errno_location: pcint; cdecl;external clib name
'__errno_location';
function tcgetattr(__fd:cint; __termios_p: Ptermios):cint;cdecl;external
clib name 'tcgetattr';
function tcsetattr(__fd:cint; __optional_actions:cint; __termios_p:
Ptermios):cint;cdecl;external clib name 'tcsetattr';
function __read(Handle: cint; var Buffer; Count: size_t): ssize_t;
cdecl;external clib name 'read';
function __write(Handle: cint; const Buffer; Count: size_t): ssize_t;
cdecl;external clib name 'write';
function __close(Handle: cint): cint; cdecl;external clib name 'close';
function getpt:cint;cdecl;external clib name 'getpt';
function grantpt(__fd:cint):cint;cdecl;external clib name 'grantpt';
function unlockpt(__fd:cint):cint;cdecl;external clib name 'unlockpt';
function ptsname_r(__fd:cint; __buf:Pchar;
__buflen:size_t):cint;cdecl;external clib name 'ptsname_r';
function fcntl(Handle: cint; Command: cint; Arg: clong): cint;
cdecl;external clib name 'fcntl';
function errno : error_t;
begin
Result:=__errno_location()^;
end;
// From TPseudoTerminal / unit GDBMIClasses
const
BufLen = 100;
var
ios: termios;
i,int1: integer;
FDeviceName: string;
FPTy: Integer;
FReadBuf: String;
begin
FPTy := getpt;
if FPTy < 0 then begin
writeln('error getpt');
exit;
end;
if (grantpt(FPTy) < 0) or (unlockpt(FPTy) < 0) then begin
writeln('error grantpt / unlock');
exit;
end;
setlength(FDeviceName, BufLen);
if ptsname_r(FPTy, @FDeviceName[1], BufLen) < 0 then begin
writeln('error ptsname');
exit;
end;
setlength(FDeviceName,length(pchar(FDeviceName)));
if tcgetattr(FPTy, @ios) <> 0 then begin
writeln('error tcgetattr');
exit;
end;
ios.c_lflag:= ios.c_lflag and not (icanon); // or echo);
ios.c_cc[vmin]:= 1;
ios.c_cc[vtime]:= 0;
if tcsetattr(FPTy, tcsanow, @ios) <> 0 then begin
writeln('error tcsetattr');
exit;
end;
int1 := fcntl(FPTy, f_getfl, 0);
if int1 = InvalHandle then begin
writeln('error fcntlgetpt');
exit;
end;
if fcntl(FPTy, f_setfl, int1 or o_nonblock) = InvalHandle then
begin
writeln('error fcntl');
exit;
end;
writeln('now read');
SetLength(FReadBuf, BufLen + 1);
i := __read(FPTy, FReadBuf[1], BufLen);
writeln(i);
end.
--
_______________________________________________
Lazarus mailing list
[email protected]
http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus
