From: Charles Stoner Date: Sat, 13 Apr 2019 04:45:11 +0000 (-0700) Subject: Port ErrObject and CreateProjectError (dotnet/corefx#36808) X-Git-Tag: submit/tizen/20210909.063632~11031^2~1896 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=2b5a619b73346d1111243232d70ba5132d9d457c;p=platform%2Fupstream%2Fdotnet%2Fruntime.git Port ErrObject and CreateProjectError (dotnet/corefx#36808) * Port ErrObject and CreateProjectError * PR feedback * Add FilterDefaultMessage test Commit migrated from https://github.com/dotnet/corefx/commit/e2ab05d35f00f9cd9a92a94284698cc241f8380d --- diff --git a/src/libraries/Microsoft.VisualBasic.Core/ref/Microsoft.VisualBasic.Core.cs b/src/libraries/Microsoft.VisualBasic.Core/ref/Microsoft.VisualBasic.Core.cs index a97b125..e46a95a 100644 --- a/src/libraries/Microsoft.VisualBasic.Core/ref/Microsoft.VisualBasic.Core.cs +++ b/src/libraries/Microsoft.VisualBasic.Core/ref/Microsoft.VisualBasic.Core.cs @@ -100,6 +100,17 @@ namespace Microsoft.VisualBasic 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 @@ -110,6 +121,7 @@ namespace Microsoft.VisualBasic 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; } @@ -467,6 +479,7 @@ namespace Microsoft.VisualBasic.CompilerServices { 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) { } } diff --git a/src/libraries/Microsoft.VisualBasic.Core/src/Microsoft.VisualBasic.Core.vbproj b/src/libraries/Microsoft.VisualBasic.Core/src/Microsoft.VisualBasic.Core.vbproj index 7cbc84d..8c74e86 100644 --- a/src/libraries/Microsoft.VisualBasic.Core/src/Microsoft.VisualBasic.Core.vbproj +++ b/src/libraries/Microsoft.VisualBasic.Core/src/Microsoft.VisualBasic.Core.vbproj @@ -68,6 +68,7 @@ + diff --git a/src/libraries/Microsoft.VisualBasic.Core/src/Microsoft/VisualBasic/CompilerServices/ExceptionUtils.vb b/src/libraries/Microsoft.VisualBasic.Core/src/Microsoft/VisualBasic/CompilerServices/ExceptionUtils.vb index 7ec627e..653334b 100644 --- a/src/libraries/Microsoft.VisualBasic.Core/src/Microsoft/VisualBasic/CompilerServices/ExceptionUtils.vb +++ b/src/libraries/Microsoft.VisualBasic.Core/src/Microsoft/VisualBasic/CompilerServices/ExceptionUtils.vb @@ -190,8 +190,7 @@ Namespace Microsoft.VisualBasic.CompilerServices 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 diff --git a/src/libraries/Microsoft.VisualBasic.Core/src/Microsoft/VisualBasic/CompilerServices/ProjectData.vb b/src/libraries/Microsoft.VisualBasic.Core/src/Microsoft/VisualBasic/CompilerServices/ProjectData.vb index d81f9d0..3587e99 100644 --- a/src/libraries/Microsoft.VisualBasic.Core/src/Microsoft/VisualBasic/CompilerServices/ProjectData.vb +++ b/src/libraries/Microsoft.VisualBasic.Core/src/Microsoft/VisualBasic/CompilerServices/ProjectData.vb @@ -2,11 +2,14 @@ ' 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 Public NotInheritable Class ProjectData + Friend m_Err As ErrObject Friend m_rndSeed As Integer = &H50000I 'm_oProject is per-Thread @@ -14,12 +17,6 @@ Namespace Global.Microsoft.VisualBasic.CompilerServices 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 '************************* @@ -34,5 +31,61 @@ Namespace Global.Microsoft.VisualBasic.CompilerServices m_oProject = GetProjectData End If End Function + + ''' + ''' 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 + ''' + ''' + ''' + Public Shared Function CreateProjectError(ByVal hr As Integer) As System.Exception + '************************* + '*** PERFORMANCE NOTE: *** + '************************* + ' Err Object is 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 + + ''' + ''' 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. + ''' + ''' + Public Overloads Shared Sub SetProjectError(ByVal ex As Exception) + Err.CaptureException(ex) + End Sub + + ''' + ''' 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. + ''' + ''' + ''' + 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 diff --git a/src/libraries/Microsoft.VisualBasic.Core/src/Microsoft/VisualBasic/ErrObject.vb b/src/libraries/Microsoft.VisualBasic.Core/src/Microsoft/VisualBasic/ErrObject.vb new file mode 100644 index 0000000..c50742f --- /dev/null +++ b/src/libraries/Microsoft.VisualBasic.Core/src/Microsoft/VisualBasic/ErrObject.vb @@ -0,0 +1,294 @@ +' 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 + + ''' + ''' 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. + ''' + ''' + ''' + 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 + + ''' + ''' VB calls clear whenever it executes any type of Resume statement, Exit Sub, Exit funcion, exit Property, or + ''' any On Error statement. + ''' + 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 + + ''' + ''' This function is called when the Raise code command is executed + ''' + ''' The error code being raised + ''' If not supplied we take the name from the assembly + ''' If not supplied, we try to look one up based on the error code being raised + ''' + ''' + 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 diff --git a/src/libraries/Microsoft.VisualBasic.Core/src/Microsoft/VisualBasic/Information.vb b/src/libraries/Microsoft.VisualBasic.Core/src/Microsoft/VisualBasic/Information.vb index 715fb30..78d1882 100644 --- a/src/libraries/Microsoft.VisualBasic.Core/src/Microsoft/VisualBasic/Information.vb +++ b/src/libraries/Microsoft.VisualBasic.Core/src/Microsoft/VisualBasic/Information.vb @@ -37,6 +37,21 @@ Namespace Microsoft.VisualBasic &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 diff --git a/src/libraries/Microsoft.VisualBasic.Core/tests/ErrObjectTests.cs b/src/libraries/Microsoft.VisualBasic.Core/tests/ErrObjectTests.cs new file mode 100644 index 0000000..ce134d4 --- /dev/null +++ b/src/libraries/Microsoft.VisualBasic.Core/tests/ErrObjectTests.cs @@ -0,0 +1,60 @@ +// 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(() => Information.Err().Raise(0)).ToString(); + + ProjectData.SetProjectError(new Exception()); + _ = Assert.Throws(() => Information.Err().Raise(7)).ToString(); + + ProjectData.SetProjectError(new ArgumentException()); + _ = Assert.Throws(() => Information.Err().Raise(7)).ToString(); + + ProjectData.SetProjectError(new ArgumentException()); + _ = Assert.Throws(() => Information.Err().Raise(32768)).ToString(); + + ProjectData.SetProjectError(new InvalidOperationException()); + _ = Assert.Throws(() => 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); + } + } +} diff --git a/src/libraries/Microsoft.VisualBasic.Core/tests/Microsoft.VisualBasic.Core.Tests.csproj b/src/libraries/Microsoft.VisualBasic.Core/tests/Microsoft.VisualBasic.Core.Tests.csproj index dbb78ee..e5ef8c6 100644 --- a/src/libraries/Microsoft.VisualBasic.Core/tests/Microsoft.VisualBasic.Core.Tests.csproj +++ b/src/libraries/Microsoft.VisualBasic.Core/tests/Microsoft.VisualBasic.Core.Tests.csproj @@ -25,11 +25,13 @@ + + diff --git a/src/libraries/Microsoft.VisualBasic.Core/tests/ProjectDataTests.cs b/src/libraries/Microsoft.VisualBasic.Core/tests/ProjectDataTests.cs new file mode 100644 index 0000000..64887d9 --- /dev/null +++ b/src/libraries/Microsoft.VisualBasic.Core/tests/ProjectDataTests.cs @@ -0,0 +1,52 @@ +// 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(() => ProjectData.CreateProjectError(0)).ToString(); + _ = Assert.IsType(ProjectData.CreateProjectError(1)).ToString(); + _ = Assert.IsType(ProjectData.CreateProjectError(7)).ToString(); + _ = Assert.IsType(ProjectData.CreateProjectError(32768)).ToString(); + _ = Assert.IsType(ProjectData.CreateProjectError(40068)).ToString(); + _ = Assert.IsType(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); + } + } +} diff --git a/src/libraries/Microsoft.VisualBasic.Core/tests/VB/Microsoft.VisualBasic.VB.Tests.vbproj b/src/libraries/Microsoft.VisualBasic.Core/tests/VB/Microsoft.VisualBasic.VB.Core.Tests.vbproj similarity index 100% rename from src/libraries/Microsoft.VisualBasic.Core/tests/VB/Microsoft.VisualBasic.VB.Tests.vbproj rename to src/libraries/Microsoft.VisualBasic.Core/tests/VB/Microsoft.VisualBasic.VB.Core.Tests.vbproj