256 lines
9.0 KiB
OpenEdge ABL
256 lines
9.0 KiB
OpenEdge ABL
VERSION 1.0 CLASS
|
|
BEGIN
|
|
MultiUse = -1 'True
|
|
Persistable = 0 'NotPersistable
|
|
DataBindingBehavior = 0 'vbNone
|
|
DataSourceBehavior = 0 'vbNone
|
|
MTSTransactionMode = 0 'NotAnMTSObject
|
|
END
|
|
Attribute VB_Name = "fldattributes"
|
|
Attribute VB_GlobalNameSpace = False
|
|
Attribute VB_Creatable = True
|
|
Attribute VB_PredeclaredId = False
|
|
Attribute VB_Exposed = True
|
|
Implements ITestCases
|
|
|
|
Dim codelib As New adolvl0.Common
|
|
Dim g_caseerrorobj As ModuleBase.IError
|
|
Dim g_caseprovobj As ModuleBase.IProviderInfo
|
|
Dim xModInfo As New ModInfo
|
|
Dim pifObj As ParseInitFile
|
|
Dim col As Column
|
|
Dim tracecase As Boolean
|
|
Dim provstr As String
|
|
Dim curlocstr As String
|
|
Dim rsstr As String
|
|
Dim connstr As String
|
|
Dim g_verbose As Boolean
|
|
|
|
Private Function ITestCases_ExecuteVariation(ByVal lIndex As Long) As ModuleBase.tagVARIATION_STATUS
|
|
' call variation indicated by lIndex
|
|
ITestCases_ExecuteVariation = eVariationStatusFailed
|
|
If tracecase Then
|
|
g_caseerrorobj.Transmit "Inside: ITestCases_ExecuteVariation(" + CStr(lIndex) + ")" + Chr(10)
|
|
End If
|
|
Select Case lIndex
|
|
Case 0
|
|
ITestCases_ExecuteVariation = validtest()
|
|
Case 1
|
|
ITestCases_ExecuteVariation = invalidtest()
|
|
End Select
|
|
End Function
|
|
Private Function ITestCases_GetDescription() As String
|
|
' eventually get the description from the registry
|
|
ITestCases_GetDescription = "Field Attributes Tests"
|
|
End Function
|
|
Private Function ITestCases_GetIndexOfVariationWithID(ByVal lID As Long) As Long
|
|
If tracecase Then
|
|
g_caseerrorobj.Transmit "Inside: ITestCases_GetIndexOfVariationWithID(" + CStr(lID) + ")" + Chr(10)
|
|
End If
|
|
ITestCases_GetIndexOfVariationWithID = lID + 1
|
|
End Function
|
|
Private Function ITestCases_GetName() As String
|
|
If tracecase Then
|
|
g_caseerrorobj.Transmit "Inside: ITestCases_GetName" + Chr(10)
|
|
End If
|
|
ITestCases_GetName = "fld.Attributes"
|
|
End Function
|
|
Private Function ITestCases_GetOwningITestModule() As ModuleBase.ITestModule
|
|
Set ITestCases_GetOwningITestModule = g_tm
|
|
End Function
|
|
Private Function ITestCases_GetProviderInterface() As ModuleBase.IProviderInfo
|
|
Set ITestCases_GetProviderInterface = g_caseprovobj
|
|
End Function
|
|
Private Function ITestCases_GetVariationCount() As Long
|
|
ITestCases_GetVariationCount = 1
|
|
End Function
|
|
Private Function ITestCases_GetVariationDesc(ByVal lIndex As Long) As String
|
|
If tracecase Then
|
|
g_caseerrorobj.Transmit "Inside: ITestCases_GetVariationDesc(" + CStr(lIndex) + ")" + Chr(10)
|
|
End If
|
|
Select Case lIndex
|
|
Case 0
|
|
ITestCases_GetVariationDesc = "Read and display attributes for each field"
|
|
Case 1
|
|
ITestCases_GetVariationDesc = "Invalid Test Case"
|
|
End Select
|
|
End Function
|
|
Private Function ITestCases_GetVariationID(ByVal lIndex As Long) As Long
|
|
If tracecase Then
|
|
g_caseerrorobj.Transmit "Inside: ITestCases_GetVariationID(" + CStr(lIndex) + ")" + Chr(10)
|
|
End If
|
|
Select Case lIndex
|
|
Case 0
|
|
ITestCases_GetVariationID = 1
|
|
Case 1
|
|
ITestCases_GetVariationID = 2
|
|
End Select
|
|
End Function
|
|
Private Function ITestCases_Init() As Long
|
|
Const SELECT_ALLFROMTBL = 2
|
|
Dim inistr As String
|
|
|
|
ITestCases_Init = 0
|
|
xModInfo.InitString = g_caseprovobj.GetInitString
|
|
fResult = xModInfo.Init() 'Initialize CModuleInfo::Init()
|
|
fResult = xModInfo.ParseInitString
|
|
|
|
retcode = xModInfo.GetInitStringValue("FILE", inistr)
|
|
If inistr = "" Then
|
|
' we don't have an ini file, we require one to run
|
|
g_caseerrorobj.Transmit "The ADO tests require an ini file to run."
|
|
Else
|
|
Set pifObj = xModInfo.ParseObject
|
|
|
|
' build connection string and initialize pifObj
|
|
connstr = codelib.GetConnStr(xModInfo, g_caseprovobj)
|
|
rsstr = pifObj.GetQuery(SELECT_ALLFROMTBL)
|
|
retcode = xModInfo.GetInitStringValue("CURSORLOC", curlocstr)
|
|
If UCase(Trim(curlocstr)) = "CLIENT" Then
|
|
curlocstr = "3"
|
|
Else
|
|
curlocstr = "2"
|
|
End If
|
|
If (connstr = "" Or rsstr = "") Then
|
|
' we don't have enough info to run
|
|
g_caseerrorobj.Transmit "The ADO tests require a valid ini FILE and a DATASOURCE/LOCATION,USERID, and PASSWORD."
|
|
Else
|
|
ITestCases_Init = 1
|
|
End If
|
|
End If
|
|
|
|
End Function
|
|
|
|
Private Sub ITestCases_SyncProviderInterface()
|
|
|
|
End Sub
|
|
|
|
Private Function ITestCases_Terminate() As Boolean
|
|
Set xModInfo = Nothing
|
|
Set pifObj = Nothing
|
|
ITestCases_Terminate = True
|
|
End Function
|
|
Public Sub SetCaseError(lError As ModuleBase.IError)
|
|
Set g_caseerrorobj = lError
|
|
tracecase = False
|
|
End Sub
|
|
Public Sub SetCaseProvider(lprov As ModuleBase.IProviderInfo)
|
|
Set g_caseprovobj = lprov
|
|
End Sub
|
|
|
|
Public Function validtest() As ModuleBase.tagVARIATION_STATUS
|
|
Dim connection1 As New ADODB.Connection
|
|
Dim recset1 As New ADODB.Recordset
|
|
Dim AttribArray(11) As Long
|
|
Dim AttribArrayStr(11) As Variant
|
|
AttribArray(0) = adFldMayBeNull
|
|
AttribArray(1) = adFldLong
|
|
AttribArray(2) = adFldIsNullable
|
|
AttribArray(3) = adfldupdateable
|
|
AttribArray(4) = adFldFixed
|
|
AttribArray(5) = adFldBookmark
|
|
AttribArray(6) = adFldCacheDeferred
|
|
AttribArray(7) = adFldMayDefer
|
|
AttribArray(8) = adFldRowID
|
|
AttribArray(9) = adFldRowVersion
|
|
AttribArray(10) = adfldunknownupdateable
|
|
|
|
AttribArrayStr(0) = "adfldmaybenull"
|
|
AttribArrayStr(1) = "adfldlong"
|
|
AttribArrayStr(2) = "adfldisnullable"
|
|
AttribArrayStr(3) = "adfldupdateable"
|
|
AttribArrayStr(4) = "adfldfixed"
|
|
AttribArrayStr(5) = "adfldbookmark"
|
|
AttribArrayStr(6) = "adfldcachedeferred"
|
|
AttribArrayStr(7) = "adfldmaydefer"
|
|
AttribArrayStr(8) = "adfldrowid"
|
|
AttribArrayStr(9) = "adfldrowversion"
|
|
AttribArrayStr(10) = "adfldunknownupdateable"
|
|
|
|
On Error GoTo ErrorHandler
|
|
|
|
g_caseerrorobj.SetErrorLevel (HR_STRICT)
|
|
g_ExpError = 0
|
|
|
|
If tracecase Then
|
|
g_caseerrorobj.Transmit ("inside validtest" + Chr(10))
|
|
End If
|
|
|
|
bTestPassed = True
|
|
|
|
' open connection
|
|
connection1.ConnectionString = connstr
|
|
connection1.CursorLocation = CInt(curlocstr)
|
|
connection1.Open
|
|
|
|
' open recordset
|
|
recset1.Open rsstr, connection1, adOpenStatic
|
|
|
|
icnt = 0
|
|
For Each fld In recset1.Fields
|
|
If g_verbose Then
|
|
g_caseerrorobj.Transmit "Field(" + Trim(fld.Name) + ") Type: " + CStr(fld.Type) + Chr(10)
|
|
For ix = 0 To UBound(AttribArray)
|
|
If (fld.Attributes And AttribArray(ix)) = AttribArray(ix) Then
|
|
g_caseerrorobj.Transmit " Attribute: " & AttribArrayStr(ix) + Chr(10)
|
|
End If
|
|
Next ix
|
|
End If
|
|
Set col = pifObj.GetColumn(CStr(icnt))
|
|
If col.IsFixedLength <> IIf((fld.Attributes And AttribArray(4)) = AttribArray(4), 1, 0) Then
|
|
g_caseerrorobj.Transmit "INI file field(" + Trim(col.Name) + ") IsFixedLength: " + CStr(col.IsFixedLength) + Chr(10)
|
|
g_caseerrorobj.Transmit "Does not match recordset field(" + Trim(fld.Name) + ") adfldfixed: " + CStr(IIf((fld.Attributes And AttribArray(4)) = AttribArray(4), 1, 0)) + Chr(10)
|
|
End If
|
|
If col.IsLong <> IIf((fld.Attributes And AttribArray(1)) = AttribArray(1), 1, 0) Then
|
|
g_caseerrorobj.Transmit "INI file field(" + Trim(col.Name) + ") IsLong: " + CStr(col.IsLong) + Chr(10)
|
|
g_caseerrorobj.Transmit "Does not match recordset field(" + Trim(fld.Name) + ") adFldLong: " + CStr(IIf((fld.Attributes And AttribArray(1)) = AttribArray(1), 1, 0)) + Chr(10)
|
|
End If
|
|
iniexp = -1
|
|
If (fld.Attributes And adFldMayBeNull) = adFldMayBeNull Then
|
|
iniexp = 0
|
|
End If
|
|
If (fld.Attributes And adFldIsNullable) = adFldIsNullable Then
|
|
iniexp = 1
|
|
End If
|
|
If col.IsNullable <> iniexp Then
|
|
g_caseerrorobj.Transmit "INI file field(" + Trim(col.Name) + ") IsNullable: " + CStr(col.IsNullable) + Chr(10)
|
|
g_caseerrorobj.Transmit "Does not match recordset field(" + Trim(fld.Name) + ") adFldIsNullable: " + IIf(iniexp = -1, "Unknown:", IIf(iniexp = 0, "False:", "True:")) + CStr(iniexp) + Chr(10)
|
|
g_caseerrorobj.Transmit "fld.Attributes:" + CStr(fld.Attributes) + Chr(10)
|
|
End If
|
|
icnt = icnt + 1
|
|
Next fld
|
|
|
|
' Output Test pass/fail
|
|
If (bTestPassed = False) Then
|
|
validtest = eVariationStatusFailed
|
|
Else
|
|
validtest = eVariationStatusPassed
|
|
End If
|
|
connection1.Close
|
|
Exit Function
|
|
ErrorHandler:
|
|
' Output error message
|
|
bTestPassed = codelib.ErrorHandler(g_caseerrorobj, ITestCases_GetName(), g_ExpError)
|
|
Resume Next
|
|
|
|
End Function
|
|
Public Function invalidtest() As ModuleBase.tagVARIATION_STATUS
|
|
Dim connection1 As New ADODB.Connection
|
|
On Error GoTo ErrorHandler
|
|
|
|
If tracecase Then
|
|
g_caseerrorobj.Transmit ("inside invalidtest") + Chr(10)
|
|
End If
|
|
|
|
Exit Function
|
|
ErrorHandler:
|
|
' Output error message
|
|
bTestPassed = codelib.ErrorHandler(g_caseerrorobj, ITestCases_GetName(), g_ExpError)
|
|
hiterror = True
|
|
Resume Next
|
|
End Function
|
|
|
|
|
|
|
|
|