public static System.DateTime Now { get { throw null; } }
public static System.DateTime Today { get { throw null; } }
}
+ public sealed partial class ErrObject
+ {
+ internal ErrObject() { }
+ public void Clear() { }
+ public string Description { get { throw null; } set { } }
+ public int Erl { get { throw null; } }
+ public System.Exception GetException() { throw null; }
+ public int LastDllError { get { throw null; } }
+ public int Number { get { throw null; } set { } }
+ public void Raise(int Number, object Source = null, object Description = null, object HelpFile = null, object HelpContext = null) { }
+ }
[System.AttributeUsageAttribute(System.AttributeTargets.Class, AllowMultiple=false, Inherited=false)]
[System.ComponentModel.EditorBrowsableAttribute(System.ComponentModel.EditorBrowsableState.Never)]
public sealed partial class HideModuleNameAttribute : System.Attribute
public sealed partial class Information
{
internal Information() { }
+ public static ErrObject Err() { throw null; }
public static bool IsArray(object VarName) { throw null; }
public static bool IsDate(object Expression) { throw null; }
public static bool IsDBNull(object Expression) { throw null; }
{
internal ProjectData() { }
public static void ClearProjectError() { }
+ public static System.Exception CreateProjectError(int hr) { throw null; }
public static void SetProjectError(System.Exception ex) { }
public static void SetProjectError(System.Exception ex, int lErl) { }
}
<Compile Include="Microsoft\VisualBasic\Helpers\ForEachEnum.vb" />
<Compile Include="Microsoft\VisualBasic\CompilerServices\DoubleType.vb" />
<Compile Include="Microsoft\VisualBasic\DateAndTime.vb" />
+ <Compile Include="Microsoft\VisualBasic\ErrObject.vb" />
<Compile Include="Microsoft\VisualBasic\HideModuleNameAttribute.vb" />
<Compile Include="Microsoft\VisualBasic\Information.vb" />
<Compile Include="Microsoft\VisualBasic\Interaction.vb" />
End Function
Friend Shared Function VbMakeException(ByVal ex As Exception, ByVal hr As Integer) As System.Exception
- ' UNDONE - Err() requires port of Information.vb, ProjectData.vb
- 'Err().SetUnmappedError(hr)
+ Err().SetUnmappedError(hr)
Return ex
End Function
' The .NET Foundation licenses this file to you under the MIT license.
' See the LICENSE file in the project root for more information.
+Imports System
+
Namespace Global.Microsoft.VisualBasic.CompilerServices
<Global.System.Diagnostics.DebuggerNonUserCode()>
<Global.System.ComponentModel.EditorBrowsable(Global.System.ComponentModel.EditorBrowsableState.Never)>
Public NotInheritable Class ProjectData
+ Friend m_Err As ErrObject
Friend m_rndSeed As Integer = &H50000I
'm_oProject is per-Thread
Private Sub New()
End Sub
- Public Overloads Shared Sub SetProjectError(ex As Global.System.Exception)
- End Sub
- Public Overloads Shared Sub SetProjectError(ex As Global.System.Exception, lErl As Integer)
- End Sub
- Public Shared Sub ClearProjectError()
- End Sub
Friend Shared Function GetProjectData() As ProjectData
'*************************
m_oProject = GetProjectData
End If
End Function
+
+ ''' <summary>
+ ''' This function is called by the compiler in response to err code, e.g. err 123
+ ''' It is also called when the compiler encounters a resume that isn't preceded by an On Error command
+ ''' </summary>
+ ''' <param name="hr"></param>
+ ''' <returns></returns>
+ Public Shared Function CreateProjectError(ByVal hr As Integer) As System.Exception
+ '*************************
+ '*** PERFORMANCE NOTE: ***
+ '*************************
+ ' Err Object is <ThreadStatic> and is pretty expensive to access so we cache to a local to cut the number of accesses
+ Dim ErrObj As ErrObject = Err()
+ ErrObj.Clear()
+ Dim ErrNumber As Integer = ErrObj.MapErrorNumber(hr)
+ Return ErrObj.CreateException(hr, Utils.GetResourceString(CType(ErrNumber, vbErrors)))
+ End Function
+
+ ''' <summary>
+ ''' Called by the compiler in response to falling into a catch block.
+ ''' Inside the catch statement the compiler generates code to call:
+ ''' ProjectData::SetProjectError(exception) That call
+ ''' in turns sets the ErrObject which is accessed via the VB Err statement.
+ ''' So a VB6 programmer would typically then do something like:
+ ''' if err.Number = * do something where err accesses the ErrObject that
+ ''' is set by this method.
+ ''' </summary>
+ ''' <param name="ex"></param>
+ Public Overloads Shared Sub SetProjectError(ByVal ex As Exception)
+ Err.CaptureException(ex)
+ End Sub
+
+ ''' <summary>
+ ''' Called by the compiler in response to falling into a catch block.
+ ''' Inside the catch statement the compiler generates code to call:
+ ''' ProjectData::SetProjectError(exception, lineNumber) This call
+ ''' differs from SetProjectError(ex as Exception)because it is called
+ ''' when the exception is thrown from a specific line number, e.g:
+ ''' 123: Throw new Exception
+ ''' 123: Error x80004003
+ ''' This method in turn sets the ErrObject which is accessed via the
+ ''' VB "Err" statement.
+ ''' So a VB6 programmer could then do something like:
+ ''' if err.Number = *
+ ''' err.Erl will also be set
+ ''' is set by this class.
+ ''' </summary>
+ ''' <param name="ex"></param>
+ ''' <param name="lErl"></param>
+ Public Overloads Shared Sub SetProjectError(ByVal ex As Exception, ByVal lErl As Integer)
+ Err.CaptureException(ex, lErl)
+ End Sub
+
+ Public Shared Sub ClearProjectError()
+ Err.Clear()
+ End Sub
End Class
End Namespace
--- /dev/null
+' Licensed to the .NET Foundation under one or more agreements.
+' The .NET Foundation licenses this file to you under the MIT license.
+' See the LICENSE file in the project root for more information.
+
+Imports Microsoft.VisualBasic.CompilerServices
+Imports Microsoft.VisualBasic.CompilerServices.Utils
+Imports Microsoft.VisualBasic.CompilerServices.ExceptionUtils
+
+Imports System
+Imports System.Runtime.InteropServices
+
+Namespace Microsoft.VisualBasic
+
+ Public NotInheritable Class ErrObject
+
+ ' Error object private values
+ Private m_curException As Exception
+ Private m_curErl As Integer
+ Private m_curNumber As Integer
+ Private m_curDescription As String
+ Private m_NumberIsSet As Boolean
+ Private m_ClearOnCapture As Boolean
+ Private m_DescriptionIsSet As Boolean
+
+ Friend Sub New()
+ Me.Clear() 'need to do this so the fields are set to Empty string, not Nothing
+ End Sub
+
+ '============================================================================
+ ' ErrObject functions.
+ '============================================================================
+ Public ReadOnly Property Erl() As Integer
+ Get
+ Return m_curErl
+ End Get
+ End Property
+
+ Public Property Number() As Integer
+ Get
+ If m_NumberIsSet Then
+ Return m_curNumber
+ End If
+
+ If Not m_curException Is Nothing Then
+ Me.Number = MapExceptionToNumber(m_curException)
+ Return m_curNumber
+ Else
+ 'The default case. NOTE: falling into the default does not "Set" the property.
+ 'We only get here if the Err object was previously cleared.
+ Return 0
+ End If
+ End Get
+
+ Set(ByVal Value As Integer)
+ m_curNumber = MapErrorNumber(Value)
+ m_NumberIsSet = True
+ End Set
+ End Property
+
+ ''' <summary>
+ ''' Determines what the correct error description should be.
+ ''' If we don't have an exception that we are responding to then
+ ''' we don't do anything to the message.
+ ''' If we do have an exception pending, we morph the description
+ ''' to match the corresponding VB error.
+ ''' We also special case HRESULT exceptions to map to a VB description
+ ''' if we have one.
+ ''' </summary>
+ ''' <param name="Msg"></param>
+ ''' <returns></returns>
+ Private Function FilterDefaultMessage(ByVal Msg As String) As String
+ Dim NewMsg As String
+
+ 'This is one of the default messages,
+ If m_curException Is Nothing Then
+ 'Leave message as is
+ Return Msg
+ End If
+
+ Dim tmpNumber As Integer = Me.Number
+
+ If Msg Is Nothing OrElse Msg.Length = 0 Then
+ Msg = GetResourceString("ID" & CStr(tmpNumber))
+ ElseIf System.String.CompareOrdinal("Exception from HRESULT: 0x", 0, Msg, 0, Math.Min(Msg.Length, 26)) = 0 Then
+ NewMsg = GetResourceString("ID" & CStr(m_curNumber))
+ If Not NewMsg Is Nothing Then
+ Msg = NewMsg
+ End If
+ End If
+
+ Return Msg
+ End Function
+
+ Public Property Description() As String
+ Get
+ If m_DescriptionIsSet Then
+ Return m_curDescription
+ End If
+
+ If Not m_curException Is Nothing Then
+ Me.Description = FilterDefaultMessage(m_curException.Message)
+ Return m_curDescription
+ Else
+ 'The default case. NOTE: falling into the default does not "Set" the property.
+ 'We only get here if the Err object was previously cleared.
+ Return ""
+ End If
+ End Get
+
+ Set(ByVal Value As String)
+ m_curDescription = Value
+ m_DescriptionIsSet = True
+ End Set
+ End Property
+
+ Public Function GetException() As Exception
+ Return m_curException
+ End Function
+
+ ''' <summary>
+ ''' VB calls clear whenever it executes any type of Resume statement, Exit Sub, Exit funcion, exit Property, or
+ ''' any On Error statement.
+ ''' </summary>
+ Public Sub Clear()
+ 'CONSIDER: do we even care about CLEARING the fields if clearing the flags are enough (aside from m_curException)?
+ m_curException = Nothing
+ m_curNumber = 0
+ m_curDescription = ""
+ m_curErl = 0
+ m_NumberIsSet = False
+ m_DescriptionIsSet = False
+ m_ClearOnCapture = True
+ End Sub
+
+ ''' <summary>
+ ''' This function is called when the Raise code command is executed
+ ''' </summary>
+ ''' <param name="Number">The error code being raised</param>
+ ''' <param name="Source">If not supplied we take the name from the assembly</param>
+ ''' <param name="Description">If not supplied, we try to look one up based on the error code being raised</param>
+ ''' <param name="HelpFile"></param>
+ ''' <param name="HelpContext"></param>
+ Public Sub Raise(ByVal Number As Integer,
+ Optional ByVal Source As Object = Nothing,
+ Optional ByVal Description As Object = Nothing,
+ Optional ByVal HelpFile As Object = Nothing,
+ Optional ByVal HelpContext As Object = Nothing)
+
+ If Number = 0 Then
+ 'This is only called by Raise, so Raise(0) should give the following exception
+ Throw New ArgumentException(GetResourceString(SR.Argument_InvalidValue1, "Number"))
+ End If
+ Me.Number = Number
+
+ If Not Description Is Nothing Then
+ Me.Description = CStr(Description)
+ ElseIf Not m_DescriptionIsSet Then
+ 'Set the Description here so the exception object contains the right message
+ Me.Description = GetResourceString(CType(m_curNumber, vbErrors))
+ End If
+
+ Dim e As Exception
+ e = MapNumberToException(m_curNumber, m_curDescription)
+ m_ClearOnCapture = False
+ Throw e
+ End Sub
+
+ ReadOnly Property LastDllError() As Integer
+ Get
+ Return Marshal.GetLastWin32Error()
+ End Get
+ End Property
+
+ Friend Sub SetUnmappedError(ByVal Number As Integer)
+ Me.Clear()
+ Me.Number = Number
+ m_ClearOnCapture = False
+ End Sub
+
+ 'a function like this that can be used by the runtime to generate errors which will also do a clear would be nice.
+ Friend Function CreateException(ByVal Number As Integer, ByVal Description As String) As System.Exception
+ Me.Clear()
+ Me.Number = Number
+
+ If Number = 0 Then
+ 'This is only called by Error xxxx, zero is not a valid exception number
+ Throw New ArgumentException(GetResourceString(SR.Argument_InvalidValue1, "Number"))
+ End If
+
+ Dim e As Exception = MapNumberToException(m_curNumber, Description)
+ m_ClearOnCapture = False
+ Return e
+ End Function
+
+ Friend Overloads Sub CaptureException(ByVal ex As Exception)
+ 'if we've already captured this exception, then we're done
+ If ex IsNot m_curException Then
+ If m_ClearOnCapture Then
+ Me.Clear()
+ Else
+ m_ClearOnCapture = True 'False only used once - set this flag back to the default
+ End If
+ m_curException = ex
+ End If
+ End Sub
+
+ Friend Overloads Sub CaptureException(ByVal ex As Exception, ByVal lErl As Integer)
+ CaptureException(ex)
+ m_curErl = lErl 'This is the only place where the line number can be set
+ End Sub
+
+ Private Function MapExceptionToNumber(ByVal e As Exception) As Integer
+ Diagnostics.Debug.Assert(e IsNot Nothing, "Exception shouldn't be Nothing")
+ Dim typ As Type = e.GetType()
+
+ If typ Is GetType(System.IndexOutOfRangeException) Then
+ Return vbErrors.OutOfBounds
+ ElseIf typ Is GetType(System.RankException) Then
+ Return vbErrors.OutOfBounds
+ ElseIf typ Is GetType(System.DivideByZeroException) Then
+ Return vbErrors.DivByZero
+ ElseIf typ Is GetType(System.OverflowException) Then
+ Return vbErrors.Overflow
+ ElseIf typ Is GetType(System.NotFiniteNumberException) Then
+ Dim exNotFiniteNumber As NotFiniteNumberException = CType(e, NotFiniteNumberException)
+ If exNotFiniteNumber.OffendingNumber = 0 Then
+ Return vbErrors.DivByZero
+ Else
+ Return vbErrors.Overflow
+ End If
+ ElseIf typ Is GetType(System.NullReferenceException) Then
+ Return vbErrors.ObjNotSet
+ ElseIf TypeOf e Is System.AccessViolationException Then
+ Return vbErrors.AccessViolation
+ ElseIf typ Is GetType(System.InvalidCastException) Then
+ Return vbErrors.TypeMismatch
+ ElseIf typ Is GetType(System.NotSupportedException) Then
+ Return vbErrors.TypeMismatch
+ ElseIf typ Is GetType(System.Runtime.InteropServices.SEHException) Then
+ Return vbErrors.DLLCallException
+ ElseIf typ Is GetType(System.DllNotFoundException) Then
+ Return vbErrors.FileNotFound
+ ElseIf typ Is GetType(System.EntryPointNotFoundException) Then
+ Return vbErrors.InvalidDllFunctionName
+ '
+ 'Must fall after EntryPointNotFoundException because of inheritance
+ '
+ ElseIf typ Is GetType(System.TypeLoadException) Then
+ Return vbErrors.CantCreateObject
+ ElseIf typ Is GetType(System.OutOfMemoryException) Then
+ Return vbErrors.OutOfMemory
+ ElseIf typ Is GetType(System.FormatException) Then
+ Return vbErrors.TypeMismatch
+ ElseIf typ Is GetType(System.IO.DirectoryNotFoundException) Then
+ Return vbErrors.PathNotFound
+ ElseIf typ Is GetType(System.IO.IOException) Then
+ Return vbErrors.IOError
+ ElseIf typ Is GetType(System.IO.FileNotFoundException) Then
+ Return vbErrors.FileNotFound
+ ElseIf TypeOf e Is MissingMemberException Then
+ Return vbErrors.OLENoPropOrMethod
+ ElseIf TypeOf e Is Runtime.InteropServices.InvalidOleVariantTypeException Then
+ Return vbErrors.InvalidTypeLibVariable
+ Else
+ Return vbErrors.IllegalFuncCall 'Generic error
+ End If
+
+ End Function
+
+ Private Function MapNumberToException(ByVal Number As Integer,
+ ByVal Description As String) As System.Exception
+ Return ExceptionUtils.BuildException(Number, Description, False)
+ End Function
+
+ Friend Function MapErrorNumber(ByVal Number As Integer) As Integer
+ If Number > 65535 Then
+ ' Number cannot be greater than 65535.
+ Throw New ArgumentException(GetResourceString(SR.Argument_InvalidValue1), "Number")
+ End If
+
+ If Number >= 0 Then
+ Return Number
+ End If
+
+ 'strip off top two bytes if FACILITY_CONTROL is set
+ If (Number And SCODE_FACILITY) = FACILITY_CONTROL Then
+ Return (Number And &HFFFFI)
+ End If
+
+ Return Number
+ End Function
+
+ End Class
+End Namespace
&HFF00FFI, &HFFFFI, &HFFFFFFI}
Friend Const COMObjectName As String = "__ComObject"
+ '============================================================================
+ ' Error functions.
+ '============================================================================
+ Public Function Err() As ErrObject
+
+ Dim oProj As ProjectData
+ oProj = ProjectData.GetProjectData()
+
+ If oProj.m_Err Is Nothing Then
+ oProj.m_Err = New ErrObject
+ End If
+ Err = oProj.m_Err
+
+ End Function
+
Public Function IsArray(ByVal VarName As Object) As Boolean
If VarName Is Nothing Then
--- /dev/null
+// Licensed to the .NET Foundation under one or more agreements.
+// The .NET Foundation licenses this file to you under the MIT license.
+// See the LICENSE file in the project root for more information.
+
+using Microsoft.VisualBasic.CompilerServices;
+using System;
+using Xunit;
+
+namespace Microsoft.VisualBasic.Tests
+{
+ public class ErrObjectTests
+ {
+ [Fact]
+ public void Clear()
+ {
+ ProjectData.SetProjectError(new ArgumentException(), 3);
+ var errObj = Information.Err();
+ errObj.Number = 5;
+ errObj.Description = "Description";
+ errObj.Clear();
+ Assert.Equal(0, errObj.Erl);
+ Assert.Equal(0, errObj.LastDllError);
+ Assert.Equal(0, errObj.Number);
+ Assert.Equal("", errObj.Description);
+ Assert.Null(errObj.GetException());
+ }
+
+ [Fact]
+ public void Raise()
+ {
+ ProjectData.SetProjectError(new Exception());
+ _ = Assert.Throws<ArgumentException>(() => Information.Err().Raise(0)).ToString();
+
+ ProjectData.SetProjectError(new Exception());
+ _ = Assert.Throws<OutOfMemoryException>(() => Information.Err().Raise(7)).ToString();
+
+ ProjectData.SetProjectError(new ArgumentException());
+ _ = Assert.Throws<OutOfMemoryException>(() => Information.Err().Raise(7)).ToString();
+
+ ProjectData.SetProjectError(new ArgumentException());
+ _ = Assert.Throws<Exception>(() => Information.Err().Raise(32768)).ToString();
+
+ ProjectData.SetProjectError(new InvalidOperationException());
+ _ = Assert.Throws<Exception>(() => Information.Err().Raise(1, Description: "MyDescription")).ToString();
+ }
+
+ [Fact]
+ public void FilterDefaultMessage()
+ {
+ ProjectData.SetProjectError(new System.IO.FileNotFoundException("Description"));
+ Assert.Equal("Description", Information.Err().Description);
+
+ ProjectData.SetProjectError(new System.IO.FileNotFoundException(""));
+ Assert.Equal("ID53", Information.Err().Description);
+
+ ProjectData.SetProjectError(new System.IO.FileNotFoundException("Exception from HRESULT: 0x80"));
+ Assert.Equal("ID53", Information.Err().Description);
+ }
+ }
+}
<Compile Include="Microsoft\VisualBasic\CompilerServices\StructUtilsTests.cs" />
<Compile Include="Microsoft\VisualBasic\Devices\NetworkAvailableEventArgsTests.cs" />
<Compile Include="ConversionsTests.cs" />
+ <Compile Include="ErrObjectTests.cs" />
<Compile Include="OperatorsTests.cs" />
<Compile Include="OperatorsTests.Comparison.cs" />
<Compile Include="DateAndTimeTests.cs" />
<Compile Include="IConvertibleWrapper.cs" />
<Compile Include="InformationTests.cs" />
+ <Compile Include="ProjectDataTests.cs" />
<Compile Include="UtilsTests.cs" />
<Compile Include="VBMathTests.cs" />
<Compile Include="StringsTests.cs" />
--- /dev/null
+// Licensed to the .NET Foundation under one or more agreements.
+// The .NET Foundation licenses this file to you under the MIT license.
+// See the LICENSE file in the project root for more information.
+
+using Microsoft.VisualBasic.CompilerServices;
+using System;
+using Xunit;
+
+namespace Microsoft.VisualBasic.CompilerServices.Tests
+{
+ public class ProjectDataTests
+ {
+ [Fact]
+ public void CreateProjectError()
+ {
+ _ = Assert.Throws<ArgumentException>(() => ProjectData.CreateProjectError(0)).ToString();
+ _ = Assert.IsType<Exception>(ProjectData.CreateProjectError(1)).ToString();
+ _ = Assert.IsType<OutOfMemoryException>(ProjectData.CreateProjectError(7)).ToString();
+ _ = Assert.IsType<Exception>(ProjectData.CreateProjectError(32768)).ToString();
+ _ = Assert.IsType<Exception>(ProjectData.CreateProjectError(40068)).ToString();
+ _ = Assert.IsType<Exception>(ProjectData.CreateProjectError(41000)).ToString();
+ }
+
+ [Fact]
+ public void SetProjectError()
+ {
+ Exception e = new ArgumentException();
+ ProjectData.SetProjectError(e);
+ Assert.Same(e, Information.Err().GetException());
+ Assert.Equal(0, Information.Err().Erl);
+
+ e = new InvalidOperationException();
+ ProjectData.SetProjectError(e, 3);
+ Assert.Same(e, Information.Err().GetException());
+ Assert.Equal(3, Information.Err().Erl);
+
+ e = new Exception();
+ ProjectData.SetProjectError(e);
+ Assert.Same(e, Information.Err().GetException());
+ Assert.Equal(0, Information.Err().Erl);
+ }
+
+ [Fact]
+ public void ClearProjectError()
+ {
+ ProjectData.SetProjectError(new ArgumentException(), 3);
+ ProjectData.ClearProjectError();
+ Assert.Null(Information.Err().GetException());
+ Assert.Equal(0, Information.Err().Erl);
+ }
+ }
+}
projects / platform / upstream / dotnet / runtime.git / commitdiff