File: ProjectData.vb

package info (click to toggle)
mono-basic 2.6.2-2
  • links: PTS, VCS
  • area: main
  • in suites: squeeze
  • size: 18,852 kB
  • ctags: 809
  • sloc: cs: 8,852; makefile: 516; sh: 307
file content (143 lines) | stat: -rw-r--r-- 6,024 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
'
' ProjectData.vb
'
' Authors:
'   Mizrahi Rafael (rafim@mainsoft.com)
'

'
' Copyright (C) 2002-2006 Mainsoft Corporation.
' Copyright (C) 2004-2006 Novell, Inc (http://www.novell.com)
'
' Permission is hereby granted, free of charge, to any person obtaining
' a copy of this software and associated documentation files (the
' "Software"), to deal in the Software without restriction, including
' without limitation the rights to use, copy, modify, merge, publish,
' distribute, sublicense, and/or sell copies of the Software, and to
' permit persons to whom the Software is furnished to do so, subject to
' the following conditions:
' 
' The above copyright notice and this permission notice shall be
' included in all copies or substantial portions of the Software.
' 
' THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
' EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
' MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
' NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
' LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
' OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
' WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
'

Imports System
Imports System.ComponentModel
Imports System.Runtime.InteropServices

Namespace Microsoft.VisualBasic.CompilerServices
    ' ProjectData class is used in VB exception handling.
    ' it holds an ErrObject which stores the current error status of the whole running program.
    <System.ComponentModel.EditorBrowsable(ComponentModel.EditorBrowsableState.Never)> _
    Public NotInheritable Class ProjectData

        ' ProjectData singelton
        Private Shared Inst As ProjectData = Nothing
#If TARGET_JVM Then
        private Shared m_projectErrorSlot as LocalDataStoreSlot = System.Threading.Thread.AllocateDataSlot()
#Else
        '
        ' ThreadStatic Indicates that the value of a static field is unique for each thread.
        ' Although there is one ProjectData, every thread which set get VB errors must have its own ErrObject
        <ThreadStatic()> _
        Friend Shared m_projectError As ErrObject
#End If

        Friend ReadOnly Property ProjectError() As ErrObject
            Get
#If TARGET_JVM Then
                                dim errObj as Object = System.Threading.Thread.GetData(m_projectErrorSlot)
                                if (errObj is Nothing)
                                    errObj = New ErrObject
                                    System.Threading.Thread.SetData(m_projectErrorSlot, errObj)
                                End if
                                return CType( errObj, ErrObject)
#Else
                Return m_projectError
#End If
            End Get
        End Property
        Private Sub New()
            'Nobody should see constructor
            '#If TRACE Then
            '            Console.WriteLine("TRACE:ProjectData.New:called")
            '#End If
        End Sub
        'singelton, override New in order to use only one instance of ProjectData
        Friend Shared Function Instance() As ProjectData
            If Inst Is Nothing Then
                Inst = New ProjectData
            End If
#If Not TARGET_JVM Then
            If m_projectError Is Nothing Then
                m_projectError = New ErrObject
            End If
#End If
            Return Inst
        End Function
        'ClearProjectError is called by the statement "On Error Resume Next"
#If NET_VER >= 2.0 Then
        <System.Runtime.ConstrainedExecution.ReliabilityContract(Runtime.ConstrainedExecution.Consistency.WillNotCorruptState, Runtime.ConstrainedExecution.Cer.Success)> _
        Public Shared Sub ClearProjectError()
#Else
        Public Shared Sub ClearProjectError()
#End If
            'FIXME: "On Error Resume Next" cause to stop throwing exceptions. 
            'might be some friend variable of ErrObject which store that flag .
            Dim pd As ProjectData = Instance()
            pd.ProjectError.Clear()
        End Sub
        Public Shared Function CreateProjectError(ByVal hr As Integer) As Exception
            'FIXME: hr might be a Windows HResult number, and not a VB error number.
            'FIXME: Add a test and verify that. 
#If TRACE Then
            Console.WriteLine("TRACE:ProjectData.CreateProjectError:hr:" + hr.ToString())
#End If
            Dim pd As ProjectData = Instance()

            Dim description As String
            description = Conversion.ErrorToString(hr)

            pd.ProjectError.SetExceptionFromNumber(hr, description)

            Return pd.ProjectError.GetException

        End Function

#If NET_VER >= 2.0 Then
        <System.Runtime.ConstrainedExecution.ReliabilityContract(Runtime.ConstrainedExecution.Consistency.WillNotCorruptState, Runtime.ConstrainedExecution.Cer.Success)> _
        Public Overloads Shared Sub SetProjectError(ByVal ex As Exception)
#Else
        Public Overloads Shared Sub SetProjectError(ByVal ex As Exception)
#End If
            Dim pd As ProjectData = Instance()
            pd.ProjectError.SetException(ex)
        End Sub

#If NET_VER >= 2.0 Then
        <System.Runtime.ConstrainedExecution.ReliabilityContract(Runtime.ConstrainedExecution.Consistency.WillNotCorruptState, Runtime.ConstrainedExecution.Cer.Success)> _
        Public Overloads Shared Sub SetProjectError(ByVal ex As Exception, ByVal lErl As Integer)
#Else
        Public Overloads Shared Sub SetProjectError(ByVal ex As Exception, ByVal lErl As Integer)
#End If
            Throw New NotImplementedException("implement me: Erl")
            'FIXME: projectError.SetException(ex)
            'FIXME: projectError.Erl = lErl
            'FIXME: projectError.Erl  is readonly. suggested solution, add an overload of SetException(Exception,Integer)
        End Sub

#If Moonlight = False Then
        Public Shared Sub EndApp()
            Environment.Exit(Environment.ExitCode)
        End Sub
#End If
    End Class
End Namespace