Posts: 372
Threads: 23
Joined: May 2022
Reputation:
56
(11-14-2023, 08:57 PM)SpriggsySpriggs Wrote: I can't say that I'm confirming the issue because I'm running my Windows version of QB64pe in Wine, but I will say it did work before but is currently not working in 3.9.1. Pretty sure it's something that would have changed with QB64pe itself, but I wouldn't know what. Would probably need Matt or Samuel to take a peek.
Would you be able to share the latest version of pipecom? Or better yet, share a working example.
BTW, I peeked at the C header in bplus's post, and it uses the C++ standard library string class without the std namespace.
We got rid of using namespace std from libqb.cpp in 3.9.0 and newer (and for good reasons). So, now you'll just need to add std:: before all C++ standard library stuff.
Posts: 303
Threads: 10
Joined: Apr 2022
Reputation:
44
11-14-2023, 09:40 PM
(This post was last modified: 11-14-2023, 09:41 PM by DSMan195276.)
The problem is these two lines in the code:
Code: (Select All)
While ReadFile(hStdOutPipeRead, _Offset(buf), 4096, _Offset(dwRead), 0) <> 0 And dwRead > 0
' ...
While ReadFile(hStdReadPipeError, _Offset(buf), 4096, _Offset(dwRead), 0) <> 0 And dwRead > 0
The issue is that `And` does not require the left side to be evaluated first, rather the compiler picks the order it wants to evaluate the operands in. In this case that creates a bug because the right side of the `And` depends on the result from the left side (since it assigns `dwRead`). In v3.9.0 there is a new MinGW version and it apparently decides to evaluate the `dwRead > 0` side first, resulting in the check always failing since `dwRead` starts as zero.
I'm not really sure if this is a QB64 bug or not, this is definitely something that could always happen in every QB64 version and pipecom was just getting lucky. That said this behavior probably wasn't intentional and mostly just comes from the C behavior - in C the bitwsie operators do not imply evaluation ordering like the logical operators do. A good thing to know is if in QB45 the bitwise operators did imply evaluation order and QB64 isn't doing that, or if this kind of thing could always happen. I suspect they probably did by accident since I doubt QB45 did much in the way of optimization.
Posts: 733
Threads: 30
Joined: Apr 2022
Reputation:
43
Interesting. Let me adjust those lines and see what happens.
Tread on those who tread on you
Posts: 2,696
Threads: 327
Joined: Apr 2022
Reputation:
217
Code: (Select All)
COMMON SHARED winver%, utente$
COMMON SHARED ip4$
DIM ver AS STRING
ver = MID$(pipecom_lite("ver"), 2)
PRINT pipecom_lite("ver")
SLEEP
k$ = ""
FOR f = 1 TO LEN(ver)
IF INSTR("1234567890.", MID$(ver, f, 1)) <> 0 THEN k$ = k$ + MID$(ver, f, 1)
NEXT f
IF INSTR(k$, "6.1.76") > 0 THEN
winver = 7
ELSEIF INSTR(k$, "6.2.") > 0 OR INSTR(k$, "6.3.") > 0 THEN
winver = 8
ELSEIF INSTR(k$, "10.") > 0 THEN
winver = 10
END IF
IF winver = 10 THEN
FOR f = INSTR(_DIR$(""), "User") TO LEN(_DIR$(""))
IF MID$(_DIR$(""), f, 1) = "\" THEN EXIT FOR
NEXT f
utente$ = MID$(_DIR$(""), f + 1, INSTR(MID$(_DIR$(""), f + 1), "\") - 1)
ELSEIF winver = 7 THEN
FOR f = INSTR(_DIR$(""), "User") TO LEN(_DIR$(""))
IF MID$(_DIR$(""), f, 1) = "\" THEN EXIT FOR
NEXT f
utente$ = MID$(_DIR$(""), f + 1, INSTR(MID$(_DIR$(""), f + 1), "\") - 1)
END IF
END
'-----------------------------------------------------------------------------------------------------------------------------
'6.0.6000 Windows Vista
'6.0.6001 Windows Vista with Service Pack 1 'or Windows Server 2008
'6.1.7600 Windows 7 'or Windows Server 2008 R2
'6.1.7601 Windows 7 with Service Pack 1 'or Windows Server 2008 R2 with Service Pack 1
'6.2.9200 Windows 8 'or Windows Server 2012
'6.3.9200 Windows 8.1 'or Windows Server 2012 R2
'6.3.9600 Windows 8.1 with Update 1
'10.0.10240 Windows 10 Version 1507
'10.0.10586 Windows 10 Version 1511 (November Update)
'10.0.14393 Windows 10 Version 1607 (Anniversary Update) 'or Windows Server 2016
'10.0.15063 Windows 10 Version 1703 (Creators Update)
'10.0.16299 Windows 10 Version 1709 (Fall Creators Update)
'10.0.17134 Windows 10 Version 1803 (April 2018 Update)
'10.0.17763 Windows 10 Version 1809 (October 2018 Update) 'or Windows Server 2019
'10.0.18362 Windows 10 Version 1903 (May 2019 Update)
'10.0.18363 Windows 10 Version 1909 (November 2019 Update)
'10.0.19041 Windows 10 Version 2004 (May 2020 Update)
'Note that there is normally no need to specify the build numbers (i.e., you may simply use "6.2" for Windows 8).
'-----------------------------------------------------------------------------------------------------------------------------
$IF PIPECOM = UNDEFINED THEN
$LET PIPECOM = TRUE
FUNCTION pipecom& (cmd AS STRING, stdout AS STRING, stderr AS STRING)
stdout = "": stderr = ""
$IF WIN THEN
TYPE SECURITY_ATTRIBUTES
AS _UNSIGNED LONG nLength
$IF 64BIT THEN
AS STRING * 4 padding
$END IF
AS _OFFSET lpSecurityDescriptor
AS LONG bInheritHandle
$IF 64BIT THEN
AS STRING * 4 padding2
$END IF
END TYPE
TYPE STARTUPINFO
AS LONG cb
$IF 64BIT THEN
AS STRING * 4 padding
$END IF
AS _OFFSET lpReserved, lpDesktop, lpTitle
AS _UNSIGNED LONG dwX, dwY, dwXSize, dwYSize, dwXCountChars, dwYCountChars, dwFillAttribute, dwFlags
AS _UNSIGNED INTEGER wShowWindow, cbReserved2
$IF 64BIT THEN
AS STRING * 4 padding2
$END IF
AS _OFFSET lpReserved2, hStdInput, hStdOutput, hStdError
END TYPE
TYPE PROCESS_INFORMATION
AS _OFFSET hProcess, hThread
AS _UNSIGNED LONG dwProcessId
$IF 64BIT THEN
AS STRING * 4 padding
$END IF
END TYPE
CONST STARTF_USESTDHANDLES = &H00000100
CONST CREATE_NO_WINDOW = &H8000000
CONST INFINITE = 4294967295
CONST WAIT_FAILED = &HFFFFFFFF
DECLARE CUSTOMTYPE LIBRARY
FUNCTION CreatePipe& (BYVAL hReadPipe AS _OFFSET, BYVAL hWritePipe AS _OFFSET, BYVAL lpPipeAttributes AS _OFFSET, BYVAL nSize AS _UNSIGNED LONG)
FUNCTION CreateProcess& (BYVAL lpApplicationName AS _OFFSET, BYVAL lpCommandLine AS _OFFSET, BYVAL lpProcessAttributes AS _OFFSET, BYVAL lpThreadAttributes AS _OFFSET, BYVAL bInheritHandles AS LONG, BYVAL dwCreationFlags AS _UNSIGNED LONG, BYVAL lpEnvironment AS _OFFSET, BYVAL lpCurrentDirectory AS _OFFSET, BYVAL lpStartupInfo AS _OFFSET, BYVAL lpProcessInformation AS _OFFSET)
FUNCTION GetExitCodeProcess& (BYVAL hProcess AS _OFFSET, BYVAL lpExitCode AS _OFFSET)
SUB HandleClose ALIAS "CloseHandle" (BYVAL hObject AS _OFFSET)
FUNCTION ReadFile& (BYVAL hFile AS _OFFSET, BYVAL lpBuffer AS _OFFSET, BYVAL nNumberOfBytesToRead AS _UNSIGNED LONG, BYVAL lpNumberOfBytesRead AS _OFFSET, BYVAL lpOverlapped AS _OFFSET)
FUNCTION WaitForSingleObject~& (BYVAL hHandle AS _OFFSET, BYVAL dwMilliseconds AS _UNSIGNED LONG)
END DECLARE
DIM AS LONG ok: ok = 1
DIM AS _OFFSET hStdOutPipeRead, hStdOutPipeWrite, hStdReadPipeError, hStdOutPipeError
DIM AS SECURITY_ATTRIBUTES sa: sa.nLength = LEN(sa): sa.lpSecurityDescriptor = 0: sa.bInheritHandle = 1
IF CreatePipe(_OFFSET(hStdOutPipeRead), _OFFSET(hStdOutPipeWrite), _OFFSET(sa), 0) = 0 THEN
pipecom = -1
EXIT FUNCTION
END IF
IF CreatePipe(_OFFSET(hStdReadPipeError), _OFFSET(hStdOutPipeError), _OFFSET(sa), 0) = 0 THEN
pipecom = -1
EXIT FUNCTION
END IF
DIM si AS STARTUPINFO
si.cb = LEN(si)
si.dwFlags = STARTF_USESTDHANDLES
si.hStdError = hStdOutPipeError
si.hStdOutput = hStdOutPipeWrite
si.hStdInput = 0
DIM AS PROCESS_INFORMATION procinfo
DIM AS _OFFSET lpApplicationName
DIM AS STRING lpCommandLine: lpCommandLine = "cmd /c " + cmd + CHR$(0)
DIM AS _OFFSET lpProcessAttributes, lpThreadAttributes
DIM AS LONG bInheritHandles: bInheritHandles = 1
DIM AS _UNSIGNED LONG dwCreationFlags: dwCreationFlags = CREATE_NO_WINDOW
DIM AS _OFFSET lpEnvironment, lpCurrentDirectory
ok = CreateProcess(lpApplicationName, _OFFSET(lpCommandLine), lpProcessAttributes, lpThreadAttributes, bInheritHandles, dwCreationFlags, lpEnvironment, lpCurrentDirectory, _OFFSET(si), _OFFSET(procinfo))
IF ok = 0 THEN
pipecom = -1
EXIT FUNCTION
END IF
HandleClose hStdOutPipeWrite
HandleClose hStdOutPipeError
DIM AS STRING buf: buf = SPACE$(4096 + 1)
DIM AS _UNSIGNED LONG dwRead
WHILE 1
'While ReadFile(hStdOutPipeRead, _Offset(buf), 4096, _Offset(dwRead), 0) <> 0 And dwRead > 0
x = ReadFile(hStdOutPipeRead, _OFFSET(buf), 4096, _OFFSET(dwRead), 0)
IF x <> 0 AND dwRead > 0 THEN
buf = MID$(buf, 1, dwRead)
GOSUB RemoveChr13
stdout = stdout + buf
buf = SPACE$(4096 + 1)
ELSE
EXIT WHILE
END IF
WEND
WHILE 1
x = ReadFile(hStdReadPipeError, _OFFSET(buf), 4096, _OFFSET(dwRead), 0)
IF x <> 0 AND dwRead > 0 THEN
buf = MID$(buf, 1, dwRead)
GOSUB RemoveChr13
stderr = stderr + buf
buf = SPACE$(4096 + 1)
ELSE
EXIT FUNCTION
END IF
WEND
DIM AS LONG exit_code, ex_stat
IF WaitForSingleObject(procinfo.hProcess, INFINITE) <> WAIT_FAILED THEN
IF GetExitCodeProcess(procinfo.hProcess, _OFFSET(exit_code)) THEN
ex_stat = 1
END IF
END IF
HandleClose hStdOutPipeRead
HandleClose hStdReadPipeError
IF ex_stat = 1 THEN
pipecom = exit_code
ELSE
pipecom = -1
END IF
EXIT FUNCTION
RemoveChr13:
DIM AS LONG j
j = INSTR(buf, CHR$(13))
DO WHILE j
buf = LEFT$(buf, j - 1) + MID$(buf, j + 1)
j = INSTR(buf, CHR$(13))
LOOP
RETURN
$ELSE
Declare CustomType Library
Function popen%& (cmd As String, readtype As String)
Function feof& (ByVal stream As _Offset)
Function fgets$ (str As String, Byval n As Long, Byval stream As _Offset)
Function pclose& (ByVal stream As _Offset)
End Declare
Declare Library
Function WEXITSTATUS& (ByVal stat_val As Long)
End Declare
Dim As _Offset stream
Dim buffer As String * 4096
If _FileExists("pipestderr") Then
Kill "pipestderr"
End If
stream = popen(cmd + " 2>pipestderr", "r")
If stream Then
While feof(stream) = 0
If fgets(buffer, 4096, stream) <> "" And feof(stream) = 0 Then
stdout = stdout + Mid$(buffer, 1, InStr(buffer, Chr$(0)) - 1)
End If
Wend
Dim As Long status, exit_code
status = pclose(stream)
exit_code = WEXITSTATUS(status)
If _FileExists("pipestderr") Then
Dim As Integer errfile
errfile=FREEFILE
Open "pipestderr" For Binary As #errfile
If LOF(errfile) > 0 Then
stderr = Space$(LOF(errfile))
Get #errfile, , stderr
End If
Close #errfile
Kill "pipestderr"
End If
pipecom = exit_code
Else
pipecom = -1
End If
$END IF
END FUNCTION
FUNCTION pipecom_lite$ (cmd AS STRING)
DIM AS LONG a
DIM AS STRING stdout, stderr
a = pipecom(cmd, stdout, stderr)
IF stderr <> "" THEN
pipecom_lite = stderr
ELSE
pipecom_lite = stdout
END IF
END FUNCTION
$END IF
Fixed version for you. 
Posts: 733
Threads: 30
Joined: Apr 2022
Reputation:
43
That was exactly the issue. I changed the lines to:
Code: (Select All)
While ReadFile(hStdOutPipeRead, _Offset(buf), 4096, _Offset(dwRead), 0) <> 0
If dwRead > 0 Then
buf = Mid$(buf, 1, dwRead)
GoSub RemoveChr13
stdout = stdout + buf
buf = Space$(4096 + 1)
End If
Wend
While ReadFile(hStdReadPipeError, _Offset(buf), 4096, _Offset(dwRead), 0) <> 0
If dwRead > 0 Then
buf = Mid$(buf, 1, dwRead)
GoSub RemoveChr13
stderr = stderr + buf
buf = Space$(4096 + 1)
End If
Wend
Very crazy that mingw's new version would adjust things so much. I wonder how many other programs might get screwed.
Tread on those who tread on you
Posts: 2,696
Threads: 327
Joined: Apr 2022
Reputation:
217
Fix I used was here, to make certain that things get evaluated in order:
Code: (Select All) WHILE 1
'While ReadFile(hStdOutPipeRead, _Offset(buf), 4096, _Offset(dwRead), 0) <> 0 And dwRead > 0
x = ReadFile(hStdOutPipeRead, _OFFSET(buf), 4096, _OFFSET(dwRead), 0)
IF x <> 0 AND dwRead > 0 THEN
buf = MID$(buf, 1, dwRead)
GOSUB RemoveChr13
stdout = stdout + buf
buf = SPACE$(4096 + 1)
ELSE
EXIT WHILE
END IF
WEND
WHILE 1
x = ReadFile(hStdReadPipeError, _OFFSET(buf), 4096, _OFFSET(dwRead), 0)
IF x <> 0 AND dwRead > 0 THEN
buf = MID$(buf, 1, dwRead)
GOSUB RemoveChr13
stderr = stderr + buf
buf = SPACE$(4096 + 1)
ELSE
EXIT FUNCTION
END IF
WEND
Posts: 733
Threads: 30
Joined: Apr 2022
Reputation:
43
Yeah, I like my fix better.
Tread on those who tread on you
Posts: 48
Threads: 11
Joined: Jun 2022
Reputation:
0
Thank you, very fast!
Now everything works again
This is a community very helpful and ready, you can't find them around...
|
