Description:
This appears to be a problem that has been present for a while but the test missed it. The test was opening a compound record set and then moving through each recordSet contained within. It then opened a second individual set using the active command from the current set of the compound set. It then compares them to see if they are the same.
However it failed to verify whether the compound set for some reason closed early which appears to be the case if the cursor location is adUseServer.
In this case, as soon as a second recordSet is opened which uses the same open connection as the test recordSet, then the portions of the compound recordSet that extend beyond the recordSet currently being accessed are dropped. This will not occur if the location of the cursor is adUseClient, and it also won't occur if you open the second record set using a new connection.
I verified that the sequence of events which is currently failing here will work if the test case is run against sqlServer.
Test was tried against MySQL Server 5.0,5.1, and 6.0
ODBC trace against server 5.0.62 is attached.
How to repeat:
'This test case will be committed to the ado conformance/tests/bugs suite under 'this bug number.
option explicit
' Copyright 2009 - MySQL AB
Const BUG = 99
Dim fso, f, s
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile("../common/adovbs.inc", 1)
s = f.ReadAll()
ExecuteGlobal s
Set f = fso.OpenTextFile("../common/mysql-common.inc", 1)
s = f.ReadAll()
f.Close
Set f = Nothing
'Set fso = Nothing
ExecuteGlobal s
Dim bSetup: bSetup = cBool(True)
Sub setup()
' just do this once
If bSetup Then
Call readConnStrings()
bSetup = cBool(False)
End If
Dim oConn, StrSQL, vbSingleQuote, data
vbSingleQuote = Chr(39)
Set oConn = CreateObject("ADODB.Connection")
oConn.ConnectionString = connstr
oConn.Open
StrSQL = "DROP TABLE IF EXISTS `" & BUG & "`"
oConn.Execute StrSQL
StrSQL = "CREATE TABLE `" & BUG & "` (C1 TINYINT PRIMARY KEY, C2 CHAR(20), C3 TIME)"
oConn.Execute StrSQL
StrSQL = "INSERT INTO `" & BUG & "` VALUES (1, " & vbSingleQuote & "FOO" & vbSingleQuote &_
", NOW()), (2, " & vbSingleQuote & "FOO" & vbSingleQuote & ", NOW())"
oConn.Execute StrSQL
oConn.Close
Set oConn = Nothing
End Sub
Sub teardown()
Dim oConn, StrSQL
Set oConn = CreateObject("ADODB.Connection")
oConn.ConnectionString = connstr
oConn.Open
StrSQL = "DROP TABLE `" & BUG & "`"
oConn.Execute StrSQL
oConn.Close
Set oConn = Nothing
End Sub
Sub Cleanup(conn1, conn2, recset, recset2)
If recset.State <> adStateClosed Then
recset.Close
End If
Set recset = Nothing
If recset2.State <> adStateClosed Then
recset2.Close
End If
Set recset2 = Nothing
If conn1.State <> adStateClosed Then
conn1.Close
End If
Set conn1 = Nothing
If conn2.State <> adStateClosed Then
conn2.Close
End If
Set conn2 = Nothing
End Sub
Sub CountRows(recset, iRecordCount)
dim fld
iRecordCount = recset.RecordCount
recset.MoveFirst
If iRecordCount <> -1 Then
' need to get a handle to the connection in case it needs to be closed early
If iRecordCount = 0 Then
On Error Goto 0
Assert.Failure "There are no records in the test table"
Exit Sub
End If
Else
' the record count property isn't supported so have to find out the max num of records another way
dim iTemp: iTemp = 0
while NOT recset.EOF
REM for each fld in recset.fields
REM if fld.name = "C1" then
REM assert.trace fld.value
REM end if
REM next
recset.MoveNext
iTemp = iTemp + 1
wend
iRecordCount = iTemp
End If
End Sub
Sub SetMultipleCommandOption(conntemp)
' Add the option for multiple SQL statements to the connection string options
Dim iOpt, iIndex, iIndex2
iIndex = InStr(connstr, "OPTION=") + 7
iOpt = Mid(connstr, iIndex, Len(connstr) - iIndex + 1)
iIndex2 = InStr(iOpt, ";")
iOpt = Mid(iOpt, 1, Len(iOpt) - iIndex2 + 1)
If (iOpt And 67108864) <> 67108864 Then
iOpt = cLng(iOpt) + 67108864 ' ADD the option value for Multi_Statements if not there already
End If
conntemp = Mid(connstr, 1, iIndex-1)
conntemp = conntemp & iOpt
End Sub
Sub Test_SERVER_SIDE()
Dim conntemp
Call SetMultipleCommandOption(conntemp)
Assert.Trace "Test is using this connection string:"
Assert.Trace conntemp
On Error Resume Next
Dim strSQLcompound, oConn, oConn2, oRs, oRs2, strSQL(3), iRecordCount
Set oConn = CreateObject("ADODB.Connection")
Set oConn2 = CreateObject("ADODB.Connection")
Set oRs = CreateObject("ADODB.RecordSet")
Set oRs2 = CreateObject("ADODB.RecordSet")
strSQL(0) = "SELECT * FROM `" &BUG & "`"
strSQL(1) = "SELECT * FROM `" &BUG & "` LIMIT 1"
strSQL(2) = "SELECT C1 FROM `" &BUG & "` WHERE C1 > 1"
strSQL(3) = "SELECT 'ONE' as numberone"
strSQLcompound = strSQL(0) & ";" & strSQL(1) & ";" & strSQL(2) & ";" & strSQL(3) & ";"
' open connection
oConn.ConnectionString = conntemp
oConn.CursorLocation = adUseServer
oConn2.ConnectionString = conntemp
oConn2.CursorLocation = adUseServer
Err.Clear
oConn.Open
oConn2.Open
If Err.Number <> 0 Then
Call Cleanup (oConn, oConn2, oRs, oRs2)
Assert.Trace Err.Number & "::" & Err.Description
On Error Goto 0
Assert.Failure "Error opening connection"
End If
' open record set
oRs.Open strSQLcompound, oConn, adOpenStatic, adLockOptimistic
If Err.Number <> 0 Then
Call Cleanup (oConn, oConn2, oRs, oRs2)
Assert.Trace Err.Number & "::" & Err.Description
On Error Goto 0
Assert.Failure "Error opening Record Set"
End If
If Not cBool((oRs.State And adStateOpen) = adStateOpen) Then
On Error Goto 0
Assert.Failure "Failed to open the compound record set"
End If
oRs.Movefirst
' Verify
dim failsafe, i, SQL
failsafe = 0 'used to prevent an infinite loop
i = 0
Do Until oRs Is Nothing
If failsafe = 5 Then
Call CountRows(oRs, iRecordCount)
On Error Goto 0
Assert.Failure "Timed Out, End of Compount RecordSet can't be found"
End If
Select Case i
Case 0 ' verify first record set "SELECT * FROM x "
Call CountRows(oRs, iRecordCount)
Assert.Trace "1st Command: " & strSQL(0)
assert.trace "reccount: " & iRecordCount
If iRecordCount <> 2 Then
Call Cleanup (oConn, oConn2, oRs, oRs2)
On Error Goto 0
Assert.Failure "The # of records in the RecordSet 1 isn't correct"
Else
Assert.Trace "1st record set passed"
End If
Case 1 ' verify second record set "SELECT * FROM x LIMIT " & limit
Call CountRows(oRs, iRecordCount)
Assert.Trace "2nd Command: " & strSQL(1)
If iRecordCount <> 1 Then
Call Cleanup (oConn, oConn2, oRs, oRs2)
On Error Goto 0
Assert.Failure "The # of records in the RecordSet 2 isn't correct"
Else
Assert.Trace "2nd record set passed"
End If
' #####################################################################################
' COMMENTING OUT THE NEXT LINE ALLOWS THIS TEST TO PASS ####################################
oRs2.Open "SELECT 'one';", oConn, adOpenStatic, adLockOptimistic '############################
' #####################################################################################
Case 2 ' verify the third record set "SELECT C1 FROM x WHERE C1 > 1"
Call CountRows(oRs, iRecordCount)
Assert.Trace "3rd Command: " & strSQL(2)
If iRecordCount <> 1 Then
assert.trace "reccount: " & iRecordCount
Call Cleanup (oConn, oConn2, oRs, oRs2)
On Error Goto 0
Assert.Failure "The # of records in the RecordSet 3 isn't correct"
Else
Assert.Trace "3rd record set passed"
End If
Case 3 ' verify the forth record set "SELECT 'ONE' as numberone"
Call CountRows(oRs, iRecordCount)
Assert.Trace "4th Command: " & strSQL(3)
If iRecordCount <> 1 Then
Call Cleanup (oConn, oConn2, oRs, oRs2)
On Error Goto 0
Assert.Failure "The # of records in the RecordSet 4 isn't correct"
Else
Assert.Trace "4th record set passed"
End If
End Select
Err.Clear
Set oRs = oRs.NextRecordset
If Err.Number <> 0 Then
Assert.Trace "Error when calling NextRecordSet()"
Assert.Trace Err.Description
On Error Goto 0
Assert.Failure "Ended test early"
End If
failsafe = failsafe + 1
i = i + 1
Loop
If i <> 4 Then
On Error Goto 0
Assert.Failure "Test ended early, record set " & i+1 & " wasn't processed"
End if
Call Cleanup (oConn, oConn2, oRs, oRs2)
End Sub
Description: This appears to be a problem that has been present for a while but the test missed it. The test was opening a compound record set and then moving through each recordSet contained within. It then opened a second individual set using the active command from the current set of the compound set. It then compares them to see if they are the same. However it failed to verify whether the compound set for some reason closed early which appears to be the case if the cursor location is adUseServer. In this case, as soon as a second recordSet is opened which uses the same open connection as the test recordSet, then the portions of the compound recordSet that extend beyond the recordSet currently being accessed are dropped. This will not occur if the location of the cursor is adUseClient, and it also won't occur if you open the second record set using a new connection. I verified that the sequence of events which is currently failing here will work if the test case is run against sqlServer. Test was tried against MySQL Server 5.0,5.1, and 6.0 ODBC trace against server 5.0.62 is attached. How to repeat: 'This test case will be committed to the ado conformance/tests/bugs suite under 'this bug number. option explicit ' Copyright 2009 - MySQL AB Const BUG = 99 Dim fso, f, s Set fso = CreateObject("Scripting.FileSystemObject") Set f = fso.OpenTextFile("../common/adovbs.inc", 1) s = f.ReadAll() ExecuteGlobal s Set f = fso.OpenTextFile("../common/mysql-common.inc", 1) s = f.ReadAll() f.Close Set f = Nothing 'Set fso = Nothing ExecuteGlobal s Dim bSetup: bSetup = cBool(True) Sub setup() ' just do this once If bSetup Then Call readConnStrings() bSetup = cBool(False) End If Dim oConn, StrSQL, vbSingleQuote, data vbSingleQuote = Chr(39) Set oConn = CreateObject("ADODB.Connection") oConn.ConnectionString = connstr oConn.Open StrSQL = "DROP TABLE IF EXISTS `" & BUG & "`" oConn.Execute StrSQL StrSQL = "CREATE TABLE `" & BUG & "` (C1 TINYINT PRIMARY KEY, C2 CHAR(20), C3 TIME)" oConn.Execute StrSQL StrSQL = "INSERT INTO `" & BUG & "` VALUES (1, " & vbSingleQuote & "FOO" & vbSingleQuote &_ ", NOW()), (2, " & vbSingleQuote & "FOO" & vbSingleQuote & ", NOW())" oConn.Execute StrSQL oConn.Close Set oConn = Nothing End Sub Sub teardown() Dim oConn, StrSQL Set oConn = CreateObject("ADODB.Connection") oConn.ConnectionString = connstr oConn.Open StrSQL = "DROP TABLE `" & BUG & "`" oConn.Execute StrSQL oConn.Close Set oConn = Nothing End Sub Sub Cleanup(conn1, conn2, recset, recset2) If recset.State <> adStateClosed Then recset.Close End If Set recset = Nothing If recset2.State <> adStateClosed Then recset2.Close End If Set recset2 = Nothing If conn1.State <> adStateClosed Then conn1.Close End If Set conn1 = Nothing If conn2.State <> adStateClosed Then conn2.Close End If Set conn2 = Nothing End Sub Sub CountRows(recset, iRecordCount) dim fld iRecordCount = recset.RecordCount recset.MoveFirst If iRecordCount <> -1 Then ' need to get a handle to the connection in case it needs to be closed early If iRecordCount = 0 Then On Error Goto 0 Assert.Failure "There are no records in the test table" Exit Sub End If Else ' the record count property isn't supported so have to find out the max num of records another way dim iTemp: iTemp = 0 while NOT recset.EOF REM for each fld in recset.fields REM if fld.name = "C1" then REM assert.trace fld.value REM end if REM next recset.MoveNext iTemp = iTemp + 1 wend iRecordCount = iTemp End If End Sub Sub SetMultipleCommandOption(conntemp) ' Add the option for multiple SQL statements to the connection string options Dim iOpt, iIndex, iIndex2 iIndex = InStr(connstr, "OPTION=") + 7 iOpt = Mid(connstr, iIndex, Len(connstr) - iIndex + 1) iIndex2 = InStr(iOpt, ";") iOpt = Mid(iOpt, 1, Len(iOpt) - iIndex2 + 1) If (iOpt And 67108864) <> 67108864 Then iOpt = cLng(iOpt) + 67108864 ' ADD the option value for Multi_Statements if not there already End If conntemp = Mid(connstr, 1, iIndex-1) conntemp = conntemp & iOpt End Sub Sub Test_SERVER_SIDE() Dim conntemp Call SetMultipleCommandOption(conntemp) Assert.Trace "Test is using this connection string:" Assert.Trace conntemp On Error Resume Next Dim strSQLcompound, oConn, oConn2, oRs, oRs2, strSQL(3), iRecordCount Set oConn = CreateObject("ADODB.Connection") Set oConn2 = CreateObject("ADODB.Connection") Set oRs = CreateObject("ADODB.RecordSet") Set oRs2 = CreateObject("ADODB.RecordSet") strSQL(0) = "SELECT * FROM `" &BUG & "`" strSQL(1) = "SELECT * FROM `" &BUG & "` LIMIT 1" strSQL(2) = "SELECT C1 FROM `" &BUG & "` WHERE C1 > 1" strSQL(3) = "SELECT 'ONE' as numberone" strSQLcompound = strSQL(0) & ";" & strSQL(1) & ";" & strSQL(2) & ";" & strSQL(3) & ";" ' open connection oConn.ConnectionString = conntemp oConn.CursorLocation = adUseServer oConn2.ConnectionString = conntemp oConn2.CursorLocation = adUseServer Err.Clear oConn.Open oConn2.Open If Err.Number <> 0 Then Call Cleanup (oConn, oConn2, oRs, oRs2) Assert.Trace Err.Number & "::" & Err.Description On Error Goto 0 Assert.Failure "Error opening connection" End If ' open record set oRs.Open strSQLcompound, oConn, adOpenStatic, adLockOptimistic If Err.Number <> 0 Then Call Cleanup (oConn, oConn2, oRs, oRs2) Assert.Trace Err.Number & "::" & Err.Description On Error Goto 0 Assert.Failure "Error opening Record Set" End If If Not cBool((oRs.State And adStateOpen) = adStateOpen) Then On Error Goto 0 Assert.Failure "Failed to open the compound record set" End If oRs.Movefirst ' Verify dim failsafe, i, SQL failsafe = 0 'used to prevent an infinite loop i = 0 Do Until oRs Is Nothing If failsafe = 5 Then Call CountRows(oRs, iRecordCount) On Error Goto 0 Assert.Failure "Timed Out, End of Compount RecordSet can't be found" End If Select Case i Case 0 ' verify first record set "SELECT * FROM x " Call CountRows(oRs, iRecordCount) Assert.Trace "1st Command: " & strSQL(0) assert.trace "reccount: " & iRecordCount If iRecordCount <> 2 Then Call Cleanup (oConn, oConn2, oRs, oRs2) On Error Goto 0 Assert.Failure "The # of records in the RecordSet 1 isn't correct" Else Assert.Trace "1st record set passed" End If Case 1 ' verify second record set "SELECT * FROM x LIMIT " & limit Call CountRows(oRs, iRecordCount) Assert.Trace "2nd Command: " & strSQL(1) If iRecordCount <> 1 Then Call Cleanup (oConn, oConn2, oRs, oRs2) On Error Goto 0 Assert.Failure "The # of records in the RecordSet 2 isn't correct" Else Assert.Trace "2nd record set passed" End If ' ##################################################################################### ' COMMENTING OUT THE NEXT LINE ALLOWS THIS TEST TO PASS #################################### oRs2.Open "SELECT 'one';", oConn, adOpenStatic, adLockOptimistic '############################ ' ##################################################################################### Case 2 ' verify the third record set "SELECT C1 FROM x WHERE C1 > 1" Call CountRows(oRs, iRecordCount) Assert.Trace "3rd Command: " & strSQL(2) If iRecordCount <> 1 Then assert.trace "reccount: " & iRecordCount Call Cleanup (oConn, oConn2, oRs, oRs2) On Error Goto 0 Assert.Failure "The # of records in the RecordSet 3 isn't correct" Else Assert.Trace "3rd record set passed" End If Case 3 ' verify the forth record set "SELECT 'ONE' as numberone" Call CountRows(oRs, iRecordCount) Assert.Trace "4th Command: " & strSQL(3) If iRecordCount <> 1 Then Call Cleanup (oConn, oConn2, oRs, oRs2) On Error Goto 0 Assert.Failure "The # of records in the RecordSet 4 isn't correct" Else Assert.Trace "4th record set passed" End If End Select Err.Clear Set oRs = oRs.NextRecordset If Err.Number <> 0 Then Assert.Trace "Error when calling NextRecordSet()" Assert.Trace Err.Description On Error Goto 0 Assert.Failure "Ended test early" End If failsafe = failsafe + 1 i = i + 1 Loop If i <> 4 Then On Error Goto 0 Assert.Failure "Test ended early, record set " & i+1 & " wasn't processed" End if Call Cleanup (oConn, oConn2, oRs, oRs2) End Sub