Changeset 475 for trunk


Ignore:
Timestamp:
Mar 13, 2008, 9:44:51 AM (17 years ago)
Author:
dai
Message:

・XmlSerializer.Deserializeメソッドを実装（仮実装なため、数値メンバのシリアライズのみに留まっている）。
・XmlNode.LastChildメソッドを追加。
・XmlNode.NextSiblingメソッドを追加。
・XmlNode.PreviouseSiblingメソッドを追加。

Location:
trunk
Files:
6 edited

Legend:

Unmodified
Added
Removed

  • trunk/Include/Classes/ActiveBasic/Core/TypeInfo.ab

    r452 r475  
    7373    End Sub
    7474
     75    Sub SetBaseType( baseType As System.TypeInfo )
     76        This.baseType = baseType
     77    End Sub
     78
    7579    Function GetPtrType() As TypeBaseImpl
    7680        If Object.ReferenceEquals( ptrType, Nothing ) Then
    … …  
    9195        Return baseType
    9296    End Function
    93 
    94     Sub SetBaseType( baseType As System.TypeInfo )
    95         This.baseType = baseType
    96     End Sub
    9797
    9898    Override Function FullName() As String
    … …  
    171171End Class
    172172
     173TypeDef _SYSTEM_CONSTRUCTOR_PROC = *Sub( pThis As *Object )
     174TypeDef _SYSTEM_DESTRUCTOR_PROC = *Sub( pThis As *Object )
     175
    173176' クラスを管理するためのクラス
    174177Class _System_TypeForClass
    175178    Inherits TypeBaseImpl
    176179
     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
    177188Public
    178189    referenceOffsets As *Long
    … …  
    191202    End Sub
    192203
     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
    193212    Override Function IsClass() As Boolean
    194213        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
    195256    End Function
    196257End Class

  • trunk/Include/Classes/System/Xml/Serialization/XmlSerializer.ab

    r452 r475  
    66Class XmlSerializer
    77    m_typeInfo As System.TypeInfo
     8
     9
     10    '----------------------------------------------------------------
     11    ' シリアライズ ロジック
     12    '----------------------------------------------------------------
    813
    914    Static Sub SerializeForBasicType( typeInfo As TypeInfo, memoryOffset As LONG_PTR, o As Object, doc As XmlDocument, parentNode As XmlNode )
    … …  
    4449        parentNode.AppendChild( childNode )
    4550        childNode.AppendChild( doc.CreateTextNode( valueStr ) )
    46 
    4751    End Sub
    4852
    … …  
    8791    End Sub
    8892
    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
    90187    End Function
    91188
    … …  
    105202        Dim doc = New XmlDocument
    106203        doc.Load( stream )
    107         Deserialize( doc )
     204        Return DeserializeForClass( m_typeInfo, doc.ChildNodes[1] )
    108205    End Function
    109206

  • trunk/Include/Classes/System/Xml/XmlNode.ab

    r455 r475  
    2828Class XmlNode
    2929
     30    nodeType As XmlNodeType
    3031    attributes As XmlAttributeCollection
    3132    childNodes As XmlNodeList
    … …  
    3536    ownerDocument As XmlDocument
    3637    value As String
    37     nodeType As XmlNodeType
     38    previousSibling As XmlNode
     39    nextSibling As XmlNode
    3840
    3941Public
    … …  
    4951        This.ownerDocument = doc
    5052        This.value = Nothing
     53        This.previousSibling = Nothing
     54        This.nextSibling = Nothing
    5155
    5256        attributes = New XmlAttributeCollection
    … …  
    6468        This.ownerDocument = doc
    6569        This.value = data
     70        This.previousSibling = Nothing
     71        This.nextSibling = Nothing
    6672
    6773        attributes = New XmlAttributeCollection
    … …  
    114120
    115121    /*!
     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    /*!
    116133    @brief  ノードのローカル名を取得します。
    117134    @return ノードのローカル名。
    … …  
    130147
    131148    /*!
     149    @brief  このノードの直後のノードを取得します。
     150    @return このノードの直後のノード。
     151    */
     152    Virtual Function NextSibling() As XmlNode
     153        Return nextSibling
     154    End Function
     155
     156    /*!
    132157    @brief  このノードのノードタイプを取得します。
    133158    @return このノードのノードタイプ。
    … …  
    159184    Virtual Function Prefix() As String
    160185        return prefix
     186    End Function
     187
     188    /*!
     189    @brief  このノードの直前のノードを取得します。
     190    @return このノードの直前のノード。
     191    */
     192    Virtual Function PreviousSibling() As XmlNode
     193        Return previousSibling
    161194    End Function
    162195
    … …  
    186219    */
    187220    Virtual Function AppendChild( newChild As XmlNode ) As XmlNode
     221        Dim lastChild = This.LastChild
    188222        childNodes.Add( newChild )
     223
     224        If Not ActiveBasic.IsNothing( lastChild ) Then
     225            ' 前後の兄弟要素を指定
     226            lastChild.nextSibling = newChild
     227            newChild.previousSibling = lastChild
     228        End If
     229
    189230        Return newChild
    190231    End Function

  • trunk/Include/system/enum.sbp

    r446 r475  
    1 Class EnumBase
     1Class EnumBase<T As EnumBase>
    22Protected
    33    value As Long
    … …  
    4040
    4141    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 )
    4743    End Function
    4844
    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 )
    5547    End Function
    5648
    … …  
    5951    End Function
    6052
    61     Function Operator <> (enumBase As EnumBase) As Boolean
    62         Return Not( This = enumBase)
     53    Function Operator <> (enumObj As T) As Boolean
     54        Return Not( This = enumObj)
    6355    End Function
    6456
    65     Function Operator or (enumBase As EnumBase) As Boolean
    66         Return ( This.value or enumBase.value ) <> 0
     57    Function Operator or (enumObj As T) As Boolean
     58        Return ( This.value or enumObj.value ) <> 0
    6759    End Function
    6860
    69     Function Operator and (enumBase As EnumBase) As Boolean
    70         Return ( This.value and enumBase.value ) <> 0
     61    Function Operator and (enumObj As T) As Boolean
     62        Return ( This.value and enumObj.value ) <> 0
    7163    End Function
    7264
    73     Function Operator or (enumBase As EnumBase) As EnumBase
    74         Return New EnumBase( This.value or enumBase.value, This.lpszName )
     65    Function Operator or (enumObj As T) As T
     66        Return New EnumBase( This.value or enumObj.value, This.lpszName )
    7567    End Function
    7668
    77     Function Operator and (enumBase As EnumBase) As EnumBase
    78         Return New EnumBase( This.value and enumBase.value, This.lpszName )
     69    Function Operator and (enumObj As T) As T
     70        Return New EnumBase( This.value and enumObj.value, This.lpszName )
    7971    End Function
    8072/*

  • trunk/TestCase/SimpleTestCase/SerializeTest.ab

    r465 r475  
    11Namespace SerializeTest
    22
     3
    34Class Foo
     5Public
    46    a As Long
    57    b As Long
    68    c As Long
    79    d As Long
    8 Public
     10
    911    Sub Foo()
    1012        a=100
    … …  
    2123    ' fooインスタンスを生成
    2224    Dim foo = New Foo
     25    foo.a = 500
     26    foo.b = 600
     27    foo.c = 700
     28    foo.d = 800
    2329
    2430
    … …  
    2935    ' 保存先のファイルを開いて、
    3036    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 )
    3238
    3339    ' シリアライズして、
    3440    Dim serializer = New System.Xml.Serialization.XmlSerializer( foo.GetType() )
    35     serializer.Serialize( fs, foo )
     41    serializer.Serialize( ofs, foo )
    3642
    3743    ' 閉じる。
    38     fs.Close()
     44    ofs.Close()
    3945
    4046
    … …  
    4349    '----------------------------------------------------------------
    4450
    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 )
    4953
    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  )
    5161End Sub
    5262
Note: See TracChangeset for help on using the changeset viewer.