Changeset 475
- Timestamp:
- Mar 13, 2008, 9:44:51 AM (17 years ago)
- Location:
- trunk
- Files:
-
- 6 edited
-
Include/Classes/ActiveBasic/Core/TypeInfo.ab (modified) (4 diffs)
-
Include/Classes/System/Xml/Serialization/XmlSerializer.ab (modified) (4 diffs)
-
Include/Classes/System/Xml/XmlNode.ab (modified) (8 diffs)
-
Include/system/enum.sbp (modified) (3 diffs)
-
TestCase/SimpleTestCase/SerializeTest.ab (modified) (4 diffs)
-
bin/BasicCompiler32.exe (modified) ( previous)
Legend:
- Unmodified
- Added
- Removed
-
trunk/Include/Classes/ActiveBasic/Core/TypeInfo.ab
r452 r475 73 73 End Sub 74 74 75 Sub SetBaseType( baseType As System.TypeInfo ) 76 This.baseType = baseType 77 End Sub 78 75 79 Function GetPtrType() As TypeBaseImpl 76 80 If Object.ReferenceEquals( ptrType, Nothing ) Then … … 91 95 Return baseType 92 96 End Function 93 94 Sub SetBaseType( baseType As System.TypeInfo )95 This.baseType = baseType96 End Sub97 97 98 98 Override Function FullName() As String … … 171 171 End Class 172 172 173 TypeDef _SYSTEM_CONSTRUCTOR_PROC = *Sub( pThis As *Object ) 174 TypeDef _SYSTEM_DESTRUCTOR_PROC = *Sub( pThis As *Object ) 175 173 176 ' クラスを管理するためのクラス 174 177 Class _System_TypeForClass 175 178 Inherits TypeBaseImpl 176 179 180 Static Const _SYSTEM_OBJECT_HEAD_SIZE = SizeOf(LONG_PTR) * 4 181 182 size As SIZE_T 183 comVtbl As VoidPtr 184 vtblList As VoidPtr 185 pDefaultConstructor As _SYSTEM_CONSTRUCTOR_PROC 186 pDestructor As _SYSTEM_DESTRUCTOR_PROC 187 177 188 Public 178 189 referenceOffsets As *Long … … 191 202 End Sub 192 203 204 Sub SetClassInfo( size As SIZE_T, comVtbl As VoidPtr, vtblList As VoidPtr, pDefaultConstructor As _SYSTEM_CONSTRUCTOR_PROC, pDestructor As _SYSTEM_DESTRUCTOR_PROC ) 205 This.size = size 206 This.comVtbl = comVtbl 207 This.vtblList = vtblList 208 This.pDefaultConstructor = pDefaultConstructor 209 This.pDestructor = pDestructor 210 End Sub 211 193 212 Override Function IsClass() As Boolean 194 213 Return True 214 End Function 215 216 217 Static Function _System_New( typeForClass As ActiveBasic.Core._System_TypeForClass ) As Object 218 If typeForClass.pDefaultConstructor = NULL Then 219 Throw New System.SystemException( "デフォルトコンストラクタを持たないクラスに対して_System_New関数は使えません。" ) 220 End If 221 222 ' まずはメモリを確保 223 Dim pPtr = _System_GC_malloc_ForObject( typeForClass.size + _SYSTEM_OBJECT_HEAD_SIZE ) As VoidPtr 224 225 ' pPtr[0]=オブジェクトの個数 226 Set_LONG_PTR( pPtr, 1 ) 227 pPtr += SizeOf(LONG_PTR) 228 229 ' pPtr[1]=オブジェクトのサイズ 230 Set_LONG_PTR( pPtr, typeForClass.size ) 231 pPtr += SizeOf(LONG_PTR) 232 233 ' pPtr[2]=デストラクタの関数ポインタ 234 Set_LONG_PTR( pPtr, typeForClass.pDestructor As LONG_PTR ) 235 pPtr += SizeOf(LONG_PTR) 236 237 ' pPtr[3]=reserve 238 pPtr += SizeOf(LONG_PTR) 239 240 Dim pObject = pPtr As *Object 241 242 ' com_vtblをセット 243 Set_LONG_PTR( pObject, typeForClass.comVtbl As LONG_PTR ) 244 245 ' vtbl_listをセット 246 Set_LONG_PTR( pObject + SizeOf(LONG_PTR), typeForClass.vtblList As LONG_PTR ) 247 248 ' 動的型情報をセットする 249 pObject->_System_SetType( typeForClass ) 250 251 ' コンストラクタを呼び出す 252 Dim proc = typeForClass.pDefaultConstructor 253 proc( pObject ) 254 255 Return ByVal pObject 195 256 End Function 196 257 End Class -
trunk/Include/Classes/System/Xml/Serialization/XmlSerializer.ab
r452 r475 6 6 Class XmlSerializer 7 7 m_typeInfo As System.TypeInfo 8 9 10 '---------------------------------------------------------------- 11 ' シリアライズ ロジック 12 '---------------------------------------------------------------- 8 13 9 14 Static Sub SerializeForBasicType( typeInfo As TypeInfo, memoryOffset As LONG_PTR, o As Object, doc As XmlDocument, parentNode As XmlNode ) … … 44 49 parentNode.AppendChild( childNode ) 45 50 childNode.AppendChild( doc.CreateTextNode( valueStr ) ) 46 47 51 End Sub 48 52 … … 87 91 End Sub 88 92 89 Function Deserialize( doc As XmlDocument ) As Object 93 94 '---------------------------------------------------------------- 95 ' デシリアライズ ロジック 96 '---------------------------------------------------------------- 97 98 Static Sub DeserializeForBasicType( typeInfo As TypeInfo, memoryOffset As LONG_PTR, object As Object, xmlNode As XmlNode ) 99 If Not xmlNode.ChildNodes.Count = 1 Then 100 Throw 101 End If 102 103 Dim valueStr = xmlNode.ChildNodes[0].Value 104 Dim memberPtr = ObjPtr( object ) + memoryOffset 105 106 If typeInfo.FullName = "Byte" Then 107 SetByte( memberPtr, Val( valueStr ) ) 108 ElseIf typeInfo.FullName = "SByte" Then 109 SetByte( memberPtr, Val( valueStr ) ) 110 ElseIf typeInfo.FullName = "Word" Then 111 SetWord( memberPtr, Val( valueStr ) ) 112 ElseIf typeInfo.FullName = "Integer" Then 113 SetWord( memberPtr, Val( valueStr ) ) 114 ElseIf typeInfo.FullName = "DWord" Then 115 SetDWord( memberPtr, Val( valueStr ) ) 116 ElseIf typeInfo.FullName = "Long" Then 117 SetDWord( memberPtr, Val( valueStr ) ) 118 ElseIf typeInfo.FullName = "QWord" Then 119 SetQWord( memberPtr, Val( valueStr ) ) 120 ElseIf typeInfo.FullName = "Int64" Then 121 SetQWord( memberPtr, Val( valueStr ) ) 122 ElseIf typeInfo.FullName = "Boolean" Then 123 If valueStr = "True" Then 124 SetByte( memberPtr, 1 ) 125 ElseIf valueStr = "False" Then 126 SetByte( memberPtr, 0 ) 127 Else 128 Throw 129 End If 130 ElseIf typeInfo.FullName = "Single" Then 131 SetSingle( memberPtr, Val( valueStr ) ) 132 ElseIf typeInfo.FullName = "Double" Then 133 SetDouble( memberPtr, Val( valueStr ) ) 134 ElseIf typeInfo.FullName = "VoidPtr" Then 135 Set_LONG_PTR( memberPtr, Val( valueStr ) As LONG_PTR ) 136 Else 137 Throw 138 End If 139 End Sub 140 141 Function DeserializeForClass( typeInfo As TypeInfo, xmlNode As XmlNode ) As Object 142 If typeInfo.IsClass() and typeInfo.FullName = "System.Object" Then 143 ' Object型にたどり着いた場合 144 145 ' 派生クラスのフルネームを元に特定されたクラスを生成し、デフォルトコンストラクタを呼ぶ 146 Return ActiveBasic.Core._System_TypeForClass._System_New( m_typeInfo As ActiveBasic.Core._System_TypeForClass ) 147 End If 148 149 If typeInfo.Name <> xmlNode.LocalName Then 150 Throw 151 End If 152 153 Dim object = Nothing As Object 154 Dim memberInfos = typeInfo.GetMembers() 155 156 If Not ActiveBasic.IsNothing( typeInfo.BaseType ) Then 157 ' 基底クラスが存在するとき 158 159 ' 基底クラスをシリアライズ 160 object = DeserializeForClass( typeInfo.BaseType, xmlNode ) 161 End If 162 163 ' メンバをシリアライズ 164 Dim childNode = xmlNode.ChildNodes[0] As XmlNode 165 Foreach memberInfo In memberInfos 166 If ActiveBasic.IsNothing( childNode ) Then 167 Throw 168 End If 169 170 If memberInfo.MemberType.IsPointer() Then 171 Throw 172 ElseIf memberInfo.MemberType.IsClass() Then 173 Dim memberObject = DeserializeForClass( memberInfo.MemberType, childNode ) 174 Set_LONG_PTR( ObjPtr( object ) + memberInfo._System_Offset, ObjPtr( memberObject ) As LONG_PTR ) 175 ElseIf memberInfo.MemberType.IsValueType() Then 176 DeserializeForBasicType( memberInfo.MemberType, memberInfo._System_Offset, object, childNode ) 177 End If 178 179 childNode = childNode.NextSibling 180 Next 181 182 If Not ActiveBasic.IsNothing( childNode ) Then 183 Throw 184 End If 185 186 Return object 90 187 End Function 91 188 … … 105 202 Dim doc = New XmlDocument 106 203 doc.Load( stream ) 107 Deserialize( doc)204 Return DeserializeForClass( m_typeInfo, doc.ChildNodes[1] ) 108 205 End Function 109 206 -
trunk/Include/Classes/System/Xml/XmlNode.ab
r455 r475 28 28 Class XmlNode 29 29 30 nodeType As XmlNodeType 30 31 attributes As XmlAttributeCollection 31 32 childNodes As XmlNodeList … … 35 36 ownerDocument As XmlDocument 36 37 value As String 37 nodeType As XmlNodeType 38 previousSibling As XmlNode 39 nextSibling As XmlNode 38 40 39 41 Public … … 49 51 This.ownerDocument = doc 50 52 This.value = Nothing 53 This.previousSibling = Nothing 54 This.nextSibling = Nothing 51 55 52 56 attributes = New XmlAttributeCollection … … 64 68 This.ownerDocument = doc 65 69 This.value = data 70 This.previousSibling = Nothing 71 This.nextSibling = Nothing 66 72 67 73 attributes = New XmlAttributeCollection … … 114 120 115 121 /*! 122 @brief ノードの最後の子を取得します。 123 */ 124 Virtual Function LastChild() As XmlNode 125 If childNodes.Count = 0 Then 126 ' 子ノードが1つもないときはNothingを返す 127 Return Nothing 128 End If 129 Return childNodes[childNodes.Count-1] 130 End Function 131 132 /*! 116 133 @brief ノードのローカル名を取得します。 117 134 @return ノードのローカル名。 … … 130 147 131 148 /*! 149 @brief このノードの直後のノードを取得します。 150 @return このノードの直後のノード。 151 */ 152 Virtual Function NextSibling() As XmlNode 153 Return nextSibling 154 End Function 155 156 /*! 132 157 @brief このノードのノードタイプを取得します。 133 158 @return このノードのノードタイプ。 … … 159 184 Virtual Function Prefix() As String 160 185 return prefix 186 End Function 187 188 /*! 189 @brief このノードの直前のノードを取得します。 190 @return このノードの直前のノード。 191 */ 192 Virtual Function PreviousSibling() As XmlNode 193 Return previousSibling 161 194 End Function 162 195 … … 186 219 */ 187 220 Virtual Function AppendChild( newChild As XmlNode ) As XmlNode 221 Dim lastChild = This.LastChild 188 222 childNodes.Add( newChild ) 223 224 If Not ActiveBasic.IsNothing( lastChild ) Then 225 ' 前後の兄弟要素を指定 226 lastChild.nextSibling = newChild 227 newChild.previousSibling = lastChild 228 End If 229 189 230 Return newChild 190 231 End Function -
trunk/Include/system/enum.sbp
r446 r475 1 Class EnumBase 1 Class EnumBase<T As EnumBase> 2 2 Protected 3 3 value As Long … … 40 40 41 41 Function Operator == (value As Long) As Boolean 42 If This.value = value Then 43 Return True 44 Else 45 Return False 46 End If 42 Return ( This.value = value ) 47 43 End Function 48 44 49 Function Operator == (enumBase As EnumBase) As Boolean 50 If This.value = enumBase.value Then 51 Return True 52 Else 53 Return False 54 End If 45 Function Operator == (enumObj As T) As Boolean 46 Return ( This.value = enumObj.value ) 55 47 End Function 56 48 … … 59 51 End Function 60 52 61 Function Operator <> (enum Base As EnumBase) As Boolean62 Return Not( This = enum Base)53 Function Operator <> (enumObj As T) As Boolean 54 Return Not( This = enumObj) 63 55 End Function 64 56 65 Function Operator or (enum Base As EnumBase) As Boolean66 Return ( This.value or enum Base.value ) <> 057 Function Operator or (enumObj As T) As Boolean 58 Return ( This.value or enumObj.value ) <> 0 67 59 End Function 68 60 69 Function Operator and (enum Base As EnumBase) As Boolean70 Return ( This.value and enum Base.value ) <> 061 Function Operator and (enumObj As T) As Boolean 62 Return ( This.value and enumObj.value ) <> 0 71 63 End Function 72 64 73 Function Operator or (enum Base As EnumBase) As EnumBase74 Return New EnumBase( This.value or enum Base.value, This.lpszName )65 Function Operator or (enumObj As T) As T 66 Return New EnumBase( This.value or enumObj.value, This.lpszName ) 75 67 End Function 76 68 77 Function Operator and (enum Base As EnumBase) As EnumBase78 Return New EnumBase( This.value and enum Base.value, This.lpszName )69 Function Operator and (enumObj As T) As T 70 Return New EnumBase( This.value and enumObj.value, This.lpszName ) 79 71 End Function 80 72 /* -
trunk/TestCase/SimpleTestCase/SerializeTest.ab
r465 r475 1 1 Namespace SerializeTest 2 2 3 3 4 Class Foo 5 Public 4 6 a As Long 5 7 b As Long 6 8 c As Long 7 9 d As Long 8 Public 10 9 11 Sub Foo() 10 12 a=100 … … 21 23 ' fooインスタンスを生成 22 24 Dim foo = New Foo 25 foo.a = 500 26 foo.b = 600 27 foo.c = 700 28 foo.d = 800 23 29 24 30 … … 29 35 ' 保存先のファイルを開いて、 30 36 Dim fooXmlFilePath = tempDir + "\foo.xml" 31 Dim fs = New System.IO.FileStream( fooXmlFilePath, System.IO.FileMode.Create )37 Dim ofs = New System.IO.FileStream( fooXmlFilePath, System.IO.FileMode.Create ) 32 38 33 39 ' シリアライズして、 34 40 Dim serializer = New System.Xml.Serialization.XmlSerializer( foo.GetType() ) 35 serializer.Serialize( fs, foo )41 serializer.Serialize( ofs, foo ) 36 42 37 43 ' 閉じる。 38 fs.Close()44 ofs.Close() 39 45 40 46 … … 43 49 '---------------------------------------------------------------- 44 50 45 ' 読み込んでみる。 46 Dim doc = New System.Xml.XmlDocument 47 doc.Load( tempDir + "\foo.xml" ) 48 System.Diagnostics.Debug.WriteLine( doc.OuterXml ) 51 ' 読込先のファイルを開いて 52 Dim ifs = New System.IO.FileStream( fooXmlFilePath, System.IO.FileMode.Open ) 49 53 50 ' TODO: デシリアライズは未完成(￣□￣；) 54 ' デシリアライズして 55 Dim fooDash = serializer.Deserialize( ifs ) As Foo 56 57 ' 閉じる 58 ifs.Close() 59 60 UnitTest( "XmlSerializer", foo.a = fooDash.a and foo.b = fooDash.b and foo.c = fooDash.c and foo.d = fooDash.d ) 51 61 End Sub 52 62
Note:
See TracChangeset
for help on using the changeset viewer.
