Skip to content

Commit b0f13be

Browse files
committed
Extract core components from ACLibDeclarationDictionary
1 parent 732975d commit b0f13be

27 files changed

+3737
-0
lines changed

.gitattributes

Lines changed: 42 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,42 @@
1+
# gitattributes template for Microsoft Access database source files
2+
# Source: https://github.com/joyfullservice/msaccess-vcs-integration
3+
#
4+
5+
###############################################################################
6+
# Set default behavior to automatically normalize line endings.
7+
###############################################################################
8+
* text=auto
9+
10+
###############################################################################
11+
# Ensure that source files use CRLF for newlines, in case they are downloaded
12+
# in a compressed archive directly from GitHub. (Otherwise class modules may
13+
# not be imported correctly. See issue #150 for more details.)
14+
###############################################################################
15+
# Most source files use this extension
16+
*.bas text eol=crlf
17+
# Class modules
18+
*.cls text eol=crlf
19+
# Some object definitions
20+
*.xml text eol=crlf
21+
# SQL output
22+
*.sql text eol=crlf
23+
# Forms 2.0 form definitions (rarely used)
24+
*.frm text eol=crlf
25+
# Common source file
26+
*.json text eol=crlf
27+
28+
###############################################################################
29+
# Clarify that the source language is VBA (Auto-detection not always accurate)
30+
# https://github.com/github/linguist/blob/master/docs/overrides.md
31+
###############################################################################
32+
*.bas linguist-language=VBA
33+
*.cls linguist-language=VBA
34+
*.twin linguist-language=VBA
35+
36+
# Git files
37+
*.gitattributes text
38+
*.gitattributes linguist-language=gitattributes
39+
40+
# Ignore files (like .npmignore or .gitignore)
41+
*.*ignore text
42+
*.*ignore export-ignore

.gitignore

