Changeset 413

Timestamp:

Feb 24, 2008, 7:03:07 PM (16 years ago)

Author:

dai

Message:

ポインタ型の型情報取得に対応した。

Location:

trunk

Files:

• Include/Classes/ActiveBasic/Core/TypeInfo.ab (modified) (5 diffs)
• Include/system/gc.sbp (modified) (1 diff)
• TestCase/SimpleTestCase/TypeInfoTest.ab (modified) (2 diffs)

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

@@ -10 +10 @@
     name As String
     fullName As String
+
+    ptrType As TypeBaseImpl
+    ptrLevel As Long
 
     ' メンバ情報
@@ -27 +30 @@
         This.fullName = fullName
         This.baseType = Nothing
+
+        ptrType = Nothing
+        ptrLevel = 0
     End Sub
 
     Sub ~TypeBaseImpl()
     End Sub
+
+    Sub PtrLevelUp()
+        ptrLevel ++
+        fullName = "*" + fullName
+    End Sub
+
+    Function Clone() As TypeBaseImpl
+        Dim result = New TypeBaseImpl( strNamespace, name, fullName )
+        result.SetBaseType( baseType )
+        result.SetMembers( memberNames, memberTypeFullNames, memberCounts )
+        result.memberInfosCache = This.memberInfosCache
+        result.ptrLevel = This.ptrLevel
+        Return result
+    End Function
 
 Public
@@ -51 +71 @@
     End Sub
 
+    Function GetPtrType() As TypeBaseImpl
+        If Object.ReferenceEquals( ptrType, Nothing ) Then
+            Dim clone = This.Clone()
+
+            ptrType = clone
+            ptrType.PtrLevelUp()
+        End If
+        Return ptrType
+    End Function
+
 
     '----------------------------------------------------------------
@@ -89 +119 @@
 
     Override Function IsPointer() As Boolean
-        Return False
+        Return ( ptrLevel > 0 )
     End Function
 
@@ -258 +288 @@
         End If
 
+        If fullName[0] = &H2A Then      ' fullName[0] = '*'
+            Dim result = Search( fullName.Substring( 1 ) )
+            Return result.GetPtrType()
+        End If
+
         Search = types.Item(fullName)
 

trunk/Include/system/gc.sbp

@@ -471 +471 @@
         End If
 
+        If Object.ReferenceEquals( classTypeInfo, ActiveBasic.Core._System_TypeBase.selfTypeInfo ) Then
+            ' TypeInfoクラスの場合はTypeBaseImplクラスとして扱う
+            classTypeInfo = _System_TypeBase_Search( "ActiveBasic.Core.TypeBaseImpl" ) As ActiveBasic.Core._System_TypeForClass
+        End If
+
         /*
         _System_DebugOnly_OutputDebugString( "  (scanning object)" )

trunk/TestCase/SimpleTestCase/TypeInfoTest.ab

@@ -4 +4 @@
 Sub TestMain()
     Dim str As String
-    /*
+
     Dim memberInfos = str.GetType().GetMembers()
     UnitTest( "TypeInfoTest(MemberInfo) ... ", True )
@@ -10 +10 @@
         UnitTest( Ex"\t" + memberInfo.Name + " As " + memberInfo.MemberType.FullName, True )
     Next
-    */
+
 End Sub