Author: rafim
Date: 2006-11-09 07:29:49 -0500 (Thu, 09 Nov 2006)
New Revision: 67591
Modified:
trunk/mono-basic/vbruntime/Microsoft.VisualBasic/Microsoft.VisualBasic.CompilerServices/StringType.vb
trunk/mono-basic/vbruntime/Microsoft.VisualBasic/Microsoft.VisualBasic/Information.vb
trunk/mono-basic/vbruntime/Microsoft.VisualBasic/Microsoft.VisualBasic/Interaction.vb
Log:
StringType - fix casting problems with CStr, fix Mid for byref params.
Interaction - fix choose.
Information - lbound, ubound for multi dim arrays.
Modified:
trunk/mono-basic/vbruntime/Microsoft.VisualBasic/Microsoft.VisualBasic/Information.vb
===================================================================
---
trunk/mono-basic/vbruntime/Microsoft.VisualBasic/Microsoft.VisualBasic/Information.vb
2006-11-09 12:04:45 UTC (rev 67590)
+++
trunk/mono-basic/vbruntime/Microsoft.VisualBasic/Microsoft.VisualBasic/Information.vb
2006-11-09 12:29:49 UTC (rev 67591)
@@ -122,14 +122,9 @@
' VB rank start at 1, but System.Array.Rank starts at 0
Dim RealRank As Integer
RealRank = Rank - 1
+ If Array Is Nothing Then Throw New
System.ArgumentException("Argument 'Array' is not a valid value")
- ' if single dimension
- If RealRank = 0 Then
- Return Array.GetLowerBound(RealRank)
- Else
- 'FIXME: not implemented support for multi-dim arrays
- Throw New NotImplementedException("Implement me: Rank <> 1")
- End If
+ Return Array.GetLowerBound(RealRank)
End Function
Public Function QBColor(ByVal Color As Integer) As Integer
If (Color < 0 Or Color > 15) Then Throw New
System.ArgumentException("Argument 'Color' is not a valid value")
@@ -207,8 +202,8 @@
TmpObjType1 = VarName.GetType().Name.ToLower
If VarName.GetType.IsArray Then
- Dim lastch As Integer = TmpObjType1.LastIndexOf("]") -1
- Dim firstch As Integer = TmpObjType1.IndexOf("[") -1
+ Dim lastch As Integer = TmpObjType1.LastIndexOf("]") - 1
+ Dim firstch As Integer = TmpObjType1.IndexOf("[") - 1
TmpObjType2 = TmpObjType1.Remove(firstch + 1, (lastch -
firstch + 1))
Else
TmpObjType2 = TmpObjType1
@@ -260,15 +255,9 @@
' VB rank start at 1, but System.Array.Rank starts at 0
Dim RealRank As Integer
RealRank = Rank - 1
+ If Array Is Nothing Then Throw New
System.ArgumentException("Argument 'Array' is not a valid value")
- ' if single dimension
- If RealRank = 0 Then
- Return Array.GetUpperBound(RealRank)
- Else
- 'FIXME: not implemented support for multi-dim arrays
- Throw New NotImplementedException("Implement me: Rank <> 1")
- End If
-
+ Return Array.GetUpperBound(RealRank)
End Function
Public Function VarType(ByVal VarName As Object) As
Microsoft.VisualBasic.VariantType
@@ -278,9 +267,9 @@
If VarName Is Nothing Then Return VariantType.Object
If TypeOf VarName Is System.Exception Then Return VariantType.Error
-
+
TmpObjType = VarName.GetType.Name.ToLower
-
+
If VarName.GetType.IsEnum Then
TmpStr =
System.Enum.GetUnderlyingType(VarName.GetType).ToString
'' remove the "System." from the type we get
@@ -339,7 +328,7 @@
End If
Return tmpVar
-
+
End Function
Public Function VbTypeName(ByVal UrtName As String) As String
@@ -373,7 +362,7 @@
RetObjType = "Single"
Case "object"
RetObjType = "Object"
- case "decimal"
+ Case "decimal"
RetObjType = "Decimal"
Case Else
RetObjType = Nothing
Modified:
trunk/mono-basic/vbruntime/Microsoft.VisualBasic/Microsoft.VisualBasic/Interaction.vb
===================================================================
---
trunk/mono-basic/vbruntime/Microsoft.VisualBasic/Microsoft.VisualBasic/Interaction.vb
2006-11-09 12:04:45 UTC (rev 67590)
+++
trunk/mono-basic/vbruntime/Microsoft.VisualBasic/Microsoft.VisualBasic/Interaction.vb
2006-11-09 12:29:49 UTC (rev 67591)
@@ -57,21 +57,19 @@
End Function
Public Function Choose(ByVal Index As Double, ByVal ParamArray
Choice() As Object) As Object
- 'FIXME: why Index is Double, while an Index of an Array is Integer
?
- Dim IntIndex As Integer
- IntIndex = Convert.ToInt32(Index)
-
- 'TODO: add the exception message.
If (Choice.Rank <> 1) Then
Throw New ArgumentException
End If
+ 'FIXME: why Index is Double, while an Index of an Array is Integer
?
+ Dim IntIndex As Integer
+ IntIndex = Convert.ToInt32(Index)
+ Dim ChoiceIndex As Integer = IntIndex - 1
- If ((IntIndex >= 0) And (IntIndex <= Information.UBound(Choice)))
Then
- Return Choice(IntIndex)
+ If ((IntIndex >= 0) And (ChoiceIndex <=
Information.UBound(Choice))) Then
+ Return Choice(ChoiceIndex)
Else
- 'TODO: add the exception message.
- Throw New ArgumentOutOfRangeException
+ Return Nothing
End If
End Function
Public Function Command() As String
Modified:
trunk/mono-basic/vbruntime/Microsoft.VisualBasic/Microsoft.VisualBasic.CompilerServices/StringType.vb
===================================================================
---
trunk/mono-basic/vbruntime/Microsoft.VisualBasic/Microsoft.VisualBasic.CompilerServices/StringType.vb
2006-11-09 12:04:45 UTC (rev 67590)
+++
trunk/mono-basic/vbruntime/Microsoft.VisualBasic/Microsoft.VisualBasic.CompilerServices/StringType.vb
2006-11-09 12:29:49 UTC (rev 67591)
@@ -76,32 +76,32 @@
Dim type1 As Type = Value.GetType()
Select Case Type.GetTypeCode(type1)
Case TypeCode.Boolean
- Value = CBool(Value)
+ Return Convert.ToString(DirectCast(Value, Boolean))
Case TypeCode.Byte
- Value = CByte(Value)
+ Return Convert.ToString(DirectCast(Value, Byte))
Case TypeCode.Char
- Value = CChar(Value)
+ Return Convert.ToString(DirectCast(Value, Char))
Case TypeCode.DateTime
- Value = CDate(Value)
+ ' Return StringType.FromDate(DirectCast(Value, Date))
+ Return StringType.FromDate(DateType.FromObject(Value))
Case TypeCode.Double
- Value = CDbl(Value)
+ Return Convert.ToString(DirectCast(Value, Double))
Case TypeCode.Decimal
- Value = (CDec(Value))
+ Return Convert.ToString(DirectCast(Value, Decimal))
Case TypeCode.Int32
- Value = CInt(Value)
+ Return Convert.ToString(DirectCast(Value, Integer))
Case TypeCode.Int16
- Value = CShort(Value)
+ Return Convert.ToString(DirectCast(Value, Short))
Case TypeCode.Int64
- Value = CLng(Value)
+ Return Convert.ToString(DirectCast(Value, Long))
Case TypeCode.Single
- Value = CSng(Value)
+ Return Convert.ToString(DirectCast(Value, Single))
Case TypeCode.String
' do nothing.
+ Return Value.ToString()
Case Else 'TypeCode.Object and other
Throw New InvalidCastException
End Select
- Return Value.ToString()
-
End Function
Public Shared Function FromDouble(ByVal value As Double) As String
@@ -171,7 +171,21 @@
End Function
Public Shared Sub MidStmtStr(ByRef sDest As String, ByVal
StartPosition As Integer, ByVal MaxInsertLength As Integer, ByVal sInsert As
String)
- sDest = sInsert.Substring(StartPosition, MaxInsertLength)
+ Dim tmp_str As String
+ Dim destLen As Integer = sDest.Length
+ Dim LenToInsert As Integer
+
+ If MaxInsertLength > sInsert.Length Then
+ LenToInsert = sInsert.Length
+ ElseIf MaxInsertLength > (destLen - StartPosition) Then
+ LenToInsert = ((destLen - StartPosition) + 1)
+ Else
+ LenToInsert = MaxInsertLength
+ End If
+
+ sDest = sDest.Remove(StartPosition - 1, LenToInsert)
+ sDest = sDest.Insert(StartPosition - 1, sInsert.Substring(0,
LenToInsert))
+
End Sub
Public Shared Function StrLike(ByVal Source As String, ByVal Pattern
As String, ByVal CompareOption As Microsoft.VisualBasic.CompareMethod) As
Boolean
@@ -201,14 +215,21 @@
Dim carr() As Char = expression.ToCharArray()
Dim sb As StringBuilder = New StringBuilder
+ Dim bDigit As Boolean = False '' need it in order to clode the
string pattern
+
For pos As Integer = 0 To carr.Length - 1
Select Case carr(pos)
Case "?"c
sb.Append("."c)
Case "*"c
sb.Append("."c).Append("*"c)
- Case "#"c
- sb.Append("\"c).Append("d"c)
+ Case "#"c '' only one digit and only once -> "^\d{1}$"
+ If bDigit Then
+
sb.Append("\"c).Append("d"c).Append("{"c).Append("1"c).Append("}"c)
+ Else
+
sb.Append("^"c).Append("\"c).Append("d"c).Append("{"c).Append("1"c).Append("}"c)
+ bDigit = True
+ End If
Case "["c
Dim gsb As StringBuilder =
ConvertGroupSubexpression(carr, pos)
' skip groups of form [], i.e. empty strings
@@ -219,6 +240,8 @@
sb.Append(carr(pos))
End Select
Next
+ If bDigit Then sb.Append("$"c)
+
Return sb.ToString()
End Function
_______________________________________________
Mono-patches maillist - [email protected]
http://lists.ximian.com/mailman/listinfo/mono-patches