Lines changed: 23 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,23 @@
1+
# gitattributes template for Microsoft Access database source files
2+
# Website: https://github.com/joyfullservice/msaccess-vcs-addin
3+
#
4+
5+
# Ignore Microsoft Access database binary files (Build these from source)
6+
*.accda
7+
*.accdb
8+
*.mdb
9+
10+
# Ignore database lock files
11+
*.laccdb
12+
*.ldb
13+
14+
# The local VCS index file is paired with the binary database file
15+
# and should not be comitted to version control.
16+
vcs-index.json
17+
18+
# Ignore any dotenv files (used for external database connections)
19+
*.env
20+
21+
# Ignore log files generated by the VCS Add-in
22+
# Comment out the following line if you wish to include log files in git.
23+
*.log
Lines changed: 113 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,113 @@
1+
VERSION 1.0 CLASS
2+
BEGIN
3+
MultiUse = -1 'True
4+
END
5+
Attribute VB_Name = "DeclarationDictTestCodemodule"
6+
Attribute VB_GlobalNameSpace = False
7+
Attribute VB_Creatable = False
8+
Attribute VB_PredeclaredId = False
9+
Attribute VB_Exposed = False
10+
Option Compare Database
11+
Option Explicit
12+
13+
'AccUnit:TestRelated
14+
15+
Implements CodeModulGenerator
16+
17+
Dim AccUnitX As Long
18+
Private m_AccUnitInfo As String
19+
Public Field As String
20+
21+
Private Const Const1 As String = "abc"
22+
23+
Private Enum TestEnum: TestEnum_P1 = 2: End Enum
24+
Private Type TestType1
25+
FldA As Long
26+
FldB As String
27+
FldC As Boolean
28+
End Type
29+
30+
Private Enum TestEnum2
31+
TestEnum2_P1 = 2
32+
TestEnum2_P2 = 3
33+
End Enum
34+
35+
Private Type TestType2
36+
Fld2A As Long
37+
Fld2B As String
38+
FldC As Date
39+
End Type
40+
41+
Private WithEvents m_TextBox As TextBox
42+
Attribute m_TextBox.VB_VarHelpID = -1
43+
44+
Public Event RaiseSomething(ByVal EventParam1 As Variant)
45+
46+
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
47+
48+
Private Declare PtrSafe Function CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
49+
(ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long) As Long
50+
51+
Public Event RaiseSomething2(ByVal EventParam1 As Variant, ByVal EventParam2 As Variant)
52+
53+
Private Sub Class_Initialize()
54+
' Dim Class_Initialize_Xyz as String ... ignored!
55+
End Sub
56+
57+
Public Function AccUnitTestFunct(ByVal FuncParam1 As Variant, FuncParam2() As String) As Variant
58+
59+
Dim FuncVar1 As Variant, FuncVar2
60+
Dim FuncVar3() ' _
61+
Dim CommentX as String, CommentY As Long
62+
63+
Dim FuncVar4 As Long: FuncVar4 = 5
64+
65+
Dim Dim1 As Long: Dim Dim2
66+
67+
Dim Counter2 ' _
68+
Public X asString, Y As Long
69+
70+
End Function
71+
72+
Public Sub ProcWith3DeclLines( _
73+
ByVal D3P1 As Variant, _
74+
ByRef D3P2() As String)
75+
'
76+
End Sub
77+
78+
' Declaration of a property procedure in one line:
79+
Friend Property Get Name1() As String: Name1 = "TestName": End Property
80+
81+
Friend Property Let Name2(ByVal NewValue As String)
82+
'
83+
End Property
84+
85+
Friend Property Set PropertySet(ByVal ObjRef As Object)
86+
'
87+
End Property
88+
89+
Private Sub TestMe() ' _
90+
Private Sub ThisIsOnlyAComment(
91+
92+
End Sub
93+
94+
Public Sub VariableParams(ParamArray Args() As Variant)
95+
'
96+
End Sub
97+
98+
Private Static Sub MyStaticSub(Optional ByVal Reset As Boolean = False)
99+
Static Counter2 As Integer
100+
End Sub
101+
102+
103+
Private Function CodeModulGenerator_CreateCodemodule(ByVal ComponentType As VBIDE.vbext_ComponentType, Optional ByVal Name As String = vbNullString) As VBIDE.VBComponent
104+
'
105+
End Function
106+
107+
Private Sub CodeModulGenerator_InsertDeclarationLine(ByVal Code As String)
108+
'
109+
End Sub
110+
111+
Private Sub CodeModulGenerator_RemoveCodemodule()
112+
'
113+
End Sub
Lines changed: 182 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,182 @@
1+
VERSION 1.0 CLASS
2+
BEGIN
3+
MultiUse = -1 'True
4+
END
5+
Attribute VB_Name = "DeclarationDictTests"
6+
Attribute VB_GlobalNameSpace = False
7+
Attribute VB_Creatable = False
8+
Attribute VB_PredeclaredId = False
9+
Attribute VB_Exposed = False
10+
Option Compare Text
11+
Option Explicit
12+
13+
'AccUnit:TestClass
14+
15+
Private m_DeclDict As DeclarationDict
16+
17+
'--------------------------------------------------------------------
18+
' Test Preparation / Cleanup
19+
'--------------------------------------------------------------------
20+
Public Sub Setup()
21+
Set m_DeclDict = New DeclarationDict
22+
End Sub
23+
24+
Public Sub TearDown()
25+
Set m_DeclDict = Nothing
26+
End Sub
27+
28+
'--------------------------------------------------------------------
29+
' Tests
30+
'--------------------------------------------------------------------
31+
32+
'AccUnit:Row("Public Function Func1() As String", "Func1")
33+
'AccUnit:Row("Private Function Func1() As String", "Func1")
34+
'AccUnit:Row("Friend Function Func1() As String()", "Func1")
35+
'AccUnit:Row("Function Func1()", "Func1")
36+
'AccUnit:Row("Dim Abc As String", "Abc")
37+
'AccUnit:Row("Dim Abc", "Abc")
38+
'AccUnit:Row("Dim Abc() As String", "Abc")
39+
'AccUnit:Row("Dim Abc()", "Abc")
40+
'AccUnit:Row("ReDim Abc(5)", "Abc")
41+
'AccUnit:Row("Private Abc As String", "Abc")
42+
'AccUnit:Row("Private Abc", "Abc")
43+
'AccUnit:Row("Private Abc() As String", "Abc")
44+
'AccUnit:Row("Private Abc()", "Abc")
45+
'AccUnit:Row("Public Abc", "Abc")
46+
'AccUnit:Row("Global Abc", "Abc")
47+
'AccUnit:Row("Private Function Func1(a, b) As String()", "Func1|a|b")
48+
'AccUnit:Row("Private Function Func1(a(), b) As String()", "Func1|a|b")
49+
'AccUnit:Row("Private Function Func1(a(), b()) As String()", "Func1|a|b")
50+
'AccUnit:Row("Dim Abc() As String, b(), C As Long", "Abc|b|C")
51+
'AccUnit:Row("Function Abc(ByVal X as Long) as Long: Abc = X*X: End Function", "Abc|X")
52+
'AccUnit:Row("Function Abc(ByVal X as Long, Optional ByVal Y As String = "" : '"") as Long", "Abc|X|Y")
53+
'AccUnit:Row("Implements CodeModulGenerator", "CodeModulGenerator")
54+
'AccUnit:Row("X = 5: Dim Y as Long: Y = 4", "Y")
55+
Public Sub ImportCode_InsertCodeLine_CheckKeys(ByVal Code As String, ByVal Expected As String)
56+
57+
Dim Actual As String
58+
59+
m_DeclDict.ImportCode Code
60+
Actual = Join(m_DeclDict.WordsDict.Keys, "|")
61+
62+
Assert.That Actual, Iz.EqualTo(Expected)
63+
64+
End Sub
65+
66+
'AccUnit:Row("Private Function Func1() As String" & Environment.NewLine & Environment.NewLine & " Dim X as String, Y As Long", "Func1|X|Y")
67+
'AccUnit:Row(Environment.NewLine & " Private abc " & Environment.NewLine & " Public X as String, Y As Long", "abc|X|Y")
68+
'AccUnit:Row("Private Function Func1() As String ' _" & Environment.NewLine & " Dim X as String, Y As Long", "Func1")
69+
'AccUnit:Row("Dim abc ' _" & Environment.NewLine & "Dim X as String, Y As Long", "abc")
70+
Public Sub ImportCode_InsertCodeLines_CheckKeys(ByVal Code As String, ByVal Expected As String)
71+
72+
Dim Actual As String
73+
74+
m_DeclDict.ImportCode Code
75+
Actual = Join(m_DeclDict.WordsDict.Keys, "|")
76+
77+
Assert.That Actual, Iz.EqualTo(Expected)
78+
79+
End Sub
80+
81+
'AccUnit:Row("Private Declare PtrSafe Sub Sleep Lib ""kernel32"" (ByVal dwMilliseconds As LongPtr)", "Sleep|dwMilliseconds")
82+
'AccUnit:Row("Private Declare PtrSafe Function CopyMemory Lib ""kernel32"" Alias ""RtlMoveMemory""(ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long) As Long", "CopyMemory|Destination|Source|Length")
83+
Public Sub ImportCode_API_CheckKeys(ByVal Code As String, ByVal Expected As String)
84+
85+
Dim Actual As String
86+
'
87+
' Dim RegEx As RegExp
88+
' Set RegEx = New RegExp
89+
'
90+
' RegEx.IgnoreCase = True
91+
' RegEx.Global = True
92+
' RegEx.Pattern = "(?:Declare)\s(Function|Sub)\s([^ ]*)[^(]*\("
93+
' Actual = RegEx.Replace(Code, "$1 $2(")
94+
95+
m_DeclDict.ImportCode Code
96+
Actual = Join(m_DeclDict.WordsDict.Keys, "|")
97+
98+
Assert.That Actual, Iz.EqualTo(Expected)
99+
100+
End Sub
101+
102+
Public Sub ImportCode_EnumCode_CheckKeys()
103+
104+
Dim Actual As String
105+
Dim Code As String
106+
107+
Code = "Dim x as long" & vbNewLine & _
108+
"Private Enum xyz" & vbNewLine & _
109+
" en1 = 0" & vbNewLine & _
110+
" en2 = 1" & vbNewLine & _
111+
"End Enum" & vbNewLine & _
112+
"Dim y()"
113+
114+
Const Expected As String = "xyz|en1|en2|x|y"
115+
116+
m_DeclDict.ImportCode Code
117+
Actual = Join(m_DeclDict.WordsDict.Keys, "|")
118+
119+
Assert.That Actual, Iz.EqualTo(Expected)
120+
121+
End Sub
122+
123+
Public Sub ImportCode_TypeCode_CheckKeys()
124+
125+
Dim Actual As String
126+
Dim Code As String
127+
128+
Code = "Dim x as long" & vbNewLine & _
129+
"Private Type xyz" & vbNewLine & _
130+
" F1 As String" & vbNewLine & _
131+
" F2 As Long" & vbNewLine & _
132+
"End Type" & vbNewLine & _
133+
"Dim y()"
134+
135+
Const Expected As String = "xyz|F1|F2|x|y"
136+
137+
m_DeclDict.ImportCode Code
138+
Actual = Join(m_DeclDict.WordsDict.Keys, "|")
139+
140+
Assert.That Actual, Iz.EqualTo(Expected)
141+
142+
End Sub
143+
144+
Public Sub ImportClassCodeModule_CheckKeysExists()
145+
146+
Dim ActualDict As Scripting.Dictionary
147+
148+
Dim ExpectedKeys() As Variant
149+
ExpectedKeys = Array("CodeModulGenerator", "CodeModulGenerator_CreateCodemodule", "ComponentType", "Name", "CodeModulGenerator_InsertDeclarationLine", "Code", "CodeModulGenerator_RemoveCodemodule", _
150+
"AccUnitX", "m_AccUnitInfo", "Field", "Const1", _
151+
"TestEnum", "TestEnum_P1", _
152+
"TestType1", "FldA", "FldB", "FldC", _
153+
"TestEnum2", "TestEnum2_P1", "TestEnum2_P2", _
154+
"TestType2", "Fld2A", "Fld2B", _
155+
"m_TextBox", _
156+
"RaiseSomething", "EventParam1", _
157+
"Sleep", "dwMilliseconds", _
158+
"CopyMemory", "Destination", "Source", "Length", _
159+
"RaiseSomething2", "EventParam2", _
160+
"Class_Initialize", _
161+
"AccUnitTestFunct", "FuncParam1", "FuncParam2", "FuncVar1", "FuncVar2", "FuncVar3", "FuncVar4", "Dim1", "Dim2", _
162+
"ProcWith3DeclLines", "D3P1", "D3P2", _
163+
"Name1", "Name2", "NewValue", _
164+
"PropertySet", "ObjRef", _
165+
"TestMe", _
166+
"VariableParams", "Args", _
167+
"MyStaticSub", "Reset", "Counter2")
168+
169+
170+
m_DeclDict.ImportVBComponent CurrentVbProject.VBComponents("DeclarationDictTestCodemodule")
171+
172+
Set ActualDict = m_DeclDict.WordsDict
173+
174+
Assert.That ActualDict.Count, Iz.EqualTo(UBound(ExpectedKeys) + 1), "Count of items"
175+
176+
Dim i As Long
177+
For i = 0 To UBound(ExpectedKeys)
178+
Assert.IsTrue ActualDict.Exists(ExpectedKeys(i)), ExpectedKeys(i) & " not exists"
179+
Next
180+
181+
End Sub
182+

0 commit comments

Comments
 (0)