diff --git a/.gitattributes b/.gitattributes index 182d9a63..28450818 100644 --- a/.gitattributes +++ b/.gitattributes @@ -21,3 +21,7 @@ wisdom/extract/workflow.mjs text eol=lf # from its source tree, and the two must agree in every checkout. bugs/** -text *.twinproj binary + +# The VB6 template `bug_repro.mjs new --with-vb6` copies into a reproducer's vb6/ +# is CRLF in every checkout, as the bugs/** files it becomes are, and VB6 needs it. +test/repro-templates/vb6/** -text diff --git a/BUGS-TO-REPORT.md b/BUGS-TO-REPORT.md index f179d743..e90bf417 100644 --- a/BUGS-TO-REPORT.md +++ b/BUGS-TO-REPORT.md @@ -86,16 +86,19 @@ kebab-case name for the bug, and its **To Reproduce** names the project file: | `bugs//src/` | the project's exported source tree: `Settings`, `Sources/` and the rest | yes, byte for byte | | `bugs//.twinproj` | the project file, packed from `src/` | yes | | `bugs//.zip` | the `.twinproj` zipped, because a GitHub issue does not accept a `.twinproj` attachment, with any file `repro.json`'s `attach` names, such as a `.twinpack` | no | +| `bugs//vb6/` | optional: a VB6 project, to show what VB6 does where the entry compares it with twinBASIC: `Probe.vbp` and its `.bas`, `.cls` and `.frm` files, sources only, never an exe or an output | yes, byte for byte | +| `bugs//-vb6.zip` | the source files of `vb6/` zipped, to attach beside the other zip; written only when `vb6/` exists | no | `scripts/bug_repro.mjs` makes and checks them (the tool's page is [Tools and Scripts](docs/Documentation/Tools.md#bug-repro)): ```sh node scripts/bug_repro.mjs new "" # bugs//src/ and repro.json -node scripts/bug_repro.mjs pack # src/ -> .twinproj -> .zip +node scripts/bug_repro.mjs pack # src/ -> .twinproj -> .zip; vb6/ -> -vb6.zip node scripts/bug_repro.mjs compile # compile it in the IDE, print the diagnostics node scripts/bug_repro.mjs build # and build it node scripts/bug_repro.mjs run # run Sub Main, print the DEBUG CONSOLE +node scripts/bug_repro.mjs vb6 # build vb6/ with VB6, run it, print out.txt node scripts/bug_repro.mjs verify [ ...] # does each entry still reproduce? node scripts/bug_repro.mjs file # move a filed entry out of the queue node scripts/bug_repro.mjs file --marked # the same for every marked entry @@ -118,7 +121,19 @@ code of `tbbuild`, the diagnostic codes, or a regular expression the output must may be fixed on this build) or `manual`, which prints the `steps` it holds. It needs a twinBASIC install, and is run by a person, never by a gate or by CI. -Attach the `.zip` to the issue. When the entry is filed, its folder moves to +**A VB6 comparison is a project of its own in `vb6/`**, made by `new "" --with-vb6` +from the template in `test/repro-templates/vb6/`. By convention `Probe.vbp` builds `Probe.exe`, +and `Sub Main` writes what it finds to `out.txt` beside the exe, with every error handled: an +unhandled error or a `MsgBox` in a compiled exe opens a modal box on the desktop of whoever runs +it, so `pack` and `vb6` refuse a project whose sources call `MsgBox` or `InputBox`. `vb6 ` +builds it in a copy under the temp folder, so no exe or output lands in `bugs/`, with VB6's +Unattended Execution option, and prints `out.txt`. It needs VB6 (`--vb6 ` or `VB6_EXE`) and no +IDE, and is run by a person. VB6 is only ever started by this tool, never from a shell: in a shell +`/make` is rewritten as a path, and VB6 answers with a modal box. An entry that quotes VB6's output +says that the project is attached as `-vb6.zip`, and every entry that quotes it has a +project of its own in its own reproducer. + +Attach the `.zip`, and the `-vb6.zip` when there is one, to the issue. When the entry is filed, its folder moves to `bugs/filed//`; see [Filed bugs](#filed-bugs). ## Filed bugs @@ -790,37 +805,443 @@ Severity: low; the build passes when repeated, and an IDE run by a person rarely --- -## For Each over WebView2 request or response headers crashes in WebView2HeadersCollection.Next +## An `Interface` declared with the identifier of `IUnknown` compiles, and calling its method ends in an access violation **Describe the bug** -`For Each` over the `WebView2RequestHeaders` that `NavigationStarting` receives crashes with an access violation in `WebView2HeadersCollection.Next`. `WebView2ResponseHeaders` returns the same enumerator from its `_NewEnum`, so `For Each` over response headers reaches the same code (not run). `For Each` calls `IEnumVARIANT::Next` with `pCeltFetched` set to a null pointer, which the interface allows, and the package's `Next` assigns to `pCeltFetched` without testing it. The DEBUG CONSOLE shows `NATIVE EXCEPTION: ACCESS_VIOLATION /WebView2HeadersCollection.twin; WebView2HeadersCollection.Next`. +An `Interface` whose `[InterfaceId]` is the identifier of `IUnknown`, `00000000-0000-0000-C000-000000000046`, compiles without a diagnostic, and a class can implement it. Calling one of its methods through a variable of that type ends the run with `NATIVE EXCEPTION: ACCESS_VIOLATION`. The `Set` to the variable succeeds, but what it stores is the object's ordinary `IUnknown` pointer, whose method table is not the interface's. **To Reproduce** Steps to reproduce the behavior: -1. Open `wv2-headers-foreach-crash.twinproj` (attached as `wv2-headers-foreach-crash.zip`). It references the WebView2 package and has one form, `Form1`, with one WebView2 control, `WebView21`. `Sub Main` shows the form modally. When the control is ready it navigates to `about:blank`, and its `NavigationStarting` handler goes through the request headers: - ``` - Private Sub WebView21_NavigationStarting(ByVal Uri As String, ByVal IsUserInitiated As Boolean, _ - ByVal IsRedirected As Boolean, ByVal RequestHeaders As WebView2RequestHeaders, _ - Cancel As Boolean) Handles WebView21.NavigationStarting - Debug.Print "NavigationStarting " & Uri - Dim h As WebView2Header - For Each h In RequestHeaders - Debug.Print h.Name & ": " & h.Value - Next - Debug.Print "after For Each" +1. Open `iunknown-iid-interface.twinproj` (attached as `iunknown-iid-interface.zip`). Its one source file, `Startup.twin`, holds the whole bug: + ``` + [InterfaceId("00000000-0000-0000-C000-000000000046")] + Private Interface IUnk + Sub Dummy() + End Interface + + Private Class RC + Implements IUnk + Private Sub IUnk_Dummy() Implements IUnk.Dummy + End Sub + End Class + + Module Startup + Public Sub Main() + Dim u As IUnk + Set u = New RC + Debug.Print "ok" + u.Dummy + Debug.Print "called" + End Sub + End Module + ``` +2. Run the project in the IDE (F5). +3. See `ok` in the DEBUG CONSOLE, and then `NATIVE EXCEPTION: ACCESS_VIOLATION /Startup.twin; Startup.Main LINE 000020`. `called` is never printed. + +**Expected behavior** +The compiler refuses the declaration, because an interface cannot have the identifier of `IUnknown` and also have its own methods at the slots that follow `IUnknown`'s three. Failing that, the call works. A run that ends in a native access violation, with no diagnostic anywhere, is worse than either. + +**Desktop:** + - OS: Windows 10 Pro 22H2 (build 19045) + - twinBASIC compiler version: BETA 995 + +**Additional context** +Severity: low; it takes a deliberate copy of `IUnknown`'s identifier, but the compiler accepts it silently and the failure is a crash. + +What was tried: +- The same code with any other identifier on the interface runs to the end and prints `called`. +- If the class does not implement the interface at all, `Set u = New RC` still succeeds, and `u.Dummy` returns with no error and no effect: the `Set` asks for `IUnknown`, which every class answers. +- An interface with three `[PreserveSig]` members declared in `IUnknown`'s order, `QueryInterface`, `AddRef` and `Release`, behaves the same way: `Set` succeeds, and the calls go to the wrong slots (one `AddRef` returned 0, and the next call crashed). +- `Interface IUnk Extends stdole.IUnknown` with that identifier compiles, and `u.AddRef` is then reported as `TB5027 Unrecognized member 'AddRef' on type 'IUnk'`, as it is for `stdole.IUnknown` itself, which has no members that twinBASIC code can call. + + + +--- + +## A late-bound call that passes arguments and fails is issued a second time, without them + +**Describe the bug** +When a late-bound call that passes arguments fails, twinBASIC calls `Invoke` a second time, as a property read (`wFlags` 3) with no arguments. A `Sub` called with an argument it does not take therefore runs twice before error 13 is raised, a failed property assignment runs the property's `Property Get` afterwards, and the error the caller sees is replaced. Observed in a run of the reproducer project, and with `Invoke` implemented by a class that records its calls. + +**To Reproduce** +Steps to reproduce the behavior: +1. Open `latebound-call-retried.twinproj` (attached as `latebound-call-retried.zip`). Its one source file, `Startup.twin`, holds a class and `Sub Main`. `Widget` has `Sub Hello()`, which counts how often it runs, and a `Property Let Prop` that raises error 5 beside a `Property Get Prop` that counts how often it runs. +2. Run it. `Main` calls `o.Hello 1` and `o.Prop = 1` through `Dim o As Object = New Widget`, with `On Error Resume Next`, and prints the error and the counts after each: + ``` + o.Hello 1: error 13, ran 2 time(s), Property Get ran 0 + o.Boom 1: error 5, ran 1 time(s), Property Get ran 0 + x = o.BoomFn(1): error 5, ran 1 time(s), Property Get ran 0 + o.Prop = 1: error -2147352567, ran 1 time(s), Property Get ran 1 + w.Boom 1 (early bound): error 5, ran 1 time(s), Property Get ran 0 + ``` +3. See `Hello` run twice, and `Property Get Prop` run after the `Property Let` that failed. The error from the assignment is `&H80020009` (`DISP_E_EXCEPTION`) where the `Property Let` raised 5. +4. To see the second call, implement `IDispatch` in a `NotDispatchable` class (see `bugs/callbyname-membernotfound-retried/`, which has one, and whose `Invoke` can return another code) whose `Invoke` prints `wFlags`, `pDispParams.cArgs` and whether `pVarResult` is null, and returns a failure code. With `Fail3` returning `DISP_E_TYPEMISMATCH` and `Fail5` raising error 5: + ``` + o.Fail3 1 Invoke flags=1 cArgs=1 result=null, then Invoke flags=3 cArgs=0 result=set + o.Fail3 = 5 Invoke flags=4 cArgs=1 result=null, then Invoke flags=3 cArgs=0 result=set + o.Fail5 = 5 Invoke flags=4 cArgs=1 result=null, then Invoke flags=3 cArgs=0 result=set + Set o.Fail1 = e Invoke flags=8 cArgs=1 result=null, then Invoke flags=3 cArgs=0 result=set + ``` + +**Expected behavior** +One `Invoke` per late-bound call, as a raw `Invoke` does: calling `Invoke` directly with the same argument runs `Hello` once and returns `DISP_E_TYPEMISMATCH`. In VB6 the same two statements fail without running anything the callee counts: `o.Hello 1` raises error 450, *Wrong number of arguments or invalid property assignment*, with `Hello` run 0 times, and `o.Prop = 1` raises error 5 from the `Property Let` with the `Property Get` run 0 times. The VB6 project is attached as `latebound-call-retried-vb6.zip`; it prints `o.Hello 1 -> error 450 (1C2) [Wrong number of arguments or invalid property assignment]` with `Hits=0`, and `o.Prop = 1 -> error 5 (5) [Invalid procedure call or argument]` with `Hits=1 Gets=0` (the one run is the `Property Let`). At the least a failed call must not run the callee again, and the error of the assignment must be the one the `Property Let` raised. + +**Desktop:** + - OS: Windows 10 Pro 22H2 (build 19045) + - twinBASIC compiler version: BETA 995 + +**Additional context** +Severity: a late-bound call with a wrong argument count has side effects twice, and a late-bound property assignment that fails calls the getter, which may be expensive or have effects of its own. + +What does not reproduce it: a statement with no arguments (`o.Fail3`, `o.Hello`, `x = o.Fail3`); a statement that raises from inside the callee (`o.Boom 1` and `x = o.BoomFn(1)` run once and keep error 5); `CallByName` with an argument, for every call type (one `Invoke`); a call that succeeds; early-bound calls. What does reproduce it: `o.Hello 1`, `o.Hello(1)`, `o.Hello 1, 2`, the same through a `Variant` holding the object, and `o.Fn 1` for a `Function` with no parameters (ran twice, error 13). An assignment is repeated whatever the failure was (`DISP_E_TYPEMISMATCH`, `DISP_E_MEMBERNOTFOUND`, `E_FAIL`, an error raised by the setter); a statement call is repeated after `DISP_E_TYPEMISMATCH`, but not after an error raised in the callee. + +The second call resembles VB's rule for `o.Member(args)` on a property that returns an object or a collection: read the property with no arguments, then apply the arguments to the result. It is applied after a failure of any call that has arguments. The single run of `Hello` in the raw `Invoke` case is also at odds with the COM contract, which gives `DISP_E_BADPARAMCOUNT` for too many arguments without running the member; it is left out of this entry. + + + +--- + +## `CallByName` calls `Invoke` a second time, with no result, when the first call returns DISP_E_MEMBERNOTFOUND + +**Describe the bug** +`CallByName` on an object whose `IDispatch.Invoke` returns `DISP_E_MEMBERNOTFOUND` calls `Invoke` twice: first with a result variant (`pVarResult` supplied), then again with the same identifier and flags and a null `pVarResult`. A late-bound statement for the same member, `o.Anything`, calls it once. Seen with a class that implements `IDispatch` itself and counts the calls. + +**To Reproduce** +Steps to reproduce the behavior: +1. Open `callbyname-membernotfound-retried.twinproj` (attached as `callbyname-membernotfound-retried.zip`). Its one source file, `Startup.twin`, declares a copy of `IDispatch` (the `stdole` one cannot be called) and a `NotDispatchable` class `Recorder` that implements it. Its `GetIDsOfNames` returns 1 for any name, and its `Invoke` prints its `wFlags`, says whether `pVarResult` is null, counts the call, and returns `DISP_E_MEMBERNOTFOUND` with `Err.ReturnHResult`. +2. Run it. `Main` calls `CallByName o, "Anything", vbMethod` and then `o.Anything`, with `On Error Resume Next`, through `Dim o As Object = New Recorder`: + ``` + Invoke 1: wFlags 1, result supplied + Invoke 2: wFlags 1, result null + CallByName: error 438, Invoke called 2 time(s) + Invoke 1: wFlags 1, result null + o.Anything: error 438, Invoke called 1 time(s) + ``` + +**Expected behavior** +One `Invoke` per `CallByName`, as for the statement form. A method that did its work and then reported `DISP_E_MEMBERNOTFOUND` (a scripting host whose members are resolved inside `Invoke` is an example) runs again, and a call with arguments and side effects is repeated. + +**Desktop:** + - OS: Windows 10 Pro 22H2 (build 19045) + - twinBASIC compiler version: BETA 995 + +**Additional context** +Severity: low. It only shows with an `IDispatch` that returns `DISP_E_MEMBERNOTFOUND` after doing work. + +What does not reproduce it: `CallByName` with `vbGet` or `vbLet` against `DISP_E_TYPEMISMATCH`, `DISP_E_BADPARAMCOUNT`, `E_FAIL`, an error raised in `Invoke`, or success (one `Invoke` each); `Invoke` returning `DISP_E_MEMBERNOTFOUND` to a late-bound statement or to `x = o.Member` (one `Invoke` each). `vbGet`, `vbMethod` and `vbLet` all repeat after `DISP_E_MEMBERNOTFOUND`. + +A separate behaviour, in its own entry, repeats a failed late-bound statement that passes arguments as a property read: see the entry "A late-bound call that passes arguments and fails is issued a second time, without them". The two are not the same: that one is for calls with arguments and needs no `DISP_E_MEMBERNOTFOUND`, and this one is `CallByName` with or without arguments. + + + +--- + +## A late-bound call to a member that does not exist raises &H80020006, and `CallByName` raises &H80004005, where VB6 raises 438 + +**Describe the bug** +Calling a member that an object does not have, through an `Object` variable, raises error `&H80020006` (`DISP_E_UNKNOWNNAME`, *Unknown name.*) instead of 438, *Object doesn't support this property or method*. `CallByName` with the same name raises `&H80004005`, *Unspecified error*. An `On Error` handler written for VB6 or VBA, which tests for 438, does not catch either. Observed in a run of the reproducer project. + +**To Reproduce** +Steps to reproduce the behavior: +1. Open `latebound-unknown-member-error.twinproj` (attached as `latebound-unknown-member-error.zip`). Its one source file, `Startup.twin`, holds a class `Widget` with a `Sub Hello()` and a `Sub Main` that calls members through `Object` variables, with `On Error Resume Next`. +2. Run it and read the DEBUG CONSOLE: + ``` + o.Nope -> error -2147352570 (80020006) [Unknown name.] + Collection.Nope -> error -2147352570 (80020006) [Unknown name.] + CallByName o, Nope -> error -2147467259 (80004005) [Unspecified error] + o.Hello (control) -> error 0 (0) [] + ``` + +**Expected behavior** +Error 438 for all three, as in VB6 and VBA. The same cases in a VB6 project (a class, a `Variant` holding it, a `Collection`, a `Scripting.Dictionary`, and `CallByName` on each of them), attached as `latebound-unknown-member-error-vb6.zip`: +``` +o.Nope (class) -> error 438 (1B6) [Object doesn't support this property or method] +v.Nope (class in a Variant) -> error 438 (1B6) [Object doesn't support this property or method] +Collection.Nope -> error 438 (1B6) [Object doesn't support this property or method] +Dictionary.Nope -> error 438 (1B6) [Object doesn't support this property or method] +CallByName class Nope -> error 438 (1B6) [Object doesn't support this property or method] +CallByName Dictionary Nope -> error 438 (1B6) [Object doesn't support this property or method] +CallByName Collection Nope -> error 438 (1B6) [Object doesn't support this property or method] +``` +twinBASIC already maps `DISP_E_MEMBERNOTFOUND` from `Invoke` to 438; `DISP_E_UNKNOWNNAME` from `GetIDsOfNames`, which is the answer for a name the object does not have, should be mapped the same way, and `CallByName` should not turn it into `E_FAIL`. + +**Desktop:** + - OS: Windows 10 Pro 22H2 (build 19045) + - twinBASIC compiler version: BETA 995 + +**Additional context** +Severity: code ported from VB6 or VBA that probes an object for a member with `On Error` and 438 stops working, and the message names a COM code instead of the problem. + +The twinBASIC class's `GetIDsOfNames` itself is right: it returns `DISP_E_UNKNOWNNAME` for a name it does not know, as the contract says; the conversion into a run-time error is what differs. The same `&H80020006` came from a twinBASIC class, a `Collection`, a `Scripting.Dictionary` and a `Scripting.FileSystemObject`, and a `Variant` holding an object; `CallByName` gave `&H80004005` for a twinBASIC class and a `Dictionary`. Other failures are mapped as VB6 does: a call that `Invoke` rejects with `DISP_E_MEMBERNOTFOUND` raises 438, and a `Nothing` object raises 91. + + + +--- + +## Calling a method of `stdole.IDispatch` is a late-bound call by name and fails with &H80020006 + +**Describe the bug** +A variable declared `As stdole.IDispatch` does not call the four `IDispatch` methods through the interface. `d.GetTypeInfoCount count` is compiled as a late-bound call: the compiler accepts any arguments, whatever their number and type, and at run time the call looks `GetTypeInfoCount` up by name in the object, which does not have it, and raises `&H80020006` (*Unknown name.*). With no error handler the error ends the run (in the IDE's run, with no message). A call of `GetTypeInfo`, `GetIDsOfNames` or `Invoke` ends the run the same way when unhandled. Members of the object itself can be called through the variable, as through an `Object`. + +**To Reproduce** +Steps to reproduce the behavior: +1. Open `stdole-idispatch-late-bound.twinproj` (attached as `stdole-idispatch-late-bound.zip`). Its one source file, `Startup.twin`, holds a class `Widget` with a `Sub Hello()` that counts its runs, and: + ``` + Dim w As New Widget + Dim d As stdole.IDispatch = w + On Error Resume Next + d.Hello + d.GetTypeInfoCount count + d.GetTypeInfoCount "a", "b", "c" + d.NoSuchMethod + ``` +2. See no compile error, and this output (each line prints `Err.Number` after the statement): + ``` + d.Hello: error 0, Hello ran 1 time(s) + d.GetTypeInfoCount: error -2147352570 (80020006) Unknown name. + d.GetTypeInfoCount "a", "b", "c": error -2147352570 + d.NoSuchMethod: error -2147352570 + ``` +3. Remove the `On Error Resume Next` line and run again: the output stops at the first `d.GetTypeInfoCount`, and the run ends with no message. + +**Expected behavior** +The call goes through the interface: `GetTypeInfoCount` returns the count (1 for a twinBASIC class), and a wrong number or type of argument is a compile error, as for any other interface method. If `stdole.IDispatch` is meant to be an alias of `Object`, `d.GetTypeInfoCount` should still not compile, or the type should not list four methods that cannot be called. A project's own declaration of the interface, with the same `[InterfaceId]`, calls them correctly. + +**Desktop:** + - OS: Windows 10 Pro 22H2 (build 19045) + - twinBASIC compiler version: BETA 995 + +**Additional context** +Severity: low, since a project can declare its own copy of the interface, but the failure is silent without a handler and the compiler gives no sign that the call is not what it appears to be. + +What was tried: `GetIDsOfNames` and `Invoke` with zero arguments, and `GetTypeInfo` with a null pointer, each end the run the same way; calls with arguments of the wrong type compile (`d.GetTypeInfoCount "a"`, `d.GetTypeInfo "a", "b", "c"`, `d.Invoke "a", "b", "c", "d", "e", "f", "g", "h"` all compile). An unhandled `Err.Raise 5` in the same harness ends the run the same way, so the silent end is how an unhandled error shows there, not a separate fault. Running the built exe with `--exe` was not possible on this machine (the harness could not start it). + + + +--- + +## A twinBASIC class's `GetTypeInfo` with an `iTInfo` of 1 returns E_UNEXPECTED, not DISP_E_BADINDEX + +**Describe the bug** +`IDispatch::GetTypeInfo` on an object of a twinBASIC class returns `E_UNEXPECTED` (`&H8000FFFF`) for any `iTInfo` other than 0. The object's `GetTypeInfoCount` returns 1, so 0 is the only valid index, and the contract gives `DISP_E_BADINDEX` for a bad one. Observed in a run of the reproducer project, calling the method through a project's own declaration of the interface. + +**To Reproduce** +Steps to reproduce the behavior: +1. Open `gettypeinfo-badindex.twinproj` (attached as `gettypeinfo-badindex.zip`). Its one source file, `Startup.twin`, declares a copy of `IDispatch` with the same `[InterfaceId]` (the `stdole` declaration cannot be called), a class `Widget` with one `Sub`, and a `Sub Main` that calls `GetTypeInfoCount` and `GetTypeInfo` on a `Widget` through the copy. +2. Run it and read the DEBUG CONSOLE: + ``` + GetTypeInfoCount = 1 + GetTypeInfo(0): HRESULT 0, pointer returned True + GetTypeInfo(1): HRESULT 8000FFFF, error -2147418113, pointer returned False + GetTypeInfo(2): HRESULT 8000FFFF, error -2147418113, pointer returned False + GetTypeInfo(-1): HRESULT 8000FFFF, error -2147418113 + ``` + +**Expected behavior** +`DISP_E_BADINDEX` (`&H8002000B`), which the `IDispatch::GetTypeInfo` documentation gives for an index that is not valid, for an index the object does not have. `E_UNEXPECTED` (*Catastrophic failure*) is the code for a call made at a time when the object cannot take it, and it reads as a fault in the object. + +**Desktop:** + - OS: Windows 10 Pro 22H2 (build 19045) + - twinBASIC compiler version: BETA 995 + +**Additional context** +Severity: minor. A caller that checks for `DISP_E_BADINDEX` to learn that an object has no more type information gets a different code; `GetTypeInfo(0)` and `GetTypeInfoCount` are right. + + + +--- + +## `Err.Raise` without a source or a description leaves `Source` empty, and the defaults are not VBA's + +**Describe the bug** +`Err.Raise` called with only a number leaves `Err.Source` empty, where VBA and VB6 set it to the name of the project. It gives `Err.Description` an empty string for numbers such as 1, 95, 99 and 513, where VBA gives `Application-defined or object-defined error`, and `Automation error` for numbers from 1000 up, where VBA gives the same generic text. And an omitted argument no longer keeps the value an earlier `Err.Raise` left, which VBA-Docs describes for `Raise`. Observed in a run of the reproducer project, in the IDE and in a built exe alike. + +**To Reproduce** +Steps to reproduce the behavior: +1. Open `err-raise-defaults.twinproj` (attached as `err-raise-defaults.zip`) and run it (F5). Its `Sub Main` raises with `On Error Resume Next` and prints `[Err.Source] [Err.Description]` after each call, calling `Err.Clear` first except in the last case: + ``` + Err.Raise 5 + Err.Raise 1 + Err.Raise 513 + Err.Raise 1000 + Err.Raise 1000, "A.Src", "B desc" + Err.Raise 5 + ``` +2. See, beside what the same program prints when built in VB6 (the VB6 project is attached as `err-raise-defaults-vb6.zip`): + + | call | twinBASIC | VB6 | + |---|---|---| + | `Err.Raise 5` | `[] [Invalid procedure call or argument]` | `[Probe] [Invalid procedure call or argument]` | + | `Err.Raise 1` | `[] []` | `[Probe] [Application-defined or object-defined error]` | + | `Err.Raise 513` | `[] []` | `[Probe] [Application-defined or object-defined error]` | + | `Err.Raise 1000` | `[] [Automation error]` | `[Probe] [Application-defined or object-defined error]` | + | `Err.Raise 5` after a full `Err.Raise 1000, "A.Src", "B desc"`, no `Err.Clear` between | `[] [Invalid procedure call or argument]` | `[A.Src] [B desc]` | + + The rule for the description, from a sweep of every number from 0 to 65537: a number with a built-in message (5, 11, 13 and 84 others, the ones `Error$` knows) gets that message, as in VBA. A number from 1 to 746 without one gets an empty string. A number from 747 up gets the Windows system message for that number when there is one (1001 gives `Recursion too deep; the stack overflowed.`, 15861 a licensing message) and `Automation error` when there is none. A negative number is looked up as an `HRESULT` the same way (`vbObjectError + 1` gives `Invalid advise flags`, `vbObjectError + 513` gives `An event was unable to invoke any of the subscribers`, `vbObjectError + 1000` gives `Automation error`). `Error$(n)` and the `Error n` statement give VBA's generic text for all of these. + +**Expected behavior** +What VBA-Docs states for `Err.Raise`, which VB6 does as well: `Source` is the programmatic ID of the project when *source* is omitted; *description* is the message of the built-in error, or `Application-defined or object-defined error` when there is none; and an omitted argument is taken from the properties of `Err` when they still hold an earlier error's values. A program that reads `Err.Source` to find where an error came from, or tests `Err.Description <> ""`, behaves differently without any diagnostic. + +**Desktop:** + - OS: Windows 10 Pro 22H2 (build 19045) + - twinBASIC compiler version: BETA 995 + +**Additional context** +Severity: low for a program that passes all the arguments; for one that does not, `Err.Source` and `Err.Description` are not what the VBA code it was ported from expects. The result is the same for an error raised in a method of a class and read by its caller, apart from an empty description, which arrives as `Application-defined or object-defined error` there. It is also the same in a built exe. + +Related and also different from VB6: `Err.Raise 65536` is accepted, and `Err.Number` is 65536, where VB6 raises error 5. `Err.Raise 0` raises error 5 in both. An explicit empty string for the source or the description gives an empty `Source` or `Description`, in VB6 as well. `Err.HelpContext` is 0 in twinBASIC, and VB6 sets it to 1000000 plus the number for a `Raise` without one (`1000005` for 5). + + + +--- + +## The error information twinBASIC leaves in the thread's slot reads from `Err` as it is later, and stays there after the error is handled + +**Describe the bug** +After an `Err.Raise` that is handled, the calling thread's `IErrorInfo` slot holds one object that reads its five values from `Err` each time a method of it is called, and nothing takes it out of the slot. After `Err.Clear` it returns empty strings, and after the next `Err.Raise` it returns the new error's values, where the COM contract has an `IErrorInfo` keep what was stored in it. And `GetErrorInfo` finds the object even when the error was handled in twinBASIC code that never reads the slot, where it should find the slot empty, so a later failure that carries no error information is described by whatever `Err` holds at that moment. Observed in a run of the reproducer project, which uses no class and no interface for the first symptom. + +**To Reproduce** +Steps to reproduce the behavior: +1. Open `err-info-live-view.twinproj` (attached as `err-info-live-view.zip`) and run it (F5). It declares `IErrorInfo` and `GetErrorInfo` and, under `On Error Resume Next`, prints: + ``` + read at once: [My.Source] [My description] + after Err.Clear: [] [] + Err after the call: -2147220270 [My description] + slot afterwards: [My.Source] [My description] + E_FAIL after the cleared error: -2147467259 [Unspecified error] + E_FAIL, slot emptied first: -2147467259 [Automation error] + ``` +2. The first two lines come from `Err.Raise vbObjectError + 1234, "My.Source", "My description"`, then `GetErrorInfo 0, info`, one read of `info.GetSource()` and `info.GetDescription()`, then `Err.Clear` and a second read of the same `info`. The second read returns empty strings. +3. The third and fourth lines: a method of a class, called through an interface, raises the same error; the caller handles it and reads `Err`, then calls `GetErrorInfo`. It returns an object, with the values `Err` holds, although the caller already has the error in `Err` and nothing should be left to read (a second `GetErrorInfo` then returns `S_FALSE`). +4. The last two lines: a method that fails with `Err.ReturnHResult = &H80004005` and sets no error information. When the call comes after a raised error that the program has cleared with `Err.Clear`, `Err.Description` is `Unspecified error`, the system text for an empty description; after the slot has been emptied with `GetErrorInfo`, it is `Automation error`, the text twinBASIC uses for a failure that carries no information. + +**Expected behavior** +`IErrorInfo` holds the values it was given, as an object made with `CreateErrorInfo` does: a read after `Err.Clear` or after another error returns the first error's source and description. A handled error leaves the slot empty, as in VB6 (the same sequence, with an `Err.Raise 5` handled in the procedure, and with a raise in a class method handled by the caller, finds `GetErrorInfo` returning `S_FALSE` and no object), so that `Err.Description` of a later failure does not depend on what ran before. The failure with no information should always give the same description. The VB6 project is attached as `err-info-live-view-vb6.zip`; it prints `empty (GetErrorInfo 1)` for the slot on a fresh thread, after an `Err.Raise 5` handled in the procedure, after a class method that raised an error the caller handled (`Err` then holds `-2147220270 [Something failed on purpose] [Probe.Subject]`), and after a class method that handled its own error. + +**Desktop:** + - OS: Windows 10 Pro 22H2 (build 19045) + - twinBASIC compiler version: BETA 995 + +**Additional context** +The two symptoms are one bug because the object is the same: `ObjPtr` of what `GetErrorInfo` returns is identical after an `Err.Raise` handled in the same procedure, after a failed call through an interface, after a failure with `SetErrorInfo` plus `Err.ReturnHResult`, and after a call that handled its own error, and it is not `Err` itself. One object, installed in the slot whenever an error occurs or a failure is processed and reading `Err`, accounts for both. They can be fixed apart: a snapshot object would fix the first, and withdrawing the object once the error is delivered, the second. + +What does not reproduce it: a fresh thread (`GetErrorInfo` returns `S_FALSE`); a caller that makes the call through an interface whose methods are declared `[PreserveSig]` and reads the slot itself, where the first `GetErrorInfo` returns the values and the second returns `S_FALSE`; the second `GetErrorInfo` after the object has been read from the slot (it returns `S_FALSE`, so `GetErrorInfo` does empty the slot). +Severity: low. The slot is not a documented twinBASIC interface, but a program that reads error information with the COM functions, or a library that does, sees values that change under it, and a program cannot rely on the description of a failure that came with no error information. + + + +--- + +## `IConnectionPoint.Advise(Nothing)` on a twinBASIC class's connection point ends in an access violation + +**Describe the bug** +A class that declares an `Event` is a connectable object, and its connection point is reached through `IConnectionPointContainer`. Calling `Advise` on that connection point with a null sink raises a native `ACCESS_VIOLATION` and ends the run, instead of returning an error. It is the same crash whether the argument is `Nothing` or an unassigned `stdole.IUnknown` variable. + +**To Reproduce** +Steps to reproduce the behavior: +1. Open `advise-nothing-crashes.twinproj` (attached as `advise-nothing-crashes.zip`). Its one source file, `Startup.twin`, declares the project's own copies of `IConnectionPointContainer`, `IEnumConnectionPoints` and `IConnectionPoint` (`stdole` has none of them), a class with one event, and this: + ``` + Private Class Source + Public Event Ping() + End Class + + Public Sub Main() + Dim src As New Source + Dim container As IConnectionPointContainer = src + Dim points As IEnumConnectionPoints = container.EnumConnectionPoints() + Dim point As IConnectionPoint, fetched As Long + points.Next 1, point, fetched + Debug.Print "before" + Dim cookie As Long = point.Advise(Nothing) + Debug.Print "after " & cookie End Sub ``` -2. Run the project (F5). -3. See `NavigationStarting about:blank` in the DEBUG CONSOLE, and then `NATIVE EXCEPTION: ACCESS_VIOLATION /WebView2HeadersCollection.twin; WebView2HeadersCollection.Next`. `after For Each` is never printed. +2. Run the project in the IDE (F5). +3. See `before` in the DEBUG CONSOLE, and then `NATIVE EXCEPTION: ACCESS_VIOLATION /Startup.twin; Startup.Main LINE 000033 [...twinBASIC_win32.dll+00389F3E]`. `after` is never printed. **Expected behavior** -`For Each` yields each header, and the loop ends. The package's documentation shows this loop in a `NavigationStarting` handler. `Next` should assign to `pCeltFetched` only when its address is not zero, for example `If VarPtr(pCeltFetched) <> 0 Then pCeltFetched = 1`, in both places it assigns it. +`Advise` returns `E_POINTER`, which twinBASIC raises as run-time error `&H80004003` that `On Error` can handle. The Windows SDK page for [IConnectionPoint::Advise](https://learn.microsoft.com/en-us/windows/win32/api/ocidl/nf-ocidl-iconnectionpoint-advise) lists `E_POINTER` for "The value in *pUnkSink* or *pdwCookie* is not valid. For example, either pointer may be **NULL**." **Desktop:** - OS: Windows 10 Pro 22H2 (build 19045) - twinBASIC compiler version: BETA 995 **Additional context** -Severity: medium; `For Each` is the documented way to read the headers, and it ends the program. Without the `For Each`, the same project navigates, closes the form and returns. The same project crashes the same way on BETA 983. Calling `Next` directly, through a copy of `IEnumVARIANT` with a variable for `pCeltFetched`, returns the headers and then the end; the crash needs the null pointer that `For Each` passes. The same null `pCeltFetched` from `For Each` was measured with an enumerator written in a project: an unguarded assignment fails with an access violation there too. `Reset`, which `For Each` calls first, returns `E_NOTIMPL` here, and `For Each` goes on to call `Next` regardless. +Severity: low in practice, since a program rarely advises a null sink, but a COM client written in any language can send one, and the connection point crashes the process that hosts the class instead of refusing the call. + +What was tried: an object that is not a sink gives an ordinary error (`E_NOINTERFACE`, `&H80004002`, see the entry about `Advise` and `Unadvise` error codes), so only a null pointer crashes. The address of the crash is the same in the standalone probe and in this project. + + + +--- + +## `Advise` with a sink that lacks the outgoing interface fails with `E_NOINTERFACE`, and `Unadvise` with a cookie that names no connection succeeds + +**Describe the bug** +On the connection point of a twinBASIC class that has an `Event`, two calls return a different code from the one the COM contract names. `Advise` with a sink that does not answer `QueryInterface` for the outgoing interface fails with `E_NOINTERFACE` (`&H80004002`), where the contract returns `CONNECT_E_CANNOTCONNECT` (`&H80040201`). `Unadvise` with a cookie that names no connection (0 and 99 were tried) succeeds silently and does nothing, where the contract returns an error. + +**To Reproduce** +Steps to reproduce the behavior: +1. Open `advise-unadvise-hresults.twinproj` (attached as `advise-unadvise-hresults.zip`). Its one source file, `Startup.twin`, declares the project's own copies of the connection-point interfaces (`stdole` has none of them), a class `Source` with one event, and a class `NotASink` with one field. `Sub Main` runs, with `On Error Resume Next`: + ``` + cookie = point.Advise(sink) ' sink is a NotASink + point.Unadvise 0 + point.Unadvise 99 + ``` +2. Run the project in the IDE (F5). +3. See in the DEBUG CONSOLE: + ``` + Advise, a sink without the outgoing interface: error=80004002 + Unadvise 0: error=0 + Unadvise 99: error=0 + ``` + +**Expected behavior** +`Advise` fails with `CONNECT_E_CANNOTCONNECT`. The Windows SDK page for [IConnectionPoint::Advise](https://learn.microsoft.com/en-us/windows/win32/api/ocidl/nf-ocidl-iconnectionpoint-advise) lists it as "The sink does not support the interface required by this connection point", and says to implementers: "The connection point must query the *pUnkSink* pointer for the correct outgoing interface. If this query fails, this method must return CONNECT_E_CANNOTCONNECT." `Unadvise` reports the bad cookie: the page for [IConnectionPoint::Unadvise](https://learn.microsoft.com/en-us/windows/win32/api/ocidl/nf-ocidl-iconnectionpoint-unadvise) lists `E_POINTER` for "The value in *dwCookie* does not represent a valid connection". It is not `S_OK`. + +**Desktop:** + - OS: Windows 10 Pro 22H2 (build 19045) + - twinBASIC compiler version: BETA 995 + +**Additional context** +Severity: low. A client that tests for `CONNECT_E_CANNOTCONNECT` to tell a refused sink from other failures never sees it, and a client that releases a connection twice, or with a wrong cookie, is told it worked. + +What was tried: a sink that is an ordinary twinBASIC class gives the same `E_NOINTERFACE` whether it has no members or implements `IDispatch` (the outgoing interface's identifier is generated for each build, so a twinBASIC class cannot answer for it). Nothing is connected afterwards, and no event reaches the sink. Calling `Unadvise` a second time with the cookie of the failed `Advise`, which is 0, also returns without an error. + + +--- + +## `New` on an `Interface` compiles, and a call on the object returns a default value, or ends in an access violation for an inherited member + +**Describe the bug** +`New` is accepted on an `Interface`, although no class exists for it, and the statement returns an object that is not `Nothing` and has no implementation behind its members. A call on a member the interface declares itself returns the default for its type (0 for a `Long`, an empty string, `Nothing` for an interface) and raises no error. A call on a member the interface inherits from another `Interface` ends the run with a native `ACCESS_VIOLATION`. `New stdole.IUnknown` and `New stdole.IDispatch` are refused with TB5074 (*Class construction expected class datatype*), so the check exists for an interface from a type library, and is missing for one declared in twinBASIC source, in a project or a package. Observed in a run of the reproducer project; found with `ErrorContext` of the VBRUN package, an interface with no class, and `ErrorCallstack` does the same. + +**To Reproduce** +Steps to reproduce the behavior: +1. Open `new-on-interface.twinproj` (attached as `new-on-interface.zip`). Its one source file, `Startup.twin`, declares `Interface IParent` with one `Function F() As Long` and `Interface IChild Extends IParent` with one `Function G() As Long`, and a `Sub Main` that constructs `New IParent`, `New ErrorContext` and `New IChild` and calls their members. +2. Run it (F5) and read the DEBUG CONSOLE: + ``` + IParent: Nothing? False, F() = 0 + ErrorContext: Unknown, Number = 0, Callstack Nothing? True + IChild.G() = 0 + IChild.F(), inherited, next + NATIVE EXCEPTION: ACCESS_VIOLATION /Startup.twin; Startup.Main LINE 000029 [$00000000] + ``` + The project compiles without a diagnostic. `ObjPtr` of each object is not 0. `ErrorContext.Number` and `.State` read 0, `.Description` and `.Source` read an empty string, and `.Callstack` is `Nothing`, so `e.Callstack.Count` raises error 91, as any call on `Nothing` does. That error 91 is not a second defect: an unhandled one ends a run, as it does for a `Collection` variable that is `Nothing`, and under `On Error Resume Next` it skips the statement. + +**Expected behavior** +A compile error, TB5074, for `New` on any `Interface`, as for `stdole.IUnknown`: an interface is a contract, and `New` needs a class that implements it. If an object is built nevertheless, a call on any of its members should behave the same way, not return a default for one member and crash on another. Code written against the VBRUN documentation, which lists `ErrorContext` with its members, compiles and then reads zeros, where a refusal would say at once that nothing can create the object. + +**Desktop:** + - OS: Windows 10 Pro 22H2 (build 19045) + - twinBASIC compiler version: BETA 995 + +**Additional context** +Severity: low in practice, since few programs write `New` on an interface, but it is a compile-time check that is missing, and the result is a silent wrong value or a crash. + +What was tried, each in a project of its own: `New` is accepted on an interface declared with `Extends stdole.IUnknown`, with no `Extends`, with `Extends stdole.IDispatch`, with `Extends` another interface of the project, and on a `Private` one, and `Dim x As New IFoo` is accepted as well. `TypeName` gives `Unknown` for an interface that extends `stdole.IUnknown` (and for `ErrorContext` and `ErrorCallstack`), and the interface's own name for one with no `Extends` or with `Extends stdole.IDispatch`. A `String` member returns an empty string, a `Property Get` returns 0, a `Sub` returns without a sign, and a member returning the interface itself returns `Nothing`. Only inherited members crash. `New stdole.IUnknown` and `New stdole.IDispatch` are refused. The same results on BETA 983. + +VB6 has no comparison: a project cannot declare an `Interface`, and the interfaces of the type libraries it references (`stdole.IUnknown`, `IPictureDisp`, `IFontDisp`) are hidden from it (*User-defined type not defined*). + + - diff --git a/WIP.ExamplesBuild.md b/WIP.ExamplesBuild.md index 6bb076b4..f2b282df 100644 --- a/WIP.ExamplesBuild.md +++ b/WIP.ExamplesBuild.md @@ -40,7 +40,7 @@ and in a bare twinBASIC project that line does not compile at all. Stated first, because it is the constraint everything else bends around. -- **Cost.** An IDE cold start is 8--11 s per project and flat in project size (WIP.md, +- **Cost.** An IDE cold start is 6--8 s per project and flat in project size (WIP.md, measured). A normal `build.bat` is ~4 s. - **`npm install` must remain sufficient** to build the docs. A twinBASIC install is not on that path, and `dot.mjs`'s setup-failure behaviour exists to preserve exactly that. @@ -362,7 +362,7 @@ produces a green run whose samples were compiled apart. **The residual is stated rather than closed:** two *ungrouped* samples still share a project and can still see each other. Nothing in twinBASIC hides a module's public members -from the rest of a project, so the only complete fix is a project per sample, at 8--11 s +from the rest of a project, so the only complete fix is a project per sample, at 6--8 s each. What removes the risk where it matters is that a real dependency is now written down. Collision rules, all forced by putting unrelated samples in one compilation unit: @@ -402,6 +402,33 @@ only by an error the callee did not handle (measured: `InStr(0, "abc", "a")` unh sample's body printed `[tbx-run] error 5 Invalid procedure call or argument`, and the next sample ran), and `Resume tbxNext` clears it before the next call. +**`node scripts/vb6run.mjs --docs` compares the same fences with VB6.** It reads the +`check_run` fences through `collectFences` and `joinConcatGroups`, refuses them with +`runRefusal`, and judges what VB6 prints with `expectedOutput` and `judgeOutput`, so the +comparison is the one `check_run` makes, against a second implementation. A fence of a +`projname=` group is built as a project of its own (class and module names collide between +groups, so groups are never batched together): the group's other fences, gathered by name as +`checkGroups` gathers them, are its files, each `slot=file` fence translated into VB6 +components by `translateTwinFile` --- every `Class` block a `.cls` with VB6's class header, +every `Module` block a `.bas`, and what is outside both one more `.bas` --- and each run +fence is a module in it. Nothing else is translated: an `Interface`, an attribute line or a +generic stays where it is and VB6 refuses it, so a group whose files do not build ends with +every run fence `not VB6`, at the first error's page line. Each component keeps the fence's +line numbers, with the other components' lines blank, and a class's line is the file's less +two as a module's is (checked against a real error in a class, a module and the top level). +The dispatcher opens the output file before each sample and closes it after, so +`Class_Terminate` of an object released when the sample's `Sub` ends prints into it. Most +twinBASIC syntax is not VB6, and a compile error there is the state `not VB6`, which is +information; a `differs` is what the tool is for. What building in VB6 taught +(`scripts/lib/vb6.mjs`, which has the list): `Debug.Print` writes nothing in a compiled exe, +so each one is rewritten to `Print #511,`, and the comma stays on a bare `Debug.Print` +because `Print #511` without it is a syntax error; the project is built with +`Unattended=-1` so that a box VB6 would show goes to the event log; VB6 numbers a module's +lines from 0 and not counting `Attribute` lines, so a compile error's line is the file's +less two; and `Err.Source` of an error raised in the exe is the project name, which is why +`ErrObject/Raise.md` differs. `Close` with no argument in a sample also closes the file the +output goes to, so the sample's next `Debug.Print` raises error 52. + Two things a batch runner must do that a single-fence runner need not: - **Keep a source map.** Errors return against a generated file and line; the report names @@ -420,7 +447,8 @@ Two things a batch runner must do that a single-fence runner need not: the whole bisect. - **A batch that reports nothing is not a clean batch: a canary rides in every one.** `waitForCompile` reads the IDE's window --- the status counters and the Problems panel of - the open project --- once the compiler status is OPERATIONAL and five one-second samples + the open project --- once the compiler status is OPERATIONAL and either the page's traffic + shows the compile has ended and the window agrees with it, or five one-second samples match. It waits for no build. An IDE under load can sit OPERATIONAL with an empty panel before it has published anything, and every sample of that batch then reads as compiling, with nothing to tell it from a batch that has no errors. `sweep_attributes` met it first, diff --git a/WIP.Harness.md b/WIP.Harness.md index 2caaaada..8a5e4d5f 100644 --- a/WIP.Harness.md +++ b/WIP.Harness.md @@ -252,6 +252,47 @@ The CDP client is [scripts/lib/tb-cdp.mjs](scripts/lib/tb-cdp.mjs) --- raw rathe puppeteer, because a pending `alert()` blocks the renderer and puppeteer's `connect()` handshake talks to the renderer, so it hangs on precisely the state you need to recover from. +**How the wait for the compile ends.** Nothing in the IDE's window says that a compile has +finished. So the harness used to wait for the window --- the compiler's status, the four +counters and the Problems panel --- to read OPERATIONAL and stand still for five seconds, +and those five seconds were nearly half of a `tbbuild` run. It now also watches the IDE +page's own traffic through CDP, and stops once that traffic shows the compile has ended and +the window agrees with it: the same four counts, and a row in the panel for each. Three rules +keep that from ending a wait too soon: + +- a compile that had already ended when the wait began does not count, so a wait that follows + an Apply or an edit takes the compile after it, not the one before; +- a compile is believed only once it has been the latest for 300 ms, because every keystroke + starts a compile of its own; +- a compile from before the compiler restarted --- after a crash, a change of target or the + restart button --- never counts. + +A project whose traffic never shows a compile ending falls back to the five-second rule, and +so does a page that a dialog has blocked. The reproducer `interface-extends-itself` is one +such project: its compiler never reports a result at all. + +**The new wait was checked against the five-second rule** on the install's 32 samples and +templates, with and without `--arch win64`; on the 26 of them that build without registering +anything, with `--build` and with `--llvm`; on the 44 projects under `bugs/`; and through +`bug_repro verify`, `examples.bat`, `addin-test.bat` and `ide-test.bat`, run from two +checkouts. Apart from the two differences below, which were not the wait's doing, every exit +code, count, diagnostic row and build result was the same, and no add-in wrote to the DEBUG +CONSOLE in the three seconds after any wait of the add-in or IDE lanes ended. Each project +takes about five seconds less: `tbbuild` on a one-file template went from 11 s to 6 s, and a +full `examples.bat` from about 125 s to about 80 s (BETA 995). + +The two differences: + +- **`--llvm`, four projects at a time, left 4 of 52 builds hanging** --- three under the new + wait, one under the old: each build started and then reported nothing for 120 s. One at a + time, the same four built on both sides, twice. `examples.bat` already builds a failed batch + a second time for this reason; `tbbuild` does not. +- **The `assert` lane of `ide-test.bat` failed all three times under the old code**, and + passes under the new code only by chance. The IDE ignores a click on the error panel's Stop + that comes as soon as the panel is drawn, though the click hits the button; a second later + it works. The new code passes with its early end switched off too, so it is watching the + page's traffic, not the wait, that moves the click late enough. + **The mechanics are one library, [scripts/lib/tb-ide.mjs](scripts/lib/tb-ide.mjs)**: starting the IDE, attaching, waiting for the compile, reading the diagnostics and the DEBUG CONSOLE, clicking, building, and ending the process tree. `tbbuild` and `tbrun` are command lines @@ -417,27 +458,24 @@ The IDE is three processes, and their command lines say how they relate: |---|---|---| | `twinBASIC.exe` | `` | shell; hosts the WebView2, and the only one given the project | | `twinBASIC_win32.exe` | `--ide=` | serves `ide/` over HTTP on an ephemeral port | -| `twinBASIC_win32_noDEP.exe` | `--compiler=` | the compiler; opens six websocket ports | - -The page reaches the compiler at -`ws://localhost://{root,language,fs,debugger}`, and `language` really is LSP ---- it pushes `textDocument/publishDiagnostics` with per-file `diagnostics` and error, -warning, hint and info counts, alongside a `compilationStarted` event. - -**But the port and the pass key are both minted inside the WebView.** -`hostAppObject.CreateCompilerInstance(...)` returns the port, `GetCompilerPassKey(...)` -returns a GUID, and both are WebView2 host objects --- reachable only from a page the shell -has loaded. Starting the compiler directly is no way round it either: `--compiler=` is not a -port but an opaque handle the shell hands it (`8591158` in one run, against compiler ports -`61917-61922`). So a proxy between the WebView and the HTTP server is possible --- the page -and its scripts come over plain HTTP, and a patched `main2.js` could be served --- but it -would not remove the WebView, it would only change what runs inside it. The thing you would -want to delete is the thing that mints the connection. - -What the websockets *would* be good for, once an IDE is up, is replacing the poll-for-DOM- -stability heuristic with `compilationStarted` plus a quiet period of `publishDiagnostics`, -and taking structured diagnostics instead of scraped text. That is a robustness change, not -a speed one, and the current reader is the IDE's own report walk, so it is not urgent. +| `twinBASIC_win32_noDEP.exe` | `--compiler=` | the compiler; the page talks to it over websockets | + +The page's websockets carry everything the window shows about a compile, the diagnostics and +their counts included. + +**But what a connection needs, its address and its key, is minted inside the WebView**, by +host objects the shell gives its page --- reachable only from a page the shell has loaded. +Starting the compiler directly is no way round it either: `--compiler=` is not a port but +an opaque handle the shell hands it. So a proxy between the WebView and the HTTP server is +possible --- the page and its scripts come over plain HTTP, and a patched `main2.js` could +be served --- but it would not remove the WebView, it would only change what runs inside it. +The thing you would want to delete is the thing that mints the connection. + +Watching the page's traffic is another matter: CDP shows it to the harness with no key, and +the wait for a compile now ends on it (*How the wait for the compile ends*, above) instead of +five seconds after the window stops changing. This paragraph once called that a robustness +change rather than a speed one. It was both: those five seconds were nearly half of every +run. The diagnostics still come from the IDE's own report walk. ### One project per IDE, and that is the scaling unit @@ -450,11 +488,13 @@ project at a time and closing the previous one is part of that path. So the cold start is not overhead to be optimised away; it is the unit of work. `tbbuild` starting a fresh IDE per project is the design, not a convenience. -**It costs less than it sounds like.** Measured on this box: **8 to 11 seconds per project, -and flat in project size** --- a one-file project and the 32-probe exploratory project both -land at about ten seconds, because what is being paid for is IDE startup and not -compilation. That number was once guessed at "roughly 40 seconds" and is out by a factor -of four: time it before quoting it. +**It costs less than it sounds like.** Measured on this box: **6 to 8 seconds per project, +and flat in project size** --- a one-file template and the template that carries the whole +of VBCCR both land at about six seconds, because what is being paid for is IDE startup and +not compilation. It was 8 to 11 seconds while the wait for the compile ended five seconds +after the window stopped changing (*How the wait for the compile ends*, above). It was once +guessed at "roughly 40 seconds", out by a factor of four even then: time it before quoting +it. **Concurrency works and is the route to a fast probe suite.** Distinct `--port` values give distinct DevTools ports, WebView2 user-data folders, temp folders and private desktops, so instances do @@ -900,9 +940,9 @@ IDE has gone, and the first delete failed. `removeTree` in `tb-ide-copy.mjs` ret to five seconds, and `removeIdeCopy` and the add-in runner both use it. **`loadedAddins(c)`** in `tb-ide-addins.mjs` is the check that the copy is what it claims to be. -It asks the page's `root.getAddinsList`, which asks the compiler over its root socket -(`RequestAddinsStateList`), so the answer is the compiler's own, not an inference from files -on disk. It is the same list the Add-Ins menu shows. +It asks the page's `root.getAddinsList`, which asks the compiler, so the answer is the +compiler's own, not an inference from files on disk. It is the same list the Add-Ins menu +shows. ## The IDE runs inside a job @@ -1062,7 +1102,7 @@ view draws only the rows that fit, and a tool window is a shadow root that `document.querySelector` cannot see into, so the calls read `toolWindowsById`, a list view's `dataNodes` and `window.editor` rather than what is drawn. -Seven things about it were learned, the first six on the samples: +Eight things about it were learned, the first six on the samples: - **A click scrolls its target into view, and checks what is at the point before it clicks.** Sample 10's tool window is taller than it is shown. Its eleventh button had a @@ -1070,7 +1110,11 @@ Seven things about it were learned, the first six on the samples: went to the window's resize handle and did nothing. `click` now calls `scrollIntoView`, finds the element at the centre point through every shadow root, and throws, naming both, when something else is there. It also throws when there is no such element, or the - element has no size, which is what a hidden tool window's elements have. + element has no size, which is what a hidden tool window's elements have. It scrolls only + a target that is partly hidden --- outside the viewport, or clipped by an ancestor --- or + whose centre is covered: scrolling every target to the centre, as it first did, scrolled + whatever held a target in full view, and in the code editor each click on the error panel + scrolled the code, by 110 to 158 px. - **A click waits for its target, up to five seconds.** What an add-in adds is in the page's data a moment before it is drawn. The first run of the Sample 15 scenario waited until the results list held both files' results, read from the list view's data, and clicked a @@ -1116,6 +1160,23 @@ Seven things about it were learned, the first six on the samples: at 3:1. When the IDE is still revealing lines 10 s later, `openFile`, `setCursor` and `select` throw, naming the file and the place, rather than go on while the cursor can still move; `afterReveal` itself returns `false`. The IDE's side of it is in BUGS-TO-REPORT.md. +- **A click checks where its press lands** (learned on the `assert` lane of + `ide-test.bat`). The page can change between the call that aims and the press, a few + milliseconds to a hundred later on a busy page. In an editor the debugger has just + opened, the error panel goes on moving after it is drawn: the file's decorations bring + code lenses above the failing line and push it down 48 px. The test clicked Stop as soon + as the panel was there, the press landed on the panel's header, and the run went on, which + looked for a long time like the IDE ignoring the click. So the call that aims also puts a + one-shot `pointerdown` listener on the window, in the capture phase, which records the + element the press lands on before the page's own handlers on it run, and `click` throws, + naming that element, when it is not in the target. A press in what the target's selector + finds by then also counts, so a target the page draws again in place is still hit. The + release is not checked, because a control may act on the press and close before it. A + press a window listener of the page's own stops first is not seen, and not reported. + Checked in a plain Chromium page through puppeteer: a target moved before the press + throws, naming what took its place, and one drawn again in place, one in a shadow root + and a double click do not. The `assert` lane itself now waits for the panel to stop + moving (`panelStill` in `test/ide/assert.test.mjs`). **The connection itself changed in three ways.** They were the gaps item 1 found in `tbbuild`, and they matter more once a harness clicks into dialogs on purpose: @@ -1296,11 +1357,11 @@ probe lanes: which turn out to be one window, as P9's lane first suggested. - [test/addin/symbols.test.mjs](test/addin/symbols.test.mjs), P5: no add-in. It opens the project in [test/addin/probes/symbols](test/addin/probes/symbols), which references tbIDE - and is never built, and asks the compiler's language socket about names in it: hover, - Go To Definition, signature help and a completion's details, each with the parameters the - IDE's own code sends. `lspSocket.request` answers through a callback, so each question is - one `Runtime.evaluate` of a promise. Positions are found in the source by text, so an edit - to the probe project does not shift them. + and is never built, and asks the compiler about names in it the way the IDE's own code + does: hover, Go To Definition, signature help and a completion's details, each with the + parameters the IDE's own code sends. The page's call answers through a callback, so each + question is one `Runtime.evaluate` of a promise. Positions are found in the source by + text, so an edit to the probe project does not shift them. - [test/addin/ideserver.test.mjs](test/addin/ideserver.test.mjs), P13: no add-in either. It writes fifteen files under `ide\p13\` in the lane's copy before the IDE starts, and one more after, then fetches each from the page, relative to its base URL, and compares a diff --git a/WIP.HelpAddin.md b/WIP.HelpAddin.md index 87ff1b78..aeaa01a3 100644 --- a/WIP.HelpAddin.md +++ b/WIP.HelpAddin.md @@ -69,8 +69,8 @@ the compiler what a symbol is.** Each of those gaps shapes a stage below. (`main.js@961019`) the text `%APPDATA%\twinBASIC`, which the host expands in the IDE's own environment, creates `packages`, `themes`, `locale`, `addins\win32` and `addins\win64` in, and returns. The page keeps the path as `commonFolderRootPath` and - sends it with `RequestStartCompiler` and `RequestLoadAddins` (`main.js@1047705` and - `@1048667`). Measured on BETA 983 and 995 by + passes it to the compiler when it starts it and when it asks it to load the add-ins + (`main.js@1047705` and `@1048667`). Measured on BETA 983 and 995 by [test/addin/appdata.test.mjs](test/addin/appdata.test.mjs), with a probe add-in that prints the file it was loaded from: an IDE started with `APPDATA` naming a folder of the lane's own loaded the probe from `\twinBASIC\addins\win32`, and not a second @@ -101,8 +101,8 @@ the compiler what a symbol is.** Each of those gaps shapes a stage below. add-in in `addins\win64`: `[InFolder_win64.dll] Failed to load addin. LoadLibrary() failed.` **An add-in that failed to load is still in the compiler's list**, as `Unknown Addin`, so a test looks for the name it expects rather than counting. -- **Holding Shift while a project opens skips the add-ins.** The page sends - `RequestLoadAddins` only when `shiftKeyDown` is false, and otherwise writes `[IDE] SHIFT +- **Holding Shift while a project opens skips the add-ins.** The page asks the compiler to + load them only when `shiftKeyDown` is false, and otherwise writes `[IDE] SHIFT KEY DETECTED: DISABLED LOADING OF ADDINS` to the DEBUG CONSOLE (`main.js@1048443`). `shiftKeyDown` follows the keymap's `tbMisc_ShiftKeyStateDown` and `...Up` actions, so a test that presses Shift must not do it while a project is opening. @@ -273,8 +273,8 @@ Read at `main.js@1002292` (`toolWindowElementAddChild`) and `@1005960` match. Text from a file or the user must be escaped before it goes into such HTML; the published HtmlElementProperties page says so. - **Events.** A name the element has as a property or as `on` gets a real - `addEventListener`, and a copy of the event goes back to the add-in over the compiler's - root socket, with `target` reduced to `{id, value}` (`copyEvent`). Any other name is + `addEventListener`, and a copy of the event goes back to the add-in through the + compiler, with `target` reduced to its `id` and `value` (`copyEvent`). Any other name is stored as a function on the element, or on the object at the end of the property path, under that name (`toolWindowElementSetPropertyCallback`) --- that function is what `raiseEvent` calls. `raiseEvent` climbs `parentNode` to the first node with a @@ -345,9 +345,9 @@ BETA 983 and 995)**, measured by [test/addin/ideserver.test.mjs](test/addin/ides with files put in a lane's copy of the install: - The server is the page server, `bin\twinBASIC_win32.exe --ide=`, not the compiler: - it was the process listening on the page's port. The page is - `http://localhost://main.htm` with ``, the - passkey a GUID, and a relative URL is a path under `ide\`. + it was the process listening on the page's port. The page's URL starts its path with a + key the IDE makes for the run, a GUID, and the page's base URL points there, so a + relative URL is a path under `ide\`. - Fifteen files of the kinds the offline site is made of came back byte for byte: pages, stylesheets, scripts, images and fonts, in folders two deep, a name with a space in it, 4 MB of JavaScript, and a file written after the IDE had started. A frame given the @@ -357,7 +357,7 @@ with files put in a lane's copy of the install: query on this route; a fragment is not sent, and does no harm. `.html`, `.json`, `.jpg`, `.woff2`, `.mjs` and `.txt` come with no `Content-Type` --- the browser sniffs the page and it renders --- while `.htm`, `.css`, `.js`, `.svg`, `.png` and `.gif` get the usual - types. A folder is not a page, and nothing is served without the passkey. + types. A folder is not a page, and nothing is served without the key. - **A page served this way is on the IDE page's own origin**, so its script can reach the IDE's internals: the framed page read `typeof parent.openEditors` as `"object"`. Only our own pages, then, and `sandbox` on the frame if that matters. @@ -373,7 +373,7 @@ have: writing into the install, which every new build replaces. Still deferred. source. - **The compiler knows, and names the package, the container and the kind (P5).** Measured on BETA 983 and 995 by [test/addin/symbols.test.mjs](test/addin/symbols.test.mjs), which puts each - question the way the IDE's own code does. Hover (`textDocument/hover`, `main.js@842393`) + question the way the IDE's own code does. Hover (`main.js@842393`) returns markdown: for a procedure, its declaration, then a heading naming where it is declared, then its `[Description]` text, which for a VBA function is several paragraphs: @@ -396,22 +396,24 @@ have: writing into the install, which every new build replaces. Still deferred. instead, `TB-DEBUG CODEGEN SIZE: [NOT-READY]`; over a `ByVal` parameter of a class, `String`, `Variant` or `Object` it adds a wrong note about `Option Explicit` ([BUGS-TO-REPORT.md](BUGS-TO-REPORT.md)). -- **Go To Definition names the package's own source.** `textDocument/definition` - (`@846297`) returns one `{uri, range}`. For `MsgBox` it is - `twinbasic:/SymbolsProbe/Packages/tbIDE/Packages/VBA/Sources/Interaction.twin`, the - declaration's lines, and the IDE's file system opens it. Each package's own references - sit under its `Packages` folder again, so in a project that references tbIDE, VBA is in - the tree twice, and definition named tbIDE's copy: the package is the name after the last - `Packages/`. The file is the module for a function, and for a class's member the file the - interface is in (`Collection.twin`, `ToolWindows.twin`). Nothing for `Debug.Print`. -- **Signature help and completion say the same.** The completion request's `signatures[]` - (`textDocument/completion`, which the code editor's intellisense sends) have a `doc` that - starts with the same heading, for package procedures as for the project's own: P2 saw - `in AddinHost.Haystack` in the expanded signature help. `textDocument/lazyCompletion` - gives a completion's declaring file and line, the same as definition's. -- **Only page script can ask.** The call is `lspSocket.request(method, params, callback)`. - A harness makes it over CDP; an add-in could only through an inline handler in HTML it - sets (P4), which [Open decisions](#open-decisions) keeps for probes. +- **Go To Definition names the package's own source.** Definition (`@846297`) returns one + file and range. For `MsgBox` the file is + `twinbasic:/SymbolsProbe/Packages/tbIDE/Packages/VBA/Sources/Interaction.twin` and the + range the declaration's lines, and the IDE's file system opens the file. Each package's + own references sit under its `Packages` folder again, so in a project that references + tbIDE, VBA is in the tree twice, and definition named tbIDE's copy: the package is the + name after the last `Packages/`. The file is the module for a function, and for a class's + member the file the interface is in (`Collection.twin`, `ToolWindows.twin`). Nothing for + `Debug.Print`. +- **Signature help and completion say the same.** The signatures that the completion + request returns (the request the code editor's intellisense sends) carry documentation + that starts with the same heading, for package procedures as for the project's own: P2 + saw `in AddinHost.Haystack` in the expanded signature help. The request for a + completion's details gives its declaring file and line, the same as definition's. +- **Only page script can ask.** The question is a call on the page's own socket to the + compiler, answered through a callback. A harness makes it over CDP; an add-in could only + through an inline handler in HTML it sets (P4), which [Open decisions](#open-decisions) + keeps for probes. ### Dialogs @@ -715,7 +717,7 @@ WebView2 preferring light. | P10 | Does an environment variable set by the harness reach the add-in (`Environ$`)? **Answered, BETA 983: yes**, through the launcher, the IDE and the compiler the IDE starts. With `TB_ADDIN_TEST=1` in `launchIde`'s environment, `Environ$` and `GetEnvironmentVariableW` both returned `1` in the add-in, and a compiler started by the restart button returned it too; left out, both said it was unset. `WEBVIEW2_USER_DATA_FOLDER`, which `launchIde` always sets, arrived with the lane's port in it. | the side-effect switch | | P11 | Does the IDE write into its own install folder during a session? **Answered, BETA 983 and 995: no.** On 983 a compile, a compiler crash and a `tbrun` build-and-run left all 233 files byte-identical, mtimes included. On 995 the install (235 files) was byte-identical after exports, a `tbbuild` and two `tbrun` runs; `%APPDATA%` was not re-checked. | hardlinks or copies --- copies, for safety, at 380 ms | | P12 | Does `raiseEvent` from plain tool-window HTML throw? **Answered, BETA 983 and 995: yes** --- `TypeError: Cannot read properties of null (reading 'rootEventHandler')`, and the listener is not called. An inline handler that calls the listener `AddEventListener` stored on its parent, `this.parentNode.(event)`, reaches the add-in. | how the pane's events are written | -| P13 | Does the compiler's HTTP server serve any file placed under `ide\`? **Answered, BETA 983 and 995: yes**, and it is the page server, `twinBASIC_win32.exe --ide=`, not the compiler. Any file, byte for byte, below the page's passkey path, including one written after the IDE started; a frame with a relative `src` shows it on the IDE page's own origin. A query string makes a 404, and `.html` has no `Content-Type`. | an offline route --- it exists ([Offline](#ways-to-show-a-page)) | +| P13 | Does the compiler's HTTP server serve any file placed under `ide\`? **Answered, BETA 983 and 995: yes**, and it is the page server, `twinBASIC_win32.exe --ide=`, not the compiler. Any file, byte for byte, below the page's own path, including one written after the IDE started; a frame with a relative `src` shows it on the IDE page's own origin. A query string makes a 404, and `.html` has no `Content-Type`. | an offline route --- it exists ([Offline](#ways-to-show-a-page)) | | P14 | What do `tbCreateCompilerAddin_v2` and `_v3` expect? **Answered, BETA 983 and 995: what `tbCreateCompilerAddin` does.** The loader looks for the plain name, then `_v2`, then `_v3`, and calls whichever it finds with the `Host` alone and asks the result for `IAddInV1`. The names are version stamps: the linker exports a function named `tbCreateCompilerAddin` as `tbCreateCompilerAddin_v3` alone, and an IDE that knows none of a DLL's names refuses it as `compiled for a newer version of the twinBASIC IDE`, as a patched `_v4` was. | nothing in the design --- the add-in declares `tbCreateCompilerAddin` as the package says; the tbIDE page has a NOTE | ### Stage 3: the symbol index, generated by the docs build @@ -933,9 +935,9 @@ harness about a second against opening a new IDE. scanner would have to find the declaration of `c` and the type of `Host.ToolWindows` first. But only page script can ask, so the route is the choice: through the public API once upstream adds a call, with the add-in's own parser below until then; or through - `lspSocket` from an inline handler (P4), which the open decision on page internals rules - out for the shipped add-in. Either way the answer names an interface, which the index - maps to its class (Stage 3). + the page's socket from an inline handler (P4), which the open decision on page internals + rules out for the shipped add-in. Either way the answer names an interface, which the + index maps to its class (Stage 3). 4. **Later:** hover help through `CodeEditor.AddMonacoWidget` after a pause (the cost of adding and removing widgets is not measured); offering only the packages the project references; the `[Description]` connection; offline use. @@ -1000,11 +1002,12 @@ Recommended, and not yet confirmed: - **Page internals are for probes only.** The shipped add-in uses the public API and `ShellExecuteW`, and whatever the API lacks is requested upstream. P4 showed the route - exists: any inline handler can reach the page's globals, `openEditors`, `lspSocket` and - `hostAppObject` among them. `raiseEvent` in a list view's items is the exception, since - the IDE's own samples use it that way and it is the only way a list view reports a click. - P5 raises what the rule costs: through `lspSocket` the add-in would know the package and - interface of any name under the cursor today (Stage 4, increment 3). + exists: any inline handler can reach the page's globals, `openEditors`, the socket to the + compiler and `hostAppObject` among them. `raiseEvent` in a list view's items is the + exception, since the IDE's own samples use it that way and it is the only way a list view + reports a click. + P5 raises what the rule costs: through the page's socket the add-in would know the + package and interface of any name under the cursor today (Stage 4, increment 3). - **The site reads a `theme` query parameter**, so that a page in the help pane can match the IDE's theme (Stage 3, after P3). **Deferred** until the add-in works, at least in part (2026-09-25); decided then, not before. diff --git a/WIP.md b/WIP.md index 880f5ca5..796ef178 100644 --- a/WIP.md +++ b/WIP.md @@ -138,7 +138,7 @@ node scripts/tbrun.mjs # what does it print - **Give the executable backslashed paths, and `export` a full path to the project.** `export` prefixes `\\?\` to its project path, so a relative one, or one with forward slashes, reports `input twinproj file does not exist`; and a folder named with forward slashes cannot be created or even found, even when it exists. With backslashes `export` creates every missing level of its output folder. Redirect stdin (`\`), so the given `.twinproj` is untouched, and a plain `--build` is the control for an `--llvm` run. `--llvm` refuses a Community or Personal licence. - **It runs the IDE on a private Windows desktop**, so it cannot seize focus mid-sentence. Set `TBBUILD_SHOW=1` while working interactively and leave it unset for unattended runs --- a wedged IDE nobody can see is the failure that costs an afternoon. -- **One project per IDE**, 8--11 seconds each and flat in project size. Reusing a live IDE for a second project wedges it, so the cold start is the unit of work, not overhead to optimise away. Concurrency is how to go faster: distinct `--port` values give distinct DevTools ports, user-data folders, temp folders (`%TEMP%\tbbuild-tmp-`; IDEs building in one temp folder fail now and then to write the type library) and desktops. +- **One project per IDE**, 6--8 seconds each and flat in project size. Reusing a live IDE for a second project wedges it, so the cold start is the unit of work, not overhead to optimise away. Concurrency is how to go faster: distinct `--port` values give distinct DevTools ports, user-data folders, temp folders (`%TEMP%\tbbuild-tmp-`; IDEs building in one temp folder fail now and then to write the type library) and desktops. - **Keep a probe that might crash the compiler in a project of its own.** twinBASIC runs the compiler in the same process as user code, so one bad probe can take the run down and cost the other thirty their answer. - **`tbrun` takes an exported tree, not a `.twinproj`**, because it has to pin `project.buildPath` in its own staged copy --- a project still on the default template opens a native Save dialog that is invisible on the private desktop, and the build simply never happens while every health check says the IDE is fine. The probe is a module with a `[RunAfterBuild]` Sub, and must start with `Debug.Cls`. Its exit codes: 0 the probe ran and its output was captured, 1 the project has compile errors, 2 the harness failed or the build did after a clean compile, 3 no output, 4 the compiler crashed, as `tbbuild` reports it, 5 the probe ended before it returned (`End`, or an error raised with no handler in LLVM-compiled code, which ends the run silently), 6 with `--exe`, the exe exited with a code other than 0 or was still running at `--timeout`. - **Measuring LLVM: `tbrun --llvm`** (or `--compiler-options ""`) compiles the whole probe with LLVM, by setting `compiler.debugOptions` --- what a `[RunAfterBuild]` run is compiled with; `compiler.buildOptions` alone does not reach it (BETA 995) --- and `compiler.buildOptions`, for the exe. It refuses a Community or Personal licence. `--exe` also runs the built exe on a private desktop; the exe runs `Sub Main` and prints with `TbRun.Out`, a module `tbrun` adds, because `Debug.Print` writes nothing in an exe. @@ -425,7 +425,7 @@ over them, because a `tb` fence is something `check_code_regions.mjs` protects t the compiler now. A sample opts in by carrying `check_build` in its fence info string; the tool works out what to generate around it, packs many samples into one project, builds them through `tbbuild` on concurrent lanes, and reports each diagnostic against the line in the -page it came from. **1,136 samples are marked, and the run takes about 120 seconds.** +page it came from. **1,144 samples are marked, and the run takes about 80 seconds.** It is **never** wired into `build.bat`, `check.bat`, `test.bat` or CI: it needs a twinBASIC install, which `npm install` is not, and Windows with a private desktop and a @@ -466,10 +466,11 @@ Why the report separates the wedged task from the merely blocked ones, and why - `test.bat` — the tests the *toolchain* has to pass: the publish-allowlist self-test (`scripts/check_publish_policy.mjs`), the gate-list check (`scripts/check_gate_lists.mjs`), the CI-workflow roster check (`scripts/check_ci_workflows.mjs`), the lint gate (`scripts/check_lint.mjs`), the site-search unit tests (`node --test test/search.test.mjs`), the markdown-plugin unit tests (`node --test test/render.test.mjs`), the date-formatter unit tests (`node --test test/strftime.test.mjs`), `check_examples.mjs`'s probes (`node --test test/example-batches.test.mjs`), the regex-safety gate (`scripts/check_regex_safety.mjs`), the code-region gate (`scripts/check_code_regions.mjs`), the page-count drift-guard probes (`scripts/check_page_baseline.mjs`), the book-coverage probes (`scripts/check_book_coverage.mjs`), the symbol-index probes (`scripts/check_symbol_index.mjs`), the twinBASIC-scanner probes (`scripts/check_twin_parsers.mjs`), the attribute-sweep probes (`scripts/check_attribute_sweep.mjs`), the command-line probes and cases (`scripts/check_cli.mjs`), the pdf-lib shim comparison (`scripts/check_pdf_shims_equiv.mjs`), the impexp parity check (`scripts/check_impexp_parity.mjs`), and the axe source-patch verification (`scripts/check_axe_patch_equiv.mjs`). ~23 s, of which the regex-safety gate is ~10 s and the impexp check ~4 s. See [What belongs in test.bat rather than check.bat](WIP.Build.md#what-belongs-in-testbat-rather-than-checkbat). - `book.bat` — renders the PDF from `docs\_site-pdf\book.html` via `node book\render-book.mjs` into `docs\_pdf\twinBASIC Book.pdf`. Run `build.bat` first to populate `_site-pdf/`; `book.bat` refuses a tree older than its sources rather than rendering the previous book (see [The book refuses a stale source tree](WIP.Build.md#the-book-refuses-a-stale-source-tree)). -- `examples.bat` — compiles the documentation's own twinBASIC code samples, every `tb` fence marked `check_build`, and reports the ones the compiler refuses against the line in the page they came from; a statement sample also marked `check_run` is built and run, and what it prints is checked against the page. Needs a twinBASIC install and Windows, so it is outside every gate and outside CI; ~120 s over the 1,136 samples marked. `--build` also builds each project that compiles clean, and `--llvm` builds it with LLVM (see [WIP.ExamplesBuild.md](WIP.ExamplesBuild.md)). Two modes need no compiler at all: `--census` classifies every fence and says how many classifiable ones are still unmarked, and `--report ` groups a saved `--propose --json` survey by diagnostic, section and unresolved name. `--propose` itself does compile. See [Compiling the reference's own code samples](#compiling-the-references-own-code-samples) and [WIP.ExamplesBuild.md](WIP.ExamplesBuild.md). +- `examples.bat` — compiles the documentation's own twinBASIC code samples, every `tb` fence marked `check_build`, and reports the ones the compiler refuses against the line in the page they came from; a statement sample also marked `check_run` is built and run, and what it prints is checked against the page. Needs a twinBASIC install and Windows, so it is outside every gate and outside CI; ~80 s over the 1,144 samples marked. `--build` also builds each project that compiles clean, and `--llvm` builds it with LLVM (see [WIP.ExamplesBuild.md](WIP.ExamplesBuild.md)). Two modes need no compiler at all: `--census` classifies every fence and says how many classifiable ones are still unmarked, and `--report ` groups a saved `--propose --json` survey by diagnostic, section and unresolved name. `--propose` itself does compile. See [Compiling the reference's own code samples](#compiling-the-references-own-code-samples) and [WIP.ExamplesBuild.md](WIP.ExamplesBuild.md). - `addin-test.bat` — tests IDE add-ins by operating an IDE: every lane in `test/addin/lanes.mjs` builds the add-ins it tests into a private copy of the install, opens a project and checks what the add-in does. Outside every gate and outside CI for the same reasons as `examples.bat`; ~140 s for the ten lanes today: Samples 10 and 15, and the eight probe lanes behind Stage 2's answers in [WIP.HelpAddin.md](WIP.HelpAddin.md). Exit 0 every lane passed and the registry is as it was found, 1 a lane failed, 2 the harness failed, 3 the registry or a work folder was not put back. See [Driving the twinBASIC compiler](#driving-the-twinbasic-compiler) for its rules. - `ide-test.bat` --- the same runner for scenarios that operate the IDE itself rather than an add-in: every lane in `test/ide/lanes.mjs`, base port 9660. Same exit codes, same standing outside every gate and outside CI, same rules. -- `node scripts/bug_repro.mjs` --- the reproducer projects under `bugs//` for the entries of [BUGS-TO-REPORT.md](BUGS-TO-REPORT.md): `new`, `pack` (impexp, then the zip, written in Node), `compile`, `build` and `run` through `tbbuild` and `tbrun`, `file` (moves a filed entry and its reproducer to `bugs/filed//`; `file --marked` does every marked entry), and `verify`, which reads each `bugs/*/repro.json` and `bugs/filed/*/repro.json` and says whether the bug still reproduces on the newest beta. It has no wrapper. **`verify` is run by a person only**, never by a gate or CI: it needs a twinBASIC install, like `examples.bat`. Default port 9440, and `--jobs N` takes N ports from there. Its command-line cases are in `scripts/lib/cli-cases.mjs`, and need no IDE. +- `node scripts/bug_repro.mjs` --- the reproducer projects under `bugs//` for the entries of [BUGS-TO-REPORT.md](BUGS-TO-REPORT.md): `new`, `pack` (impexp, then the zip, written in Node), `compile`, `build` and `run` through `tbbuild` and `tbrun`, `vb6` (builds the optional `vb6/` VB6 project beside the twinBASIC one in a temp copy and prints its `out.txt`; `pack` zips its sources into `-vb6.zip`; VB6 is started only by `scripts/lib/vb6.mjs`, never from a shell), `file` (moves a filed entry and its reproducer to `bugs/filed//`; `file --marked` does every marked entry), and `verify`, which reads each `bugs/*/repro.json` and `bugs/filed/*/repro.json` and says whether the bug still reproduces on the newest beta. It has no wrapper. **`verify` is run by a person only**, never by a gate or CI: it needs a twinBASIC install, like `examples.bat`. Default port 9440, and `--jobs N` takes N ports from there. Its command-line cases are in `scripts/lib/cli-cases.mjs`, and need no IDE. +- `node scripts/vb6run.mjs ` and `node scripts/vb6run.mjs --docs [--only ]` --- build and run VB6 code, so that what a sample prints in twinBASIC can be compared with VB6: a stand-alone file of statements or a `.bas` module, or `--docs`, which builds the documentation's `check_run` fences in VB6 and says for each whether it prints what its page says (`same`, `differs`, `not VB6`, `error`, `refused`; a `projname=` group is built as a project of its own, its `slot=file` fences translated into VB6 `.cls` and `.bas` components). It has no wrapper and is outside every gate and outside CI: it needs VB6 (`--vb6`, `VB6_EXE`, or the standard install folder). **Never start `VB6.EXE` from a shell**: in Git Bash `/make` is rewritten as a path and VB6 answers with a modal box on the desktop; the tool spawns it from Node with an argument array, and a sample that calls `MsgBox` or `InputBox` or contains `End` is refused. Its `Debug.Print` rewrite and its file translation have probes in `test/example-batches.test.mjs`, and its command-line cases are in `scripts/lib/cli-cases.mjs`; both need no VB6. What it relies on is in [WIP.ExamplesBuild.md](WIP.ExamplesBuild.md). Three generators sit outside that loop and produce committed artifacts rather than build output — none runs during a build, and none is needed for one. `python scripts/build_fonts.py` rebuilds the subset webfaces under `docs/assets/fonts/` and needs a network connection; `node scripts/build_dot_metrics.mjs` regenerates `builder/inter-metrics.json` from those webfaces and needs only a browser. See [Typography](#typography). `node scripts/build_package_api.mjs` regenerates `builder/package-api.json`, the packages' declared API that the build's symbol index (`tB/symbols.json`, for the IDE help add-in) is annotated from; it needs a twinBASIC install, so **run it when the reference is re-indexed against a newer build** and commit it with the pages. See [WIP.HelpAddin.md, Stage 3](WIP.HelpAddin.md#stage-3-the-symbol-index-generated-by-the-docs-build). diff --git a/bugs/advise-nothing-crashes/advise-nothing-crashes.twinproj b/bugs/advise-nothing-crashes/advise-nothing-crashes.twinproj new file mode 100644 index 00000000..47457767 Binary files /dev/null and b/bugs/advise-nothing-crashes/advise-nothing-crashes.twinproj differ diff --git a/bugs/advise-nothing-crashes/repro.json b/bugs/advise-nothing-crashes/repro.json new file mode 100644 index 00000000..17c671b8 --- /dev/null +++ b/bugs/advise-nothing-crashes/repro.json @@ -0,0 +1,10 @@ +{ + "mode": "run", + "expect": { + "exit": 5, + "output": [ + "^before$", + "NATIVE EXCEPTION: ACCESS_VIOLATION" + ] + } +} diff --git a/bugs/advise-nothing-crashes/src/Settings b/bugs/advise-nothing-crashes/src/Settings new file mode 100644 index 00000000..42817a24 --- /dev/null +++ b/bugs/advise-nothing-crashes/src/Settings @@ -0,0 +1,61 @@ +{ + "configuration.inherits": "Defaults", + "project.appTitle": "AdviseNothingCrashes", + "project.buildPath": "${SourcePath}\\Build\\${ProjectName}_${Architecture}.${FileExtension}", + "project.buildType": "Standard EXE", + "project.description": "Reproduces: t", + "project.exportPathIsV2": true, + "project.id": "{8A50AEC4-3E42-4FFF-8CBB-20995A8ECB02}", + "project.name": "AdviseNothingCrashes", + "project.optionExplicit": true, + "project.references": [ + { + "id": "{00020430-0000-0000-C000-000000000046}", + "lcid": 0, + "name": "OLE Automation", + "path32": "C:\\Windows\\SysWOW64\\stdole2.tlb", + "path64": "C:\\Windows\\System32\\stdole2.tlb", + "symbolId": "stdole", + "versionMajor": 2, + "versionMinor": 0 + }, + { + "id": "{F50B82D0-DCAB-43FE-9631-11959D4A4728}", + "isCompilerPackage": true, + "licence": "MIT", + "name": "[COMPILER PACKAGE] twinBASIC - VB Compatibility Package (Forms)", + "path32": "", + "path64": "", + "publisher": "TWINBASIC-COMPILER", + "symbolId": "VB", + "versionBuild": 0, + "versionMajor": 0, + "versionMinor": 0, + "versionRevision": 31 + }, + { + "id": "{C192FB39-64CA-4D9B-B477-A5502F48EFCC}", + "isCompilerPackage": true, + "licence": "MIT", + "name": "[COMPILER PACKAGE] twinBASIC - App global class object", + "path32": "", + "path64": "", + "publisher": "TWINBASIC-COMPILER", + "symbolId": "AppGlobalClassProject", + "versionBuild": 0, + "versionMajor": 1, + "versionMinor": 0, + "versionRevision": 0 + } + ], + "project.settingsVersion": 1, + "project.startupObject": "Sub Main", + "project.warnings": { + "errors": [], + "hints": [], + "ignored": [], + "info": [], + "warnings": [] + }, + "runtime.useUnicodeStandardLibrary": true +} diff --git a/bugs/advise-nothing-crashes/src/Sources/Startup.twin b/bugs/advise-nothing-crashes/src/Sources/Startup.twin new file mode 100644 index 00000000..caacaee9 --- /dev/null +++ b/bugs/advise-nothing-crashes/src/Sources/Startup.twin @@ -0,0 +1,37 @@ +' Advise(Nothing) on the connection point of a class that has an Event ends in an ACCESS_VIOLATION. +' The contract returns E_POINTER. +[InterfaceId("B196B284-BAB4-101A-B69C-00AA00341D07")] +Private Interface IConnectionPointContainer Extends stdole.IUnknown + Function EnumConnectionPoints() As IEnumConnectionPoints +End Interface + +[InterfaceId("B196B285-BAB4-101A-B69C-00AA00341D07")] +Private Interface IEnumConnectionPoints Extends stdole.IUnknown + Sub Next(ByVal cConnections As Long, ByRef ppCP As IConnectionPoint, ByRef pcFetched As Long) +End Interface + +[InterfaceId("B196B286-BAB4-101A-B69C-00AA00341D07")] +Private Interface IConnectionPoint Extends stdole.IUnknown + Sub GetConnectionInterface(ByVal piid As LongPtr) + Function GetConnectionPointContainer() As IConnectionPointContainer + Function Advise(ByVal pUnkSink As stdole.IUnknown) As Long +End Interface + +Private Class Source + Public Event Ping() +End Class + +Module Startup + + Public Sub Main() + Dim src As New Source + Dim container As IConnectionPointContainer = src + Dim points As IEnumConnectionPoints = container.EnumConnectionPoints() + Dim point As IConnectionPoint, fetched As Long + points.Next 1, point, fetched + Debug.Print "before" + Dim cookie As Long = point.Advise(Nothing) + Debug.Print "after " & cookie + End Sub + +End Module diff --git a/bugs/advise-unadvise-hresults/advise-unadvise-hresults.twinproj b/bugs/advise-unadvise-hresults/advise-unadvise-hresults.twinproj new file mode 100644 index 00000000..e74ff173 Binary files /dev/null and b/bugs/advise-unadvise-hresults/advise-unadvise-hresults.twinproj differ diff --git a/bugs/advise-unadvise-hresults/repro.json b/bugs/advise-unadvise-hresults/repro.json new file mode 100644 index 00000000..3eb8edb3 --- /dev/null +++ b/bugs/advise-unadvise-hresults/repro.json @@ -0,0 +1,11 @@ +{ + "mode": "run", + "expect": { + "exit": 0, + "output": [ + "^Advise, a sink without the outgoing interface: error=80004002$", + "^Unadvise 0: error=0$", + "^Unadvise 99: error=0$" + ] + } +} diff --git a/bugs/advise-unadvise-hresults/src/Settings b/bugs/advise-unadvise-hresults/src/Settings new file mode 100644 index 00000000..37994d37 --- /dev/null +++ b/bugs/advise-unadvise-hresults/src/Settings @@ -0,0 +1,61 @@ +{ + "configuration.inherits": "Defaults", + "project.appTitle": "AdviseUnadviseHresults", + "project.buildPath": "${SourcePath}\\Build\\${ProjectName}_${Architecture}.${FileExtension}", + "project.buildType": "Standard EXE", + "project.description": "Reproduces: t", + "project.exportPathIsV2": true, + "project.id": "{78910B45-8933-4A4E-85F7-AF5A6D88DBF5}", + "project.name": "AdviseUnadviseHresults", + "project.optionExplicit": true, + "project.references": [ + { + "id": "{00020430-0000-0000-C000-000000000046}", + "lcid": 0, + "name": "OLE Automation", + "path32": "C:\\Windows\\SysWOW64\\stdole2.tlb", + "path64": "C:\\Windows\\System32\\stdole2.tlb", + "symbolId": "stdole", + "versionMajor": 2, + "versionMinor": 0 + }, + { + "id": "{F50B82D0-DCAB-43FE-9631-11959D4A4728}", + "isCompilerPackage": true, + "licence": "MIT", + "name": "[COMPILER PACKAGE] twinBASIC - VB Compatibility Package (Forms)", + "path32": "", + "path64": "", + "publisher": "TWINBASIC-COMPILER", + "symbolId": "VB", + "versionBuild": 0, + "versionMajor": 0, + "versionMinor": 0, + "versionRevision": 31 + }, + { + "id": "{C192FB39-64CA-4D9B-B477-A5502F48EFCC}", + "isCompilerPackage": true, + "licence": "MIT", + "name": "[COMPILER PACKAGE] twinBASIC - App global class object", + "path32": "", + "path64": "", + "publisher": "TWINBASIC-COMPILER", + "symbolId": "AppGlobalClassProject", + "versionBuild": 0, + "versionMajor": 1, + "versionMinor": 0, + "versionRevision": 0 + } + ], + "project.settingsVersion": 1, + "project.startupObject": "Sub Main", + "project.warnings": { + "errors": [], + "hints": [], + "ignored": [], + "info": [], + "warnings": [] + }, + "runtime.useUnicodeStandardLibrary": true +} diff --git a/bugs/advise-unadvise-hresults/src/Sources/Startup.twin b/bugs/advise-unadvise-hresults/src/Sources/Startup.twin new file mode 100644 index 00000000..adf74c54 --- /dev/null +++ b/bugs/advise-unadvise-hresults/src/Sources/Startup.twin @@ -0,0 +1,55 @@ +' Advise with a sink that does not support the outgoing interface fails with E_NOINTERFACE, +' where CONNECT_E_CANNOTCONNECT (&H80040201) is expected. Unadvise with a cookie that names +' no connection succeeds, where an error is expected. +[InterfaceId("B196B284-BAB4-101A-B69C-00AA00341D07")] +Private Interface IConnectionPointContainer Extends stdole.IUnknown + Function EnumConnectionPoints() As IEnumConnectionPoints +End Interface + +[InterfaceId("B196B285-BAB4-101A-B69C-00AA00341D07")] +Private Interface IEnumConnectionPoints Extends stdole.IUnknown + Sub Next(ByVal cConnections As Long, ByRef ppCP As IConnectionPoint, ByRef pcFetched As Long) +End Interface + +[InterfaceId("B196B286-BAB4-101A-B69C-00AA00341D07")] +Private Interface IConnectionPoint Extends stdole.IUnknown + Sub GetConnectionInterface(ByVal piid As LongPtr) + Function GetConnectionPointContainer() As IConnectionPointContainer + Function Advise(ByVal pUnkSink As stdole.IUnknown) As Long + Sub Unadvise(ByVal dwCookie As Long) +End Interface + +Private Class Source + Public Event Ping() +End Class + +Private Class NotASink + Public Value As Long +End Class + +Module Startup + + Private Sub Report(ByVal What As String) + Debug.Print What & ": error=" & Hex$(Err.Number) + Err.Clear + End Sub + + Public Sub Main() + Dim src As New Source + Dim container As IConnectionPointContainer = src + Dim points As IEnumConnectionPoints = container.EnumConnectionPoints() + Dim point As IConnectionPoint, fetched As Long + points.Next 1, point, fetched + + Dim sink As New NotASink + Dim cookie As Long + On Error Resume Next + cookie = point.Advise(sink) + Report "Advise, a sink without the outgoing interface" + point.Unadvise 0 + Report "Unadvise 0" + point.Unadvise 99 + Report "Unadvise 99" + End Sub + +End Module diff --git a/bugs/callbyname-membernotfound-retried/callbyname-membernotfound-retried.twinproj b/bugs/callbyname-membernotfound-retried/callbyname-membernotfound-retried.twinproj new file mode 100644 index 00000000..eb1f1f4d Binary files /dev/null and b/bugs/callbyname-membernotfound-retried/callbyname-membernotfound-retried.twinproj differ diff --git a/bugs/callbyname-membernotfound-retried/repro.json b/bugs/callbyname-membernotfound-retried/repro.json new file mode 100644 index 00000000..8c8cc392 --- /dev/null +++ b/bugs/callbyname-membernotfound-retried/repro.json @@ -0,0 +1,10 @@ +{ + "mode": "run", + "expect": { + "exit": 0, + "output": [ + "^CallByName: error 438, Invoke called 2 time\\(s\\)$", + "^o\\.Anything: error 438, Invoke called 1 time\\(s\\)$" + ] + } +} diff --git a/bugs/callbyname-membernotfound-retried/src/Settings b/bugs/callbyname-membernotfound-retried/src/Settings new file mode 100644 index 00000000..9958819e --- /dev/null +++ b/bugs/callbyname-membernotfound-retried/src/Settings @@ -0,0 +1,61 @@ +{ + "configuration.inherits": "Defaults", + "project.appTitle": "CallbynameMembernotfoundRetried", + "project.buildPath": "${SourcePath}\\Build\\${ProjectName}_${Architecture}.${FileExtension}", + "project.buildType": "Standard EXE", + "project.description": "Reproduces: CallByName calls Invoke a second time when the first returns DISP_E_MEMBERNOTFOUND", + "project.exportPathIsV2": true, + "project.id": "{88C59DD2-CB35-44BA-820E-64E951AE34AF}", + "project.name": "CallbynameMembernotfoundRetried", + "project.optionExplicit": true, + "project.references": [ + { + "id": "{00020430-0000-0000-C000-000000000046}", + "lcid": 0, + "name": "OLE Automation", + "path32": "C:\\Windows\\SysWOW64\\stdole2.tlb", + "path64": "C:\\Windows\\System32\\stdole2.tlb", + "symbolId": "stdole", + "versionMajor": 2, + "versionMinor": 0 + }, + { + "id": "{F50B82D0-DCAB-43FE-9631-11959D4A4728}", + "isCompilerPackage": true, + "licence": "MIT", + "name": "[COMPILER PACKAGE] twinBASIC - VB Compatibility Package (Forms)", + "path32": "", + "path64": "", + "publisher": "TWINBASIC-COMPILER", + "symbolId": "VB", + "versionBuild": 0, + "versionMajor": 0, + "versionMinor": 0, + "versionRevision": 31 + }, + { + "id": "{C192FB39-64CA-4D9B-B477-A5502F48EFCC}", + "isCompilerPackage": true, + "licence": "MIT", + "name": "[COMPILER PACKAGE] twinBASIC - App global class object", + "path32": "", + "path64": "", + "publisher": "TWINBASIC-COMPILER", + "symbolId": "AppGlobalClassProject", + "versionBuild": 0, + "versionMajor": 1, + "versionMinor": 0, + "versionRevision": 0 + } + ], + "project.settingsVersion": 1, + "project.startupObject": "Sub Main", + "project.warnings": { + "errors": [], + "hints": [], + "ignored": [], + "info": [], + "warnings": [] + }, + "runtime.useUnicodeStandardLibrary": true +} diff --git a/bugs/callbyname-membernotfound-retried/src/Sources/Startup.twin b/bugs/callbyname-membernotfound-retried/src/Sources/Startup.twin new file mode 100644 index 00000000..fa49f21d --- /dev/null +++ b/bugs/callbyname-membernotfound-retried/src/Sources/Startup.twin @@ -0,0 +1,52 @@ +[InterfaceId("00020400-0000-0000-C000-000000000046")] +Private Interface IDispatchCopy Extends stdole.IUnknown + Sub GetTypeInfoCount(ByRef pctinfo As Long) + Sub GetTypeInfo(ByVal iTInfo As Long, ByVal lcid As Long, ByRef ppTInfo As LongPtr) + Sub GetIDsOfNames(ByVal riid As LongPtr, ByVal rgszNames As LongPtr, ByVal cNames As Long, ByVal lcid As Long, ByVal rgDispId As LongPtr) + Sub Invoke(ByVal dispIdMember As Long, ByVal riid As LongPtr, ByVal lcid As Long, ByVal wFlags As Integer, ByVal pDispParams As LongPtr, ByVal pVarResult As LongPtr, ByVal pExcepInfo As LongPtr, ByVal puArgErr As LongPtr) +End Interface + +NotDispatchable Class Recorder + Implements IDispatchCopy + + Public Calls As Long + + Private Sub IDispatchCopy_GetTypeInfoCount(ByRef pctinfo As Long) Implements IDispatchCopy.GetTypeInfoCount + pctinfo = 0 + End Sub + + Private Sub IDispatchCopy_GetTypeInfo(ByVal iTInfo As Long, ByVal lcid As Long, ByRef ppTInfo As LongPtr) Implements IDispatchCopy.GetTypeInfo + Err.ReturnHResult = &H80004001 + End Sub + + Private Sub IDispatchCopy_GetIDsOfNames(ByVal riid As LongPtr, ByVal rgszNames As LongPtr, ByVal cNames As Long, ByVal lcid As Long, ByVal rgDispId As LongPtr) Implements IDispatchCopy.GetIDsOfNames + Dim id As Long = 1 + CopyMemory rgDispId, VarPtr(id), 4 + End Sub + + Private Sub IDispatchCopy_Invoke(ByVal dispIdMember As Long, ByVal riid As LongPtr, ByVal lcid As Long, ByVal wFlags As Integer, ByVal pDispParams As LongPtr, ByVal pVarResult As LongPtr, ByVal pExcepInfo As LongPtr, ByVal puArgErr As LongPtr) Implements IDispatchCopy.Invoke + Calls += 1 + Debug.Print " Invoke " & Calls & ": wFlags " & wFlags & ", result " & IIf(pVarResult = 0, "null", "supplied") + Err.ReturnHResult = &H80020003 ' DISP_E_MEMBERNOTFOUND + End Sub +End Class + +Module Api + Public Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As LongPtr, ByVal Source As LongPtr, ByVal Length As LongPtr) +End Module + +Module Startup + + Public Sub Main() + Dim r As New Recorder + Dim o As Object = r + On Error Resume Next + CallByName o, "Anything", vbMethod + Debug.Print "CallByName: error " & Err.Number & ", Invoke called " & r.Calls & " time(s)" + Err.Clear + r.Calls = 0 + o.Anything + Debug.Print "o.Anything: error " & Err.Number & ", Invoke called " & r.Calls & " time(s)" + End Sub + +End Module diff --git a/bugs/err-info-live-view/err-info-live-view.twinproj b/bugs/err-info-live-view/err-info-live-view.twinproj new file mode 100644 index 00000000..91f6f353 Binary files /dev/null and b/bugs/err-info-live-view/err-info-live-view.twinproj differ diff --git a/bugs/err-info-live-view/repro.json b/bugs/err-info-live-view/repro.json new file mode 100644 index 00000000..affa2044 --- /dev/null +++ b/bugs/err-info-live-view/repro.json @@ -0,0 +1,13 @@ +{ + "mode": "run", + "expect": { + "exit": 0, + "output": [ + "^read at once: \\[My.Source\\] \\[My description\\]$", + "^after Err.Clear: \\[\\] \\[\\]$", + "^slot afterwards: \\[My.Source\\] \\[My description\\]$", + "^E_FAIL after the cleared error: -2147467259 \\[Unspecified error\\]$", + "^E_FAIL, slot emptied first: -2147467259 \\[Automation error\\]$" + ] + } +} diff --git a/bugs/err-info-live-view/src/Settings b/bugs/err-info-live-view/src/Settings new file mode 100644 index 00000000..5ccd8dc5 --- /dev/null +++ b/bugs/err-info-live-view/src/Settings @@ -0,0 +1,61 @@ +{ + "configuration.inherits": "Defaults", + "project.appTitle": "ErrInfoLiveView", + "project.buildPath": "${SourcePath}\\Build\\${ProjectName}_${Architecture}.${FileExtension}", + "project.buildType": "Standard EXE", + "project.description": "Reproduces: The error information twinBASIC leaves for a caller reads from `Err` and stays in the thread's slot after the error is handled", + "project.exportPathIsV2": true, + "project.id": "{6CFD32BD-995E-4B48-B876-0F1826E1B19C}", + "project.name": "ErrInfoLiveView", + "project.optionExplicit": true, + "project.references": [ + { + "id": "{00020430-0000-0000-C000-000000000046}", + "lcid": 0, + "name": "OLE Automation", + "path32": "C:\\Windows\\SysWOW64\\stdole2.tlb", + "path64": "C:\\Windows\\System32\\stdole2.tlb", + "symbolId": "stdole", + "versionMajor": 2, + "versionMinor": 0 + }, + { + "id": "{F50B82D0-DCAB-43FE-9631-11959D4A4728}", + "isCompilerPackage": true, + "licence": "MIT", + "name": "[COMPILER PACKAGE] twinBASIC - VB Compatibility Package (Forms)", + "path32": "", + "path64": "", + "publisher": "TWINBASIC-COMPILER", + "symbolId": "VB", + "versionBuild": 0, + "versionMajor": 0, + "versionMinor": 0, + "versionRevision": 31 + }, + { + "id": "{C192FB39-64CA-4D9B-B477-A5502F48EFCC}", + "isCompilerPackage": true, + "licence": "MIT", + "name": "[COMPILER PACKAGE] twinBASIC - App global class object", + "path32": "", + "path64": "", + "publisher": "TWINBASIC-COMPILER", + "symbolId": "AppGlobalClassProject", + "versionBuild": 0, + "versionMajor": 1, + "versionMinor": 0, + "versionRevision": 0 + } + ], + "project.settingsVersion": 1, + "project.startupObject": "Sub Main", + "project.warnings": { + "errors": [], + "hints": [], + "ignored": [], + "info": [], + "warnings": [] + }, + "runtime.useUnicodeStandardLibrary": true +} diff --git a/bugs/err-info-live-view/src/Sources/Startup.twin b/bugs/err-info-live-view/src/Sources/Startup.twin new file mode 100644 index 00000000..9afa8eb8 --- /dev/null +++ b/bugs/err-info-live-view/src/Sources/Startup.twin @@ -0,0 +1,68 @@ +[InterfaceId("1CF2B120-547D-101B-8E65-08002B2BD119")] +Private Interface IErrorInfo Extends stdole.IUnknown + Sub GetGUID(ByVal pGUID As LongPtr) + Function GetSource() As String + Function GetDescription() As String +End Interface + +[InterfaceId("11111111-2222-3333-4444-555555555503")] +Private Interface IWorker Extends stdole.IUnknown + Sub RaiseFull() + Sub ReturnFailure() +End Interface + +Private Class Worker + Implements IWorker + + Private Sub RaiseFull() Implements IWorker.RaiseFull + Err.Raise vbObjectError + 1234, "My.Source", "My description" + End Sub + + Private Sub ReturnFailure() Implements IWorker.ReturnFailure + Err.ReturnHResult = &H80004005 ' E_FAIL, and no error information + End Sub +End Class + +Module Startup + + Private Declare PtrSafe Function GetErrorInfo Lib "oleaut32" ( _ + ByVal dwReserved As Long, ByRef pperrinfo As IErrorInfo) As Long + + Private Function Slot() As String + Dim info As IErrorInfo + Dim hr As Long = GetErrorInfo(0, info) + If info Is Nothing Then Return "empty (" & hr & ")" + Return "[" & info.GetSource() & "] [" & info.GetDescription() & "]" + End Function + + Public Sub Main() + On Error Resume Next + Dim w As IWorker = New Worker + + ' 1. The object holds what Err held when it is read, not when it was made. + Dim info As IErrorInfo + Err.Raise vbObjectError + 1234, "My.Source", "My description" + GetErrorInfo 0, info + Debug.Print "read at once: [" & info.GetSource() & "] [" & info.GetDescription() & "]" + Err.Clear + Debug.Print "after Err.Clear: [" & info.GetSource() & "] [" & info.GetDescription() & "]" + + ' 2. A caller has handled the error, and the slot still holds an object. + Err.Clear + w.RaiseFull + Debug.Print "Err after the call: " & Err.Number & " [" & Err.Description & "]" + Debug.Print "slot afterwards: " & Slot() + + ' 3. So a later failure that carries no information is described by Err. + Err.Clear + w.RaiseFull + Err.Clear + w.ReturnFailure + Debug.Print "E_FAIL after the cleared error: " & Err.Number & " [" & Err.Description & "]" + Dim ignore As String = Slot() + Err.Clear + w.ReturnFailure + Debug.Print "E_FAIL, slot emptied first: " & Err.Number & " [" & Err.Description & "]" + End Sub + +End Module diff --git a/bugs/err-info-live-view/vb6/Module1.bas b/bugs/err-info-live-view/vb6/Module1.bas new file mode 100644 index 00000000..f34e2ecd --- /dev/null +++ b/bugs/err-info-live-view/vb6/Module1.bas @@ -0,0 +1,46 @@ +Attribute VB_Name = "Module1" +Option Explicit + +Private Declare Function GetErrorInfo Lib "oleaut32" (ByVal dwReserved As Long, ByRef pperrinfo As Long) As Long + +Sub Emit(ByVal s As String) + Print #9, s +End Sub + +Function Slot() As String + Dim p As Long, r As Long + r = GetErrorInfo(0, p) + If p = 0 Then + Slot = "empty (GetErrorInfo " & Hex(r) & ")" + Else + Slot = "an object" + End If +End Function + +Sub Main() + On Error GoTo Fail + Open App.Path & "\out.txt" For Output As #9 + Cases + Close #9 + Exit Sub +Fail: + On Error Resume Next + Print #9, "unhandled error " & Err.Number & ": " & Err.Description + Close #9 +End Sub + +Sub Cases() + On Error Resume Next + Dim t As New Thrower + Emit "T1 fresh thread: " & Slot() + Err.Raise 5 + Emit "T2 after Err.Raise 5 handled in this procedure: " & Slot() + Err.Clear + t.RaiseFull + Emit "T4 Err " & Err.Number & " [" & Err.Description & "] [" & Err.Source & "]" + Emit "T4 slot afterwards: " & Slot() + Err.Clear + t.Handled + Emit "T6 slot after a call that handled its own error: " & Slot() + Err.Clear +End Sub diff --git a/bugs/err-info-live-view/vb6/Probe.vbp b/bugs/err-info-live-view/vb6/Probe.vbp new file mode 100644 index 00000000..456e5a9f --- /dev/null +++ b/bugs/err-info-live-view/vb6/Probe.vbp @@ -0,0 +1,8 @@ +Type=Exe +Module=Module1; Module1.bas +Class=Thrower; Thrower.cls +Startup="Sub Main" +ExeName32="Probe.exe" +Name="Probe" +CompilationType=0 +OptimizationType=0 diff --git a/bugs/err-info-live-view/vb6/Thrower.cls b/bugs/err-info-live-view/vb6/Thrower.cls new file mode 100644 index 00000000..53924588 --- /dev/null +++ b/bugs/err-info-live-view/vb6/Thrower.cls @@ -0,0 +1,23 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True + Persistable = 0 'NotPersistable + DataBindingBehavior = 0 'vbNone + DataSourceBehavior = 0 'vbNone + MTSTransactionMode = 0 'NotAnMTSObject +END +Attribute VB_Name = "Thrower" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = True +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = True +Option Explicit + +Public Sub RaiseFull() + Err.Raise vbObjectError + 1234, "Probe.Subject", "Something failed on purpose" +End Sub + +Public Sub Handled() + On Error Resume Next + Err.Raise vbObjectError + 99, "Probe.Inner", "handled inside" +End Sub diff --git a/bugs/err-raise-defaults/err-raise-defaults.twinproj b/bugs/err-raise-defaults/err-raise-defaults.twinproj new file mode 100644 index 00000000..7d552d6d Binary files /dev/null and b/bugs/err-raise-defaults/err-raise-defaults.twinproj differ diff --git a/bugs/err-raise-defaults/repro.json b/bugs/err-raise-defaults/repro.json new file mode 100644 index 00000000..54d09026 --- /dev/null +++ b/bugs/err-raise-defaults/repro.json @@ -0,0 +1,12 @@ +{ + "mode": "run", + "expect": { + "exit": 0, + "output": [ + "^Raise 5: \\[\\] \\[Invalid procedure call or argument\\]$", + "^Raise 1: \\[\\] \\[\\]$", + "^Raise 1000: \\[\\] \\[Automation error\\]$", + "^Raise 5 after a full Raise: \\[\\] \\[Invalid procedure call or argument\\]$" + ] + } +} diff --git a/bugs/err-raise-defaults/src/Settings b/bugs/err-raise-defaults/src/Settings new file mode 100644 index 00000000..0d79848c --- /dev/null +++ b/bugs/err-raise-defaults/src/Settings @@ -0,0 +1,61 @@ +{ + "configuration.inherits": "Defaults", + "project.appTitle": "ErrRaiseDefaults", + "project.buildPath": "${SourcePath}\\Build\\${ProjectName}_${Architecture}.${FileExtension}", + "project.buildType": "Standard EXE", + "project.description": "Reproduces: `Err.Raise` without a source or a description leaves `Source` empty and `Description` empty or `Automation error`", + "project.exportPathIsV2": true, + "project.id": "{1B88F6EE-90C0-49BD-BAFB-3AE2E6D77BB7}", + "project.name": "ErrRaiseDefaults", + "project.optionExplicit": true, + "project.references": [ + { + "id": "{00020430-0000-0000-C000-000000000046}", + "lcid": 0, + "name": "OLE Automation", + "path32": "C:\\Windows\\SysWOW64\\stdole2.tlb", + "path64": "C:\\Windows\\System32\\stdole2.tlb", + "symbolId": "stdole", + "versionMajor": 2, + "versionMinor": 0 + }, + { + "id": "{F50B82D0-DCAB-43FE-9631-11959D4A4728}", + "isCompilerPackage": true, + "licence": "MIT", + "name": "[COMPILER PACKAGE] twinBASIC - VB Compatibility Package (Forms)", + "path32": "", + "path64": "", + "publisher": "TWINBASIC-COMPILER", + "symbolId": "VB", + "versionBuild": 0, + "versionMajor": 0, + "versionMinor": 0, + "versionRevision": 31 + }, + { + "id": "{C192FB39-64CA-4D9B-B477-A5502F48EFCC}", + "isCompilerPackage": true, + "licence": "MIT", + "name": "[COMPILER PACKAGE] twinBASIC - App global class object", + "path32": "", + "path64": "", + "publisher": "TWINBASIC-COMPILER", + "symbolId": "AppGlobalClassProject", + "versionBuild": 0, + "versionMajor": 1, + "versionMinor": 0, + "versionRevision": 0 + } + ], + "project.settingsVersion": 1, + "project.startupObject": "Sub Main", + "project.warnings": { + "errors": [], + "hints": [], + "ignored": [], + "info": [], + "warnings": [] + }, + "runtime.useUnicodeStandardLibrary": true +} diff --git a/bugs/err-raise-defaults/src/Sources/Startup.twin b/bugs/err-raise-defaults/src/Sources/Startup.twin new file mode 100644 index 00000000..5299fdc4 --- /dev/null +++ b/bugs/err-raise-defaults/src/Sources/Startup.twin @@ -0,0 +1,32 @@ +Module Startup + + Private Sub Show(ByVal Label As String) + Debug.Print Label & ": [" & Err.Source & "] [" & Err.Description & "]" + End Sub + + Public Sub Main() + On Error Resume Next + + Err.Clear + Err.Raise 5 + Show "Raise 5" + + Err.Clear + Err.Raise 1 + Show "Raise 1" + + Err.Clear + Err.Raise 513 + Show "Raise 513" + + Err.Clear + Err.Raise 1000 + Show "Raise 1000" + + Err.Clear + Err.Raise 1000, "A.Src", "B desc" + Err.Raise 5 + Show "Raise 5 after a full Raise" + End Sub + +End Module diff --git a/bugs/err-raise-defaults/vb6/Module1.bas b/bugs/err-raise-defaults/vb6/Module1.bas new file mode 100644 index 00000000..b3652dd1 --- /dev/null +++ b/bugs/err-raise-defaults/vb6/Module1.bas @@ -0,0 +1,43 @@ +Attribute VB_Name = "Module1" +Option Explicit + +Sub Show(ByVal Label As String) + Print #9, Label & ": [" & Err.Source & "] [" & Err.Description & "]" +End Sub + +Sub Main() + On Error GoTo Fail + Open App.Path & "\out.txt" For Output As #9 + Cases + Close #9 + Exit Sub +Fail: + On Error Resume Next + Print #9, "unhandled error " & Err.Number & ": " & Err.Description + Close #9 +End Sub + +Sub Cases() + On Error Resume Next + + Err.Clear + Err.Raise 5 + Show "Raise 5" + + Err.Clear + Err.Raise 1 + Show "Raise 1" + + Err.Clear + Err.Raise 513 + Show "Raise 513" + + Err.Clear + Err.Raise 1000 + Show "Raise 1000" + + Err.Clear + Err.Raise 1000, "A.Src", "B desc" + Err.Raise 5 + Show "Raise 5 after a full Raise" +End Sub diff --git a/bugs/err-raise-defaults/vb6/Probe.vbp b/bugs/err-raise-defaults/vb6/Probe.vbp new file mode 100644 index 00000000..4d210b0e --- /dev/null +++ b/bugs/err-raise-defaults/vb6/Probe.vbp @@ -0,0 +1,7 @@ +Type=Exe +Module=Module1; Module1.bas +Startup="Sub Main" +ExeName32="Probe.exe" +Name="Probe" +CompilationType=0 +OptimizationType=0 diff --git a/bugs/filed/enum-connection-points-contract/REPORT.md b/bugs/filed/enum-connection-points-contract/REPORT.md new file mode 100644 index 00000000..06d0ba8f --- /dev/null +++ b/bugs/filed/enum-connection-points-contract/REPORT.md @@ -0,0 +1,44 @@ +Filed as [twinbasic/twinbasic#2462](https://github.com/twinbasic/twinbasic/issues/2462). + +## The `IEnumConnectionPoints` of a twinBASIC class raises `E_FAIL` at the end of the list, and `Skip` and `Clone` raise `E_NOTIMPL` + +**Describe the bug** +The enumerator that `IConnectionPointContainer.EnumConnectionPoints` returns for a class with an `Event` does not follow the `IEnum` contract. `Next` raises `E_FAIL` when no item is left, and when more items are asked for than remain, where `S_FALSE` is expected. `Skip` and `Clone` both raise `E_NOTIMPL`. `Reset`, and `Next` with exactly one item left, work. + +**To Reproduce** +Steps to reproduce the behavior: +1. Open `enum-connection-points-contract.twinproj` (attached as `enum-connection-points-contract.zip`). Its one source file, `Startup.twin`, declares the project's own copies of `IConnectionPointContainer` and `IEnumConnectionPoints` (`stdole` has neither) and a class with one event. `Sub Main` gets the enumerator and calls it with `On Error Resume Next`: + ``` + points.Next 1, item, fetched ' the one point + points.Next 1, item, fetched ' at the end + points.Reset + points.Next 2, item, fetched ' two asked for, one left + points.Reset + points.Skip 1 + Dim copy As IEnumConnectionPoints = points.Clone() + ``` +2. Run the project in the IDE (F5). +3. See in the DEBUG CONSOLE: + ``` + Next 1, one point: error=0 LastHresult=0 fetched=1 + Next 1, at the end: error=80004005 LastHresult=0 fetched=0 + Next 2, one point: error=80004005 LastHresult=0 fetched=0 + Skip 1: error=80004001 LastHresult=0 fetched=0 + Clone: error=80004001 LastHresult=0 fetched=0 + ``` + +**Expected behavior** +The enumerator follows the contract, as the Windows SDK pages state it. [IEnumConnectionPoints::Next](https://learn.microsoft.com/en-us/windows/win32/api/ocidl/nf-ocidl-ienumconnectionpoints-next): "If there are fewer than the requested number of items left in the sequence, this method retrieves the remaining elements", *pcFetched* is the number retrieved, and "If the method retrieves the number of items requested, the return value is S_OK. Otherwise, it is S_FALSE." So the second call returns `S_FALSE` with 0 items and the third returns `S_FALSE` with 1. [Skip](https://learn.microsoft.com/en-us/windows/win32/api/ocidl/nf-ocidl-ienumconnectionpoints-skip) returns `S_OK`, or `S_FALSE` when it could not skip as many as asked. [Clone](https://learn.microsoft.com/en-us/windows/win32/api/ocidl/nf-ocidl-ienumconnectionpoints-clone) returns a new enumerator with the same state, and lists `E_INVALIDARG`, `E_OUTOFMEMORY`, `E_UNEXPECTED` and `S_OK`, not `E_NOTIMPL`. The sibling `IEnumConnections` of the same connection points does return `S_FALSE` at its end and implements `Skip` and `Clone`. VB6 follows the contract. For a VB6 class with one `Event`, the same calls through the vtable return: `Next 1` with one point: `S_OK`, fetched=1; `Next 1` at the end: `S_FALSE` (`00000001`), fetched=0; after `Reset`, `Next 2` with one point: `S_FALSE`, fetched=1; `Skip 1`: `S_OK`; `Clone`: `S_OK` and a new enumerator. No call fails. + +**Desktop:** + - OS: Windows 10 Pro 22H2 (build 19045) + - twinBASIC compiler version: BETA 995 + +**Additional context** +Severity: low for twinBASIC code, which knows there is one connection point, but a client written for the contract, such as a C++ loop that runs while `Next` returns `S_OK` and treats any failure as fatal, gets an error where it expects the end of the list. + +What was tried: a class with one event has exactly one connection point, so `Next 1` returning it and `Reset` followed by another `Next` both work. Reading `LastHresult` after the failing call gives 0, because the call raised its error instead of returning a success code. The same calls from a probe that passed raw pointers instead of typed variables gave the same codes. + +VB6 comparison: the VB6 project is attached as `enum-connection-points-contract-vb6.zip`. VB6 cannot declare these interfaces, so it calls them through the vtable with `DispCallFunc` on raw pointers. It was built with VB6 SP6 and run, and writes `out.txt` beside the exe. Its output for this entry's calls is `Next 1, one point: hr=00000000 fetched=1`, `Next 1, at the end: hr=00000001 fetched=0`, `Next 2, one point: hr=00000001 fetched=1`, `Skip 1: hr=00000000`, `Clone: hr=00000000`, against twinBASIC's `80004005`, `80004005`, `80004001` and `80004001` for the last four. + + diff --git a/bugs/filed/enum-connection-points-contract/enum-connection-points-contract.twinproj b/bugs/filed/enum-connection-points-contract/enum-connection-points-contract.twinproj new file mode 100644 index 00000000..073f7bb1 Binary files /dev/null and b/bugs/filed/enum-connection-points-contract/enum-connection-points-contract.twinproj differ diff --git a/bugs/filed/enum-connection-points-contract/repro.json b/bugs/filed/enum-connection-points-contract/repro.json new file mode 100644 index 00000000..7a974f1d --- /dev/null +++ b/bugs/filed/enum-connection-points-contract/repro.json @@ -0,0 +1,13 @@ +{ + "mode": "run", + "expect": { + "exit": 0, + "output": [ + "^Next 1, at the end: error=80004005 ", + "^Next 2, one point: error=80004005 ", + "^Skip 1: error=80004001 ", + "^Clone: error=80004001 " + ] + }, + "issue": 2462 +} diff --git a/bugs/filed/enum-connection-points-contract/src/Settings b/bugs/filed/enum-connection-points-contract/src/Settings new file mode 100644 index 00000000..cf6fae59 --- /dev/null +++ b/bugs/filed/enum-connection-points-contract/src/Settings @@ -0,0 +1,61 @@ +{ + "configuration.inherits": "Defaults", + "project.appTitle": "EnumConnectionPointsContract", + "project.buildPath": "${SourcePath}\\Build\\${ProjectName}_${Architecture}.${FileExtension}", + "project.buildType": "Standard EXE", + "project.description": "Reproduces: t", + "project.exportPathIsV2": true, + "project.id": "{33636B5C-756D-47E6-81D5-B030D3D8F9B9}", + "project.name": "EnumConnectionPointsContract", + "project.optionExplicit": true, + "project.references": [ + { + "id": "{00020430-0000-0000-C000-000000000046}", + "lcid": 0, + "name": "OLE Automation", + "path32": "C:\\Windows\\SysWOW64\\stdole2.tlb", + "path64": "C:\\Windows\\System32\\stdole2.tlb", + "symbolId": "stdole", + "versionMajor": 2, + "versionMinor": 0 + }, + { + "id": "{F50B82D0-DCAB-43FE-9631-11959D4A4728}", + "isCompilerPackage": true, + "licence": "MIT", + "name": "[COMPILER PACKAGE] twinBASIC - VB Compatibility Package (Forms)", + "path32": "", + "path64": "", + "publisher": "TWINBASIC-COMPILER", + "symbolId": "VB", + "versionBuild": 0, + "versionMajor": 0, + "versionMinor": 0, + "versionRevision": 31 + }, + { + "id": "{C192FB39-64CA-4D9B-B477-A5502F48EFCC}", + "isCompilerPackage": true, + "licence": "MIT", + "name": "[COMPILER PACKAGE] twinBASIC - App global class object", + "path32": "", + "path64": "", + "publisher": "TWINBASIC-COMPILER", + "symbolId": "AppGlobalClassProject", + "versionBuild": 0, + "versionMajor": 1, + "versionMinor": 0, + "versionRevision": 0 + } + ], + "project.settingsVersion": 1, + "project.startupObject": "Sub Main", + "project.warnings": { + "errors": [], + "hints": [], + "ignored": [], + "info": [], + "warnings": [] + }, + "runtime.useUnicodeStandardLibrary": true +} diff --git a/bugs/filed/enum-connection-points-contract/src/Sources/Startup.twin b/bugs/filed/enum-connection-points-contract/src/Sources/Startup.twin new file mode 100644 index 00000000..494a1284 --- /dev/null +++ b/bugs/filed/enum-connection-points-contract/src/Sources/Startup.twin @@ -0,0 +1,48 @@ +' The IEnumConnectionPoints that a class with an Event returns: +' Next raises E_FAIL at the end of the list (S_FALSE expected), and Skip and Clone raise E_NOTIMPL. +[InterfaceId("B196B284-BAB4-101A-B69C-00AA00341D07")] +Private Interface IConnectionPointContainer Extends stdole.IUnknown + Function EnumConnectionPoints() As IEnumConnectionPoints +End Interface + +[InterfaceId("B196B285-BAB4-101A-B69C-00AA00341D07")] +Private Interface IEnumConnectionPoints Extends stdole.IUnknown + Sub Next(ByVal cConnections As Long, ByRef ppCP As stdole.IUnknown, ByRef pcFetched As Long) + Sub Skip(ByVal cConnections As Long) + Sub Reset() + Function Clone() As IEnumConnectionPoints +End Interface + +Private Class Source + Public Event Ping() +End Class + +Module Startup + + Private Sub Report(ByVal What As String, ByVal Fetched As Long) + Debug.Print What & ": error=" & Hex$(Err.Number) & " LastHresult=" & Hex$(Err.LastHresult) & " fetched=" & Fetched + Err.Clear + End Sub + + Public Sub Main() + Dim src As New Source + Dim container As IConnectionPointContainer = src + Dim points As IEnumConnectionPoints = container.EnumConnectionPoints() + Dim item As stdole.IUnknown, fetched As Long + On Error Resume Next + + points.Next 1, item, fetched + Report "Next 1, one point", fetched + points.Next 1, item, fetched + Report "Next 1, at the end", fetched + points.Reset + points.Next 2, item, fetched + Report "Next 2, one point", fetched + points.Reset + points.Skip 1 + Report "Skip 1", fetched + Dim copy As IEnumConnectionPoints = points.Clone() + Report "Clone", fetched + End Sub + +End Module diff --git a/bugs/filed/enum-connection-points-contract/vb6/Holder.cls b/bugs/filed/enum-connection-points-contract/vb6/Holder.cls new file mode 100644 index 00000000..e2db21fa --- /dev/null +++ b/bugs/filed/enum-connection-points-contract/vb6/Holder.cls @@ -0,0 +1,20 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "Holder" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +Option Explicit + +' Each Holder with a WithEvents variable set to the source is one connection. +Private WithEvents Src As Source + +Public Sub Attach(ByVal Target As Source) + Set Src = Target +End Sub + +Private Sub Src_Ping() +End Sub diff --git a/bugs/filed/enum-connection-points-contract/vb6/Probe.vbp b/bugs/filed/enum-connection-points-contract/vb6/Probe.vbp new file mode 100644 index 00000000..f4a01c6e --- /dev/null +++ b/bugs/filed/enum-connection-points-contract/vb6/Probe.vbp @@ -0,0 +1,9 @@ +Type=Exe +Module=ProbeMain; ProbeMain.bas +Class=Source; Source.cls +Class=Holder; Holder.cls +Startup="Sub Main" +ExeName32="Probe.exe" +Name="Probe" +CompilationType=0 +OptimizationType=0 diff --git a/bugs/filed/enum-connection-points-contract/vb6/ProbeMain.bas b/bugs/filed/enum-connection-points-contract/vb6/ProbeMain.bas new file mode 100644 index 00000000..6e7c357b --- /dev/null +++ b/bugs/filed/enum-connection-points-contract/vb6/ProbeMain.bas @@ -0,0 +1,218 @@ +Attribute VB_Name = "ProbeMain" +Option Explicit + +' The VB6 counterpart of bugs/enum-connections-one-item and bugs/enum-connection-points-contract. +' VB6 cannot declare IConnectionPointContainer, IEnumConnectionPoints, IConnectionPoint or +' IEnumConnections, so each call goes through the vtable with DispCallFunc on raw pointers. +' Vtable slots: IUnknown 0..2; IConnectionPointContainer.EnumConnectionPoints 3; +' IEnumConnectionPoints / IEnumConnections Next 3, Skip 4, Reset 5, Clone 6; +' IConnectionPoint.EnumConnections 7. Output goes to out.txt beside the exe. + +Private Declare Function DispCallFunc Lib "oleaut32" (ByVal pvInstance As Long, ByVal oVft As Long, ByVal cc As Long, ByVal vtReturn As Integer, ByVal cActuals As Long, prgvt As Integer, prgpvarg As Long, pvargResult As Variant) As Long +Private Declare Function IIDFromString Lib "ole32" (ByVal lpsz As Long, lpiid As GUID) As Long + +Private Type GUID + Data1 As Long + Data2 As Integer + Data3 As Integer + Data4(0 To 7) As Byte +End Type + +Private Type CONNECTDATA + pUnk As Long + dwCookie As Long +End Type + +Private Const CC_STDCALL As Long = 4 +Private Const VT_I4 As Integer = 3 + +Private Items(0 To 3) As CONNECTDATA +Private Points(0 To 3) As Long + +Sub Main() + On Error GoTo Fail + Open App.Path & "\out.txt" For Output As #9 + Run + Close #9 + Exit Sub +Fail: + On Error Resume Next + Print #9, "unhandled error " & Err.Number & ": " & Err.Description + Close #9 +End Sub + +Private Sub Emit(ByVal s As String) + Print #9, s +End Sub + +Private Function H(ByVal v As Long) As String + H = Right$("00000000" & Hex$(v), 8) +End Function + +' Calls vtable slot Slot of the object at pObj with up to four Long arguments; returns the HRESULT. +Private Function VCall(ByVal pObj As Long, ByVal Slot As Long, ParamArray A() As Variant) As Long + Dim n As Long, i As Long + Dim vars(0 To 3) As Variant + Dim vts(0 To 3) As Integer + Dim ptrs(0 To 3) As Long + Dim res As Variant + Dim rc As Long + n = UBound(A) + 1 + For i = 0 To n - 1 + vars(i) = CLng(A(i)) + vts(i) = VT_I4 + ptrs(i) = VarPtr(vars(i)) + Next i + res = Empty + rc = DispCallFunc(pObj, Slot * 4, CC_STDCALL, VT_I4, n, vts(0), ptrs(0), res) + If rc <> 0 Then + VCall = rc + Else + VCall = CLng(res) + End If +End Function + +Private Sub ReleasePtr(ByVal p As Long) + If p <> 0 Then VCall p, 2 +End Sub + +Private Sub Run() + Dim src As Source + Dim a As Holder, b As Holder + Dim iid As GUID + Dim pCPC As Long, pEnumPts As Long, pPoint As Long + Dim hr As Long + + Set src = New Source + Set a = New Holder + Set b = New Holder + a.Attach src + b.Attach src + + hr = IIDFromString(StrPtr("{B196B284-BAB4-101A-B69C-00AA00341D07}"), iid) + Emit "IIDFromString: hr=" & H(hr) + hr = VCall(ObjPtr(src), 0, VarPtr(iid), VarPtr(pCPC)) + Emit "QueryInterface(IConnectionPointContainer): hr=" & H(hr) & " ptr<>0: " & (pCPC <> 0) + If pCPC = 0 Then Exit Sub + + ' --- IEnumConnectionPoints: the sequence of enum-connection-points-contract --- + hr = VCall(pCPC, 3, VarPtr(pEnumPts)) + Emit "EnumConnectionPoints: hr=" & H(hr) + If pEnumPts = 0 Then Exit Sub + PointsNext pEnumPts, 1, "Next 1, one point" + PointsNext pEnumPts, 1, "Next 1, at the end" + Emit "Reset: hr=" & H(VCall(pEnumPts, 5)) + PointsNext pEnumPts, 2, "Next 2, one point" + Emit "Reset: hr=" & H(VCall(pEnumPts, 5)) + Emit "Skip 1: hr=" & H(VCall(pEnumPts, 4, 1)) + Dim pCopy As Long + hr = VCall(pEnumPts, 6, VarPtr(pCopy)) + Emit "Clone: hr=" & H(hr) & " ptr<>0: " & (pCopy <> 0) + ReleasePtr pCopy + ReleasePtr pEnumPts + + ' --- IEnumConnections: the sequence of enum-connections-one-item --- + hr = VCall(pCPC, 3, VarPtr(pEnumPts)) + Emit "EnumConnectionPoints (again): hr=" & H(hr) + PointsNext pEnumPts, 1, "Next 1, one point (to get the point)" + pPoint = Points(0) + Points(0) = 0 + ReleasePtr pEnumPts + If pPoint = 0 Then Exit Sub + + Dim pEnum As Long, pClone As Long + + pEnum = NewConnEnum(pPoint) + ConnNext pEnum, 2, "Next 2, two connections" + ConnNext pEnum, 1, "Next 1, after Next 2 took both" + ReleasePtr pEnum + + pEnum = NewConnEnum(pPoint) + ConnNext pEnum, 3, "Next 3, two connections" + ReleasePtr pEnum + + pEnum = NewConnEnum(pPoint) + ConnNext pEnum, 1, "Next 1, first" + ConnNext pEnum, 1, "Next 1, second" + ConnNext pEnum, 1, "Next 1, at the end" + Emit "Reset: hr=" & H(VCall(pEnum, 5)) + ConnNext pEnum, 2, "Next 2, after Reset" + ReleasePtr pEnum + + pEnum = NewConnEnum(pPoint) + Emit "Skip 1: hr=" & H(VCall(pEnum, 4, 1)) + ConnNext pEnum, 1, "Next 1, after Skip 1" + ReleasePtr pEnum + + pEnum = NewConnEnum(pPoint) + ConnNext pEnum, 1, "Next 1, before Clone" + pClone = 0 + hr = VCall(pEnum, 6, VarPtr(pClone)) + Emit "Clone: hr=" & H(hr) & " ptr<>0: " & (pClone <> 0) + If pClone <> 0 Then ConnNext pClone, 2, "Next 2 on the clone, one left" + ReleasePtr pClone + ReleasePtr pEnum + + pEnum = NewConnEnum(pPoint) + ClearItems + hr = VCall(pEnum, 3, 1, VarPtr(Items(0)), 0) + Emit "Next 1 with null pcFetched: hr=" & H(hr) & " cookie=" & Items(0).dwCookie + ReleaseItems + ReleasePtr pEnum + + ReleasePtr pPoint + ReleasePtr pCPC +End Sub + +Private Sub PointsNext(ByVal pEnumPts As Long, ByVal Count As Long, ByVal Label As String) + Dim i As Long, hr As Long, fetched As Long + For i = 0 To 3 + Points(i) = 0 + Next i + fetched = -1 + hr = VCall(pEnumPts, 3, Count, VarPtr(Points(0)), VarPtr(fetched)) + Emit Label & ": hr=" & H(hr) & " fetched=" & fetched + ' Points(0) stays set for the caller that wants the point; release every other pointer. + Dim keep As Long + If InStr(Label, "to get the point") > 0 Then keep = 1 Else keep = 0 + For i = keep To 3 + ReleasePtr Points(i) + Points(i) = 0 + Next i +End Sub + +Private Function NewConnEnum(ByVal pPoint As Long) As Long + Dim hr As Long, p As Long + hr = VCall(pPoint, 7, VarPtr(p)) + If hr <> 0 Then Emit "EnumConnections: hr=" & H(hr) + NewConnEnum = p +End Function + +Private Sub ClearItems() + Dim i As Long + For i = 0 To 3 + Items(i).pUnk = 0 + Items(i).dwCookie = 0 + Next i +End Sub + +Private Sub ReleaseItems() + Dim i As Long + For i = 0 To 3 + ReleasePtr Items(i).pUnk + Items(i).pUnk = 0 + Next i +End Sub + +Private Sub ConnNext(ByVal pEnum As Long, ByVal Count As Long, ByVal Label As String) + Dim hr As Long, fetched As Long, i As Long, s As String + ClearItems + fetched = -1 + hr = VCall(pEnum, 3, Count, VarPtr(Items(0)), VarPtr(fetched)) + s = "" + For i = 0 To Count - 1 + s = s & " " & Items(i).dwCookie + Next i + Emit Label & ": hr=" & H(hr) & " fetched=" & fetched & ", cookies" & s + ReleaseItems +End Sub diff --git a/bugs/filed/enum-connection-points-contract/vb6/Source.cls b/bugs/filed/enum-connection-points-contract/vb6/Source.cls new file mode 100644 index 00000000..59f1b368 --- /dev/null +++ b/bugs/filed/enum-connection-points-contract/vb6/Source.cls @@ -0,0 +1,13 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "Source" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +Option Explicit + +' A class with one event, so one connection point. +Public Event Ping() diff --git a/bugs/filed/enum-connections-one-item/REPORT.md b/bugs/filed/enum-connections-one-item/REPORT.md new file mode 100644 index 00000000..3e2846d9 --- /dev/null +++ b/bugs/filed/enum-connections-one-item/REPORT.md @@ -0,0 +1,34 @@ +Filed as [twinbasic/twinbasic#2461](https://github.com/twinbasic/twinbasic/issues/2461). + +## `IEnumConnections.Next` returns one item when asked for two with two connections present + +**Describe the bug** +The enumerator that `IConnectionPoint.EnumConnections` returns for a twinBASIC class's connection point returns at most one item per `Next` call, whatever the count asked for. With two sinks connected, `Next 2` fills one `CONNECTDATA`, reports `pcFetched` as 1, and leaves the second element of the array untouched. + +**To Reproduce** +Steps to reproduce the behavior: +1. Open `enum-connections-one-item.twinproj` (attached as `enum-connections-one-item.zip`). Its one source file, `Startup.twin`, declares the project's own copies of the connection-point interfaces (`stdole` has none of them), a class `Source` with one event, and a class `Listener` with a `WithEvents` variable of type `Source`. `Sub Main` attaches two listeners to one source, takes the connection point, and asks for both connections at once: + ``` + Dim items(0 To 1) As CONNECTDATA + Dim connections As IEnumConnections = point.EnumConnections() + connections.Next 2, items(0), fetched + Debug.Print "asked for 2, two connections present: fetched=" & fetched & ", cookies " & items(0).dwCookie & " and " & items(1).dwCookie + ``` +2. Run the project in the IDE (F5). +3. See `asked for 2, two connections present: fetched=1, cookies 1 and 0`. + +**Expected behavior** +`fetched` is 2 and the cookies are 1 and 2. The Windows SDK page for [IEnumConnections::Next](https://learn.microsoft.com/en-us/windows/win32/api/ocidl/nf-ocidl-ienumconnections-next) says *cConnections* is "The number of items to be retrieved. If there are fewer than the requested number of items left in the sequence, this method retrieves the remaining elements", *pcFetched* is "The number of items that were retrieved", and the return value is `S_OK` "If the method retrieves the number of items requested". A caller that passes an array and a count, as the page says it may, loses every connection after the first, and does not know it, because the call returns `S_OK`. VB6 follows the contract. With two `WithEvents` holders on one source object, `Next 2` returns `S_OK` with fetched=2 and both `CONNECTDATA` elements filled (the cookies are two different values, `4685276` and `4686156` in that run); `Next 3` returns `S_FALSE` with fetched=2; `Next 1` called three times returns the two items in turn, then `S_FALSE` with fetched=0, and `Next 2` after `Reset` returns both again. + +**Desktop:** + - OS: Windows 10 Pro 22H2 (build 19045) + - twinBASIC compiler version: BETA 995 + +**Additional context** +Severity: low; the interface is mostly read one item at a time, which works, and the call at the end of the list is correct. It matters to a client that reads in blocks. + +What was tried: `Next 3` with two connections returns 1 item as well. `Next 1` called repeatedly returns the items in turn, and returns `S_FALSE` with 0 items at the end. `Skip` and `Clone` work, and a null *pcFetched* is accepted for a request of 1. `IEnumConnectionPoints`, the sibling enumerator, has a different fault (see the entry about its `E_FAIL`), so the two are separate. + +VB6 comparison: the VB6 project is attached as `enum-connections-one-item-vb6.zip`. VB6 cannot declare these interfaces, so it calls them through the vtable with `DispCallFunc` on raw pointers: a `Source` class with one `Event`, two `Holder` classes each with a `WithEvents` variable set to the one source, then the same calls. It was built with VB6 SP6 and run, and writes `out.txt` beside the exe. Its output for the call of this entry is `Next 2, two connections: hr=00000000 fetched=2, cookies 4685276 4686156`, against twinBASIC's `fetched=1, cookies 1 and 0`. The other calls match twinBASIC: `Skip 1` and `Clone` return `S_OK`, a null *pcFetched* is accepted for `Next 1`, and `Next 1` at the end returns `S_FALSE` with fetched=0. VB6's cookies are large values, not 1 and 2, so only the count and the two distinct non-zero cookies are the expectation, not the values 1 and 2. + + diff --git a/bugs/filed/enum-connections-one-item/enum-connections-one-item.twinproj b/bugs/filed/enum-connections-one-item/enum-connections-one-item.twinproj new file mode 100644 index 00000000..92e546c0 Binary files /dev/null and b/bugs/filed/enum-connections-one-item/enum-connections-one-item.twinproj differ diff --git a/bugs/filed/enum-connections-one-item/repro.json b/bugs/filed/enum-connections-one-item/repro.json new file mode 100644 index 00000000..2ddfc55f --- /dev/null +++ b/bugs/filed/enum-connections-one-item/repro.json @@ -0,0 +1,10 @@ +{ + "mode": "run", + "expect": { + "exit": 0, + "output": [ + "^asked for 2, two connections present: fetched=1, cookies 1 and 0$" + ] + }, + "issue": 2461 +} diff --git a/bugs/filed/enum-connections-one-item/src/Settings b/bugs/filed/enum-connections-one-item/src/Settings new file mode 100644 index 00000000..e67c99a8 --- /dev/null +++ b/bugs/filed/enum-connections-one-item/src/Settings @@ -0,0 +1,61 @@ +{ + "configuration.inherits": "Defaults", + "project.appTitle": "EnumConnectionsOneItem", + "project.buildPath": "${SourcePath}\\Build\\${ProjectName}_${Architecture}.${FileExtension}", + "project.buildType": "Standard EXE", + "project.description": "Reproduces: t", + "project.exportPathIsV2": true, + "project.id": "{56E42A1F-E0AB-43A8-AEC4-446D3A1833A9}", + "project.name": "EnumConnectionsOneItem", + "project.optionExplicit": true, + "project.references": [ + { + "id": "{00020430-0000-0000-C000-000000000046}", + "lcid": 0, + "name": "OLE Automation", + "path32": "C:\\Windows\\SysWOW64\\stdole2.tlb", + "path64": "C:\\Windows\\System32\\stdole2.tlb", + "symbolId": "stdole", + "versionMajor": 2, + "versionMinor": 0 + }, + { + "id": "{F50B82D0-DCAB-43FE-9631-11959D4A4728}", + "isCompilerPackage": true, + "licence": "MIT", + "name": "[COMPILER PACKAGE] twinBASIC - VB Compatibility Package (Forms)", + "path32": "", + "path64": "", + "publisher": "TWINBASIC-COMPILER", + "symbolId": "VB", + "versionBuild": 0, + "versionMajor": 0, + "versionMinor": 0, + "versionRevision": 31 + }, + { + "id": "{C192FB39-64CA-4D9B-B477-A5502F48EFCC}", + "isCompilerPackage": true, + "licence": "MIT", + "name": "[COMPILER PACKAGE] twinBASIC - App global class object", + "path32": "", + "path64": "", + "publisher": "TWINBASIC-COMPILER", + "symbolId": "AppGlobalClassProject", + "versionBuild": 0, + "versionMajor": 1, + "versionMinor": 0, + "versionRevision": 0 + } + ], + "project.settingsVersion": 1, + "project.startupObject": "Sub Main", + "project.warnings": { + "errors": [], + "hints": [], + "ignored": [], + "info": [], + "warnings": [] + }, + "runtime.useUnicodeStandardLibrary": true +} diff --git a/bugs/filed/enum-connections-one-item/src/Sources/Startup.twin b/bugs/filed/enum-connections-one-item/src/Sources/Startup.twin new file mode 100644 index 00000000..f4f098a2 --- /dev/null +++ b/bugs/filed/enum-connections-one-item/src/Sources/Startup.twin @@ -0,0 +1,69 @@ +' The IEnumConnections that a connection point returns hands back one item per Next call, +' even when asked for two with two connections present. +Public Module Types + Public Type CONNECTDATA + pUnk As stdole.IUnknown + dwCookie As Long + End Type +End Module + +[InterfaceId("B196B284-BAB4-101A-B69C-00AA00341D07")] +Private Interface IConnectionPointContainer Extends stdole.IUnknown + Function EnumConnectionPoints() As IEnumConnectionPoints +End Interface + +[InterfaceId("B196B285-BAB4-101A-B69C-00AA00341D07")] +Private Interface IEnumConnectionPoints Extends stdole.IUnknown + Sub Next(ByVal cConnections As Long, ByRef ppCP As IConnectionPoint, ByRef pcFetched As Long) +End Interface + +[InterfaceId("B196B286-BAB4-101A-B69C-00AA00341D07")] +Private Interface IConnectionPoint Extends stdole.IUnknown + Sub GetConnectionInterface(ByVal piid As LongPtr) + Function GetConnectionPointContainer() As IConnectionPointContainer + Function Advise(ByVal pUnkSink As stdole.IUnknown) As Long + Sub Unadvise(ByVal dwCookie As Long) + Function EnumConnections() As IEnumConnections +End Interface + +[InterfaceId("B196B287-BAB4-101A-B69C-00AA00341D07")] +Private Interface IEnumConnections Extends stdole.IUnknown + Sub Next(ByVal cConnections As Long, ByRef rgcd As CONNECTDATA, ByRef pcFetched As Long) + Sub Skip(ByVal cConnections As Long) + Sub Reset() + Function Clone() As IEnumConnections +End Interface + +Private Class Source + Public Event Ping() +End Class + +Private Class Listener + Private WithEvents Src As Source + Public Sub Attach(ByVal Target As Source) + Set Src = Target + End Sub + Private Sub Src_Ping() + End Sub +End Class + +Module Startup + + Public Sub Main() + Dim src As New Source + Dim a As New Listener, b As New Listener + a.Attach src + b.Attach src + + Dim container As IConnectionPointContainer = src + Dim points As IEnumConnectionPoints = container.EnumConnectionPoints() + Dim point As IConnectionPoint, fetched As Long + points.Next 1, point, fetched + + Dim items(0 To 1) As CONNECTDATA + Dim connections As IEnumConnections = point.EnumConnections() + connections.Next 2, items(0), fetched + Debug.Print "asked for 2, two connections present: fetched=" & fetched & ", cookies " & items(0).dwCookie & " and " & items(1).dwCookie + End Sub + +End Module diff --git a/bugs/filed/enum-connections-one-item/vb6/Holder.cls b/bugs/filed/enum-connections-one-item/vb6/Holder.cls new file mode 100644 index 00000000..e2db21fa --- /dev/null +++ b/bugs/filed/enum-connections-one-item/vb6/Holder.cls @@ -0,0 +1,20 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "Holder" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +Option Explicit + +' Each Holder with a WithEvents variable set to the source is one connection. +Private WithEvents Src As Source + +Public Sub Attach(ByVal Target As Source) + Set Src = Target +End Sub + +Private Sub Src_Ping() +End Sub diff --git a/bugs/filed/enum-connections-one-item/vb6/Probe.vbp b/bugs/filed/enum-connections-one-item/vb6/Probe.vbp new file mode 100644 index 00000000..f4a01c6e --- /dev/null +++ b/bugs/filed/enum-connections-one-item/vb6/Probe.vbp @@ -0,0 +1,9 @@ +Type=Exe +Module=ProbeMain; ProbeMain.bas +Class=Source; Source.cls +Class=Holder; Holder.cls +Startup="Sub Main" +ExeName32="Probe.exe" +Name="Probe" +CompilationType=0 +OptimizationType=0 diff --git a/bugs/filed/enum-connections-one-item/vb6/ProbeMain.bas b/bugs/filed/enum-connections-one-item/vb6/ProbeMain.bas new file mode 100644 index 00000000..6e7c357b --- /dev/null +++ b/bugs/filed/enum-connections-one-item/vb6/ProbeMain.bas @@ -0,0 +1,218 @@ +Attribute VB_Name = "ProbeMain" +Option Explicit + +' The VB6 counterpart of bugs/enum-connections-one-item and bugs/enum-connection-points-contract. +' VB6 cannot declare IConnectionPointContainer, IEnumConnectionPoints, IConnectionPoint or +' IEnumConnections, so each call goes through the vtable with DispCallFunc on raw pointers. +' Vtable slots: IUnknown 0..2; IConnectionPointContainer.EnumConnectionPoints 3; +' IEnumConnectionPoints / IEnumConnections Next 3, Skip 4, Reset 5, Clone 6; +' IConnectionPoint.EnumConnections 7. Output goes to out.txt beside the exe. + +Private Declare Function DispCallFunc Lib "oleaut32" (ByVal pvInstance As Long, ByVal oVft As Long, ByVal cc As Long, ByVal vtReturn As Integer, ByVal cActuals As Long, prgvt As Integer, prgpvarg As Long, pvargResult As Variant) As Long +Private Declare Function IIDFromString Lib "ole32" (ByVal lpsz As Long, lpiid As GUID) As Long + +Private Type GUID + Data1 As Long + Data2 As Integer + Data3 As Integer + Data4(0 To 7) As Byte +End Type + +Private Type CONNECTDATA + pUnk As Long + dwCookie As Long +End Type + +Private Const CC_STDCALL As Long = 4 +Private Const VT_I4 As Integer = 3 + +Private Items(0 To 3) As CONNECTDATA +Private Points(0 To 3) As Long + +Sub Main() + On Error GoTo Fail + Open App.Path & "\out.txt" For Output As #9 + Run + Close #9 + Exit Sub +Fail: + On Error Resume Next + Print #9, "unhandled error " & Err.Number & ": " & Err.Description + Close #9 +End Sub + +Private Sub Emit(ByVal s As String) + Print #9, s +End Sub + +Private Function H(ByVal v As Long) As String + H = Right$("00000000" & Hex$(v), 8) +End Function + +' Calls vtable slot Slot of the object at pObj with up to four Long arguments; returns the HRESULT. +Private Function VCall(ByVal pObj As Long, ByVal Slot As Long, ParamArray A() As Variant) As Long + Dim n As Long, i As Long + Dim vars(0 To 3) As Variant + Dim vts(0 To 3) As Integer + Dim ptrs(0 To 3) As Long + Dim res As Variant + Dim rc As Long + n = UBound(A) + 1 + For i = 0 To n - 1 + vars(i) = CLng(A(i)) + vts(i) = VT_I4 + ptrs(i) = VarPtr(vars(i)) + Next i + res = Empty + rc = DispCallFunc(pObj, Slot * 4, CC_STDCALL, VT_I4, n, vts(0), ptrs(0), res) + If rc <> 0 Then + VCall = rc + Else + VCall = CLng(res) + End If +End Function + +Private Sub ReleasePtr(ByVal p As Long) + If p <> 0 Then VCall p, 2 +End Sub + +Private Sub Run() + Dim src As Source + Dim a As Holder, b As Holder + Dim iid As GUID + Dim pCPC As Long, pEnumPts As Long, pPoint As Long + Dim hr As Long + + Set src = New Source + Set a = New Holder + Set b = New Holder + a.Attach src + b.Attach src + + hr = IIDFromString(StrPtr("{B196B284-BAB4-101A-B69C-00AA00341D07}"), iid) + Emit "IIDFromString: hr=" & H(hr) + hr = VCall(ObjPtr(src), 0, VarPtr(iid), VarPtr(pCPC)) + Emit "QueryInterface(IConnectionPointContainer): hr=" & H(hr) & " ptr<>0: " & (pCPC <> 0) + If pCPC = 0 Then Exit Sub + + ' --- IEnumConnectionPoints: the sequence of enum-connection-points-contract --- + hr = VCall(pCPC, 3, VarPtr(pEnumPts)) + Emit "EnumConnectionPoints: hr=" & H(hr) + If pEnumPts = 0 Then Exit Sub + PointsNext pEnumPts, 1, "Next 1, one point" + PointsNext pEnumPts, 1, "Next 1, at the end" + Emit "Reset: hr=" & H(VCall(pEnumPts, 5)) + PointsNext pEnumPts, 2, "Next 2, one point" + Emit "Reset: hr=" & H(VCall(pEnumPts, 5)) + Emit "Skip 1: hr=" & H(VCall(pEnumPts, 4, 1)) + Dim pCopy As Long + hr = VCall(pEnumPts, 6, VarPtr(pCopy)) + Emit "Clone: hr=" & H(hr) & " ptr<>0: " & (pCopy <> 0) + ReleasePtr pCopy + ReleasePtr pEnumPts + + ' --- IEnumConnections: the sequence of enum-connections-one-item --- + hr = VCall(pCPC, 3, VarPtr(pEnumPts)) + Emit "EnumConnectionPoints (again): hr=" & H(hr) + PointsNext pEnumPts, 1, "Next 1, one point (to get the point)" + pPoint = Points(0) + Points(0) = 0 + ReleasePtr pEnumPts + If pPoint = 0 Then Exit Sub + + Dim pEnum As Long, pClone As Long + + pEnum = NewConnEnum(pPoint) + ConnNext pEnum, 2, "Next 2, two connections" + ConnNext pEnum, 1, "Next 1, after Next 2 took both" + ReleasePtr pEnum + + pEnum = NewConnEnum(pPoint) + ConnNext pEnum, 3, "Next 3, two connections" + ReleasePtr pEnum + + pEnum = NewConnEnum(pPoint) + ConnNext pEnum, 1, "Next 1, first" + ConnNext pEnum, 1, "Next 1, second" + ConnNext pEnum, 1, "Next 1, at the end" + Emit "Reset: hr=" & H(VCall(pEnum, 5)) + ConnNext pEnum, 2, "Next 2, after Reset" + ReleasePtr pEnum + + pEnum = NewConnEnum(pPoint) + Emit "Skip 1: hr=" & H(VCall(pEnum, 4, 1)) + ConnNext pEnum, 1, "Next 1, after Skip 1" + ReleasePtr pEnum + + pEnum = NewConnEnum(pPoint) + ConnNext pEnum, 1, "Next 1, before Clone" + pClone = 0 + hr = VCall(pEnum, 6, VarPtr(pClone)) + Emit "Clone: hr=" & H(hr) & " ptr<>0: " & (pClone <> 0) + If pClone <> 0 Then ConnNext pClone, 2, "Next 2 on the clone, one left" + ReleasePtr pClone + ReleasePtr pEnum + + pEnum = NewConnEnum(pPoint) + ClearItems + hr = VCall(pEnum, 3, 1, VarPtr(Items(0)), 0) + Emit "Next 1 with null pcFetched: hr=" & H(hr) & " cookie=" & Items(0).dwCookie + ReleaseItems + ReleasePtr pEnum + + ReleasePtr pPoint + ReleasePtr pCPC +End Sub + +Private Sub PointsNext(ByVal pEnumPts As Long, ByVal Count As Long, ByVal Label As String) + Dim i As Long, hr As Long, fetched As Long + For i = 0 To 3 + Points(i) = 0 + Next i + fetched = -1 + hr = VCall(pEnumPts, 3, Count, VarPtr(Points(0)), VarPtr(fetched)) + Emit Label & ": hr=" & H(hr) & " fetched=" & fetched + ' Points(0) stays set for the caller that wants the point; release every other pointer. + Dim keep As Long + If InStr(Label, "to get the point") > 0 Then keep = 1 Else keep = 0 + For i = keep To 3 + ReleasePtr Points(i) + Points(i) = 0 + Next i +End Sub + +Private Function NewConnEnum(ByVal pPoint As Long) As Long + Dim hr As Long, p As Long + hr = VCall(pPoint, 7, VarPtr(p)) + If hr <> 0 Then Emit "EnumConnections: hr=" & H(hr) + NewConnEnum = p +End Function + +Private Sub ClearItems() + Dim i As Long + For i = 0 To 3 + Items(i).pUnk = 0 + Items(i).dwCookie = 0 + Next i +End Sub + +Private Sub ReleaseItems() + Dim i As Long + For i = 0 To 3 + ReleasePtr Items(i).pUnk + Items(i).pUnk = 0 + Next i +End Sub + +Private Sub ConnNext(ByVal pEnum As Long, ByVal Count As Long, ByVal Label As String) + Dim hr As Long, fetched As Long, i As Long, s As String + ClearItems + fetched = -1 + hr = VCall(pEnum, 3, Count, VarPtr(Items(0)), VarPtr(fetched)) + s = "" + For i = 0 To Count - 1 + s = s & " " & Items(i).dwCookie + Next i + Emit Label & ": hr=" & H(hr) & " fetched=" & fetched & ", cookies" & s + ReleaseItems +End Sub diff --git a/bugs/filed/enum-connections-one-item/vb6/Source.cls b/bugs/filed/enum-connections-one-item/vb6/Source.cls new file mode 100644 index 00000000..59f1b368 --- /dev/null +++ b/bugs/filed/enum-connections-one-item/vb6/Source.cls @@ -0,0 +1,13 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "Source" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +Option Explicit + +' A class with one event, so one connection point. +Public Event Ping() diff --git a/bugs/filed/wv2-headers-foreach-crash/REPORT.md b/bugs/filed/wv2-headers-foreach-crash/REPORT.md new file mode 100644 index 00000000..e4fcd77a --- /dev/null +++ b/bugs/filed/wv2-headers-foreach-crash/REPORT.md @@ -0,0 +1,36 @@ +Filed as [twinbasic/twinbasic#2460](https://github.com/twinbasic/twinbasic/issues/2460). + +## For Each over WebView2 request or response headers crashes in WebView2HeadersCollection.Next + +**Describe the bug** +`For Each` over the `WebView2RequestHeaders` that `NavigationStarting` receives crashes with an access violation in `WebView2HeadersCollection.Next`. `WebView2ResponseHeaders` returns the same enumerator from its `_NewEnum`, so `For Each` over response headers reaches the same code (not run). `For Each` calls `IEnumVARIANT::Next` with `pCeltFetched` set to a null pointer, which the interface allows, and the package's `Next` assigns to `pCeltFetched` without testing it. The DEBUG CONSOLE shows `NATIVE EXCEPTION: ACCESS_VIOLATION /WebView2HeadersCollection.twin; WebView2HeadersCollection.Next`. + +**To Reproduce** +Steps to reproduce the behavior: +1. Open `wv2-headers-foreach-crash.twinproj` (attached as `wv2-headers-foreach-crash.zip`). It references the WebView2 package and has one form, `Form1`, with one WebView2 control, `WebView21`. `Sub Main` shows the form modally. When the control is ready it navigates to `about:blank`, and its `NavigationStarting` handler goes through the request headers: + ``` + Private Sub WebView21_NavigationStarting(ByVal Uri As String, ByVal IsUserInitiated As Boolean, _ + ByVal IsRedirected As Boolean, ByVal RequestHeaders As WebView2RequestHeaders, _ + Cancel As Boolean) Handles WebView21.NavigationStarting + Debug.Print "NavigationStarting " & Uri + Dim h As WebView2Header + For Each h In RequestHeaders + Debug.Print h.Name & ": " & h.Value + Next + Debug.Print "after For Each" + End Sub + ``` +2. Run the project (F5). +3. See `NavigationStarting about:blank` in the DEBUG CONSOLE, and then `NATIVE EXCEPTION: ACCESS_VIOLATION /WebView2HeadersCollection.twin; WebView2HeadersCollection.Next`. `after For Each` is never printed. + +**Expected behavior** +`For Each` yields each header, and the loop ends. The package's documentation shows this loop in a `NavigationStarting` handler. `Next` should assign to `pCeltFetched` only when its address is not zero, for example `If VarPtr(pCeltFetched) <> 0 Then pCeltFetched = 1`, in both places it assigns it. + +**Desktop:** + - OS: Windows 10 Pro 22H2 (build 19045) + - twinBASIC compiler version: BETA 995 + +**Additional context** +Severity: medium; `For Each` is the documented way to read the headers, and it ends the program. Without the `For Each`, the same project navigates, closes the form and returns. The same project crashes the same way on BETA 983. Calling `Next` directly, through a copy of `IEnumVARIANT` with a variable for `pCeltFetched`, returns the headers and then the end; the crash needs the null pointer that `For Each` passes. The same null `pCeltFetched` from `For Each` was measured with an enumerator written in a project: an unguarded assignment fails with an access violation there too. `Reset`, which `For Each` calls first, returns `E_NOTIMPL` here, and `For Each` goes on to call `Next` regardless. + + diff --git a/bugs/wv2-headers-foreach-crash/repro.json b/bugs/filed/wv2-headers-foreach-crash/repro.json similarity index 91% rename from bugs/wv2-headers-foreach-crash/repro.json rename to bugs/filed/wv2-headers-foreach-crash/repro.json index 5afabb0f..dad8ae65 100644 --- a/bugs/wv2-headers-foreach-crash/repro.json +++ b/bugs/filed/wv2-headers-foreach-crash/repro.json @@ -9,5 +9,6 @@ "absent": [ "^after For Each$" ] - } + }, + "issue": 2460 } diff --git a/bugs/wv2-headers-foreach-crash/src/Settings b/bugs/filed/wv2-headers-foreach-crash/src/Settings similarity index 100% rename from bugs/wv2-headers-foreach-crash/src/Settings rename to bugs/filed/wv2-headers-foreach-crash/src/Settings diff --git a/bugs/wv2-headers-foreach-crash/src/Sources/Form1.tbform b/bugs/filed/wv2-headers-foreach-crash/src/Sources/Form1.tbform similarity index 100% rename from bugs/wv2-headers-foreach-crash/src/Sources/Form1.tbform rename to bugs/filed/wv2-headers-foreach-crash/src/Sources/Form1.tbform diff --git a/bugs/wv2-headers-foreach-crash/src/Sources/Form1.twin b/bugs/filed/wv2-headers-foreach-crash/src/Sources/Form1.twin similarity index 100% rename from bugs/wv2-headers-foreach-crash/src/Sources/Form1.twin rename to bugs/filed/wv2-headers-foreach-crash/src/Sources/Form1.twin diff --git a/bugs/wv2-headers-foreach-crash/src/Sources/Startup.twin b/bugs/filed/wv2-headers-foreach-crash/src/Sources/Startup.twin similarity index 100% rename from bugs/wv2-headers-foreach-crash/src/Sources/Startup.twin rename to bugs/filed/wv2-headers-foreach-crash/src/Sources/Startup.twin diff --git a/bugs/wv2-headers-foreach-crash/wv2-headers-foreach-crash.twinproj b/bugs/filed/wv2-headers-foreach-crash/wv2-headers-foreach-crash.twinproj similarity index 100% rename from bugs/wv2-headers-foreach-crash/wv2-headers-foreach-crash.twinproj rename to bugs/filed/wv2-headers-foreach-crash/wv2-headers-foreach-crash.twinproj diff --git a/bugs/gettypeinfo-badindex/gettypeinfo-badindex.twinproj b/bugs/gettypeinfo-badindex/gettypeinfo-badindex.twinproj new file mode 100644 index 00000000..ec3f6f6f Binary files /dev/null and b/bugs/gettypeinfo-badindex/gettypeinfo-badindex.twinproj differ diff --git a/bugs/gettypeinfo-badindex/repro.json b/bugs/gettypeinfo-badindex/repro.json new file mode 100644 index 00000000..4d56e3f4 --- /dev/null +++ b/bugs/gettypeinfo-badindex/repro.json @@ -0,0 +1,10 @@ +{ + "mode": "run", + "expect": { + "exit": 0, + "output": [ + "^GetTypeInfo\\(0\\): HRESULT 0, pointer returned True$", + "^GetTypeInfo\\(1\\): HRESULT 8000FFFF," + ] + } +} diff --git a/bugs/gettypeinfo-badindex/src/Settings b/bugs/gettypeinfo-badindex/src/Settings new file mode 100644 index 00000000..d49cf8a1 --- /dev/null +++ b/bugs/gettypeinfo-badindex/src/Settings @@ -0,0 +1,61 @@ +{ + "configuration.inherits": "Defaults", + "project.appTitle": "GettypeinfoBadindex", + "project.buildPath": "${SourcePath}\\Build\\${ProjectName}_${Architecture}.${FileExtension}", + "project.buildType": "Standard EXE", + "project.description": "Reproduces: A twinBASIC class's GetTypeInfo with an iTInfo of 1 returns E_UNEXPECTED, not DISP_E_BADINDEX", + "project.exportPathIsV2": true, + "project.id": "{A75D7620-90A1-4F6D-B0DB-449E47391782}", + "project.name": "GettypeinfoBadindex", + "project.optionExplicit": true, + "project.references": [ + { + "id": "{00020430-0000-0000-C000-000000000046}", + "lcid": 0, + "name": "OLE Automation", + "path32": "C:\\Windows\\SysWOW64\\stdole2.tlb", + "path64": "C:\\Windows\\System32\\stdole2.tlb", + "symbolId": "stdole", + "versionMajor": 2, + "versionMinor": 0 + }, + { + "id": "{F50B82D0-DCAB-43FE-9631-11959D4A4728}", + "isCompilerPackage": true, + "licence": "MIT", + "name": "[COMPILER PACKAGE] twinBASIC - VB Compatibility Package (Forms)", + "path32": "", + "path64": "", + "publisher": "TWINBASIC-COMPILER", + "symbolId": "VB", + "versionBuild": 0, + "versionMajor": 0, + "versionMinor": 0, + "versionRevision": 31 + }, + { + "id": "{C192FB39-64CA-4D9B-B477-A5502F48EFCC}", + "isCompilerPackage": true, + "licence": "MIT", + "name": "[COMPILER PACKAGE] twinBASIC - App global class object", + "path32": "", + "path64": "", + "publisher": "TWINBASIC-COMPILER", + "symbolId": "AppGlobalClassProject", + "versionBuild": 0, + "versionMajor": 1, + "versionMinor": 0, + "versionRevision": 0 + } + ], + "project.settingsVersion": 1, + "project.startupObject": "Sub Main", + "project.warnings": { + "errors": [], + "hints": [], + "ignored": [], + "info": [], + "warnings": [] + }, + "runtime.useUnicodeStandardLibrary": true +} diff --git a/bugs/gettypeinfo-badindex/src/Sources/Startup.twin b/bugs/gettypeinfo-badindex/src/Sources/Startup.twin new file mode 100644 index 00000000..2695bf4c --- /dev/null +++ b/bugs/gettypeinfo-badindex/src/Sources/Startup.twin @@ -0,0 +1,38 @@ +[InterfaceId("00020400-0000-0000-C000-000000000046")] +Private Interface IDispatchCopy Extends stdole.IUnknown + Sub GetTypeInfoCount(ByRef pctinfo As Long) + Sub GetTypeInfo(ByVal iTInfo As Long, ByVal lcid As Long, ByRef ppTInfo As LongPtr) + Sub GetIDsOfNames(ByVal riid As LongPtr, ByVal rgszNames As LongPtr, ByVal cNames As Long, ByVal lcid As Long, ByVal rgDispId As LongPtr) + Sub Invoke(ByVal dispIdMember As Long, ByVal riid As LongPtr, ByVal lcid As Long, ByVal wFlags As Integer, ByVal pDispParams As LongPtr, ByVal pVarResult As LongPtr, ByVal pExcepInfo As LongPtr, ByVal puArgErr As LongPtr) +End Interface + +Class Widget + Public Sub Hello() + End Sub +End Class + +Module Startup + + Public Sub Main() + Dim d As IDispatchCopy = New Widget + Dim count As Long + d.GetTypeInfoCount count + Debug.Print "GetTypeInfoCount = " & count + Dim ti As LongPtr + On Error Resume Next + d.GetTypeInfo 0, 0, ti + Debug.Print "GetTypeInfo(0): HRESULT " & Hex(Err.LastHresult) & ", pointer returned " & (ti <> 0) + Err.Clear + ti = 0 + d.GetTypeInfo 1, 0, ti + Debug.Print "GetTypeInfo(1): HRESULT " & Hex(Err.LastHresult) & ", error " & Err.Number & ", pointer returned " & (ti <> 0) + Err.Clear + ti = 0 + d.GetTypeInfo 2, 0, ti + Debug.Print "GetTypeInfo(2): HRESULT " & Hex(Err.LastHresult) & ", error " & Err.Number & ", pointer returned " & (ti <> 0) + Err.Clear + d.GetTypeInfo -1, 0, ti + Debug.Print "GetTypeInfo(-1): HRESULT " & Hex(Err.LastHresult) & ", error " & Err.Number + End Sub + +End Module diff --git a/bugs/iunknown-iid-interface/iunknown-iid-interface.twinproj b/bugs/iunknown-iid-interface/iunknown-iid-interface.twinproj new file mode 100644 index 00000000..d8f708b3 Binary files /dev/null and b/bugs/iunknown-iid-interface/iunknown-iid-interface.twinproj differ diff --git a/bugs/iunknown-iid-interface/repro.json b/bugs/iunknown-iid-interface/repro.json new file mode 100644 index 00000000..bba9f1b7 --- /dev/null +++ b/bugs/iunknown-iid-interface/repro.json @@ -0,0 +1,10 @@ +{ + "mode": "run", + "expect": { + "exit": 5, + "output": [ + "^ok$", + "NATIVE EXCEPTION: ACCESS_VIOLATION" + ] + } +} diff --git a/bugs/iunknown-iid-interface/src/Settings b/bugs/iunknown-iid-interface/src/Settings new file mode 100644 index 00000000..1feeab02 --- /dev/null +++ b/bugs/iunknown-iid-interface/src/Settings @@ -0,0 +1,61 @@ +{ + "configuration.inherits": "Defaults", + "project.appTitle": "IunknownIidInterface", + "project.buildPath": "${SourcePath}\\Build\\${ProjectName}_${Architecture}.${FileExtension}", + "project.buildType": "Standard EXE", + "project.description": "Reproduces: t", + "project.exportPathIsV2": true, + "project.id": "{69B8B70D-5983-4E09-9E03-8F7D200FCB98}", + "project.name": "IunknownIidInterface", + "project.optionExplicit": true, + "project.references": [ + { + "id": "{00020430-0000-0000-C000-000000000046}", + "lcid": 0, + "name": "OLE Automation", + "path32": "C:\\Windows\\SysWOW64\\stdole2.tlb", + "path64": "C:\\Windows\\System32\\stdole2.tlb", + "symbolId": "stdole", + "versionMajor": 2, + "versionMinor": 0 + }, + { + "id": "{F50B82D0-DCAB-43FE-9631-11959D4A4728}", + "isCompilerPackage": true, + "licence": "MIT", + "name": "[COMPILER PACKAGE] twinBASIC - VB Compatibility Package (Forms)", + "path32": "", + "path64": "", + "publisher": "TWINBASIC-COMPILER", + "symbolId": "VB", + "versionBuild": 0, + "versionMajor": 0, + "versionMinor": 0, + "versionRevision": 31 + }, + { + "id": "{C192FB39-64CA-4D9B-B477-A5502F48EFCC}", + "isCompilerPackage": true, + "licence": "MIT", + "name": "[COMPILER PACKAGE] twinBASIC - App global class object", + "path32": "", + "path64": "", + "publisher": "TWINBASIC-COMPILER", + "symbolId": "AppGlobalClassProject", + "versionBuild": 0, + "versionMajor": 1, + "versionMinor": 0, + "versionRevision": 0 + } + ], + "project.settingsVersion": 1, + "project.startupObject": "Sub Main", + "project.warnings": { + "errors": [], + "hints": [], + "ignored": [], + "info": [], + "warnings": [] + }, + "runtime.useUnicodeStandardLibrary": true +} diff --git a/bugs/iunknown-iid-interface/src/Sources/Startup.twin b/bugs/iunknown-iid-interface/src/Sources/Startup.twin new file mode 100644 index 00000000..898e64b5 --- /dev/null +++ b/bugs/iunknown-iid-interface/src/Sources/Startup.twin @@ -0,0 +1,25 @@ +' An Interface with IUnknown's interface identifier compiles, and a class can implement it. +' Calling its method through a variable of that type ends in an ACCESS_VIOLATION. +' With any other identifier on the interface, the same code runs to the end. +[InterfaceId("00000000-0000-0000-C000-000000000046")] +Private Interface IUnk + Sub Dummy() +End Interface + +Private Class RC + Implements IUnk + Private Sub IUnk_Dummy() Implements IUnk.Dummy + End Sub +End Class + +Module Startup + + Public Sub Main() + Dim u As IUnk + Set u = New RC + Debug.Print "ok" + u.Dummy + Debug.Print "called" + End Sub + +End Module diff --git a/bugs/latebound-call-retried/latebound-call-retried.twinproj b/bugs/latebound-call-retried/latebound-call-retried.twinproj new file mode 100644 index 00000000..a724ad0d Binary files /dev/null and b/bugs/latebound-call-retried/latebound-call-retried.twinproj differ diff --git a/bugs/latebound-call-retried/repro.json b/bugs/latebound-call-retried/repro.json new file mode 100644 index 00000000..1711a9fc --- /dev/null +++ b/bugs/latebound-call-retried/repro.json @@ -0,0 +1,10 @@ +{ + "mode": "run", + "expect": { + "exit": 0, + "output": [ + "^o\\.Hello 1: error 13, ran 2 time\\(s\\)", + "^o\\.Prop = 1: error -2147352567, ran 1 time\\(s\\), Property Get ran 1$" + ] + } +} diff --git a/bugs/latebound-call-retried/src/Settings b/bugs/latebound-call-retried/src/Settings new file mode 100644 index 00000000..a6421da6 --- /dev/null +++ b/bugs/latebound-call-retried/src/Settings @@ -0,0 +1,61 @@ +{ + "configuration.inherits": "Defaults", + "project.appTitle": "LateboundCallRetried", + "project.buildPath": "${SourcePath}\\Build\\${ProjectName}_${Architecture}.${FileExtension}", + "project.buildType": "Standard EXE", + "project.description": "Reproduces: A late-bound call that fails is issued a second time", + "project.exportPathIsV2": true, + "project.id": "{A55309D0-2372-453C-96D5-A7E28E133076}", + "project.name": "LateboundCallRetried", + "project.optionExplicit": true, + "project.references": [ + { + "id": "{00020430-0000-0000-C000-000000000046}", + "lcid": 0, + "name": "OLE Automation", + "path32": "C:\\Windows\\SysWOW64\\stdole2.tlb", + "path64": "C:\\Windows\\System32\\stdole2.tlb", + "symbolId": "stdole", + "versionMajor": 2, + "versionMinor": 0 + }, + { + "id": "{F50B82D0-DCAB-43FE-9631-11959D4A4728}", + "isCompilerPackage": true, + "licence": "MIT", + "name": "[COMPILER PACKAGE] twinBASIC - VB Compatibility Package (Forms)", + "path32": "", + "path64": "", + "publisher": "TWINBASIC-COMPILER", + "symbolId": "VB", + "versionBuild": 0, + "versionMajor": 0, + "versionMinor": 0, + "versionRevision": 31 + }, + { + "id": "{C192FB39-64CA-4D9B-B477-A5502F48EFCC}", + "isCompilerPackage": true, + "licence": "MIT", + "name": "[COMPILER PACKAGE] twinBASIC - App global class object", + "path32": "", + "path64": "", + "publisher": "TWINBASIC-COMPILER", + "symbolId": "AppGlobalClassProject", + "versionBuild": 0, + "versionMajor": 1, + "versionMinor": 0, + "versionRevision": 0 + } + ], + "project.settingsVersion": 1, + "project.startupObject": "Sub Main", + "project.warnings": { + "errors": [], + "hints": [], + "ignored": [], + "info": [], + "warnings": [] + }, + "runtime.useUnicodeStandardLibrary": true +} diff --git a/bugs/latebound-call-retried/src/Sources/Startup.twin b/bugs/latebound-call-retried/src/Sources/Startup.twin new file mode 100644 index 00000000..59b4b282 --- /dev/null +++ b/bugs/latebound-call-retried/src/Sources/Startup.twin @@ -0,0 +1,54 @@ +Class Widget + Public Hits As Long + Public Gets As Long + + Public Sub Hello() + Hits += 1 + End Sub + + Public Sub Boom(ByVal a As Long) + Hits += 1 + Err.Raise 5 + End Sub + + Public Function BoomFn(ByVal a As Long) As Long + Hits += 1 + Err.Raise 5 + End Function + + Public Property Get Prop() As Long + Gets += 1 + Return 1 + End Property + Public Property Let Prop(ByVal Value As Long) + Hits += 1 + Err.Raise 5 + End Property +End Class + +Module Startup + + Private Sub Show(ByVal label As String, ByVal w As Widget) + Debug.Print label & ": error " & Err.Number & ", ran " & w.Hits & " time(s), Property Get ran " & w.Gets + Err.Clear + w.Hits = 0 + w.Gets = 0 + End Sub + + Public Sub Main() + Dim w As New Widget + Dim o As Object = w + On Error Resume Next + o.Hello 1 + Show "o.Hello 1", w + o.Boom 1 + Show "o.Boom 1", w + Dim x As Long = o.BoomFn(1) + Show "x = o.BoomFn(1)", w + o.Prop = 1 + Show "o.Prop = 1", w + w.Boom 1 + Show "w.Boom 1 (early bound)", w + End Sub + +End Module diff --git a/bugs/latebound-call-retried/vb6/Module1.bas b/bugs/latebound-call-retried/vb6/Module1.bas new file mode 100644 index 00000000..6cc965b2 --- /dev/null +++ b/bugs/latebound-call-retried/vb6/Module1.bas @@ -0,0 +1,34 @@ +Attribute VB_Name = "Module1" +Option Explicit + +Sub Main() + On Error GoTo Fail + Open App.Path & "\out.txt" For Output As #9 + Cases + Close #9 + Exit Sub +Fail: + On Error Resume Next + Print #9, "unhandled error " & Err.Number & ": " & Err.Description + Close #9 +End Sub + +Sub Show(ByVal label As String) + Print #9, label & " -> error " & Err.Number & " (" & Hex(Err.Number) & ") [" & Err.Description & "]" + Err.Clear +End Sub + +Sub Cases() + Dim w As New Widget + Dim o As Object + Set o = w + On Error Resume Next + w.Hits = 0 + o.Hello 1 + Show "o.Hello 1" + Print #9, " Hits=" & w.Hits + w.Hits = 0: w.Gets = 0 + o.Prop = 1 + Show "o.Prop = 1" + Print #9, " Hits=" & w.Hits & " Gets=" & w.Gets +End Sub diff --git a/bugs/latebound-call-retried/vb6/Probe.vbp b/bugs/latebound-call-retried/vb6/Probe.vbp new file mode 100644 index 00000000..cd40da3d --- /dev/null +++ b/bugs/latebound-call-retried/vb6/Probe.vbp @@ -0,0 +1,8 @@ +Type=Exe +Module=Module1; Module1.bas +Class=Widget; Widget.cls +Startup="Sub Main" +ExeName32="Probe.exe" +Name="Probe" +CompilationType=0 +OptimizationType=0 diff --git a/bugs/latebound-call-retried/vb6/Widget.cls b/bugs/latebound-call-retried/vb6/Widget.cls new file mode 100644 index 00000000..88b2786e --- /dev/null +++ b/bugs/latebound-call-retried/vb6/Widget.cls @@ -0,0 +1,31 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True + Persistable = 0 'NotPersistable + DataBindingBehavior = 0 'vbNone + DataSourceBehavior = 0 'vbNone + MTSTransactionMode = 0 'NotAnMTSObject +END +Attribute VB_Name = "Widget" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = True +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = True +Option Explicit + +Public Hits As Long +Public Gets As Long + +Public Sub Hello() + Hits = Hits + 1 +End Sub + +Public Property Get Prop() As Long + Gets = Gets + 1 + Prop = 1 +End Property + +Public Property Let Prop(ByVal Value As Long) + Hits = Hits + 1 + Err.Raise 5 +End Property diff --git a/bugs/latebound-unknown-member-error/latebound-unknown-member-error.twinproj b/bugs/latebound-unknown-member-error/latebound-unknown-member-error.twinproj new file mode 100644 index 00000000..c8087c1c Binary files /dev/null and b/bugs/latebound-unknown-member-error/latebound-unknown-member-error.twinproj differ diff --git a/bugs/latebound-unknown-member-error/repro.json b/bugs/latebound-unknown-member-error/repro.json new file mode 100644 index 00000000..53fc4675 --- /dev/null +++ b/bugs/latebound-unknown-member-error/repro.json @@ -0,0 +1,11 @@ +{ + "mode": "run", + "expect": { + "exit": 0, + "output": [ + "^o\\.Nope -> error -2147352570 \\(80020006\\) \\[Unknown name\\.\\]$", + "^Collection\\.Nope -> error -2147352570 \\(80020006\\)", + "^CallByName o, Nope -> error -2147467259 \\(80004005\\)" + ] + } +} diff --git a/bugs/latebound-unknown-member-error/src/Settings b/bugs/latebound-unknown-member-error/src/Settings new file mode 100644 index 00000000..e781f2ab --- /dev/null +++ b/bugs/latebound-unknown-member-error/src/Settings @@ -0,0 +1,61 @@ +{ + "configuration.inherits": "Defaults", + "project.appTitle": "LateboundUnknownMemberError", + "project.buildPath": "${SourcePath}\\Build\\${ProjectName}_${Architecture}.${FileExtension}", + "project.buildType": "Standard EXE", + "project.description": "Reproduces: A late-bound call to a member that does not exist raises &H80020006, and CallByName raises &H80004005, where VB6 and VBA raise 438", + "project.exportPathIsV2": true, + "project.id": "{97A93038-DDBD-4CFC-A02B-D93573BDF332}", + "project.name": "LateboundUnknownMemberError", + "project.optionExplicit": true, + "project.references": [ + { + "id": "{00020430-0000-0000-C000-000000000046}", + "lcid": 0, + "name": "OLE Automation", + "path32": "C:\\Windows\\SysWOW64\\stdole2.tlb", + "path64": "C:\\Windows\\System32\\stdole2.tlb", + "symbolId": "stdole", + "versionMajor": 2, + "versionMinor": 0 + }, + { + "id": "{F50B82D0-DCAB-43FE-9631-11959D4A4728}", + "isCompilerPackage": true, + "licence": "MIT", + "name": "[COMPILER PACKAGE] twinBASIC - VB Compatibility Package (Forms)", + "path32": "", + "path64": "", + "publisher": "TWINBASIC-COMPILER", + "symbolId": "VB", + "versionBuild": 0, + "versionMajor": 0, + "versionMinor": 0, + "versionRevision": 31 + }, + { + "id": "{C192FB39-64CA-4D9B-B477-A5502F48EFCC}", + "isCompilerPackage": true, + "licence": "MIT", + "name": "[COMPILER PACKAGE] twinBASIC - App global class object", + "path32": "", + "path64": "", + "publisher": "TWINBASIC-COMPILER", + "symbolId": "AppGlobalClassProject", + "versionBuild": 0, + "versionMajor": 1, + "versionMinor": 0, + "versionRevision": 0 + } + ], + "project.settingsVersion": 1, + "project.startupObject": "Sub Main", + "project.warnings": { + "errors": [], + "hints": [], + "ignored": [], + "info": [], + "warnings": [] + }, + "runtime.useUnicodeStandardLibrary": true +} diff --git a/bugs/latebound-unknown-member-error/src/Sources/Startup.twin b/bugs/latebound-unknown-member-error/src/Sources/Startup.twin new file mode 100644 index 00000000..90e3df93 --- /dev/null +++ b/bugs/latebound-unknown-member-error/src/Sources/Startup.twin @@ -0,0 +1,27 @@ +Class Widget + Public Sub Hello() + End Sub +End Class + +Module Startup + + Private Sub Show(ByVal label As String) + Debug.Print label & " -> error " & Err.Number & " (" & Hex(Err.Number) & ") [" & Err.Description & "]" + Err.Clear + End Sub + + Public Sub Main() + Dim o As Object = New Widget + Dim c As Object = New Collection + On Error Resume Next + o.Nope + Show "o.Nope" + c.Nope + Show "Collection.Nope" + CallByName o, "Nope", vbMethod + Show "CallByName o, Nope" + o.Hello + Show "o.Hello (control)" + End Sub + +End Module diff --git a/bugs/latebound-unknown-member-error/vb6/Module1.bas b/bugs/latebound-unknown-member-error/vb6/Module1.bas new file mode 100644 index 00000000..b3a3ef98 --- /dev/null +++ b/bugs/latebound-unknown-member-error/vb6/Module1.bas @@ -0,0 +1,56 @@ +Attribute VB_Name = "Module1" +Option Explicit + +Sub Main() + On Error GoTo Fail + Open App.Path & "\out.txt" For Output As #9 + Cases + Close #9 + Exit Sub +Fail: + On Error Resume Next + Print #9, "unhandled error " & Err.Number & ": " & Err.Description + Close #9 +End Sub + +Sub Show(ByVal label As String) + Print #9, label & " -> error " & Err.Number & " (" & Hex(Err.Number) & ") [" & Err.Description & "]" + Err.Clear +End Sub + +Sub Cases() + Dim w As New Widget + Dim o As Object + Dim v As Variant + Dim c As New Collection + Dim d As Object + Set o = w + v = Empty + Set v = w + On Error Resume Next + o.Nope + Show "o.Nope (class)" + v.Nope + Show "v.Nope (class in a Variant)" + Dim oc As Object + Set oc = c + oc.Nope + Show "Collection.Nope" + Set d = CreateObject("Scripting.Dictionary") + d.Nope + Show "Dictionary.Nope" + CallByName o, "Nope", VbMethod + Show "CallByName class Nope" + CallByName d, "Nope", VbMethod + Show "CallByName Dictionary Nope" + CallByName oc, "Nope", VbMethod + Show "CallByName Collection Nope" + w.Hits = 0 + o.Hello 1 + Show "o.Hello 1" + Print #9, " Hits=" & w.Hits + w.Hits = 0: w.Gets = 0 + o.Prop = 1 + Show "o.Prop = 1" + Print #9, " Hits=" & w.Hits & " Gets=" & w.Gets +End Sub diff --git a/bugs/latebound-unknown-member-error/vb6/Probe.vbp b/bugs/latebound-unknown-member-error/vb6/Probe.vbp new file mode 100644 index 00000000..cd40da3d --- /dev/null +++ b/bugs/latebound-unknown-member-error/vb6/Probe.vbp @@ -0,0 +1,8 @@ +Type=Exe +Module=Module1; Module1.bas +Class=Widget; Widget.cls +Startup="Sub Main" +ExeName32="Probe.exe" +Name="Probe" +CompilationType=0 +OptimizationType=0 diff --git a/bugs/latebound-unknown-member-error/vb6/Widget.cls b/bugs/latebound-unknown-member-error/vb6/Widget.cls new file mode 100644 index 00000000..88b2786e --- /dev/null +++ b/bugs/latebound-unknown-member-error/vb6/Widget.cls @@ -0,0 +1,31 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True + Persistable = 0 'NotPersistable + DataBindingBehavior = 0 'vbNone + DataSourceBehavior = 0 'vbNone + MTSTransactionMode = 0 'NotAnMTSObject +END +Attribute VB_Name = "Widget" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = True +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = True +Option Explicit + +Public Hits As Long +Public Gets As Long + +Public Sub Hello() + Hits = Hits + 1 +End Sub + +Public Property Get Prop() As Long + Gets = Gets + 1 + Prop = 1 +End Property + +Public Property Let Prop(ByVal Value As Long) + Hits = Hits + 1 + Err.Raise 5 +End Property diff --git a/bugs/new-on-interface/new-on-interface.twinproj b/bugs/new-on-interface/new-on-interface.twinproj new file mode 100644 index 00000000..64aeb57a Binary files /dev/null and b/bugs/new-on-interface/new-on-interface.twinproj differ diff --git a/bugs/new-on-interface/repro.json b/bugs/new-on-interface/repro.json new file mode 100644 index 00000000..cedaf65b --- /dev/null +++ b/bugs/new-on-interface/repro.json @@ -0,0 +1,13 @@ +{ + "mode": "run", + "expect": { + "exit": 5, + "output": [ + "^IParent: Nothing\\? False, F\\(\\) = 0$", + "^ErrorContext: Unknown, Number = 0, Callstack Nothing\\? True$", + "^IChild\\.G\\(\\) = 0$", + "^IChild\\.F\\(\\), inherited, next$", + "NATIVE EXCEPTION: ACCESS_VIOLATION" + ] + } +} diff --git a/bugs/new-on-interface/src/Settings b/bugs/new-on-interface/src/Settings new file mode 100644 index 00000000..b2be6a5c --- /dev/null +++ b/bugs/new-on-interface/src/Settings @@ -0,0 +1,61 @@ +{ + "configuration.inherits": "Defaults", + "project.appTitle": "NewOnInterface", + "project.buildPath": "${SourcePath}\\Build\\${ProjectName}_${Architecture}.${FileExtension}", + "project.buildType": "Standard EXE", + "project.description": "Reproduces: `New` on an `Interface` compiles, and a call on the object returns a default value, or ends in an access violation for an inherited member", + "project.exportPathIsV2": true, + "project.id": "{9276A787-2DCB-4B14-8467-1CABF235C647}", + "project.name": "NewOnInterface", + "project.optionExplicit": true, + "project.references": [ + { + "id": "{00020430-0000-0000-C000-000000000046}", + "lcid": 0, + "name": "OLE Automation", + "path32": "C:\\Windows\\SysWOW64\\stdole2.tlb", + "path64": "C:\\Windows\\System32\\stdole2.tlb", + "symbolId": "stdole", + "versionMajor": 2, + "versionMinor": 0 + }, + { + "id": "{F50B82D0-DCAB-43FE-9631-11959D4A4728}", + "isCompilerPackage": true, + "licence": "MIT", + "name": "[COMPILER PACKAGE] twinBASIC - VB Compatibility Package (Forms)", + "path32": "", + "path64": "", + "publisher": "TWINBASIC-COMPILER", + "symbolId": "VB", + "versionBuild": 0, + "versionMajor": 0, + "versionMinor": 0, + "versionRevision": 31 + }, + { + "id": "{C192FB39-64CA-4D9B-B477-A5502F48EFCC}", + "isCompilerPackage": true, + "licence": "MIT", + "name": "[COMPILER PACKAGE] twinBASIC - App global class object", + "path32": "", + "path64": "", + "publisher": "TWINBASIC-COMPILER", + "symbolId": "AppGlobalClassProject", + "versionBuild": 0, + "versionMajor": 1, + "versionMinor": 0, + "versionRevision": 0 + } + ], + "project.settingsVersion": 1, + "project.startupObject": "Sub Main", + "project.warnings": { + "errors": [], + "hints": [], + "ignored": [], + "info": [], + "warnings": [] + }, + "runtime.useUnicodeStandardLibrary": true +} diff --git a/bugs/new-on-interface/src/Sources/Startup.twin b/bugs/new-on-interface/src/Sources/Startup.twin new file mode 100644 index 00000000..7515fa63 --- /dev/null +++ b/bugs/new-on-interface/src/Sources/Startup.twin @@ -0,0 +1,33 @@ +' New is accepted on an Interface, although no class exists for it. The object it returns has +' nothing behind its members: a call on a member of the interface itself returns 0, and a call on a +' member that the interface inherits from another Interface ends in an ACCESS_VIOLATION. +' New stdole.IUnknown and New stdole.IDispatch are refused with TB5074, so the check is on the +' interface being declared in the project, or in a package, rather than in a type library. +[InterfaceId("E5B8C0A1-0000-4000-8000-0000000000A1")] +Private Interface IParent + Function F() As Long +End Interface + +[InterfaceId("E5B8C0A1-0000-4000-8000-0000000000A2")] +Private Interface IChild Extends IParent + Function G() As Long +End Interface + +Module Startup + + Public Sub Main() + Dim p As IParent = New IParent + Debug.Print "IParent: Nothing? " & (p Is Nothing) & ", F() = " & p.F() + + ' ErrorContext is such an interface, in the VBRUN package, and has no class either. + Dim e As ErrorContext = New ErrorContext + Debug.Print "ErrorContext: " & TypeName(e) & ", Number = " & e.Number & ", Callstack Nothing? " & (e.Callstack Is Nothing) + + Dim c As IChild = New IChild + Debug.Print "IChild.G() = " & c.G() + Debug.Print "IChild.F(), inherited, next" + Debug.Print "IChild.F() = " & c.F() + Debug.Print "not reached" + End Sub + +End Module diff --git a/bugs/stdole-idispatch-late-bound/repro.json b/bugs/stdole-idispatch-late-bound/repro.json new file mode 100644 index 00000000..edf14b30 --- /dev/null +++ b/bugs/stdole-idispatch-late-bound/repro.json @@ -0,0 +1,10 @@ +{ + "mode": "run", + "expect": { + "exit": 0, + "output": [ + "^d\\.Hello: error 0, Hello ran 1 time\\(s\\)$", + "^d\\.GetTypeInfoCount: error -2147352570 \\(80020006\\) Unknown name\\.$" + ] + } +} diff --git a/bugs/stdole-idispatch-late-bound/src/Settings b/bugs/stdole-idispatch-late-bound/src/Settings new file mode 100644 index 00000000..07dfd05e --- /dev/null +++ b/bugs/stdole-idispatch-late-bound/src/Settings @@ -0,0 +1,61 @@ +{ + "configuration.inherits": "Defaults", + "project.appTitle": "StdoleIdispatchLateBound", + "project.buildPath": "${SourcePath}\\Build\\${ProjectName}_${Architecture}.${FileExtension}", + "project.buildType": "Standard EXE", + "project.description": "Reproduces: Calling a method of stdole.IDispatch is a late-bound call by name and fails with &H80020006", + "project.exportPathIsV2": true, + "project.id": "{F0AFD667-34BF-4368-94C5-D49B2BA521B1}", + "project.name": "StdoleIdispatchLateBound", + "project.optionExplicit": true, + "project.references": [ + { + "id": "{00020430-0000-0000-C000-000000000046}", + "lcid": 0, + "name": "OLE Automation", + "path32": "C:\\Windows\\SysWOW64\\stdole2.tlb", + "path64": "C:\\Windows\\System32\\stdole2.tlb", + "symbolId": "stdole", + "versionMajor": 2, + "versionMinor": 0 + }, + { + "id": "{F50B82D0-DCAB-43FE-9631-11959D4A4728}", + "isCompilerPackage": true, + "licence": "MIT", + "name": "[COMPILER PACKAGE] twinBASIC - VB Compatibility Package (Forms)", + "path32": "", + "path64": "", + "publisher": "TWINBASIC-COMPILER", + "symbolId": "VB", + "versionBuild": 0, + "versionMajor": 0, + "versionMinor": 0, + "versionRevision": 31 + }, + { + "id": "{C192FB39-64CA-4D9B-B477-A5502F48EFCC}", + "isCompilerPackage": true, + "licence": "MIT", + "name": "[COMPILER PACKAGE] twinBASIC - App global class object", + "path32": "", + "path64": "", + "publisher": "TWINBASIC-COMPILER", + "symbolId": "AppGlobalClassProject", + "versionBuild": 0, + "versionMajor": 1, + "versionMinor": 0, + "versionRevision": 0 + } + ], + "project.settingsVersion": 1, + "project.startupObject": "Sub Main", + "project.warnings": { + "errors": [], + "hints": [], + "ignored": [], + "info": [], + "warnings": [] + }, + "runtime.useUnicodeStandardLibrary": true +} diff --git a/bugs/stdole-idispatch-late-bound/src/Sources/Startup.twin b/bugs/stdole-idispatch-late-bound/src/Sources/Startup.twin new file mode 100644 index 00000000..49455a67 --- /dev/null +++ b/bugs/stdole-idispatch-late-bound/src/Sources/Startup.twin @@ -0,0 +1,28 @@ +Class Widget + Public Hits As Long + Public Sub Hello() + Hits += 1 + End Sub +End Class + +Module Startup + + Public Sub Main() + Dim w As New Widget + Dim d As stdole.IDispatch = w + On Error Resume Next + d.Hello + Debug.Print "d.Hello: error " & Err.Number & ", Hello ran " & w.Hits & " time(s)" + Err.Clear + Dim count As Long + d.GetTypeInfoCount count + Debug.Print "d.GetTypeInfoCount: error " & Err.Number & " (" & Hex(Err.Number) & ") " & Err.Description + Err.Clear + d.GetTypeInfoCount "a", "b", "c" + Debug.Print "d.GetTypeInfoCount ""a"", ""b"", ""c"": error " & Err.Number + Err.Clear + d.NoSuchMethod + Debug.Print "d.NoSuchMethod: error " & Err.Number + End Sub + +End Module diff --git a/bugs/stdole-idispatch-late-bound/stdole-idispatch-late-bound.twinproj b/bugs/stdole-idispatch-late-bound/stdole-idispatch-late-bound.twinproj new file mode 100644 index 00000000..1a0dde0c Binary files /dev/null and b/bugs/stdole-idispatch-late-bound/stdole-idispatch-late-bound.twinproj differ diff --git a/builder/page-baseline.json b/builder/page-baseline.json index dc5ba9e9..a32e7a3c 100644 --- a/builder/page-baseline.json +++ b/builder/page-baseline.json @@ -1,5 +1,5 @@ { "src": "docs", - "pages": 917, + "pages": 921, "staticFiles": 250 } diff --git a/docs/Documentation/Tools.md b/docs/Documentation/Tools.md index 1b7a35b2..41fe81ec 100644 --- a/docs/Documentation/Tools.md +++ b/docs/Documentation/Tools.md @@ -184,7 +184,7 @@ One invocation of [`check_examples.mjs`](#check-examples), with every flag passe Compiles the documentation's own twinBASIC code samples --- every ` ```tb ` fence marked `check_build` --- and reports the ones the compiler refuses, against the line in the page they came from. A sample also marked `check_run` is run, and what it prints is checked against what the page says it prints. [Authoring Pages](Authoring#checking-that-a-sample-compiles) is the page for marking a sample and for what a pull request that changes one shows; this entry is about running the tool. -**It is not one of the gates, and it must not become one.** It is absent from `build.bat`, `check.bat`, `test.bat` and both CI workflows, for three reasons that are not going to change: it needs a twinBASIC install, where `npm install` has to remain sufficient to build the docs; it needs Windows, a private desktop and a CDP-reachable WebView2, none of which exists on the CI box; and an IDE cold start is 8 to 11 seconds against a whole site build's four. It is run by a person, deliberately, which is the same arrangement [`sweep_a11y.mjs`](#sweep-a11y) already has. +**It is not one of the gates, and it must not become one.** It is absent from `build.bat`, `check.bat`, `test.bat` and both CI workflows, for three reasons that are not going to change: it needs a twinBASIC install, where `npm install` has to remain sufficient to build the docs; it needs Windows, a private desktop and a CDP-reachable WebView2, none of which exists on the CI box; and an IDE cold start is 6 to 8 seconds against a whole site build's four. It is run by a person, deliberately, which is the same arrangement [`sweep_a11y.mjs`](#sweep-a11y) already has. Exit codes: those of [`check_examples.mjs`](#check-examples), returned as they are: **0** clean, **1** a sample does not compile, or does not run as its page says, **2** the harness failed. @@ -588,7 +588,7 @@ Exit codes: **0** every test passed, **1** a test failed. node --test test/example-batches.test.mjs -Runs the probes of [`check_examples.mjs`](#check-examples) under Node's own test runner. They live in `scripts/lib/example-batches.mjs`, beside what they test: how samples are packed into projects, how a batch whose build crashed the compiler is cut down to the samples that crash it, the canary every batch carries, the fence classifier, and how a `check_run` sample is refused, read for what it says it prints, called and judged. `check_examples.mjs` runs them before every run too, but it needs a twinBASIC install, so it runs only by hand and never in CI. The probes need no IDE: crash isolation is driven through a fake lane whose builds crash on the samples a probe chooses. No browser, no built tree, well under a second. +Runs the probes of [`check_examples.mjs`](#check-examples) under Node's own test runner. They live in `scripts/lib/example-batches.mjs`, beside what they test: how samples are packed into projects, how a batch whose build crashed the compiler is cut down to the samples that crash it, the canary every batch carries, the fence classifier, and how a `check_run` sample is refused, read for what it says it prints, called and judged. `check_examples.mjs` runs them before every run too, but it needs a twinBASIC install, so it runs only by hand and never in CI. The probes need no IDE: crash isolation is driven through a fake lane whose builds crash on the samples a probe chooses. The same file also runs the probes of [`vb6run.mjs`](#vb6run), from `scripts/lib/vb6.mjs`: the `Debug.Print` rewrite on strings, comments, statement separators, single-line `If` and a bare `Debug.Print`, the generated modules, the reading of VB6's build log and the Windows-1252 encoding. It also holds the probes for a bug reproducer's VB6 project (see [`bug_repro.mjs`](#bug-repro)): which files go into its zip, what refuses a project, and the project file the build copy gets. They need no VB6. No browser, no built tree, well under a second. Exit codes: **0** every test passed, **1** a test failed. @@ -833,7 +833,7 @@ twinBASIC has no command-line build. The compiler executable's whole surface is **It runs the IDE on a private Windows desktop, and that is not decoration.** The IDE calls `HostForceFocus()` from its own `window.onload`, so it takes the keyboard whatever window style it starts with --- `start /min` was tried and the window still came to the front. A process on another desktop has no foreground to take, and the compile does not care whether anything is on screen. Hidden by default has one real cost. A wedged IDE on a private desktop is invisible to the person debugging it, and the only way to see anything is to run it again visible. Export `TBBUILD_SHOW=1` for a session you are working through interactively, and leave it unset for unattended runs. -**One IDE handles one project.** Loading a second project into a running IDE wedges it, so a fresh IDE per project is the design rather than a convenience. It costs roughly 8 to 11 seconds each on a development box and is flat in project size, because what is being paid for is IDE startup and not compilation. Concurrency is the way to make a batch of probes fast: distinct `--port` values give distinct DevTools ports, user-data folders and desktops, so instances do not collide. Keep a question that might crash the compiler in a project of its own, so the answer is attributable and one bad probe cannot cost the rest of the batch its run. +**One IDE handles one project.** Loading a second project into a running IDE wedges it, so a fresh IDE per project is the design rather than a convenience. It costs roughly 6 to 8 seconds each on a development box and is flat in project size, because what is being paid for is IDE startup and not compilation. Concurrency is the way to make a batch of probes fast: distinct `--port` values give distinct DevTools ports, user-data folders and desktops, so instances do not collide. Keep a question that might crash the compiler in a project of its own, so the answer is attributable and one bad probe cannot cost the rest of the batch its run. **The IDE it starts ends with it.** The IDE runs inside a Windows job object, so when `tbbuild` ends --- finished, failed, or stopped with Ctrl+C --- every process the IDE started ends too. That includes a compiler the IDE was restarting after a crash, which a plain process-tree kill can miss and leave running. Two exceptions: under `--keep` the IDE runs outside the job and lives until you close it, and under `--show` it is started directly on your desktop, without the job. @@ -992,10 +992,11 @@ Exit codes: **0** the probe ran and its output was captured; **1** the project h ### bug_repro.mjs {: #bug-repro } - node scripts/bug_repro.mjs new "" [--template ] + node scripts/bug_repro.mjs new "" [--template ] [--with-vb6] node scripts/bug_repro.mjs pack node scripts/bug_repro.mjs compile|build|run [--ide ] [--port N] [--arch win32|win64] [--timeout S] [--llvm] [--exe] [--keep] [--show|--hide] + node scripts/bug_repro.mjs vb6 [--vb6 ] [--timeout S] [--keep] node scripts/bug_repro.mjs verify [slug ...] [--ide ] [--port N] [--timeout S] [--jobs N] [--show|--hide] node scripts/bug_repro.mjs file [--existing] @@ -1011,11 +1012,12 @@ outside every gate and outside CI, and `verify` is run by a person only. | Command | Effect | |---|---| -| `new ""` | Creates `bugs/<slug>/src/` from the console template under `test/example-projects/`, with the project named after the slug in PascalCase, a fresh project id, the description `Reproduces: <title>` and a `Startup` module holding an empty `Sub Main`. Also writes `bugs/<slug>/repro.json` with `"mode": "manual"`. Refused, with exit 3, when `bugs/<slug>` exists. `--template <name>` starts from a folder of `test/repro-templates/` instead: its `Settings`, with the same four keys rewritten, and its `Sources/` as they are. `webview2-form` is a form holding one WebView2 control, which opens `about:blank` when the control is ready and closes when that navigation completes, shown modally by `Sub Main`. | -| `pack <slug>` | Runs `node scripts/impexp.mjs import` on `src/`, to `<slug>.twinproj`, and then writes `<slug>.zip` holding that file and the files `repro.json`'s `attach` names. The zip is written by the script itself, so neither PowerShell nor 7-Zip is needed. An `impexp` exit of 0 or 6 counts as a pack, and its output is printed. | +| `new <slug> "<title>"` | Creates `bugs/<slug>/src/` from the console template under `test/example-projects/`, with the project named after the slug in PascalCase, a fresh project id, the description `Reproduces: <title>` and a `Startup` module holding an empty `Sub Main`. Also writes `bugs/<slug>/repro.json` with `"mode": "manual"`. Refused, with exit 3, when `bugs/<slug>` exists. `--template <name>` starts from a folder of `test/repro-templates/` instead: its `Settings`, with the same four keys rewritten, and its `Sources/` as they are. `webview2-form` is a form holding one WebView2 control, which opens `about:blank` when the control is ready and closes when that navigation completes, shown modally by `Sub Main`. `--with-vb6` also creates `bugs/<slug>/vb6/` from the VB6 template in `test/repro-templates/vb6/`: `Probe.vbp` and `Module1.bas`, whose `Sub Main` opens `out.txt` beside the exe, prints one line under an error handler and closes. | +| `pack <slug>` | Runs `node scripts/impexp.mjs import` on `src/`, to `<slug>.twinproj`, and then writes `<slug>.zip` holding that file and the files `repro.json`'s `attach` names. The zip is written by the script itself, so neither PowerShell nor 7-Zip is needed. An `impexp` exit of 0 or 6 counts as a pack, and its output is printed. When `bugs/<slug>/vb6/` exists, it also writes `<slug>-vb6.zip`, holding the source files of that folder (`.vbp`, `.bas`, `.cls`, `.frm` and `.frx`) and nothing else, so an exe or an output left there is not zipped; the files left out are named. A `vb6/` with no `Probe.vbp`, or whose sources call `MsgBox` or `InputBox`, is refused. | | `compile <slug>` | Packs, then compiles the project with `tbbuild --json` and prints its diagnostics. | | `build <slug>` | Packs, then compiles and builds it with `tbbuild --build`, or `--llvm` when that is given. A build that fails prints the build log and the failing line. | | `run <slug>` | Copies `src/` to `%TEMP%\bugrepro\<port>\<slug>`, adds a `TbRunProbe` module whose `[RunAfterBuild]` Sub calls `Debug.Cls` and then `Main`, runs `tbrun` on the copy and prints what it captured. The Sub clears `WEBVIEW2_USER_DATA_FOLDER` and `WEBVIEW2_ADDITIONAL_BROWSER_ARGUMENTS` while `Main` runs: the harness starts the IDE with both, and WebView2 lets them override what a WebView2 control in the project asks for, so the control would fail to start inside the IDE's process. The tree under `bugs/` is not changed. With `--exe` no probe module is added: `tbrun` runs `Sub Main` in the built exe. | +| `vb6 <slug>` | Builds the reproducer's VB6 project, in `vb6/`, and prints what its exe wrote. By convention `Probe.vbp` builds `Probe.exe`, which writes its findings to `out.txt` beside the exe and handles every error itself. The sources are copied to a new folder under the OS temp folder, so no exe or output lands in the repository, and the copy's project is given VB6's Unattended Execution option, which sends a message box or an unhandled error to the Windows event log instead of the desktop. The project is refused, exit 2, when its sources call `MsgBox` or `InputBox`, which would open a modal box. VB6 is found from `--vb6 <path>`, else the `VB6_EXE` environment variable, else `VB98\VB6.EXE` under `C:\Program Files (x86)\Microsoft Visual Studio` and then `C:\Program Files\Microsoft Visual Studio`; it is started from Node with an argument array and no shell, as [`vb6run.mjs`](#vb6run) does it. `--timeout` is the time limit on the exe (default 30 s), and `--keep` keeps the work folder and prints where it is. It needs no IDE. | | `verify [slug ...]` | Reads `repro.json` for each named reproducer, or every one under `bugs/` and `bugs/filed/`, runs what it says and reports one line each. A filed reproducer's line is labelled with its issue, such as `(filed #2453)`, and the summary counts the filed ones on a line of their own. | | `file <slug> <issue>` | Moves the entry that names `` `<slug>.twinproj` `` out of `BUGS-TO-REPORT.md`, together with one `---` beside it, into `bugs/filed/<slug>/REPORT.md`, whose first line links the issue (`--existing`: "Covered by the existing issue ..." when an existing issue already covered the bug) and which holds no mark line. Then moves `bugs/<slug>/` to `bugs/filed/<slug>/` and records `issue` (and `existing`) in its `repro.json`. An entry whose reproducer is not an attachment names `bugs/<slug>/` in its closing comment instead. Refused, with exit 2 and nothing changed, when no entry or more than one names the slug, `bugs/<slug>` is missing, or `bugs/filed/<slug>` exists. | | `file --marked` | Does that for every entry with a mark line directly under its title: `*FILED #<n>*`, `*CAPTURED IN EXISTING #<n>*` or `*CAPTURED IN \#<n>*`, the issue and the slug taken from the entry. A line such as `*DEFERRED until after v1*` is not a mark, and the entry is skipped. If a mark cannot be read, or a slug cannot be settled, the entries concerned are printed and nothing at all is filed, exit 2. One line is printed for each entry filed. Takes neither a slug nor an issue. | @@ -1023,7 +1025,12 @@ outside every gate and outside CI, and `verify` is run by a person only. The options of `compile`, `build` and `run` are those of `tbbuild` and `tbrun` of the same name, and are passed to them: `--ide`, `--port` (default 9440), `--arch`, `--timeout`, `--keep` and `--show` / `--hide`, with `--llvm` for `build` and `run`, and `--exe` for `run`. -An option that does not apply to a command is refused, not ignored. +An option that does not apply to a command is refused, not ignored. `vb6` takes `--vb6`, +`--timeout` and `--keep` only, and `--with-vb6` is for `new` alone. + +A VB6 project in `vb6/` has no key in `repro.json`: the folder says it is there. `pack` and +`verify` check it, and `attach` may not name `<slug>-vb6.zip` or a path under `vb6/`. +`verify` runs the twinBASIC side only, and never starts VB6. **`repro.json` says how to ask the compiler about a reproducer.** It is committed with the reproducer and is not part of the `.twinproj`. A key it does not have, or a value of the @@ -1057,7 +1064,28 @@ the bug unless `expect.exit` names it. Reproducers run one at a time. `--jobs N` once, each in the IDE on its own port, from `--port` up. `verify` tidies the IDE's registry entries once for all of them, as [`check_examples.mjs`](#check-examples) does. -Exit codes: **0** done --- a project that compiled, built or ran as it should, or, for `verify`, every reproducer that can be run on its own still reproduces; **1** a finding: the project has errors, or its build failed after a clean compile, or, for `verify`, at least one reproducer no longer reproduces; **2** a refused command line, a `repro.json` that is not valid, no IDE, a project that could not be packed, a harness that failed, or a crash; for `verify`, a lane's harness failed; for `file`, an entry that is missing, ambiguous or marked unreadably, or a `bugs/filed/<slug>` already there, with nothing changed; **3** `new` found `bugs/<slug>` or `bugs/filed/<slug>` already there; **4** the compile never settled; **5** the project crashes the compiler; **6** `run`: the probe printed nothing; **7** `run`: the probe ended before it returned; **8** `run --exe`: the exe exited with a code other than 0, or was still running after `--timeout`. +Exit codes: **0** done --- a project that compiled, built or ran as it should, or, for `verify`, every reproducer that can be run on its own still reproduces; **1** a finding: the project has errors, or its build failed after a clean compile, or, for `vb6`, VB6 refused the project, or, for `verify`, at least one reproducer no longer reproduces; **2** a refused command line, a `repro.json` that is not valid, no IDE, a project that could not be packed, a harness that failed, or a crash; for `vb6`, no VB6, a reproducer with no `vb6/` folder, a project that has no `Probe.vbp` or calls `MsgBox` or `InputBox`, or VB6 failing to build it; for `verify`, a lane's harness failed; for `file`, an entry that is missing, ambiguous or marked unreadably, or a `bugs/filed/<slug>` already there, with nothing changed; **3** `new` found `bugs/<slug>` or `bugs/filed/<slug>` already there; **4** the compile never settled; **5** the project crashes the compiler; **6** `run`: the probe printed nothing; for `vb6`, the exe wrote no `out.txt`, or an empty one; **7** `run`: the probe ended before it returned; **8** `run --exe`, and `vb6`: the exe exited with a code other than 0, or was still running after `--timeout`. + +### vb6run.mjs +{: #vb6run } + + node scripts/vb6run.mjs <file | -> [--vb6 <path>] [--timeout S] [--keep] [--json] + node scripts/vb6run.mjs --docs [--only <regex>] [--vb6 <path>] [--timeout S] [--keep] [--json] + +Builds and runs Visual Basic 6 code, so that what a documented sample prints in twinBASIC can be compared with what it prints in VB6. It needs VB6, which it finds from `--vb6 <path>`, else the `VB6_EXE` environment variable, else `VB98\VB6.EXE` under `C:\Program Files (x86)\Microsoft Visual Studio` and then under `C:\Program Files\Microsoft Visual Studio`; with none of them it exits 2 and says how to point at one. It needs Windows, is outside every gate and outside CI, and is run by a person, as [`check_examples.mjs`](#check-examples) is. + +**Nothing may open a dialog, and VB6 is never started through a shell.** The tool starts `VB6.EXE` from Node with an argument array. Started from Git Bash by hand, `/make` and `/out` are rewritten as paths, and VB6 answers every switch it does not know with a modal message box on the desktop. A compiled exe also shows a modal box for an unhandled run-time error, for `MsgBox` and for `InputBox`. So each sample runs under an error handler the tool generates, the project is built with VB6's Unattended Execution option, which writes such a box to the Windows event log, and a sample that calls `MsgBox` or `InputBox` or contains an `End` statement is refused without being built, as `check_run` refuses it. Every process the tool starts has a time limit and is ended by its pid when it runs over. Work folders are created under the OS temp folder, one for each run, and removed at the end; `--keep` leaves the folder and prints where it is. + +**`Debug.Print` is rewritten.** It writes nothing in a compiled exe. The tool rewrites each `Debug.Print` statement to `Print #511,` against a file the generated `Sub Main` opens, and `Print #` takes the same arguments (`;`, `,`, `Spc`, `Tab`), so the text is the same. A `Debug.Print` inside a string or a comment is left alone, and one after a `:` or after `Then` or `Else` is rewritten. VB6 writes the file in the ANSI code page, and the tool reads it as Windows-1252. A sample that calls `Close` with no file number also closes that file, and its next `Debug.Print` raises error 52. + +| Mode | Effect | +|---|---| +| `<file>` | A `.bas` module, or a text file of bare statements; `-` reads statements from standard input. A file that defines `Sub Main` is a whole module: it is built as written, its `Sub Main` is renamed so that the generated `Main` can start it, and it keeps its `Attribute VB_Name` line or is given one. Any other file is the body of a generated procedure. What the sample printed goes to standard output. A compile error is reported to standard error as VB6 reports it, with the line given as a line of the file, and a run-time error as `[vb6] error <n>: <description>`. | +| `--docs` | Reads the documentation's `check_run` fences with the reader `check_examples.mjs` uses and builds each as a module of its own in a VB6 project; the fences that need no other fence share one project. The run fences of a `projname=` group are built in a project of their own, since class and module names collide between groups, together with the other fences of the group, each of which is a file. A `slot=file` fence is translated into VB6 components: every `Class <Name>` block becomes a class module and every `Module <Name>` block a standard module, `Public`, `Private` or `Friend` before the keyword being accepted, and anything outside those blocks (`Declare`, `Type`, `Enum`, `Const`, procedures) becomes one more standard module. Nothing else is translated. A construct VB6 has no form for, such as an `Interface`, a `CoClass`, a generic or an attribute line, stays where it is and VB6 refuses it, so each run fence of a group whose files do not build is `not VB6`, with the first error at its line in the page. Each of the run fences ends as `same` (VB6 prints what the page says twinBASIC prints), `differs` (the lines that differ, the page against VB6, with the page path and line), `not VB6` (VB6 refuses to compile it, with its first error; most twinBASIC syntax ends here, and it is informational), `error` (a run-time error, or it did not return), or `refused` (the sample cannot be run, for the reasons `check_run` gives). A compile error stops VB6 at the first module that fails, so that module is dropped and the project is built again until it builds. A summary line gives the count of each. `--only <regex>` keeps the pages whose path under `docs/` matches. | + +Other options: `--timeout S` is the time limit, in seconds, for each run of the built exe (default 30), and `--json` prints one JSON object in place of the text. + +Exit codes: **0** the sample ran, or, with `--docs`, no fence differs and none raised an error; **1** a VB6 compile error, a run-time error or a sample that did not return, or, with `--docs`, at least one fence that differs or raised an error; **2** the harness could not run --- a refused command line, a file that is missing, a sample that is refused, no VB6, VB6 failing to build, or a crash. ### addin_test.mjs {: #addin-test } @@ -1262,7 +1290,7 @@ the set, and points at `BUGS-TO-REPORT.md`. FAIL docs/Reference/Default/VBA/Strings/InStr.md:77 (Reference/Default/VBA/Strings/InStr.md#3) prints "3", the page says "7" -**A batch can report nothing when it should report something.** `tbbuild` does not wait for a build: it reads the IDE's own window, the status bar and the Problems panel for the project the IDE has open, once the compiler's status reads OPERATIONAL and has stopped changing. An IDE under load can be OPERATIONAL with an empty panel before it has published its diagnostics, and a batch read then reports every sample as compiling, which looks exactly like a batch with nothing wrong. So every batch carries a canary: a module holding a `#Warning` directive, whose warning (`TB0005`) is known. A read with no errors in it must report the canary, or it is not believed. The module carries `[EnforceWarnings(TB0005)]`, so a project setting that ignores the warning, or turns it into an error, does not change it. The warning is reported whatever else the batch holds: unterminated blocks, stray `End` statements, broken classes and many undefined names in other files do not hide it. It is a warning rather than an error so that a batch with nothing wrong still builds clean. A batch that crashes the compiler reports nothing at all and is isolated as a crash; its canary is never read. +**A batch can report nothing when it should report something.** `tbbuild` does not wait for a build: it reads the IDE's own window, the status bar and the Problems panel for the project the IDE has open, once the compiler's status reads OPERATIONAL and either the IDE's own traffic shows the compile has ended and the window agrees with it, or the window has stopped changing for five seconds. An IDE under load can be OPERATIONAL with an empty panel before it has published its diagnostics, and a batch read then reports every sample as compiling, which looks exactly like a batch with nothing wrong. So every batch carries a canary: a module holding a `#Warning` directive, whose warning (`TB0005`) is known. A read with no errors in it must report the canary, or it is not believed. The module carries `[EnforceWarnings(TB0005)]`, so a project setting that ignores the warning, or turns it into an error, does not change it. The warning is reported whatever else the batch holds: unterminated blocks, stray `End` statements, broken classes and many undefined names in other files do not hide it. It is a warning rather than an error so that a batch with nothing wrong still builds clean. A batch that crashes the compiler reports nothing at all and is isolated as a crash; its canary is never read. The canary proves only that the IDE published something, not that it published everything: a read that includes the canary but not a sample's later diagnostics would still pass that sample. So a read that holds real errors needs no canary --- the IDE was plainly not silent --- and is taken as read, whatever the canary did. Real errors here are errors in the batch's samples, and errors outside every sample that the template does not draw by itself; a template's own errors do not count, or a template that always draws one would switch the canary off for every batch built from it. A canary missing beside real errors has never been seen, and is printed as a note if it happens. A read with no errors and no canary is built once more, because a read that came too early says nothing about the batch. If it is silent again, the batch is split in half repeatedly, as for a crash, until each part reports the canary or errors of its own. A single unit --- one sample, or a group compiled as one program --- that is still silent stops the run with exit code 2 and its name, because its clean result cannot be trusted and it is not blamed for errors nobody saw. The template built with no samples, which is how the tool learns the errors a template draws by itself, follows the same rule: it needs its canary only if it has no errors, is read again when it is silent, and stops the run when it is silent twice. diff --git a/docs/Reference/COM-Interfaces/IConnectionPoint.md b/docs/Reference/COM-Interfaces/IConnectionPoint.md new file mode 100644 index 00000000..5cd01690 --- /dev/null +++ b/docs/Reference/COM-Interfaces/IConnectionPoint.md @@ -0,0 +1,424 @@ +--- +title: IConnectionPoint +parent: COM Interfaces +permalink: /Reference/COM-Interfaces/IConnectionPoint +--- + +# IConnectionPoint interface +{: .no_toc } + +Connects a client's sink to one outgoing interface of an object, and disconnects it again. It is the COM mechanism that delivers events: every class that declares [**Event**](../../tB/Core/Event) members is a connectable object, and a [**WithEvents**](../../tB/Core/WithEvents) variable connects to it through this interface. **IConnectionPointContainer**, the interface that finds the connection points of an object, has a section of its own below. + +* TOC +{:toc} + +## How connection points work + +An object that raises events, the *source*, describes them as an *outgoing interface*: an interface that the source calls, and that the client implements. The client's implementation of it is the *sink*. The connection is made in five steps: + +1. The source supports **IConnectionPointContainer**, so the client asks it for that interface with [**QueryInterface**](IUnknown). +2. The client asks the container for the connection point of the outgoing interface, by the interface's identifier with **FindConnectionPoint**, or by listing every point with **EnumConnectionPoints**. +3. The client creates the sink and passes it to the connection point's **Advise** method. The connection point asks the sink for the outgoing interface, keeps the pointer it gets, and returns a *cookie*: a number that identifies this connection. +4. When an event occurs, the source calls the matching method of every connected sink, in the order the connections were made. +5. The client passes the cookie to **Unadvise**. The source releases its pointer to the sink. + +The outgoing interface of an object is usually a *dispinterface*, an interface whose methods are reached only through [**IDispatch**](IDispatch). A sink then receives each event as a call to its **Invoke** method, with the dispatch identifier of the event and the event's arguments in a **DISPPARAMS** structure. + +## Declaration + +**IConnectionPoint** derives from **IUnknown** and has the interface identifier `B196B286-BAB4-101A-B69C-00AA00341D07`. Its five methods return an **HRESULT**, which twinBASIC hides as it does for any interface method: a failure code raises a run-time error, and a success code other than `S_OK` is read with [**Err.LastHresult**](../../tB/Modules/ErrObject/LastHresult). A method whose last parameter is an output pointer is declared as a **Function** that returns it. + +**stdole** has none of the interfaces on this page: a variable declared `As stdole.IConnectionPoint` is a compile error (TB5079, *Unrecognised datatype symbol*). A project declares its own copies, with the identifiers below. + +The structures first, **GUID** for an interface identifier and **CONNECTDATA** for one item of an enumeration of connections: + +```tb check_build projname=com-iconnpoint slot=file +Module ConnectionTypes + Public Type GUID + Data1 As Long + Data2 As Integer + Data3 As Integer + Data4(0 To 7) As Byte + End Type + + Public Type CONNECTDATA + pUnk As stdole.IUnknown + dwCookie As Long + End Type +End Module +``` + +The two interfaces this page describes, and the two enumerators they return: + +```tb check_build projname=com-iconnpoint slot=file +[InterfaceId("B196B284-BAB4-101A-B69C-00AA00341D07")] +Private Interface IConnectionPointContainer Extends stdole.IUnknown + Function EnumConnectionPoints() As IEnumConnectionPoints + Function FindConnectionPoint(ByRef riid As GUID) As IConnectionPoint +End Interface + +[InterfaceId("B196B286-BAB4-101A-B69C-00AA00341D07")] +Private Interface IConnectionPoint Extends stdole.IUnknown + Sub GetConnectionInterface(ByRef piid As GUID) + Function GetConnectionPointContainer() As IConnectionPointContainer + Function Advise(ByVal pUnkSink As stdole.IUnknown) As Long + Sub Unadvise(ByVal dwCookie As Long) + Function EnumConnections() As IEnumConnections +End Interface + +[InterfaceId("B196B285-BAB4-101A-B69C-00AA00341D07")] +Private Interface IEnumConnectionPoints Extends stdole.IUnknown + Sub Next(ByVal cConnections As Long, ByRef ppCP As IConnectionPoint, ByRef pcFetched As Long) + Sub Skip(ByVal cConnections As Long) + Sub Reset() + Function Clone() As IEnumConnectionPoints +End Interface + +[InterfaceId("B196B287-BAB4-101A-B69C-00AA00341D07")] +Private Interface IEnumConnections Extends stdole.IUnknown + Sub Next(ByVal cConnections As Long, ByRef rgcd As CONNECTDATA, ByRef pcFetched As Long) + Sub Skip(ByVal cConnections As Long) + Sub Reset() + Function Clone() As IEnumConnections +End Interface +``` + +*ppCP* and *rgcd* name the first element of the caller's array and nothing after it, which is enough to ask for one item at a time. The enumerators of this page return one item per call whatever the count asked for (see [The enumerators](#the-enumerators)). + +The identifier of the outgoing interface of a class written in twinBASIC is not a fixed value, so a program never declares it. It reads the identifier from the connection point (see [Events in twinBASIC](#events-in-twinbasic)). + +## IConnectionPoint methods + +### GetConnectionInterface +{: .no_toc } + +Returns the identifier of the outgoing interface that the connection point serves. + +Syntax: *object*.**GetConnectionInterface** *piid* + +*piid* +: *required* A **GUID** that receives the interface identifier. + +The identifier is the one to pass to **FindConnectionPoint** to get the same connection point again, and the one a sink must answer to when it is advised. + +### GetConnectionPointContainer +{: .no_toc } + +Returns the container that the connection point belongs to. + +Syntax: **Set** *container* **=** *object*.**GetConnectionPointContainer()** + +The result is the object the connection point was found on, so a client that holds only the connection point can reach the other points of its source. + +### Advise +{: .no_toc } + +Connects a sink to the connection point. + +Syntax: *cookie* **=** *object*.**Advise(** *pUnkSink* **)** + +*pUnkSink* +: *required* The sink. The connection point asks it for the outgoing interface, so it must answer **QueryInterface** for that interface's identifier. + +Returns a **Long**, the cookie that identifies the connection. The cookie is not zero when a connection was made, and no two connections of one connection point have the same one. The connection point holds a reference to the sink until the connection ends. + +In twinBASIC: + +- Cookies start at 1 for each source object and increase by one for every connection made. A cookie is not used again after its connection ends. +- A sink that does not answer for the outgoing interface fails with `E_NOINTERFACE` (`&H80004002`), where the COM contract names `CONNECT_E_CANNOTCONNECT`. An object of an ordinary twinBASIC class is such a sink, even when the class implements **IDispatch**, and so is a class declared **NotDispatchable** that implements it. A twinBASIC class cannot answer for the identifier, because the identifier of a class's event interface changes with every build and so cannot be declared. A sink that works is the object twinBASIC creates for a **WithEvents** variable, which **EnumConnections** returns (see the example). +- A sink that is already connected to the point is not connected a second time. **Advise** raises no error, returns 0, and adds nothing. +- Passing **Nothing** ends the run with an access violation in BETA 995. The COM contract returns `E_POINTER`. + +### Unadvise +{: .no_toc } + +Ends a connection. + +Syntax: *object*.**Unadvise** *dwCookie* + +*dwCookie* +: *required* A **Long**: the cookie that **Advise** returned. + +The connection point releases the reference it held to the sink, and the source stops calling it. An event that the source raises afterwards does not reach that sink. + +In twinBASIC a cookie that names no connection, 0 included, raises no error, where the COM contract reports one. A **WithEvents** variable whose connection was ended with **Unadvise** can still be set to **Nothing** without an error. + +### EnumConnections +{: .no_toc } + +Returns an enumerator over the connections that exist now. + +Syntax: **Set** *connections* **=** *object*.**EnumConnections()** + +Each item is a **CONNECTDATA**: *pUnk* is the sink, with a reference added that the caller owns, and *dwCookie* is the cookie of its connection. The items come in the order the connections were made. A caller counts the connections of a point, or finds the cookie of a sink, with it. + +## IConnectionPointContainer + +**IConnectionPointContainer** derives from **IUnknown** and has the interface identifier `B196B284-BAB4-101A-B69C-00AA00341D07`. An object that raises events supports it, with one connection point for each outgoing interface. + +### EnumConnectionPoints +{: .no_toc } + +Returns an enumerator over the connection points of the object. + +Syntax: **Set** *points* **=** *object*.**EnumConnectionPoints()** + +The enumerator is an **IEnumConnectionPoints**, which returns **IConnectionPoint** items. + +### FindConnectionPoint +{: .no_toc } + +Returns the connection point for one outgoing interface. + +Syntax: **Set** *point* **=** *object*.**FindConnectionPoint(** *riid* **)** + +*riid* +: *required* A **GUID**: the identifier of the outgoing interface. + +Raises `CONNECT_E_NOCONNECTION` (`&H80040200`) when the object has no outgoing interface with that identifier. Called again with the same identifier it returns the same connection point object that **EnumConnectionPoints** returns. + +## The enumerators + +**IEnumConnectionPoints** and **IEnumConnections** follow the pattern of [**IEnumVARIANT**](IEnumVARIANT): **Next**, **Skip**, **Reset** and **Clone**. In BETA 995 the two enumerators that twinBASIC supplies do not follow it in the same way, so a caller reads each one as described here. Both are read one item at a time, with *cConnections* of 1. + +| Method | **IEnumConnectionPoints** | **IEnumConnections** | +|--------|---------------------------|----------------------| +| **Next** | Returns one item and `S_OK`. When no item is left, raises `E_FAIL` (`&H80004005`) and sets *pcFetched* to 0, where the contract returns `S_FALSE`. Asking for more items than are left also raises `E_FAIL`. | Returns one item and `S_OK`, even when more were asked for and more are left. When no item is left, writes nothing, sets *pcFetched* to 0 and returns `S_FALSE`, so a loop ends when *pcFetched* is 0. A null *pcFetched* is accepted. | +| **Skip** | Raises `E_NOTIMPL` (`&H80004001`). | Moves past the items. | +| **Reset** | Moves back to the start. | Moves back to the start. | +| **Clone** | Raises `E_NOTIMPL`. | Returns a new enumerator, which reads on its own. | + +A caller that asks for several items at once from **IEnumConnections** therefore gets only the first, and must call again. A caller that reads **IEnumConnectionPoints** handles the error of the call that finds the end. + +## Events in twinBASIC + +A class that declares [**Event**](../../tB/Core/Event) members is a connectable object, and the compiler writes all of its connection point support. What it does, in BETA 995: + +- **Every class answers for IConnectionPointContainer.** **QueryInterface**, and a [**Set**](../../tB/Core/Set) to a variable of the container type, succeed for a class with no events as they do for a class with events. +- **A class with events has one connection point**, however many events it declares. **EnumConnectionPoints** returns it and **FindConnectionPoint** finds it by its interface identifier. +- **A class with no events has none, and says so by failing.** **EnumConnectionPoints** and **FindConnectionPoint** both raise run-time error 445, *Object doesn't support this action*. +- **The identifier of the outgoing interface is generated for each class.** Every object of one class reports the same identifier, two classes report different ones, and rebuilding the project changes them. Read it with **GetConnectionInterface**. +- **The outgoing interface is a dispinterface.** The sink twinBASIC creates answers for the interface's identifier with its **IDispatch** pointer. Each event has a dispatch identifier: 1 for the first event the class declares, 2 for the second, and so on in declaration order. A call of a dispatch identifier on the sink runs the handler of that event, and a late-bound [**CallByDispId**](../../tB/Modules/Interaction/CallByDispId) on a sink does the same. +- **A WithEvents variable is a connection.** Assigning an object to it with [**Set**](../../tB/Core/Set) calls **Advise**, which adds one connection to the source. Assigning **Nothing**, assigning another object, and destroying the object that holds the variable each call **Unadvise** on the source the variable held, which removes that connection. Two objects that watch the same source make two connections, and the handlers run in the order the connections were made. The sink object that twinBASIC registers does not keep the object that holds the variable alive: when the last reference to the holder is released, the holder terminates and its connection is removed. +- **[RaiseEvent](../../tB/Core/RaiseEvent) with no sink connected does nothing.** It raises no error. + +A **WithEvents** variable can also hold an object that is not written in twinBASIC, when the project refers to its type library. The object's own connection point is used, and its outgoing interface is the one its type library lists as a source. The example at the end of the page does this with the sink object of the WMI scripting library. + +## Example + +A class that raises events, a class that listens to them with a **WithEvents** variable, and a class with no events. The helper module holds the two loops the samples reuse: it finds the first connection point of an object, and counts the sinks connected to a point. + +```tb check_build projname=com-iconnpoint slot=file +Class Counter + Public Event Changed(ByVal NewValue As Long) + Public Event Finished() + + Private Total As Long + + Public Sub Increment() + Total += 1 + RaiseEvent Changed(Total) + End Sub + + Public Sub Finish() + RaiseEvent Finished + End Sub +End Class + +Class Display + Public Name As String + Private WithEvents Source As Counter + + Public Sub Watch(ByVal Target As Counter) + Set Source = Target + End Sub + + Public Sub Unwatch() + Set Source = Nothing + End Sub + + Private Sub Source_Changed(ByVal NewValue As Long) + Debug.Print Name & ": " & NewValue + End Sub +End Class + +Class Silent + Public Value As Long +End Class +``` + +```tb check_build projname=com-iconnpoint slot=file +Private Module ConnectionHelpers + Public Function FirstConnectionPoint(ByVal obj As Object) As IConnectionPoint + Dim container As IConnectionPointContainer = obj + Dim points As IEnumConnectionPoints = container.EnumConnectionPoints() + Dim point As IConnectionPoint, fetched As Long + points.Next 1, point, fetched + Return point + End Function + + Public Function ConnectionCount(ByVal point As IConnectionPoint) As Long + Dim sinks As IEnumConnections = point.EnumConnections() + Dim item As CONNECTDATA, fetched As Long, n As Long + Do + sinks.Next 1, item, fetched + If fetched = 0 Then Exit Do + n += 1 + Set item.pUnk = Nothing + Loop + Return n + End Function +End Module +``` + +**WithEvents** and **Set** are **Advise** and **Unadvise**. The first **Increment** has no sink, so nothing is printed and the point has no connection. Each **Watch** adds one, each **Unwatch** removes one, and the handlers run in the order of the connections: + +```tb check_run projname=com-iconnpoint +Dim c As New Counter +Dim point As IConnectionPoint = FirstConnectionPoint(c) +Dim a As New Display, b As New Display +a.Name = "A" +b.Name = "B" + +c.Increment +Debug.Print ConnectionCount(point) +a.Watch c +Debug.Print ConnectionCount(point) +b.Watch c +Debug.Print ConnectionCount(point) +c.Increment +a.Unwatch +Debug.Print ConnectionCount(point) +c.Increment +b.Unwatch +Debug.Print ConnectionCount(point) +' Output: +' 0 +' 1 +' 2 +' A: 2 +' B: 2 +' 1 +' B: 3 +' 0 +``` + +A class with events has one connection point, and the container finds it again by the identifier it reports. The enumerator has no second item: its **Next** raises `E_FAIL`. A class with no events fails in **EnumConnectionPoints** with run-time error 445. An identifier that the object does not have, here that of **IUnknown**, raises `CONNECT_E_NOCONNECTION`: + +```tb check_run projname=com-iconnpoint +Dim c As New Counter +Dim container As IConnectionPointContainer = c +Dim points As IEnumConnectionPoints = container.EnumConnectionPoints() +Dim point As IConnectionPoint, fetched As Long +points.Next 1, point, fetched +Debug.Print fetched ' 1 + +Dim iid As GUID +point.GetConnectionInterface iid +Dim again As IConnectionPoint = container.FindConnectionPoint(iid) +Debug.Print again Is point ' True +Dim back As IConnectionPointContainer = point.GetConnectionPointContainer() +Debug.Print back Is container ' True + +On Error Resume Next +points.Next 1, point, fetched +Debug.Print Hex$(Err.Number) ' 80004005 +Err.Clear + +Dim other As GUID ' the identifier of IUnknown +other.Data4(0) = &HC0 +other.Data4(7) = &H46 +container.FindConnectionPoint other +Debug.Print Hex$(Err.Number) ' 80040200 +Err.Clear + +Dim s As New Silent +Dim silentContainer As IConnectionPointContainer = s +silentContainer.EnumConnectionPoints +Debug.Print Err.Number ' 445 +``` + +The sink that twinBASIC registers for a **WithEvents** variable can be taken from **EnumConnections** and advised by hand. Advising it while it is still connected adds nothing and returns 0. After **Unadvise** it can be advised again, and the new cookie is a new number. Its **IDispatch** runs the handler: event 1 of **Counter** is **Changed**, and event 2, **Finished**, has no handler to run. An ordinary object is not a sink, and **Unadvise** with a cookie nobody holds does nothing: + +```tb check_run projname=com-iconnpoint +Dim c As New Counter +Dim point As IConnectionPoint = FirstConnectionPoint(c) +Dim d As New Display +d.Name = "D" +d.Watch c + +Dim connections As IEnumConnections = point.EnumConnections() +Dim item As CONNECTDATA, fetched As Long +connections.Next 1, item, fetched +Dim sink As stdole.IUnknown = item.pUnk +Debug.Print item.dwCookie ' 1 +Debug.Print point.Advise(sink) ' 0 +Debug.Print ConnectionCount(point) ' 1 + +point.Unadvise item.dwCookie +Debug.Print ConnectionCount(point) ' 0 +c.Increment + +Dim cookie As Long = point.Advise(sink) +Debug.Print cookie ' 2 +c.Increment +Dim target As Object = sink +CallByDispId target, 1, vbMethod, 41 +CallByDispId target, 2, vbMethod +point.Unadvise cookie +c.Increment + +On Error Resume Next +Dim notASink As New Silent +Dim refused As Long = point.Advise(notASink) +Debug.Print Hex$(Err.Number) ' 80004002 +Err.Clear +point.Unadvise 99 +Debug.Print Err.Number ' 0 +' Output: +' 1 +' 0 +' 1 +' 0 +' 2 +' D: 2 +' D: 41 +' 80004002 +' 0 +``` + +A **WithEvents** variable of a type from a type library works in the same way. This class holds the sink object of the WMI scripting library, a source of events that every Windows installation has. It needs a reference to *Microsoft WMI Scripting V1.2 Library* in the project: + +```tb inert=external +Class WmiWatcher + Public Completed As Boolean + Private WithEvents Sink As WbemScripting.SWbemSink + + Public Sub Attach() + Set Sink = New WbemScripting.SWbemSink + End Sub + + Public Sub Detach() + Set Sink = Nothing + End Sub + + Private Sub Sink_OnCompleted(ByVal iHResult As WbemScripting.WbemErrorEnum, _ + ByVal objWbemErrorObject As WbemScripting.SWbemObject, _ + ByVal objWbemAsyncContext As WbemScripting.SWbemNamedValueSet) + Completed = True + End Sub +End Class +``` + +After **Attach**, the sink's connection point for the outgoing interface **ISWbemSinkEvents** holds one connection, and after **Detach** it holds none. + +## See Also + +- [IUnknown](IUnknown) interface -- the base interface and **QueryInterface** +- [IDispatch](IDispatch) interface -- how a dispinterface sink receives an event +- [IEnumVARIANT](IEnumVARIANT) interface -- the enumerator pattern the two enumerators follow +- [Event](../../tB/Core/Event) statement -- declares an event on a class +- [RaiseEvent](../../tB/Core/RaiseEvent) statement -- fires a declared event +- [WithEvents](../../tB/Core/WithEvents) statement -- connects a sink to a source +- [Handles](../../tB/Core/Handles) clause -- binds a handler without relying on its name +- [Interfaces and CoClasses](../../Features/Language/Interfaces-CoClasses) -- declaring an interface in twinBASIC diff --git a/docs/Reference/COM-Interfaces/IDispatch.md b/docs/Reference/COM-Interfaces/IDispatch.md new file mode 100644 index 00000000..7a8b5cb8 --- /dev/null +++ b/docs/Reference/COM-Interfaces/IDispatch.md @@ -0,0 +1,541 @@ +--- +title: IDispatch +parent: COM Interfaces +permalink: /Reference/COM-Interfaces/IDispatch +--- + +# IDispatch interface +{: .no_toc } + +Lets a caller find a member of an object by name and call it, without knowing the object's type when the code is written. It is the interface behind every **Object** variable, behind [**CallByName**](../../tB/Modules/Interaction/CallByName), and behind automation servers such as Office and the Scripting Runtime. + +* TOC +{:toc} + +## Declaration + +**IDispatch** derives from **IUnknown** and has the interface identifier `00020400-0000-0000-C000-000000000046`. It adds four methods. Each returns an **HRESULT**, which twinBASIC hides as it does for any interface method: a failure code raises a run-time error, and a success code other than `S_OK` is read with [**Err.LastHresult**](../../tB/Modules/ErrObject/LastHresult). + +Every twinBASIC class has an **IDispatch** implementation that the compiler writes, so a program seldom needs the interface itself. A program needs it to call an object's **GetIDsOfNames** or **Invoke** directly, and to write a class that supplies its own member lookup. The declaration in **stdole** cannot call them (see [The stdole declaration](#the-stdole-declaration)); a project declares its own copy, with the same interface identifier. A copy needs the three structures the methods pass. + +```tb check_build projname=com-idispatch slot=file +Module DispatchTypes + Public Type GUID + Data1 As Long + Data2 As Integer + Data3 As Integer + Data4(0 To 7) As Byte + End Type + + Public Type DISPPARAMS + rgvarg As LongPtr + rgdispidNamedArgs As LongPtr + cArgs As Long + cNamedArgs As Long + End Type + + Public Type EXCEPINFO + wCode As Integer + wReserved As Integer + bstrSource As LongPtr + bstrDescription As LongPtr + bstrHelpFile As LongPtr + dwHelpContext As Long + pvReserved As LongPtr + pfnDeferredFillIn As LongPtr + scode As Long + End Type + + Public Const DISP_E_MEMBERNOTFOUND As Long = &H80020003 + Public Const DISP_E_UNKNOWNNAME As Long = &H80020006 + Public Const E_NOTIMPL As Long = &H80004001 +End Module + +[InterfaceId("00020400-0000-0000-C000-000000000046")] +Private Interface IDispatch Extends stdole.IUnknown + Sub GetTypeInfoCount(ByRef pctinfo As Long) + Sub GetTypeInfo(ByVal iTInfo As Long, ByVal lcid As Long, ByRef ppTInfo As LongPtr) + Sub GetIDsOfNames(ByRef riid As GUID, ByRef rgszNames As LongPtr, ByVal cNames As Long, ByVal lcid As Long, ByRef rgDispId As Long) + Sub Invoke(ByVal dispIdMember As Long, ByRef riid As GUID, ByVal lcid As Long, ByVal wFlags As Integer, ByRef pDispParams As DISPPARAMS, ByRef pVarResult As Variant, ByRef pExcepInfo As EXCEPINFO, ByRef puArgErr As Long) +End Interface +``` + +*rgszNames* is declared as the first element of an array of string pointers: pass `StrPtr(name)` in a **LongPtr** variable, or the first element of an array of them. *pVarResult* and *pExcepInfo* are the caller's variables. A caller that expects no result passes a null pointer for *pVarResult*, and a class that implements **Invoke** tests it with [**VarPtr**](../../tB/Modules/Information/VarPtr) before it writes. + +## Methods + +### GetTypeInfoCount +{: .no_toc } + +Says whether the object can describe itself with type information. + +Syntax: *object*.**GetTypeInfoCount** *pctinfo* + +*pctinfo* +: *required* A **Long** that receives 1 when the object has type information, and 0 when it has none. + +Returns `S_OK`. A twinBASIC class returns 1. + +### GetTypeInfo +{: .no_toc } + +Returns the object's type information, as an **ITypeInfo** pointer that the caller releases. + +Syntax: *object*.**GetTypeInfo** *iTInfo*, *lcid*, *ppTInfo* + +*iTInfo* +: *required* A **Long**: which type information to return. It is 0, the only value an object with a single description accepts. Another value fails with `DISP_E_BADINDEX` (`&H8002000B`). + +*lcid* +: *required* A **Long**: the locale for the names in the description. + +*ppTInfo* +: *required* A **LongPtr** that receives the pointer. + +A twinBASIC class returns a description for *iTInfo* 0. For 1 it fails with `E_UNEXPECTED` (`&H8000FFFF`), not with `DISP_E_BADINDEX`. [**TypeName**](../../tB/Modules/Information/TypeName) calls this method to find the name of an object's class. + +### GetIDsOfNames +{: .no_toc } + +Turns a member name, and optionally the names of that member's parameters, into the numbers **Invoke** takes. The number is the member's dispatch identifier, a **DISPID**. + +Syntax: *object*.**GetIDsOfNames** *riid*, *rgszNames*, *cNames*, *lcid*, *rgDispId* + +*riid* +: *required* A **GUID**. It is reserved and must be all zeros, `IID_NULL`. + +*rgszNames* +: *required* The names to look up. The first is the member's name. Each one after it is the name of one of that member's parameters. + +*cNames* +: *required* A **Long**: how many names *rgszNames* holds. + +*lcid* +: *required* A **Long**: the locale for interpreting the names. + +*rgDispId* +: *required* The first element of an array of *cNames* **Long** values, which receives one identifier per name, in the same order. The identifier of a parameter is the zero-based position of that parameter in the member's parameter list. + +Name matching ignores case. A member keeps its identifier for the life of the object, so a caller can look it up once and use it for every later call. + +Returns `S_OK` when every name is known. When a name is not known it returns `DISP_E_UNKNOWNNAME` (`&H80020006`) and writes `DISPID_UNKNOWN` (-1) in that name's slot, and a name the object does know still gets its identifier. + +### Invoke +{: .no_toc } + +Calls a method, or reads or writes a property, given the identifier **GetIDsOfNames** returned. + +Syntax: *object*.**Invoke** *dispIdMember*, *riid*, *lcid*, *wFlags*, *pDispParams*, *pVarResult*, *pExcepInfo*, *puArgErr* + +*dispIdMember* +: *required* A **Long**: the member's identifier. + +*riid* +: *required* A **GUID**: reserved, all zeros, as for **GetIDsOfNames**. + +*lcid* +: *required* A **Long**: the locale for interpreting the arguments. + +*wFlags* +: *required* An **Integer**: what the call does with the member, from the table below. A caller that cannot tell a method call from a property read sets both `DISPATCH_METHOD` and `DISPATCH_PROPERTYGET`, and the object does whichever the member is. + +*pDispParams* +: *required* A **DISPPARAMS** holding the arguments. + +*pVarResult* +: *required* A **Variant** that receives the result of a method or a property read. It is a null pointer when the caller wants no result, and the object ignores it for a property write. + +*pExcepInfo* +: *required* An **EXCEPINFO** that the object fills in when it returns `DISP_E_EXCEPTION`. It can be a null pointer. + +*puArgErr* +: *required* A **Long** that receives the position, in *rgvarg*, of the first argument that was wrong, when the return value says so. It can be a null pointer. + +| Flag | Value | Meaning | +|------|-------|---------| +| `DISPATCH_METHOD` | 1 | Call the member as a method. | +| `DISPATCH_PROPERTYGET` | 2 | Read the member as a property. | +| `DISPATCH_PROPERTYPUT` | 4 | Assign a value to the property. | +| `DISPATCH_PROPERTYPUTREF` | 8 | Assign an object to the property by reference, as **Set** does. | + +#### The DISPPARAMS structure + +*rgvarg* points to an array of *cArgs* **Variant** values, holding the arguments in **reverse order**: element 0 is the last argument of the call and the highest element is the first. A call `Subtract(10, 3)` passes 3 in element 0 and 10 in element 1. + +A named argument goes first in the array, which puts it at the end of the call's own order. *rgdispidNamedArgs* points to *cNamedArgs* identifiers, one per named argument, in the same order as the first *cNamedArgs* elements of *rgvarg*. The identifiers are those **GetIDsOfNames** returned for the parameter names. A call `Greet(1, n:=5)` passes 5 in element 0, with the identifier of *n* as the single named identifier, and 1 in element 1. + +A property assignment passes the new value as the only argument, named with the reserved identifier `DISPID_PROPERTYPUT` (-3): *cNamedArgs* is 1 and *rgdispidNamedArgs* points to a **Long** holding -3. + +#### Return values + +| Value | Name | Meaning | +|-------|------|---------| +| `&H00000000` | `S_OK` | The call succeeded. | +| `&H80020001` | `DISP_E_UNKNOWNINTERFACE` | *riid* is not all zeros. | +| `&H80020003` | `DISP_E_MEMBERNOTFOUND` | The object has no such member, or the member does not allow the access *wFlags* asks for. | +| `&H80020004` | `DISP_E_PARAMNOTFOUND` | A named argument's identifier is not a parameter of the member. | +| `&H80020005` | `DISP_E_TYPEMISMATCH` | An argument cannot be converted to the parameter's type. | +| `&H80020007` | `DISP_E_NONAMEDARGS` | The object does not accept named arguments. | +| `&H80020008` | `DISP_E_BADVARTYPE` | An argument is not a valid **Variant**. | +| `&H80020009` | `DISP_E_EXCEPTION` | The member raised an error. *pExcepInfo* describes it. | +| `&H8002000A` | `DISP_E_OVERFLOW` | An argument is out of range for the parameter. | +| `&H8002000E` | `DISP_E_BADPARAMCOUNT` | The call passes more or fewer arguments than the member takes. | +| `&H8002000F` | `DISP_E_PARAMNOTOPTIONAL` | A required argument is missing. | + +## Reserved identifiers + +An object may give any other number to a member, but these are reserved. Negative numbers other than the four in the table are reserved for other purposes. + +| Identifier | Name | Member | +|-----------:|------|--------| +| 0 | `DISPID_VALUE` | The default member. | +| -1 | `DISPID_UNKNOWN` | Returned by **GetIDsOfNames** for a name it does not know. | +| -3 | `DISPID_PROPERTYPUT` | The name of the value argument of a property assignment. | +| -4 | `DISPID_NEWENUM` | The member that returns the object's enumerator, which [**For Each**](../../tB/Core/For-Each-Next) uses; see [**IEnumVARIANT**](IEnumVARIANT). | + +## Late binding in twinBASIC + +A variable declared **As Object**, and a **Variant** that holds an object, call every member through **IDispatch**. That is late binding: the member is looked up by name when the statement runs, so a misspelled name compiles and fails when it is reached. A variable declared with a class or interface type calls through the vtable instead, which is faster and checked when the project compiles. See [Data Types](../Data-Types#object). + +Each late-bound statement calls **GetIDsOfNames** with the member's name, then **Invoke** with the identifier it got. A statement that names an argument passes the argument's name as a second name. [**For Each**](../../tB/Core/For-Each-Next) over an **Object** variable skips the lookup and calls **Invoke** with `DISPID_NEWENUM`. The default member is also invoked by its identifier, 0, without a lookup. + +The flags the call passes to **Invoke** depend on the statement: + +| Statement | *wFlags* | +|-----------|---------:| +| *object*.*Member* *args* (a call used as a statement) | 1 | +| *x* = *object*.*Member*(*args*) (a value is read, a method or a property) | 3 | +| *object*.*Member* = *value* | 4, with the value named -3 | +| **Set** *object*.*Member* = *value* | 8, with the value named -3 | +| *object*(*args*), the default member | 3, identifier 0 | +| **CallByName** with `vbMethod` | 1 | +| **CallByName** with `vbGet` | 2 | +| **CallByName** with `vbLet` | 4, with the value named -3 | +| **CallByName** with `vbSet` | 8, with the value named -3 | + +The four [**VbCallType**](../../tB/Modules/Constants/VbCallType) values are the four flags. [**CallByName**](../../tB/Modules/Interaction/CallByName) accepts any member with any of them: `vbGet` calls a method, and `vbMethod` reads a property. [**CallByDispId**](../../tB/Modules/Interaction/CallByDispId) does the same with an identifier in place of a name, and is the way to call a member that has an identifier and no name. + +### Errors from a late-bound call + +| Situation | Error | +|-----------|-------| +| The name is not known (**GetIDsOfNames** fails) | `&H80020006`, *Unknown name.* | +| **CallByName** with a name that is not known | `&H80004005`, *Unspecified error* | +| **Invoke** returns `DISP_E_MEMBERNOTFOUND` | 438, *Object doesn't support this property or method* | +| **Invoke** returns `DISP_E_TYPEMISMATCH` | 13, *Type mismatch* | +| **Invoke** returns any other failure code | that code as the error number, with the system's description of it | +| The object is **Nothing** | 91, *Object variable or With block variable not set* | +| **CallByName** on a value that is not an object | 424, *Object required* | + +> [!NOTE] +> In VBA an unknown member raises error 438. In twinBASIC it raises `&H80020006`, so an error handler that tests for 438 does not catch it. This holds for objects of any origin: a twinBASIC class, a **Collection**, a **Dictionary** and a **FileSystemObject** all behave alike. + +> [!NOTE] +> A call that fails inside **Invoke** can be made twice. A failed property assignment is followed by a second **Invoke** with *wFlags* 3, and **CallByName** repeats a call that returned `DISP_E_MEMBERNOTFOUND` with a null *pVarResult*. A call with more arguments than a **Sub** takes runs the **Sub**, then fails with error 13, and a late-bound statement does this twice. Code that implements **Invoke** must not change state before it can still fail. + +## Classes written in twinBASIC + +Every class gets an **IDispatch** implementation from the compiler, so an object of any class can be assigned to an **Object** variable. [**GetTypeInfoCount**](#gettypeinfocount) returns 1 and [**TypeName**](../../tB/Modules/Information/TypeName) returns the class's name. The implementation dispatches the members of the class itself --- the default interface --- and nothing else. A member of an interface the class [**Implements**](../../tB/Core/Implements) is not found through an **Object** variable; only the interface's own variable type reaches it. + +The members it finds: + +- **Public** and **Friend** methods, properties and fields. A **Private** member is not found: **GetIDsOfNames** fails with `DISP_E_UNKNOWNNAME`. +- Names matched without regard to case. +- A property's **Property Get**, **Property Let** and **Property Set** share one identifier. +- A method can be called with `DISPATCH_PROPERTYGET`, and a property read with `DISPATCH_METHOD`. A write needs `DISPATCH_PROPERTYPUT` or `DISPATCH_PROPERTYPUTREF` and a member that has a **Property Let** or **Property Set**; a call with flags 0 fails, as does a write to a **Property Get** with no setter, with `DISP_E_MEMBERNOTFOUND`. +- An **Optional** parameter can be left out, and a named argument is matched to a parameter by name. + +A bad call to a member is reported like this: + +| Call | **Invoke** returns | +|------|--------------------| +| Too many arguments to a member that has no result, such as a **Sub** | runs the member, then `DISP_E_TYPEMISMATCH` | +| Too few arguments | `DISP_E_PARAMNOTOPTIONAL` | +| Too many arguments, to a **Function** | `DISP_E_BADPARAMCOUNT` | +| An argument that cannot be converted | `DISP_E_EXCEPTION`, with `DISP_E_TYPEMISMATCH` in *pExcepInfo*'s `scode` | +| The member raises an error | `DISP_E_EXCEPTION`; `scode`, `bstrSource` and `bstrDescription` hold the error's number, source and description | +| An identifier that is not a member | `DISP_E_MEMBERNOTFOUND` | + +*puArgErr* is not written in these cases. A property assignment is accepted with or without the `DISPID_PROPERTYPUT` named argument. + +### Dispatch identifiers + +The compiler numbers the members of a class itself, and the numbers are not a contract. A member that must have a fixed identifier carries the [**[DispId]**](../../tB/Core/Attributes#dispid) attribute, which **GetIDsOfNames** then returns: + +- `[DispId(42)]` on a method makes 42 its identifier. A **Property Get** and a **Property Let** of one property carry the same number. +- [**[DefaultMember]**](../../tB/Core/Attributes#defaultmember) gives the member the identifier 0, and so does `[DispId(0)]`. `object(args)` then calls it. +- [**[Enumerator]**](../../tB/Core/Attributes#enumerator) gives the member the identifier -4, and so does `[DispId(-4)]`. **GetIDsOfNames** answers to the member's own name, not to `_NewEnum`; an **Invoke** on -4 with either flags 2 or 3 returns the enumerator as a `VT_UNKNOWN` value. [**For Each**](../../tB/Core/For-Each-Next) over an **Object** variable works. + +[**[DispId]**](../../tB/Core/Attributes#dispid) is also accepted on a member of an **Interface**, and the **Library** modules twinBASIC generates for a COM reference carry it on every member. + +### Classes that are not dispatchable + +A class declared [**NotDispatchable**](../../Features/Advanced/Classes-and-Modules#create-classes-without-idispatch) has no compiler-written **IDispatch**. Assigning it to an **Object** variable, or to an **IDispatch** variable, fails with `E_NOINTERFACE` (`&H80004002`), *No such interface supported*. A **Variant** can hold it, as `VT_UNKNOWN`. + +## Implementing IDispatch + +A class that does **Implements IDispatch**, with a project's own copy of the interface, compiles, and its four methods are never called: a request for **IDispatch** is answered by the compiler's implementation, so late-bound calls, **GetTypeInfoCount** and **GetIDsOfNames** all still reach the compiler's. + +A class that is both **NotDispatchable** and implements **IDispatch** is dispatched through its own methods. Assigning it to an **Object** variable succeeds, and every late-bound statement, **CallByName**, **CallByDispId**, **For Each** and **TypeName** is delivered to the class. This is how a class accepts member names that were not declared, as a script object or a property bag does. + +An implementation has these constraints: + +- **GetIDsOfNames** may be called with several names at once, the member's followed by its parameters'. For a named argument the runtime passes the argument's name as the second name, and it passes the identifier the implementation returns for it in *rgdispidNamedArgs*. +- It must write *rgDispId* through its address, [**VarPtr**](../../tB/Modules/Information/VarPtr)`(rgDispId)`, to fill more than the first element. +- **Invoke** is called with a null *pVarResult* for a statement that discards the result, and the call is made with the flags in the table above. Assigning to a null *pVarResult* is an access violation that ends the run. +- *puArgErr* can be null, and for a default member read with no arguments it is. +- A failure code is returned with [**Err.ReturnHResult**](../../tB/Modules/ErrObject/ReturnHResult), and an error raised in the method with **Err.Raise** arrives at the caller as it is. `DISP_E_MEMBERNOTFOUND` from **Invoke** is reported as error 438, and any other code as itself. +- When **Invoke** for `DISPID_NEWENUM` fails with `DISP_E_MEMBERNOTFOUND`, **For Each** raises error 438. When it succeeds it must return an enumerator. See [**IEnumVARIANT**](IEnumVARIANT). +- [**TypeName**](../../tB/Modules/Information/TypeName) calls **GetTypeInfo**. An implementation that returns `E_NOTIMPL` gets the name `Object`. + +[`[WithDispatchForwarding]`](../../tB/Core/Attributes#withdispatchforwarding) is a different mechanism, for a class that implements a COM interface of a host and must route the host's late-bound calls to the class's own members. + +## The stdole declaration + +A variable declared **As stdole.IDispatch** does not reach the four methods. A call through it is compiled as a late-bound call by name, the same as a call through an **Object** variable: `d.GetTypeInfoCount n` compiles with any arguments, and raises `&H80020006` (*Unknown name*) when it runs, because the object has no member of that name. A member the object does have, such as `d.Answer`, is called as it would be through **Object**. Use a project's own declaration, as above. + +## COMExtensible + +The [**[COMExtensible]**](../../tB/Core/Attributes#comextensible) attribute on an interface declares that the object behind it may accept members that its declaration does not list. It is the flag that the **tbIDE** package sets on its DOM classes, such as [**HtmlElementProperties**](../../tB/Packages/tbIDE/HtmlElementProperties), whose implementation lives in the IDE. Setting it on a project's own interface changes nothing for a class that implements it: the class's **IDispatch** still finds only the class's own public members, and `DISP_E_UNKNOWNNAME` for any other name. To accept names that nothing declares, use a **NotDispatchable** class that implements **IDispatch**, as in the example below. + +## Example + +The helper functions and the class that the first three samples use. **GetId** wraps **GetIDsOfNames**; it returns the identifier and the error number of the lookup. + +```tb check_build projname=com-idispatch slot=file +Private Module DispatchSupport + Public Declare PtrSafe Function VariantCopy Lib "oleaut32" ( _ + ByVal pvargDest As LongPtr, ByVal pvargSrc As LongPtr) As Long + Public Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _ + ByVal Destination As LongPtr, ByVal Source As LongPtr, ByVal Length As LongPtr) + Public Declare PtrSafe Function lstrlenW Lib "kernel32" (ByVal lpString As LongPtr) As Long + + Public Function GetId(ByVal obj As Object, ByVal member As String, ByRef hr As Long) As Long + Dim d As IDispatch = obj + Dim iid As GUID + Dim namePtr As LongPtr = StrPtr(member) + Dim id As Long + On Error Resume Next + d.GetIDsOfNames iid, namePtr, 1, 0, id + hr = Err.Number + On Error GoTo 0 + Return id + End Function + + Public Function PtrToString(ByVal p As LongPtr) As String + Dim n As Long = lstrlenW(p) + Dim s As String = Space$(n) + If n > 0 Then CopyMemory StrPtr(s), p, n * 2 + Return s + End Function +End Module + +Class Gadget + Public Function Answer() As Long + Return 42 + End Function + + Public Function Subtract(ByVal a As Long, ByVal b As Long) As Long + Return a - b + End Function + + Public Property Get Label() As String + Return mLabel + End Property + Public Property Let Label(ByVal Value As String) + mLabel = Value + End Property + Private mLabel As String + + [DispId(42)] + Public Sub Beep() + End Sub + + [DefaultMember] + Public Function Item(ByVal Index As Long) As String + Return "item" & Index + End Function + + [Enumerator] + Public Function Items() As stdole.IUnknown + Dim c As New Collection + c.Add 10 + c.Add 20 + Return c.[_NewEnum] + End Function + + Private Sub Secret() + End Sub + + Friend Sub Internal() + End Sub +End Class +``` + +Looking members up through the project's copy of the interface shows which identifiers a class has. The explicit and reserved identifiers are fixed; a **Private** member is not found, and the failed lookup leaves -1 in the identifier: + +```tb check_run projname=com-idispatch +Dim g As New Gadget +Dim hr As Long + +Debug.Print GetId(g, "Beep", hr) & " " & Hex(hr) ' 42 0 +Debug.Print GetId(g, "BEEP", hr) & " " & Hex(hr) ' 42 0 +Debug.Print GetId(g, "Item", hr) & " " & Hex(hr) ' 0 0 +Debug.Print GetId(g, "Items", hr) & " " & Hex(hr) ' -4 0 +Debug.Print GetId(g, "Secret", hr) & " " & Hex(hr) ' -1 80020006 +Debug.Print GetId(g, "Missing", hr) & " " & Hex(hr) ' -1 80020006 +Debug.Print GetId(g, "Internal", hr) <> -1 ' True +``` + +**Invoke** called by hand. The arguments are in reverse order, so element 0 holds the second argument of **Subtract**: + +```tb check_run projname=com-idispatch +Dim g As New Gadget +Dim d As IDispatch = g +Dim iid As GUID, hr As Long +Dim id As Long = GetId(g, "Subtract", hr) + +Dim args(0 To 1) As Variant +args(0) = 3 ' the last argument +args(1) = 10 ' the first argument + +Dim dp As DISPPARAMS +dp.rgvarg = VarPtr(args(0)) +dp.cArgs = 2 + +Dim result As Variant, info As EXCEPINFO, badArg As Long +d.Invoke id, iid, 0, 1, dp, result, info, badArg ' DISPATCH_METHOD +Debug.Print result ' 7 + +Dim count As Long +d.GetTypeInfoCount count +Debug.Print count ' 1 +``` + +The same class through an **Object** variable and **CallByName**. An unknown name and a **Private** member fail alike, with the error of the failed lookup; **CallByName** reports the unknown name differently: + +```tb check_run projname=com-idispatch +Dim o As Object = New Gadget + +Debug.Print o.Answer() ' 42 +Debug.Print o(3) ' item3 +o.Label = "tag" +Debug.Print o.Label ' tag + +Debug.Print CallByName(o, "Subtract", vbMethod, 10, 3) ' 7 +Debug.Print CallByName(o, "Answer", vbGet) ' 42 +CallByName o, "Label", vbLet, "new" +Debug.Print CallByName(o, "Label", vbGet) ' new + +On Error Resume Next +o.Secret +Debug.Print Hex(Err.Number) & " " & Err.Description ' 80020006 Unknown name. +Err.Clear +o.Missing +Debug.Print Hex(Err.Number) & " " & Err.Description ' 80020006 Unknown name. +Err.Clear +CallByName o, "Missing", vbMethod +Debug.Print Hex(Err.Number) & " " & Err.Description ' 80004005 Unspecified error +Err.Clear +o.Internal +Debug.Print Err.Number ' 0 +``` + +**For Each** over an **Object** variable calls **Invoke** with `DISPID_NEWENUM`, and `Items` returns the enumerator: + +```tb check_run projname=com-idispatch +Dim o As Object = New Gadget +Dim x As Variant +For Each x In o + Debug.Print x +Next +' Output: +' 10 +' 20 +``` + +An object that accepts any member name. Its class is **NotDispatchable** and implements **IDispatch**, so the runtime sends every late-bound statement to the four methods. Each name gets a slot the first time it is looked up, and a slot holds any value, an object included: + +```tb check_build projname=com-idispatch slot=file +NotDispatchable Class Expando + Implements IDispatch + + Private Names() As String + Private Values() As Variant + Private Count As Long + + Private Function SlotOf(ByVal Name As String) As Long + Dim i As Long + For i = 1 To Count + If StrComp(Names(i), Name, vbTextCompare) = 0 Then Return i + Next + Count += 1 + ReDim Preserve Names(1 To Count) + ReDim Preserve Values(1 To Count) + Names(Count) = Name + Return Count + End Function + + Private Sub IDispatch_GetTypeInfoCount(ByRef pctinfo As Long) Implements IDispatch.GetTypeInfoCount + pctinfo = 0 + End Sub + + Private Sub IDispatch_GetTypeInfo(ByVal iTInfo As Long, ByVal lcid As Long, ByRef ppTInfo As LongPtr) Implements IDispatch.GetTypeInfo + Err.ReturnHResult = E_NOTIMPL + End Sub + + Private Sub IDispatch_GetIDsOfNames(ByRef riid As GUID, ByRef rgszNames As LongPtr, ByVal cNames As Long, ByVal lcid As Long, ByRef rgDispId As Long) Implements IDispatch.GetIDsOfNames + Dim i As Long, namePtr As LongPtr, id As Long + For i = 0 To cNames - 1 + CopyMemory VarPtr(namePtr), VarPtr(rgszNames) + i * LenB(namePtr), LenB(namePtr) + If i = 0 Then + id = SlotOf(PtrToString(namePtr)) + Else + id = i - 1 ' a parameter name: its position + End If + CopyMemory VarPtr(rgDispId) + i * 4, VarPtr(id), 4 + Next + End Sub + + Private Sub IDispatch_Invoke(ByVal dispIdMember As Long, ByRef riid As GUID, ByVal lcid As Long, ByVal wFlags As Integer, ByRef pDispParams As DISPPARAMS, ByRef pVarResult As Variant, ByRef pExcepInfo As EXCEPINFO, ByRef puArgErr As Long) Implements IDispatch.Invoke + If dispIdMember < 1 Or dispIdMember > Count Then + Err.ReturnHResult = DISP_E_MEMBERNOTFOUND + Exit Sub + End If + If (wFlags And 12) <> 0 Then + ' DISPATCH_PROPERTYPUT or DISPATCH_PROPERTYPUTREF: the value is argument 0 + VariantCopy VarPtr(Values(dispIdMember)), pDispParams.rgvarg + ElseIf VarPtr(pVarResult) <> 0 Then + VariantCopy VarPtr(pVarResult), VarPtr(Values(dispIdMember)) + End If + End Sub +End Class +``` + +```tb check_run projname=com-idispatch +Dim bag As Object = New Expando + +bag.Color = "red" +Debug.Print bag.Color ' red + +bag.Size = 3 +Debug.Print bag.size * 2 ' 6 + +Debug.Print IsEmpty(bag.Shape) ' True +Debug.Print TypeName(bag) ' Object +``` + +## See Also + +- [IUnknown](IUnknown) -- the base of **IDispatch** +- [IEnumVARIANT](IEnumVARIANT) -- the interface **Invoke** returns for `DISPID_NEWENUM` +- [IErrorInfo](IErrorInfo) -- how an error reaches a caller through a vtable call +- [IConnectionPoint](IConnectionPoint) -- events, which a sink receives through **Invoke** +- [CallByName](../../tB/Modules/Interaction/CallByName) function +- [CallByDispId](../../tB/Modules/Interaction/CallByDispId) function +- [VbCallType](../../tB/Modules/Constants/VbCallType) enumeration +- [DispId](../../tB/Core/Attributes#dispid), [DefaultMember](../../tB/Core/Attributes#defaultmember), [Enumerator](../../tB/Core/Attributes#enumerator), [COMExtensible](../../tB/Core/Attributes#comextensible) attributes +- [Classes and Modules](../../Features/Advanced/Classes-and-Modules#create-classes-without-idispatch) -- **NotDispatchable** classes +- [Data Types](../Data-Types#object) -- the **Object** type +- [Implements](../../tB/Core/Implements) statement +- [Interfaces and CoClasses](../../Features/Language/Interfaces-CoClasses) -- declaring an interface in twinBASIC diff --git a/docs/Reference/COM-Interfaces/IErrorInfo.md b/docs/Reference/COM-Interfaces/IErrorInfo.md new file mode 100644 index 00000000..3a3148c6 --- /dev/null +++ b/docs/Reference/COM-Interfaces/IErrorInfo.md @@ -0,0 +1,412 @@ +--- +title: IErrorInfo +parent: COM Interfaces +permalink: /Reference/COM-Interfaces/IErrorInfo +--- + +# IErrorInfo interface +{: .no_toc } + +Describes an error that a COM method has reported: the source that raised it, a text description and a Help topic. It is the object a failing method leaves on the calling thread, together with the **ISupportErrorInfo** interface that says whether an object does so, and the **ICreateErrorInfo** interface that fills one in. + +* TOC +{:toc} + +## How COM passes error information + +A COM method returns an **HRESULT**, a 32-bit code that says only whether the call succeeded and, if not, roughly why. A description, a source and a Help topic do not fit in it. COM passes them separately, in a slot that holds one **IErrorInfo** object for each thread. + +The method that fails and the code that calls it follow a fixed order: + +1. The method creates an error object with **CreateErrorInfo**, which returns its **ICreateErrorInfo** interface. +2. It fills the object in with **SetGUID**, **SetSource**, **SetDescription**, **SetHelpFile** and **SetHelpContext**. +3. It stores the object in the thread's slot with **SetErrorInfo**, replacing what the slot held, and returns a failure **HRESULT**. +4. The caller sees the failure code. Before it trusts the slot, it checks that the object sets error information: it queries the object for **ISupportErrorInfo** and calls **InterfaceSupportsErrorInfo** with the identifier of the interface it called through. The check matters because the slot belongs to the thread, not to the object. Another object, called earlier on the same thread, may have left its contents behind, and a method that never set error information leaves them as they were. +5. When the answer is `S_OK`, the caller calls **GetErrorInfo**. It returns the object, **and empties the slot**, so a second call returns nothing. The caller reads the five properties and releases the object. + +**GetErrorInfo** returns `S_FALSE`, and no object, when the slot is empty. Its first argument is reserved and must be 0. + +## Declaration + +**IErrorInfo** derives from **IUnknown** and has the interface identifier `1CF2B120-547D-101B-8E65-08002B2BD119`. **ISupportErrorInfo** has `DF0B3D60-548F-101B-8E65-08002B2BD119` and **ICreateErrorInfo** has `22F03340-547D-101B-8E65-08002B2BD119`. + +The **stdole** type library declares none of the three, so a project declares its own, as it does for [**IEnumVARIANT**](IEnumVARIANT). It also needs a type for an interface identifier. The **GUID** type in **stdole** cannot be used: the compiler refuses to create a variable of it (error TB5106, `cannot create an instance of this datatype as it contains an unsupported member`). A project declares a structure of the same layout instead. + +The methods return an **HRESULT**, which twinBASIC hides as it does for any interface method: a failure code raises a run-time error, and a method whose last value is returned through a pointer is declared as a **Function**. The strings are **BSTR** values that the caller owns, and twinBASIC frees them. + +```tb check_build projname=com-ierrorinfo slot=file +Module GuidTypes + Public Type TbGuid + Data1 As Long + Data2 As Integer + Data3 As Integer + Data4(0 To 7) As Byte + End Type +End Module + +[InterfaceId("1CF2B120-547D-101B-8E65-08002B2BD119")] +Private Interface IErrorInfo Extends stdole.IUnknown + Sub GetGUID(ByRef pGUID As TbGuid) + Function GetSource() As String + Function GetDescription() As String + Function GetHelpFile() As String + Function GetHelpContext() As Long +End Interface + +[InterfaceId("DF0B3D60-548F-101B-8E65-08002B2BD119")] +Private Interface ISupportErrorInfo Extends stdole.IUnknown + Sub InterfaceSupportsErrorInfo(ByRef riid As TbGuid) +End Interface + +[InterfaceId("22F03340-547D-101B-8E65-08002B2BD119")] +Private Interface ICreateErrorInfo Extends stdole.IUnknown + Sub SetGUID(ByRef rguid As TbGuid) + Sub SetSource(ByVal szSource As LongPtr) + Sub SetDescription(ByVal szDescription As LongPtr) + Sub SetHelpFile(ByVal szHelpFile As LongPtr) + Sub SetHelpContext(ByVal dwHelpContext As Long) +End Interface + +Private Module ErrorInfoApi + Public Declare PtrSafe Function GetErrorInfo Lib "oleaut32" ( _ + ByVal dwReserved As Long, ByRef pperrinfo As IErrorInfo) As Long + Public Declare PtrSafe Function SetErrorInfo Lib "oleaut32" ( _ + ByVal dwReserved As Long, ByVal perrinfo As IErrorInfo) As Long + Public Declare PtrSafe Function CreateErrorInfo Lib "oleaut32" ( _ + ByRef pperrinfo As ICreateErrorInfo) As Long + Public Declare PtrSafe Function IIDFromString Lib "ole32" ( _ + ByVal lpsz As LongPtr, ByRef lpiid As TbGuid) As Long + Public Declare PtrSafe Function IsEqualGUID Lib "ole32" ( _ + ByRef rguid1 As TbGuid, ByRef rguid2 As TbGuid) As Long +End Module +``` + +The **ICreateErrorInfo** strings are passed as addresses of null-terminated Unicode text, which [**StrPtr**](../../tB/Modules/Information/StrPtr) supplies. The functions come from oleaut32.dll, and **IIDFromString** and **IsEqualGUID** from ole32.dll; they are described [below](#icreateerrorinfo-and-the-oleaut32-functions). + +## IErrorInfo methods + +### GetGUID +{: .no_toc } + +Returns the identifier of the interface that defined the error. + +Syntax: *object*.**GetGUID** *pGUID* + +*pGUID* +: *required* A **TbGuid** (the structure declared above) that receives the identifier. For an error raised through a dispatch interface, it is the identifier of **IDispatch**. + +### GetSource +{: .no_toc } + +Returns the name of the class or application that raised the error. + +Syntax: *object*.**GetSource**() + +Returns a **String**. By convention it has the form *project*.*class*, or the programmatic identifier of the component, as in `WshShell.RegRead`. + +### GetDescription +{: .no_toc } + +Returns the text that describes the error. + +Syntax: *object*.**GetDescription**() + +Returns a **String**, written for the person using the program. + +### GetHelpFile +{: .no_toc } + +Returns the path of the Help file that describes the error. + +Syntax: *object*.**GetHelpFile**() + +Returns a **String**. It is empty when the error has no Help topic. + +### GetHelpContext +{: .no_toc } + +Returns the number of the topic in the Help file. + +Syntax: *object*.**GetHelpContext**() + +Returns a **Long**, 0 when the error has no Help topic. The number identifies a topic in the file that **GetHelpFile** names. + +## ISupportErrorInfo + +**ISupportErrorInfo** has one method. An object implements it to promise that the methods of the interfaces it names fill the thread's slot before they return a failure code. + +### InterfaceSupportsErrorInfo +{: .no_toc } + +Says whether an interface of the object sets error information. + +Syntax: *object*.**InterfaceSupportsErrorInfo** *riid* + +*riid* +: *required* A **TbGuid** holding the interface identifier the caller asks about. + +Returns `S_OK` when the methods of that interface set error information, and `S_FALSE` when they do not. The method is declared as a **Sub**, so a caller does not get the code as a value. `S_FALSE` raises no error, and [**Err.LastHresult**](../../tB/Modules/ErrObject/LastHresult) holds it until the next call. Read it in the statement straight after the method. + +### Where twinBASIC answers it + +**Every twinBASIC class answers a query for ISupportErrorInfo**, and the answer to **InterfaceSupportsErrorInfo** is `S_OK` whatever *riid* holds: an interface the class implements, one it does not, and the all-zero identifier. The same holds for a **Collection**. A caller therefore always goes on to read the slot of a twinBASIC object. + +A class that implements **ISupportErrorInfo** itself, with [**Implements**](../../tB/Core/Implements), answers with its own method instead. It returns `S_FALSE` by setting [**Err.ReturnHResult**](../../tB/Modules/ErrObject/ReturnHResult) to 1. [The example](#a-class-that-answers-for-itself) at the end of the page does this. + +System components differ from one another, because each implements what it chooses. On Windows 10, **Scripting.FileSystemObject**, **Scripting.Dictionary**, **WScript.Shell** and **Shell.Application** refuse the query, while **ADODB.Connection** and **MSXML2.DOMDocument.6.0** accept it. twinBASIC does not need the answer when a call fails: it reads the error information of a failed call into **Err** whether or not the object implements **ISupportErrorInfo**. The description of a failed **WScript.Shell** call arrives, although that component refuses the query. A program that reads the slot itself should not make the interface a requirement. + +## ICreateErrorInfo and the oleaut32 functions + +| Name | Does | +|------|------| +| **CreateErrorInfo** | Returns a new, empty error object through its **ICreateErrorInfo** interface. | +| **ICreateErrorInfo** | **SetGUID**, **SetSource**, **SetDescription**, **SetHelpFile** and **SetHelpContext** fill in the properties that the **IErrorInfo** methods read back. Each returns `S_OK`. | +| **SetErrorInfo** | Stores an **IErrorInfo** in the calling thread's slot, replacing what was there. The first argument is reserved and must be 0. Passing `Nothing` empties the slot. | +| **GetErrorInfo** | Returns the stored object and empties the slot. Returns `S_FALSE` and `Nothing` when the slot is empty. | + +The object that **CreateErrorInfo** returns implements **IErrorInfo** as well as **ICreateErrorInfo**. Assigning the **ICreateErrorInfo** variable to an **IErrorInfo** variable queries it for the second interface. + +## What twinBASIC does + +### A method that raises an error + +An error raised in a method that has no handler for it makes twinBASIC return a failure **HRESULT** from the method and leave error information in the slot. The method can raise it with [**Err.Raise**](../../tB/Modules/ErrObject/Raise) or with a statement that fails, such as a division by zero. + +The **HRESULT** depends on the number. A number from 1 to 65535 is returned as `&H800A0000` plus the number, so error 5 returns `&H800A0005`. A number made with [**vbObjectError**](../../tB/Modules/Constants/#vbObjectError) is returned unchanged. Error 11, *Division by zero*, raised by a division rather than by **Raise**, returns `&H80020012`, the **IDispatch** code for it. + +The object that **GetErrorInfo** returns then holds what the method gave **Raise**: + +- **GetSource** returns *source*, and an empty string when **Raise** was called without one. +- **GetDescription** returns *description*. Without one, it returns what [**Err.Description**](../../tB/Modules/ErrObject/Description) holds for the number: the standard text of a built-in run-time error such as 5. +- **GetHelpFile** and **GetHelpContext** return *helpfile* and *helpcontext*, and an empty string and 0 when they were omitted. +- **GetGUID** fails with `E_NOTIMPL` (`&H80004001`): a raised error has no interface identifier. + +Two things about the object matter to a caller that reads it. **GetErrorInfo** empties the slot as COM requires, so a second read returns `Nothing`. And the object does not copy the values: it reads them from the **Err** object when a method is called. [**Err.Clear**](../../tB/Modules/ErrObject/Clear) empties **Err**, and an object read after it returns empty strings and 0. Read the five properties before calling anything else that clears **Err**. + +A method that handles an error itself, with [**On Error**](../../tB/Core/On-Error), still leaves the values in **Err** and a returned **IErrorInfo** that shows them, although it returns `S_OK`. A caller reads the slot only after a failure code. + +### What the caller sees + +A twinBASIC caller of a failed call finds the error in the [**Err**](../../tB/Modules/Information/Err) object, with no code of its own. The fields come from the **IErrorInfo** the method left: + +| Field | Set from | +|-------|----------| +| [**Description**](../../tB/Modules/ErrObject/Description) | **GetDescription**, or `Automation error` when the method left no information | +| [**Source**](../../tB/Modules/ErrObject/Source) | **GetSource**, or an empty string | +| [**HelpFile**](../../tB/Modules/ErrObject/HelpFile) | **GetHelpFile**, or an empty string | +| [**HelpContext**](../../tB/Modules/ErrObject/HelpContext) | **GetHelpContext**, or 0 | +| [**Number**](../../tB/Modules/ErrObject/Number) | the **HRESULT**, as follows | + +**Number** is the **HRESULT** read as a signed **Long**, with these exceptions, which make the number the one a VBA program expects. An **HRESULT** of the form `&H800Annnn` becomes *nnnn*, so `&H800A0005` becomes 5 and `&H800A0E78` becomes 3704. `E_INVALIDARG` (`&H80070057`) becomes 5, and `DISP_E_DIVBYZERO` (`&H80020012`) becomes 11. A success code, such as 1, raises no error, and **Number** stays 0. + +These fields hold what the component supplies. The following call into **WScript.Shell** fails, and the description names the registry key, which no table in twinBASIC could know: + +```tb check_run +On Error Resume Next +Dim sh As Object = CreateObject("WScript.Shell") +sh.RegRead "NOROOT\x" +Debug.Print Err.Number ' -2147024893 +Debug.Print Err.Source ' WshShell.RegRead +Debug.Print Err.Description ' Invalid root in registry key "NOROOT\x". +``` + +A component can supply more. A call to **Execute** on a closed **ADODB.Connection** sets **Number** to 3704, **Source** to `ADODB.Connection`, **Description** to `Operation is not allowed when the object is closed.`, **HelpFile** to the path of the ADO Help file and **HelpContext** to its topic number. + +Some components supply no source. A failed call into **Scripting.FileSystemObject** sets **Number** to 53 and **Description** to `File not found`, and leaves **Source** empty. + +### A failure with no error information + +A method can return a failure **HRESULT** without calling **SetErrorInfo**, and so can a twinBASIC method that sets [**Err.ReturnHResult**](../../tB/Modules/ErrObject/ReturnHResult) to a failure code. When the slot is empty, the caller has only the code. **Number** is derived from it as described above, and **Description** is `Automation error` whatever the code is. **Source** and **HelpFile** are empty strings and **HelpContext** is 0. + +| **HRESULT** | **Number** | **Description** | +|-------------|------------|-----------------| +| `&H80004005` (`E_FAIL`) | -2147467259 | `Automation error` | +| `&H800A0005` | 5 | `Automation error` | +| `&H80070005` (`E_ACCESSDENIED`) | -2147024891 | `Automation error` | +| `&H8FFF0001` (no meaning) | -1879113727 | `Automation error` | + +The slot is not always empty. A failed call can leave an object in it that reads from **Err**, and when **Err** has been cleared in between, that object has an empty description. **Description** is then the standard text of the code: `Unspecified error` for `E_FAIL`, `Invalid procedure call or argument` for `&H800A0005` and `Access is denied.`, in the language of the system, for `E_ACCESSDENIED`. A program that must tell failures apart reads **Number** and does not rely on **Description** for a code that arrived without information. + +### A method that sets error information itself + +A twinBASIC method can set the slot itself, with the functions above, and then fail with **Err.ReturnHResult**. A twinBASIC caller then finds the object's values in **Err**, and a caller written in another language finds the object in the slot, as it would for a component written in C++. + +The failure code has to be a failure: [**ReturnHResult**](../../tB/Modules/ErrObject/ReturnHResult) with a success code returns normally, and the information stays in the slot until something reads it. A method that calls **SetErrorInfo** and then **Err.Raise** loses what it set, because the raised error replaces it. + +## Example + +The interface declarations are those under [Declaration](#declaration). A **Worker** class implements **IWorker**, whose three methods fail in three ways: by raising an error, by setting error information itself and returning `E_FAIL`, and by returning a code it is given and nothing else. **IWorkerRaw** declares the same methods as **[PreserveSig]**, with the same interface identifier, so a caller can see the **HRESULT** and read the slot itself. + +```tb check_build projname=com-ierrorinfo slot=file +[InterfaceId("6A0B5F80-4C7D-4F29-9D45-0D7C3C1A2E10")] +Private Interface IWorker Extends stdole.IUnknown + Sub Fail() + Sub FailWithInfo() + Sub FailWith(ByVal Hr As Long) +End Interface + +[InterfaceId("6A0B5F80-4C7D-4F29-9D45-0D7C3C1A2E10")] +Private Interface IWorkerRaw Extends stdole.IUnknown + [PreserveSig] Function Fail() As Long + [PreserveSig] Function FailWithInfo() As Long + [PreserveSig] Function FailWith(ByVal Hr As Long) As Long +End Interface + +Class Worker + Implements IWorker + + Private Sub Fail() Implements IWorker.Fail + Err.Raise vbObjectError + 1000, "Demo.Worker", "The worker failed.", "C:\Help\demo.chm", 1001 + End Sub + + Private Sub FailWithInfo() Implements IWorker.FailWithInfo + Dim creator As ICreateErrorInfo + CreateErrorInfo creator + + Dim iid As TbGuid + IIDFromString StrPtr("{6A0B5F80-4C7D-4F29-9D45-0D7C3C1A2E10}"), iid + creator.SetGUID iid + creator.SetSource StrPtr("Demo.Worker") + creator.SetDescription StrPtr("The disk is full.") + creator.SetHelpFile StrPtr("C:\Help\demo.chm") + creator.SetHelpContext 2002 + + Dim info As IErrorInfo + Set info = creator + SetErrorInfo 0, info + + Err.ReturnHResult = &H80004005 ' E_FAIL + End Sub + + Private Sub FailWith(ByVal Hr As Long) Implements IWorker.FailWith + Err.ReturnHResult = Hr + End Sub +End Class +``` + +A call through **IWorker** raises the run-time error in the caller, and **Err** holds what **Raise** was given: + +```tb check_run projname=com-ierrorinfo +Dim w As IWorker = New Worker +On Error Resume Next +w.Fail +Debug.Print Err.Number ' -2147220504 +Debug.Print Err.Source ' Demo.Worker +Debug.Print Err.Description ' The worker failed. +Debug.Print Err.HelpFile ' C:\Help\demo.chm +Debug.Print Err.HelpContext ' 1001 +``` + +A call through **IWorkerRaw** returns the code as a value, and the caller reads the slot itself. The caller sets a handler first, so that the error raised inside **Fail** has one in the call chain; without it the error is unhandled, and a run from the IDE stops. **GetErrorInfo** empties the slot, so its second call returns `S_FALSE` (1) and no object: + +```tb check_run projname=com-ierrorinfo +Dim w As IWorkerRaw = New Worker +On Error Resume Next +Dim hr As Long = w.Fail() +Debug.Print Hex(hr) ' 800403E8 + +Dim info As IErrorInfo +Debug.Print GetErrorInfo(0, info) ' 0 +Debug.Print info.GetSource() ' Demo.Worker +Debug.Print info.GetDescription() ' The worker failed. +Debug.Print info.GetHelpFile() ' C:\Help\demo.chm +Debug.Print info.GetHelpContext() ' 1001 + +Dim again As IErrorInfo +Debug.Print GetErrorInfo(0, again) ' 1 +Debug.Print again Is Nothing ' True +``` + +A method that supplies its own information reaches the caller's **Err** the same way: + +```tb check_run projname=com-ierrorinfo +Dim w As IWorker = New Worker +On Error Resume Next +w.FailWithInfo +Debug.Print Err.Number ' -2147467259 +Debug.Print Err.Source ' Demo.Worker +Debug.Print Err.Description ' The disk is full. +Debug.Print Err.HelpFile ' C:\Help\demo.chm +Debug.Print Err.HelpContext ' 2002 +``` + +A failure code and no information leaves only the code. The sample empties the slot before each call with `SetErrorInfo 0, Nothing`, so that nothing is left in it from the call before: + +```tb check_run projname=com-ierrorinfo +Dim w As IWorker = New Worker +On Error Resume Next + +SetErrorInfo 0, Nothing +w.FailWith &H80004005 +Debug.Print Err.Number & " " & Err.Description ' -2147467259 Automation error + +SetErrorInfo 0, Nothing +w.FailWith &H800A0005 +Debug.Print Err.Number & " " & Err.Description ' 5 Automation error + +SetErrorInfo 0, Nothing +w.FailWith &H8FFF0001 +Debug.Print Err.Number & " " & Err.Description ' -1879113727 Automation error +``` + +### A class that answers for itself + +**Worker** has no **ISupportErrorInfo** of its own, and twinBASIC answers `S_OK` for it. **PickyWorker** implements the interface and says `S_FALSE` for any interface but **IWorker**: + +```tb check_build projname=com-ierrorinfo slot=file +Class PickyWorker + Implements IWorker + Implements ISupportErrorInfo + + Private Sub Fail() Implements IWorker.Fail + End Sub + + Private Sub FailWithInfo() Implements IWorker.FailWithInfo + End Sub + + Private Sub FailWith(ByVal Hr As Long) Implements IWorker.FailWith + End Sub + + Private Sub InterfaceSupportsErrorInfo(ByRef riid As TbGuid) _ + Implements ISupportErrorInfo.InterfaceSupportsErrorInfo + Dim mine As TbGuid + IIDFromString StrPtr("{6A0B5F80-4C7D-4F29-9D45-0D7C3C1A2E10}"), mine + If IsEqualGUID(riid, mine) = 0 Then Err.ReturnHResult = 1 ' S_FALSE + End Sub +End Class +``` + +The caller reads [**Err.LastHresult**](../../tB/Modules/ErrObject/LastHresult) in the statement after each call: + +```tb check_run projname=com-ierrorinfo +Dim iidWorker As TbGuid, iidOther As TbGuid +IIDFromString StrPtr("{6A0B5F80-4C7D-4F29-9D45-0D7C3C1A2E10}"), iidWorker +IIDFromString StrPtr("{00020400-0000-0000-C000-000000000046}"), iidOther ' IDispatch + +Dim plain As New Worker +Dim s1 As ISupportErrorInfo = plain +s1.InterfaceSupportsErrorInfo iidWorker +Debug.Print Err.LastHresult ' 0 +s1.InterfaceSupportsErrorInfo iidOther +Debug.Print Err.LastHresult ' 0 + +Dim picky As New PickyWorker +Dim s2 As ISupportErrorInfo = picky +s2.InterfaceSupportsErrorInfo iidWorker +Debug.Print Err.LastHresult ' 0 +s2.InterfaceSupportsErrorInfo iidOther +Debug.Print Err.LastHresult ' 1 +``` + +## See Also + +- [IDispatch](IDispatch) -- how a late-bound call reports an error, through *pExcepInfo* +- [IUnknown](IUnknown) -- the query a caller makes for **ISupportErrorInfo** +- [Err](../../tB/Modules/Information/Err) object +- [Err.Raise](../../tB/Modules/ErrObject/Raise) method +- [Err.ReturnHResult](../../tB/Modules/ErrObject/ReturnHResult) property +- [Err.LastHresult](../../tB/Modules/ErrObject/LastHresult) property +- [On Error](../../tB/Core/On-Error) statement +- [Implements](../../tB/Core/Implements) statement +- [PreserveSig](../../tB/Core/Attributes#preservesig) attribute +- [Interfaces and CoClasses](../../Features/Language/Interfaces-CoClasses) -- declaring an interface in twinBASIC diff --git a/docs/Reference/COM-Interfaces/IUnknown.md b/docs/Reference/COM-Interfaces/IUnknown.md new file mode 100644 index 00000000..a47a2c09 --- /dev/null +++ b/docs/Reference/COM-Interfaces/IUnknown.md @@ -0,0 +1,311 @@ +--- +title: IUnknown +parent: COM Interfaces +permalink: /Reference/COM-Interfaces/IUnknown +--- + +# IUnknown interface +{: .no_toc } + +The base of every COM interface. It lets a caller ask an object for another interface it supports, and tells the object when a caller starts and stops using it. twinBASIC calls it on every object assignment, so most code never names it. + +* TOC +{:toc} + +## Declaration + +**IUnknown** has the interface identifier `00000000-0000-0000-C000-000000000046`. It has three methods, and they are the first three entries in the method table of every other interface, in this order: + +| Slot | Method | Native signature | +|------|--------|------------------| +| 0 | **QueryInterface** | `HRESULT QueryInterface(REFIID riid, void **ppvObject)` | +| 1 | **AddRef** | `ULONG AddRef()` | +| 2 | **Release** | `ULONG Release()` | + +An interface that a project declares with [**Interface**](../../tB/Core/Interface) names **stdole.IUnknown** as its base with **Extends**, as the [IEnumVARIANT](IEnumVARIANT) declaration does, and its own methods then start at slot 3. twinBASIC supplies the three methods for every class, so a class that implements an interface never writes them (see [Implementing it](#implementing-it)). + +## Methods + +### QueryInterface +{: .no_toc } + +Asks the object for a pointer to another interface it supports. + +Syntax: *object*.**QueryInterface** *riid*, *ppvObject* + +*riid* +: *required* The interface identifier asked for. + +*ppvObject* +: *required* Receives the interface pointer, or a null pointer when the object does not support the interface. + +Returns `S_OK` and a pointer with one reference added for the caller, or `E_NOINTERFACE` (`&H80004002`) and a null pointer. Three rules govern the answer: + +- **Identity.** Asking any interface of an object for **IUnknown** always returns the same pointer value. A caller finds out whether two interface pointers belong to one object by asking each for **IUnknown** and comparing the results. +- **A fixed set.** If the object answers `S_OK` for an interface once, it never answers `E_NOINTERFACE` for it later, and the reverse. +- **Any interface leads to any other.** Asking an interface for itself succeeds (reflexive). If interface B was obtained from interface A, asking B for A succeeds (symmetric). If C can be obtained from B, and B from A, then C can be obtained from A (transitive). + +### AddRef +{: .no_toc } + +Adds a reference to the object. + +Syntax: *object*.**AddRef** + +Returns the new reference count. A caller calls it whenever it copies an interface pointer, and the count is for diagnostics only: a caller must not base logic on its value, because an object may report a number that is not its true count. + +### Release +{: .no_toc } + +Removes a reference from the object. + +Syntax: *object*.**Release** + +Returns the new reference count, with the same limit on its use as **AddRef**. A caller calls it when it no longer needs an interface pointer. When the count reaches zero the object frees itself, and every pointer to it is invalid from then on. + +## Calling it from twinBASIC + +twinBASIC issues these calls itself, so the language has no statement for them: + +- **Set** *a* **=** *b* adds a reference to the object *b* holds, and releases the object *a* held before. +- **Set** *a* **= Nothing**, and a variable going out of scope, each release one reference. +- **Set** to a variable of an interface type asks the object for that interface with **QueryInterface**. + +The three methods themselves cannot be called by name: + +- On a variable declared **As stdole.IUnknown**, `u.AddRef`, `u.Release` and `u.QueryInterface` are compile errors, TB5027 *Unrecognized member*. The same holds for a variable of a project's own interface that extends **stdole.IUnknown**. +- On an **Object** variable, `o.AddRef` raises run-time error `&H80020006` (*Unknown name*) and `CallByName(o, "AddRef", VbMethod)` raises `&H80004005` (*Unspecified error*). +- A project cannot redeclare **IUnknown** under its own name and call it. An **Interface** declared with no **Extends** clause derives from **IDispatch**, not from **IUnknown**, so its first method is at slot 7 and the three declared methods are not the three of **IUnknown**. Declared with **Extends stdole.IUnknown**, the first method is at slot 3. Neither reaches slots 0 to 2. + +> [!NOTE] +> Code that has to read or change a reference count goes through the object's method table. The example below does this with **DispCallFunc** from oleaut32.dll. [**vbaObjAddref**](../../tB/Modules/HiddenModule/vbaObjAddref) calls **AddRef** on a raw pointer without reading the result. + +Calling **IUnknown** methods by hand is a low-level operation. A wrong slot number, or a **Release** with no matching **AddRef**, ends in an access violation or in an object freed while a variable still refers to it. + +## How it shows in the language + +### Reference counts + +A twinBASIC object has one reference count, shared by every interface it is reached through. In BETA 995: + +| Operation | Effect on the count | +|-----------|---------------------| +| `Set b = a`, for **b** of the class type, of an interface type, or **Object** | adds 1 | +| `Set b = Nothing` | removes 1 | +| `Set v = a`, for a **Variant** *v* | adds 1 | +| *collection*.**Add** *a* | adds 1, removed when the collection is released | +| A local variable holding a reference, when its procedure ends | removes 1 | +| A **ByRef** parameter | adds nothing | +| A **ByVal** object parameter | adds references for as long as the call runs | +| A function result, assigned to a variable | adds 1 for the variable; the result's own reference is released | +| `TypeOf`, `Is` | adds nothing | + +### Assigning to another interface type + +**Set** to a variable whose type is an interface the object does not support raises run-time error `-2147467262` (`&H80004002`, `E_NOINTERFACE`) with the description *No such interface supported*; **Err.Source** is empty. The compiler does not refuse the statement, even when the source variable's class is known not to implement the interface, and the source can be a class-typed variable, an **Object** or a **Variant**. The target variable keeps the reference it held before the failed statement. + +Assigning to an **Object** or a **stdole.IUnknown** variable cannot fail for lack of an interface. + +### TypeOf and Is + +`TypeOf` *x* `Is` *I* is **True** when *x* holds an object that supports *I*, whichever type *x* is declared as, and **False** when *x* is **Nothing**. For **stdole.IUnknown** it is **True** for every object. It does not change the reference count. + +The **Is** operator compares identity as COM defines it: two variables of different interface types that hold the same object compare equal, and two variables that are both **Nothing** compare equal whatever their types. + +### ObjPtr + +[**ObjPtr**](../../tB/Modules/Information/ObjPtr) returns the pointer the variable holds, which is the pointer of the interface the variable is declared as. A variable of the class type, an **Object** variable and a **stdole.IUnknown** variable that were assigned the same object give the same value, but variables of two different interface types give two different values, and neither is the pointer that **QueryInterface** returns for **IUnknown**. To test whether two variables refer to one object, use [**Is**](../../tB/Core/Is), never a comparison of **ObjPtr** values. + +### When Class_Terminate runs + +The class's `Class_Terminate` procedure runs inside the **Release** that brings the count to zero, before that **Release** returns. For the language's own releases this puts it: + +- in a `Set x = Nothing` that drops the last reference, before the next statement; +- during a `Set x = ...` that replaces the last reference, before the next statement; +- when the procedure ends, for a local variable that held the last reference. + +### Implementing it + +A class never needs to implement **IUnknown**: the compiler gives every class an implementation, and an interface that extends **stdole.IUnknown** is satisfied without a body for those three methods. + +`Implements stdole.IUnknown` compiles, and the class works as before. A project's own **Interface** that carries the identifier of **IUnknown** also compiles, and a class can implement it, but the interface is unusable: **Set** to a variable of that type gives the object's ordinary **IUnknown** pointer, which has none of the interface's methods, and calling one ends in an access violation. + +## Example + +A module that reads a reference count through the method table, and a class that reports when it is destroyed. **RefCount** calls **AddRef** and then **Release**, and returns the count from before the **AddRef**. + +```tb check_build projname=com-iunknown slot=file +[InterfaceId("6B1F2A40-5C0D-4E8B-9A57-2D1E3C4B5A69")] +Private Interface IWatch Extends stdole.IUnknown + Sub Watch() +End Interface + +Private Module RefCounts + Public Declare PtrSafe Function DispCallFunc Lib "oleaut32" ( _ + ByVal pvInstance As LongPtr, ByVal oVft As LongPtr, ByVal cc As Long, _ + ByVal vtReturn As Integer, ByVal cActuals As Long, ByVal prgvt As LongPtr, _ + ByVal prgpvarg As LongPtr, ByRef pvargResult As Variant) As Long + + ' Calls the method at a slot of the object's method table: no arguments, + ' __stdcall (4), a Long result (VT_I4 is 3). + Private Function CallSlot(ByVal pUnk As LongPtr, ByVal Slot As Long) As Long + Dim result As Variant + DispCallFunc pUnk, Slot * LenB(pUnk), 4, 3, 0, 0, 0, result + Return result + End Function + + Public Function RawAddRef(ByVal pUnk As LongPtr) As Long + Return CallSlot(pUnk, 1) + End Function + + Public Function RawRelease(ByVal pUnk As LongPtr) As Long + Return CallSlot(pUnk, 2) + End Function + + Public Function RefCount(ByVal pUnk As LongPtr) As Long + Dim n As Long = RawAddRef(pUnk) + RawRelease pUnk + Return n - 1 + End Function + + Public Function CountByRef(ByRef t As Tracked, ByVal pUnk As LongPtr) As Long + Return RefCount(pUnk) + End Function + + Public Function CountByVal(ByVal t As Tracked, ByVal pUnk As LongPtr) As Long + Return RefCount(pUnk) + End Function +End Module + +Class Tracked + Implements IWatch + + Public Name As String + + Private Sub IWatch_Watch() Implements IWatch.Watch + End Sub + + Private Sub Class_Terminate() + Debug.Print "Tracked " & Name & " terminated" + End Sub +End Class + +Class Untracked +End Class +``` + +Each `Set` adds or removes one reference, and an interface variable shares the count of the object's other variables: + +```tb check_run projname=com-iunknown +Dim a As Tracked +Set a = New Tracked +a.Name = "a" +Dim p As LongPtr = ObjPtr(a) +Debug.Print RefCount(p) + +Dim b As Tracked +Set b = a +Debug.Print RefCount(p) +Set b = Nothing +Debug.Print RefCount(p) + +Dim w As IWatch +Set w = a +Debug.Print RefCount(p) +Debug.Print a Is w +Debug.Print CountByRef(a, p) +Debug.Print CountByVal(a, p) > CountByRef(a, p) +Set w = Nothing +Debug.Print RefCount(p) +' Output: +' 1 +' 2 +' 1 +' 2 +' True +' 2 +' True +' 1 +' Tracked a terminated +``` + +The last line comes from the end of the sample: the local variable `a` goes out of scope, and its reference was the last one. + +Assigning to an interface the object does not support is a run-time error, found by **QueryInterface**, and `TypeOf` asks the same question without the error: + +```tb check_run projname=com-iunknown +Dim a As Tracked +Set a = New Tracked +a.Name = "a" +Dim u As Object +Set u = New Untracked +Dim w As IWatch + +Debug.Print TypeOf a Is IWatch +Debug.Print TypeOf u Is IWatch + +On Error Resume Next +Set w = u +Debug.Print Err.Number +Debug.Print Err.Description +On Error GoTo 0 +Debug.Print w Is Nothing +' Output: +' True +' False +' -2147467262 +' No such interface supported +' True +' Tracked a terminated +``` + +The class is destroyed inside the **Release** that removes the last reference. Here an extra reference taken by hand outlives the variable, so the variable's `Set ... = Nothing` destroys nothing, and the final **Release** does: + +```tb check_run projname=com-iunknown +Dim a As Tracked +Set a = New Tracked +a.Name = "a" +Dim p As LongPtr = ObjPtr(a) + +Debug.Print RawAddRef(p) +Set a = Nothing +Debug.Print "variable set to Nothing" +Debug.Print RawRelease(p) +' Output: +' 2 +' variable set to Nothing +' Tracked a terminated +' 0 +``` + +Replacing the last reference destroys the old object before the new one is stored: + +```tb check_run projname=com-iunknown +Dim t As Tracked +Set t = New Tracked +t.Name = "first" + +Debug.Print "replacing" +Set t = New Tracked +Debug.Print "replaced" +t.Name = "second" +Set t = Nothing +Debug.Print "done" +' Output: +' replacing +' Tracked first terminated +' replaced +' Tracked second terminated +' done +``` + +## See Also + +- [IDispatch](IDispatch) -- the base of an **Interface** declared with no **Extends** +- [IEnumVARIANT](IEnumVARIANT) -- an interface that derives from **IUnknown** +- [Set](../../tB/Core/Set) statement +- [Is](../../tB/Core/Is) operator +- [ObjPtr](../../tB/Modules/Information/ObjPtr) function +- [vbaObjAddref](../../tB/Modules/HiddenModule/vbaObjAddref) procedure +- [Implements](../../tB/Core/Implements) statement +- [Interfaces and CoClasses](../../Features/Language/Interfaces-CoClasses) -- declaring an interface in twinBASIC diff --git a/docs/Reference/COM-Interfaces/index.md b/docs/Reference/COM-Interfaces/index.md index 379eca1e..d1dbfda5 100644 --- a/docs/Reference/COM-Interfaces/index.md +++ b/docs/Reference/COM-Interfaces/index.md @@ -14,4 +14,8 @@ A twinBASIC class implements a COM interface with [**Implements**](../../tB/Core ## Interfaces +- [**IUnknown**](IUnknown) -- the base of every interface: asks an object for another interface, and counts its references; what **Set**, **Is** and **TypeOf** use +- [**IDispatch**](IDispatch) -- finds a member by name and calls it; what an **Object** variable and [**CallByName**](../../tB/Modules/Interaction/CallByName) use - [**IEnumVARIANT**](IEnumVARIANT) -- enumerates a sequence of **Variant** values; what [**For Each**](../../tB/Core/For-Each-Next) uses to go through an object +- [**IErrorInfo**](IErrorInfo) and **ISupportErrorInfo** -- describe the error a method failed with; how **Err** is filled after a failed call +- [**IConnectionPoint**](IConnectionPoint) and **IConnectionPointContainer** -- connect an event sink to an object; what [**WithEvents**](../../tB/Core/WithEvents) uses diff --git a/docs/Reference/Default/VBA/ErrObject/Description.md b/docs/Reference/Default/VBA/ErrObject/Description.md index 6c35d2e0..79c6f3c0 100644 --- a/docs/Reference/Default/VBA/ErrObject/Description.md +++ b/docs/Reference/Default/VBA/ErrObject/Description.md @@ -20,6 +20,9 @@ The **Description** setting consists of a short description of the error. Use th When generating a user-defined error, assign a short description of the error to the **Description** property. If **Description** isn't filled in and the value of [**Number**](Number) corresponds to a built-in run-time error, the string returned by the [**Error**](../Conversion/Error) function is placed in **Description** when the error is generated. +> [!NOTE] +> For a number that has no built-in message, VBA places `Application-defined or object-defined error` in **Description**. twinBASIC places an empty string, a Windows system message or `Automation error`, depending on the number. [**Raise**](Raise) has the table. + ### Example This example assigns a user-defined message to the **Description** property of the **Err** object. diff --git a/docs/Reference/Default/VBA/ErrObject/Raise.md b/docs/Reference/Default/VBA/ErrObject/Raise.md index cb42315a..4ed36451 100644 --- a/docs/Reference/Default/VBA/ErrObject/Raise.md +++ b/docs/Reference/Default/VBA/ErrObject/Raise.md @@ -15,10 +15,10 @@ Syntax: **Err**.**Raise** *number* [ **,** *source* [ **,** *description* [ **,* : *required* A **Long** that identifies the nature of the error. Built-in errors fall in the range 0--65535; the range 0--512 is reserved for system errors and 513--65535 is available for user-defined errors. When raising a user-defined error from a class module, add the chosen number to the [**vbObjectError**](../Constants/#vbObjectError) constant --- for example, `vbObjectError + 513`. *source* -: *optional* A **String** naming the object or application that generated the error. When setting the [**Source**](Source) property for an object, use the form *project.class*. If *source* is not specified, the programmatic ID of the current twinBASIC project is used. +: *optional* A **String** naming the object or application that generated the error. When setting the [**Source**](Source) property for an object, use the form *project.class*. If *source* is not specified, [**Source**](Source) is an empty string. *description* -: *optional* A **String** describing the error. If unspecified, the value in *number* is examined; if it can be mapped to a built-in run-time error code, the string that would be returned by the [**Error**](../Conversion/Error) function is used as the [**Description**](Description). If there is no matching built-in error, the message `Application-defined or object-defined error` is used. +: *optional* A **String** describing the error. If unspecified, [**Description**](Description) is chosen from *number*, as the table below shows. *helpfile* : *optional* The fully qualified path to the Help file in which help on this error can be found. If unspecified, the [**HelpFile**](HelpFile) property is cleared. @@ -26,7 +26,23 @@ Syntax: **Err**.**Raise** *number* [ **,** *source* [ **,** *description* [ **,* *helpcontext* : *optional* The context ID identifying a topic within *helpfile* that provides help for the error. If omitted, the [**HelpContext**](HelpContext) property is cleared. -All of the arguments are optional except *number*. When **Raise** is called without specifying some arguments, and the corresponding properties of the **Err** object still hold values from an earlier error, those values serve as the values for the current error. +All of the arguments are optional except *number*. An omitted argument is never taken from an earlier error: each call to **Raise** sets all five properties of the **Err** object, and the ones it is not given are empty or 0. + +When *description* is omitted, **Description** depends on *number*: + +| *number* | **Description** | +|----------|-----------------| +| has a built-in run-time error message, such as 5 or 11 | the text that the [**Error**](../Conversion/Error) function returns for it, such as `Invalid procedure call or argument` | +| from 1 to 746 and has no built-in message, such as 1, 95, 99 or 513 | an empty string | +| 747 or more | the Windows system message for that number when there is one, as for 1001 (`Recursion too deep; the stack overflowed.`), and otherwise `Automation error` | +| negative | the Windows system message for that value as an **HRESULT** when there is one, and otherwise `Automation error` | + +A *description* of an empty string gives an empty **Description** for every number. The system messages are in the language of the system and differ between Windows versions; `Automation error` is the only text of the table that does not come from the system. A number above 65535 is accepted. + +When the error is raised in a method of a class and the caller handles it, an empty **Description** reaches the caller as `Application-defined or object-defined error`. The other texts arrive unchanged. + +> [!NOTE] +> VBA differs in three ways. Without *source*, VBA sets **Source** to the name of the project, and twinBASIC leaves it empty. Without *description*, VBA gives every number that has no built-in message the text `Application-defined or object-defined error`, from 1 up to 65535, and twinBASIC gives an empty string or one of the texts above. And an omitted argument keeps the value left by an earlier error in VBA, and is reset in twinBASIC. A program that relies on **Err.Source** being the project name, or on **Err.Description** being non-empty, has to pass those arguments. **Raise** is preferred over the [**Error**](../../Core/Error) statement when generating run-time errors, particularly inside class modules: the **Err** object holds richer information than the **Error** statement can supply. With **Raise** the source that generated the error can be specified in the [**Source**](Source) property, online Help for the error can be referenced through [**HelpFile**](HelpFile) and [**HelpContext**](HelpContext), and so on. @@ -46,6 +62,20 @@ Function TestName(ByVal CurrentName As String, ByVal NewName As String) End Function ``` +This example raises errors without a source or a description, and prints what **Err** holds for each: + +```tb check_run +On Error Resume Next +Err.Raise 5 +Debug.Print "[" & Err.Source & "] [" & Err.Description & "]" ' [] [Invalid procedure call or argument] +Err.Raise 513 +Debug.Print "[" & Err.Source & "] [" & Err.Description & "]" ' [] [] +Err.Raise 1000 +Debug.Print "[" & Err.Source & "] [" & Err.Description & "]" ' [] [Automation error] +Err.Raise 1000, "MyProj.MyObject", "Out of paper" +Debug.Print "[" & Err.Source & "] [" & Err.Description & "]" ' [MyProj.MyObject] [Out of paper] +``` + ### See Also - [Number](Number) property diff --git a/docs/Reference/Default/VBA/ErrObject/Source.md b/docs/Reference/Default/VBA/ErrObject/Source.md index 7e6ea8ba..7d490d9a 100644 --- a/docs/Reference/Default/VBA/ErrObject/Source.md +++ b/docs/Reference/Default/VBA/ErrObject/Source.md @@ -20,9 +20,12 @@ The **Source** property holds a string representing the object that generated th Use **Source** to provide information when handling code cannot handle an error generated in an accessed object. For example, when a call into an Automation server raises a `Division by zero` error, the server sets **Err.Number** to its error code for that error and sets **Source** to its programmatic ID. -When generating an error from user code, **Source** is the application's programmatic ID. For class modules, **Source** should contain a name in the form *project.class*. +When generating an error from user code, pass the source to [**Raise**](Raise). For class modules, **Source** should contain a name in the form *project.class*. Without a source argument, **Source** is an empty string. -When an unexpected error occurs, the **Source** property is automatically filled in. For errors in a standard module, **Source** contains the project name. For errors in a class module, **Source** contains a name in *project.class* form. +When an error occurs that twinBASIC raises itself, such as a division by zero, **Source** is an empty string too, in a standard module and in a class module alike. + +> [!NOTE] +> In VBA, **Source** is filled in automatically with the name of the project, for an error that VBA raises and for **Raise** without a source argument. twinBASIC does not fill it in. ### Example diff --git a/docs/Reference/Default/VBA/Information/ObjPtr.md b/docs/Reference/Default/VBA/Information/ObjPtr.md index 9d40b8b2..5defd875 100644 --- a/docs/Reference/Default/VBA/Information/ObjPtr.md +++ b/docs/Reference/Default/VBA/Information/ObjPtr.md @@ -8,16 +8,18 @@ redirect_from: # ObjPtr {: .no_toc } -Returns the COM-identity address of an object as a **LongPtr**. +Returns the interface pointer an object variable holds, as a **LongPtr**. Syntax: **ObjPtr(** *Object* **)** *Object* -: *required* The object reference whose pointer is to be obtained. The argument is taken as **IUnknown**. +: *required* The object reference whose pointer is to be obtained. -The returned value is the address of the object's **IUnknown** vtable --- the same value the COM runtime uses to test object identity. Two **Object** variables refer to the same instance if and only if their **ObjPtr** values are equal. +The returned value is the pointer of the interface the variable is declared as. Variables of the class's own type, **Object** variables and **stdole.IUnknown** variables that hold one object give the same value. A variable of an interface type that the class implements gives a different value, the pointer of that interface. None of them is the identity pointer that [**QueryInterface**](../../../Reference/COM-Interfaces/IUnknown#queryinterface) returns for **IUnknown**. **ObjPtr** of **Nothing** is 0. -The pointer is valid only as long as the underlying object stays alive; nothing about taking **ObjPtr** holds a reference. Pass the result to API functions that need a raw object address, or store it for an identity check, but do not assume it remains meaningful after the last reference is released. +To test whether two variables refer to one object, use the [**Is**](../../Core/Is) operator. A comparison of **ObjPtr** values is reliable only between variables declared with the same type. + +The pointer is valid only as long as the underlying object stays alive; nothing about taking **ObjPtr** holds a reference. Pass the result to API functions that need a raw object address, but do not assume it remains meaningful after the last reference is released. ### Example @@ -26,13 +28,15 @@ Dim a As Collection Dim b As Collection Set a = New Collection Set b = a -Debug.Print ObjPtr(a) = ObjPtr(b) ' True — same instance. +Debug.Print ObjPtr(a) = ObjPtr(b) ' True: the same instance Set b = New Collection -Debug.Print ObjPtr(a) = ObjPtr(b) ' False — different instances. +Debug.Print ObjPtr(a) = ObjPtr(b) ' False: different instances ``` ### See Also +- [IUnknown](../../../Reference/COM-Interfaces/IUnknown) interface -- object identity in COM +- [Is](../../Core/Is) operator - [StrPtr](StrPtr) function - [VarPtr](VarPtr) function diff --git a/docs/Reference/Default/VBRUN/ErrorCallstack/index.md b/docs/Reference/Default/VBRUN/ErrorCallstack/index.md index bbd79b42..2bc48763 100644 --- a/docs/Reference/Default/VBRUN/ErrorCallstack/index.md +++ b/docs/Reference/Default/VBRUN/ErrorCallstack/index.md @@ -14,6 +14,9 @@ An **ErrorCallstack** object is a snapshot of the chain of procedures that were The snapshot is read through the **Callstack** property of an **ErrorContext** object, which is itself accessible from the structured error-handling machinery --- typically inside a `Catch` block or an **On Error** handler. +> [!NOTE] +> As of BETA 995, twinBASIC code cannot obtain an **ErrorCallstack** object, because it cannot obtain the [**ErrorContext**](../ErrorContext) that returns one. The sample below compiles, but no code can supply its argument. + ```tb check_build Sub LogStackTrace(ByVal Stack As ErrorCallstack) Dim i As Long diff --git a/docs/Reference/Default/VBRUN/ErrorContext/index.md b/docs/Reference/Default/VBRUN/ErrorContext/index.md index 4c36d011..b3fc4879 100644 --- a/docs/Reference/Default/VBRUN/ErrorContext/index.md +++ b/docs/Reference/Default/VBRUN/ErrorContext/index.md @@ -14,6 +14,9 @@ An **ErrorContext** object captures everything the runtime knows about a run-tim The error-identity properties (**Number**, **Description**, **Source**, **HelpFile**, **HelpContext**, **LastDLLError**) have the same meaning here as on the **Err** object --- see the [**ErrObject**](../../../Modules/ErrObject) module for a discussion of each. **State** and **Callstack** are unique to **ErrorContext** and reflect the structured error-handling machinery that has no equivalent on the legacy **Err** object. +> [!NOTE] +> As of BETA 995, twinBASIC code cannot obtain an **ErrorContext** object. The **ErrEx** object that returns one is not available, and neither are the **Try**, **Catch** and **Finally** blocks that several [**State**](#state) values refer to. The **Err** object does not implement this interface. The VBRUN package declares the interface and its members, so code that uses them compiles, but nothing returns an object that implements them. + ## Members ### Callstack diff --git a/docs/Reference/Default/VBRUN/ErrorStackFrame/index.md b/docs/Reference/Default/VBRUN/ErrorStackFrame/index.md index c3228620..f01fa14c 100644 --- a/docs/Reference/Default/VBRUN/ErrorStackFrame/index.md +++ b/docs/Reference/Default/VBRUN/ErrorStackFrame/index.md @@ -12,6 +12,9 @@ has_toc: false An **ErrorStackFrame** describes one procedure that was active on the call stack at the moment a run-time error was raised --- the project it belongs to, the module that contains it, and its own name. Frames are produced by iterating an [**ErrorCallstack**](../ErrorCallstack) snapshot, which in turn is reachable from the [**Callstack**](../ErrorContext#callstack) property of an [**ErrorContext**](../ErrorContext). Every property is read-only. +> [!NOTE] +> As of BETA 995, twinBASIC code cannot obtain an **ErrorStackFrame** object, because it cannot obtain the [**ErrorContext**](../ErrorContext) that leads to one. The sample below compiles, but no code can supply its argument. + ```tb check_build Sub LogStackTrace(ByVal Stack As ErrorCallstack) Dim i As Long diff --git a/examples.bat b/examples.bat index 24eab010..f7a95aa9 100644 --- a/examples.bat +++ b/examples.bat @@ -14,7 +14,7 @@ rem * it needs a twinBASIC install, and `npm install` has to remain rem sufficient to build the docs; rem * it needs Windows, a private desktop and a CDP-reachable WebView2, none rem of which exists on the CI box; -rem * an IDE cold start is 8-11 s where a whole site build is ~4 s. +rem * an IDE cold start is 6-8 s where a whole site build is ~4 s. rem rem It is run by a person, deliberately -- the same deal sweep_a11y.mjs makes. rem Arguments are passed straight through, so the useful ones are: diff --git a/scripts/bug_repro.mjs b/scripts/bug_repro.mjs index fdcd7f03..60ce2e54 100644 --- a/scripts/bug_repro.mjs +++ b/scripts/bug_repro.mjs @@ -4,6 +4,7 @@ // node scripts/bug_repro.mjs new <slug> "<entry title>" // node scripts/bug_repro.mjs pack <slug> // node scripts/bug_repro.mjs compile|build|run <slug> [options] +// node scripts/bug_repro.mjs vb6 <slug> [--vb6 <VB6.EXE>] [--timeout S] [--keep] // node scripts/bug_repro.mjs verify [slug ...] [options] // node scripts/bug_repro.mjs file <slug> <issue> [--existing] // node scripts/bug_repro.mjs file --marked @@ -42,12 +43,15 @@ // // ------------------------------------------------------------- what it relies on // -// 1. THE ZIP IS WRITTEN HERE, in Node. Compress-Archive is PowerShell and 7-Zip -// is not on PATH; Git Bash's `tar -a` writes a tar archive under the .zip -// name and exits 0. A single-entry zip is a local header, the deflated -// bytes, a central directory entry and the end record, and zlib.crc32 is the -// checksum, so no dependency is needed. The entry's time is the .twinproj's -// own, so packing an unchanged source tree twice writes the same zip. +// 1. THE ZIP IS WRITTEN IN NODE (scripts/lib/zip.mjs). Compress-Archive is +// PowerShell and 7-Zip is not on PATH; Git Bash's `tar -a` writes a tar +// archive under the .zip name and exits 0. Each entry's time is its file's +// own, so packing an unchanged source tree twice writes the same zip. A +// reproducer that has a VB6 project beside the twinBASIC one, in +// bugs/<slug>/vb6/, gets a second zip, <slug>-vb6.zip, of that folder's +// sources, written the same way; `vb6` builds the project in a temp copy +// (scripts/lib/vb6.mjs, runRepro) and prints the out.txt it writes. VB6.EXE +// is only ever started from there, with an argument array and no shell. // 2. impexp EXITS 6 WHEN IT WARNS. `import` that finished with a warning is // still a pack, so 0 and 6 are both success, and its output is printed. // 3. AN IDE THAT RUNS MANY REPRODUCERS OWNS THE REGISTRY TIDY ONCE. Under @@ -82,7 +86,6 @@ import { } from "node:fs"; import { tmpdir } from "node:os"; import path from "node:path"; -import zlib from "node:zlib"; import { CliError, choiceOption, @@ -97,30 +100,52 @@ import { REPO_ROOT } from "../lib/repo-paths.mjs"; import { keptIdeLines, summaryLine, TARGETS } from "./lib/tb-ide.mjs"; import { compilerExe, findIde } from "./lib/tb-install.mjs"; import { finishTidy, startTidy } from "./lib/tb-registry.mjs"; +import { + NO_VB6, + REPRO_OUT, + REPRO_PROJECT, + findVb6, + reproFiles, + reproProblem, + reproZipFiles, + runRepro, +} from "./lib/vb6.mjs"; +import { fileEntry, zipFiles } from "./lib/zip.mjs"; let tidy = null; exitOnCrash(() => finishTidy(tidy)); -const USAGE = `usage: node scripts/bug_repro.mjs <command> [slug ...] [--ide <twinBASIC.exe>] [--port N] [--arch win32|win64] [--timeout S] [--llvm] [--exe] [--jobs N] [--keep] [--show|--hide] [--template <name>] [--existing] [--marked] [-h, --help] +const USAGE = `usage: node scripts/bug_repro.mjs <command> [slug ...] [--ide <twinBASIC.exe>] [--port N] [--arch win32|win64] [--timeout S] [--llvm] [--exe] [--jobs N] [--keep] [--show|--hide] [--template <name>] [--with-vb6] [--vb6 <VB6.EXE>] [--existing] [--marked] [-h, --help] Reproducer projects for the entries of BUGS-TO-REPORT.md, under bugs/<slug>/, or under bugs/filed/<slug>/ once the entry has been filed upstream. <slug> is kebab-case: lowercase letters and digits joined by single hyphens, and is never "filed". +A reproducer may also have a VB6 project in vb6/, to show what VB6 does. It holds +sources only (Probe.vbp and its .bas, .cls and .frm files), builds Probe.exe, and +writes what it finds to out.txt beside the exe, handling every error itself. + Commands: new <slug> "<title>" create bugs/<slug>/src/ from the console template, with a project of the slug's name and a Startup module, and bugs/<slug>/repro.json with "mode": "manual"; with - --template, from that template's Settings and Sources + --template, from that template's Settings and Sources; + with --with-vb6, also bugs/<slug>/vb6/, from the VB6 + template under test/repro-templates/vb6/ pack <slug> pack src/ into <slug>.twinproj with scripts/impexp.mjs, and write <slug>.zip, the file a GitHub issue accepts, with the - files repro.json's "attach" names + files repro.json's "attach" names; when vb6/ exists, also + write <slug>-vb6.zip, holding its source files only compile <slug> pack, then compile the project in the IDE (tbbuild) and print its diagnostics build <slug> pack, then compile and build it (tbbuild --build) run <slug> run a copy of src/ whose [RunAfterBuild] probe calls Sub Main, and print what it writes to the DEBUG CONSOLE (tbrun) + vb6 <slug> build vb6/ with VB6 in a copy under the temp folder (never + in the repository), run Probe.exe, and print out.txt. A + project that calls MsgBox or InputBox is refused. Needs + VB6; no IDE verify [slug ...] run what each repro.json says, for the named reproducers or all of bugs/* and bugs/filed/*, and report per reproducer whether it reproduces; a filed one is labelled with its @@ -141,16 +166,21 @@ Options: the first of the lanes' ports --arch <target> win32 or win64 (default win32); compile, build and run --timeout <secs> as tbbuild's and tbrun's; with a cli reproducer, the time - limit on the compiler executable + limit on the compiler executable; with vb6, the limit on + Probe.exe (default 30) --llvm build with LLVM; build and run --exe run also runs the built exe and prints what it writes; run --jobs <n> reproducers to run at once, on ports base, base+1, ... (default 1); verify - --keep leave the IDE running; its pid is printed; compile, build, run + --keep leave the IDE running; its pid is printed; compile, build, run. + With vb6, keep the work folder and print where it is --show, --hide show the IDE on the desktop, or keep it on a private one (default: hidden, unless TBBUILD_SHOW is set) --template <name> new: the project to start from, console (the default) or a folder of test/repro-templates/, such as webview2-form + --with-vb6 new: also create vb6/ from the VB6 template + --vb6 <path> vb6: VB6.EXE (default: $VB6_EXE, else VB98\\VB6.EXE under + Program Files (x86) or Program Files) --existing file: the issue was already open, and covers this bug; recorded as "existing" in repro.json --marked file: take the issue and the slug from the entries' marks @@ -160,35 +190,40 @@ Exit codes: 0 done: a project that compiled, built or ran as it should; with verify, every reproducer that can be run on its own still reproduces; with file, filed 1 a finding: the project has errors, or its build failed after a clean compile; - with verify, at least one reproducer no longer reproduces + with vb6, VB6 refused the project; with verify, at least one reproducer no + longer reproduces 2 a refused command line (a slug that is not kebab-case or is "filed", a reproducer that does not exist or is in both bugs/ and bugs/filed/, an option - that does not apply to the command), a repro.json that is not valid, no IDE, a - project that could not be packed, a harness that failed, or a crash; with + that does not apply to the command), a repro.json that is not valid, no IDE (or, + with vb6, no VB6), a project that could not be packed, a harness that failed, + or a crash; with vb6, a reproducer with no vb6/ folder, a VB6 project that has + no Probe.vbp or calls MsgBox or InputBox, or VB6 failing to build it; with verify, a lane's harness failed; with file, an entry that is missing, ambiguous or marked unreadably, or a bugs/filed/<slug> that is already there (nothing is changed) 3 new: bugs/<slug> or bugs/filed/<slug> already exists 4 the compile never settled 5 the project crashes the compiler - 6 run: the probe printed nothing + 6 run, vb6: the probe printed nothing (vb6: no out.txt, or an empty one) 7 run: the probe ended before it returned - 8 run --exe: the exe exited with a code other than 0, or was still running after - --timeout`; + 8 run --exe, vb6: the exe exited with a code other than 0, or was still running + after --timeout`; const usageError = { format: (err) => `${err.message}\n${USAGE}` }; // What each command takes besides -h; anything else given is refused. const APPLIES = { - new: ["template"], + new: ["template", "withVb6"], pack: [], compile: ["ide", "port", "arch", "timeout", "keep", "show", "hide"], build: ["ide", "port", "arch", "timeout", "keep", "show", "hide", "llvm"], run: ["ide", "port", "arch", "timeout", "keep", "show", "hide", "llvm", "exe"], + vb6: ["vb6", "timeout", "keep"], verify: ["ide", "port", "timeout", "jobs", "show", "hide"], file: ["existing", "marked"], }; -const FLAG = (key) => `--${key}`; +// parseCli keys an option by its camelCase name (`--with-vb6` is `withVb6`). +const FLAG = (key) => `--${key.replace(/[A-Z]/g, (c) => `-${c.toLowerCase()}`)}`; const SLUG = /^[a-z0-9]+(-[a-z0-9]+)*$/; // The folder under bugs/ that holds the reproducers of filed entries, so not a slug. @@ -209,6 +244,8 @@ const { values, positionals } = withUsageError( show: { type: "boolean", default: false }, hide: { type: "boolean", default: false }, template: { type: "string" }, + "with-vb6": { type: "boolean", default: false }, + vb6: { type: "string" }, existing: { type: "boolean", default: false }, marked: { type: "boolean", default: false }, help: { type: "boolean", short: "h", default: false }, @@ -343,6 +380,8 @@ const where = (slug) => { repro: path.join(dir, "repro.json"), twinproj: path.join(dir, `${slug}.twinproj`), zip: path.join(dir, `${slug}.zip`), + vb6: path.join(dir, "vb6"), + vb6zip: path.join(dir, `${slug}-vb6.zip`), }; }; const rel = (file) => path.relative(REPO_ROOT, file).replaceAll("\\", "/"); @@ -402,16 +441,27 @@ function setKey(text, key, value, file = TEMPLATE) { return text.replace(re, (_, head) => `${head}${JSON.stringify(value)}`); } +// The VB6 project `new --with-vb6` starts a reproducer's vb6/ from: Probe.vbp and +// Module1.bas, whose Sub Main opens out.txt, prints one line under an error handler +// and closes. It has no Settings and Sources, so it is never one of the templates +// `--template` takes. +const VB6_TEMPLATE = path.join(REPO_ROOT, "test", "repro-templates", "vb6"); + // `template` is null for the console template, else a folder of -// test/repro-templates/, whose Sources/ are copied as they are. -function newReproducer(slug, entryTitle, template = null) { +// test/repro-templates/, whose Sources/ are copied as they are. `withVb6` also +// makes vb6/. +function newReproducer(slug, entryTitle, template = null, withVb6 = false) { for (const dir of [path.join(BUGS, slug), path.join(FILED_DIR, slug)]) { if (existsSync(dir)) throw new Fail(`${rel(dir)} already exists`, 3); } const p = where(slug); const from = template ? path.join(reproTemplatesDir(), template, "Settings") : TEMPLATE; if (!existsSync(from)) throw new Fail(`no template project at ${rel(from)}`); + if (withVb6 && !existsSync(path.join(VB6_TEMPLATE, `${REPRO_PROJECT}.vbp`))) { + throw new Fail(`no VB6 template project at ${rel(VB6_TEMPLATE)}`); + } const name = pascal(slug); + const vb6Note = withVb6 ? " and vb6/" : ""; let settings = readFileSync(from, "utf8"); settings = setKey(settings, "project.name", name, from); settings = setKey(settings, "project.appTitle", name, from); @@ -423,9 +473,10 @@ function newReproducer(slug, entryTitle, template = null) { cpSync(path.join(reproTemplatesDir(), template, "Sources"), path.join(p.src, "Sources"), { recursive: true }); const steps = "Describe what a person does to see the bug, or set mode to compile, build, run or cli."; writeFileSync(p.repro, `${JSON.stringify({ mode: "manual", steps }, null, 2)}\n`); + if (withVb6) cpSync(VB6_TEMPLATE, p.vb6, { recursive: true }); console.log( - `created ${rel(p.dir)}/ (project ${name}, from template ${template}): edit src/Sources, then pack; ` + - "repro.json is manual until set", + `created ${rel(p.dir)}/ (project ${name}, from template ${template}): ` + + `edit src/Sources${vb6Note}, then pack; repro.json is manual until set`, ); return; } @@ -434,76 +485,17 @@ function newReproducer(slug, entryTitle, template = null) { writeFileSync(path.join(p.src, "Sources", "Startup.twin"), STARTUP); const steps = "Describe what a person does to see the bug, or set mode to compile, build, run or cli."; writeFileSync(p.repro, `${JSON.stringify({ mode: "manual", steps }, null, 2)}\n`); - console.log(`created ${rel(p.dir)}/ (project ${name}): edit src/Sources, then pack; repro.json is manual until set`); + if (withVb6) cpSync(VB6_TEMPLATE, p.vb6, { recursive: true }); + console.log( + `created ${rel(p.dir)}/ (project ${name}): edit src/Sources${vb6Note}, then pack; repro.json is manual until set`, + ); } -// ------------------------------------------------------------------------ zip - -/** - * A zip file, as the bytes: for each file a local header and the deflated data, - * then a central directory entry for each and the end record. Each file is - * `{ name, data, mtime }`, and keeps its own modified time. - */ -function zipFiles(files) { - const UTF8 = 0x0800; - const locals = []; - const centrals = []; - let offset = 0; - for (const { name, data, mtime } of files) { - const compressed = zlib.deflateRawSync(data, { level: 9 }); - const crc = zlib.crc32(data); - const nameBytes = Buffer.from(name, "utf8"); - const time = (mtime.getHours() << 11) | (mtime.getMinutes() << 5) | (mtime.getSeconds() >> 1); - const date = ((Math.max(mtime.getFullYear(), 1980) - 1980) << 9) | ((mtime.getMonth() + 1) << 5) | mtime.getDate(); - - const local = Buffer.alloc(30); - local.writeUInt32LE(0x04034b50, 0); - local.writeUInt16LE(20, 4); // version needed: deflate - local.writeUInt16LE(UTF8, 6); - local.writeUInt16LE(8, 8); // method: deflate - local.writeUInt16LE(time, 10); - local.writeUInt16LE(date, 12); - local.writeUInt32LE(crc, 14); - local.writeUInt32LE(compressed.length, 18); - local.writeUInt32LE(data.length, 22); - local.writeUInt16LE(nameBytes.length, 26); - // extra field length (28) stays 0 - - const central = Buffer.alloc(46); - central.writeUInt32LE(0x02014b50, 0); - central.writeUInt16LE(20, 4); // version made by - central.writeUInt16LE(20, 6); // version needed - central.writeUInt16LE(UTF8, 8); - central.writeUInt16LE(8, 10); - central.writeUInt16LE(time, 12); - central.writeUInt16LE(date, 14); - central.writeUInt32LE(crc, 16); - central.writeUInt32LE(compressed.length, 20); - central.writeUInt32LE(data.length, 24); - central.writeUInt16LE(nameBytes.length, 28); - // extra, comment, disk, internal and external attributes (30-41) stay 0 - central.writeUInt32LE(offset, 42); // offset of the local header - - locals.push(local, nameBytes, compressed); - centrals.push(central, nameBytes); - offset += local.length + nameBytes.length + compressed.length; - } - const directory = Buffer.concat(centrals); - const end = Buffer.alloc(22); - end.writeUInt32LE(0x06054b50, 0); - end.writeUInt16LE(files.length, 8); // entries on this disk - end.writeUInt16LE(files.length, 10); // entries in all - end.writeUInt32LE(directory.length, 12); - end.writeUInt32LE(offset, 16); - - return Buffer.concat([...locals, directory, end]); -} - -const fileEntry = (name, file) => ({ name, data: readFileSync(file), mtime: statSync(file).mtime }); +// ------------------------------------------------------------------------ pack // Packs src/ into the .twinproj with impexp, then zips it with the files -// repro.json's `attach` names. Returns what impexp printed, which the caller -// prints or not. +// repro.json's `attach` names; with a vb6/ folder, also zips its sources into +// <slug>-vb6.zip. Returns what impexp printed, which the caller prints or not. function pack(slug) { const p = where(slug); if (!existsSync(path.join(p.src, "Settings"))) throw new Fail(`no ${rel(p.src)}/Settings: nothing to pack`); @@ -522,7 +514,16 @@ function pack(slug) { const files = [fileEntry(`${slug}.twinproj`, p.twinproj), ...attach.map((a) => fileEntry(a, path.join(p.dir, a)))]; writeFileSync(p.zip, zipFiles(files)); const also = attach.length ? `, with ${attach.join(", ")}` : ""; - return `${said}packed ${rel(p.twinproj)} and ${rel(p.zip)}${also}`; + let packed = `${said}packed ${rel(p.twinproj)} and ${rel(p.zip)}${also}`; + if (existsSync(p.vb6)) { + const problem = vb6Problem(slug); + if (problem) throw new Fail(`${rel(p.vb6)}/ ${problem}`); + const sources = reproZipFiles(p.vb6); + writeFileSync(p.vb6zip, zipFiles(sources)); + const { others } = reproFiles(p.vb6); + packed += `\npacked ${rel(p.vb6zip)} (${sources.length} source files${others.length ? `; left out: ${others.join(", ")}` : ""})`; + } + return packed; } // ------------------------------------------------------------ repro.json @@ -568,7 +569,7 @@ function loadRepro(slug) { bad("mode", `${mode} needs a project, and there is no ${rel(p.src)}/Settings`); if ("attach" in json) { if (!hasSrc) bad("attach", `goes into ${slug}.zip, which pack writes only from ${rel(p.src)}/`); - const own = [`${slug}.twinproj`, `${slug}.zip`, "repro.json", "REPORT.md"]; + const own = [`${slug}.twinproj`, `${slug}.zip`, `${slug}-vb6.zip`, "repro.json", "REPORT.md"]; if (!Array.isArray(json.attach) || !json.attach.length) { bad("attach", "must be a list of paths, relative to the reproducer's folder"); } @@ -579,11 +580,18 @@ function loadRepro(slug) { bad(key, "must be a relative path with forward slashes, inside the reproducer's folder"); } if (own.includes(a)) bad(key, `names ${a}, which is not an attachment`); + if (a.startsWith("vb6/")) bad(key, `names ${a}, which goes into ${slug}-vb6.zip with the rest of vb6/`); if (json.attach.indexOf(a) !== i) bad(key, `names ${a} twice`); const file = path.join(p.dir, a); if (!existsSync(file) || !statSync(file).isFile()) bad(key, `names ${a}, which is not a file in ${rel(p.dir)}/`); }); } + // A VB6 project in vb6/ is packed into <slug>-vb6.zip and is built by `vb6`; it has no key + // of its own, and is checked here so that a broken one is found whatever the command. + if (existsSync(p.vb6)) { + const why = vb6Problem(slug); + if (why) throw new Fail(`${rel(p.vb6)}/ ${why}`); + } if ("issue" in json && !(Number.isInteger(json.issue) && json.issue > 0)) { bad("issue", "must be a positive whole number, the number of a twinbasic/twinbasic issue"); } @@ -651,6 +659,13 @@ function loadRepro(slug) { return out; } +/** Why bugs/<slug>/vb6/ cannot be packed or built, or null: it is not a folder, has no Probe.vbp, or calls MsgBox or InputBox. */ +function vb6Problem(slug) { + const { vb6 } = where(slug); + if (!statSync(vb6).isDirectory()) return "is not a folder"; + return reproProblem(vb6); +} + // --------------------------------------------------------- running the tools function findTools(ide) { @@ -828,6 +843,45 @@ function printRun(r) { if (r.stderr.trim()) process.stderr.write(r.stderr.endsWith("\n") ? r.stderr : `${r.stderr}\n`); } +/** + * `vb6 <slug>`: builds bugs/<slug>/vb6/ in a copy under the temp folder, runs + * Probe.exe and prints the out.txt it wrote. Returns the exit code. + */ +async function runVb6(slug) { + requireReproducer(slug, { project: false }); + const p = where(slug); + if (!existsSync(p.vb6)) throw new Fail(`${rel(p.dir)}/ has no vb6/ folder: nothing to build`); + const why = vb6Problem(slug); + if (why) throw new Fail(`${rel(p.vb6)}/ ${why}`); + const exe = findVb6(values.vb6); + if (!exe) throw new Fail(values.vb6 ? `no such file: ${values.vb6}\n${NO_VB6}` : NO_VB6); + let r; + try { + r = await runRepro(exe, p.vb6, { timeoutMs: (timeout ?? 30) * 1000, keep: values.keep }); + } catch (e) { + throw new Fail(`vb6: ${e.message}`); + } + if (values.keep) console.error(`vb6: work folder kept in ${r.work}`); + if (!r.built) { + process.stderr.write(`${r.log.trim() || "VB6 did not build the project, and wrote no log"}\n`); + return 1; + } + for (const line of r.lines) console.log(line); + if (r.timedOut) { + console.error(`vb6: ${REPRO_PROJECT}.exe was still running after ${timeout ?? 30} s and was ended`); + return 8; + } + if (!r.lines.length) { + console.error(`vb6: ${REPRO_PROJECT}.exe wrote no ${REPRO_OUT}, or an empty one`); + return 6; + } + if (r.status !== 0) { + console.error(`vb6: ${REPRO_PROJECT}.exe exited with code ${r.status}`); + return 8; + } + return 0; +} + // A reproducer is a folder with src/Settings; for verify, one with a repro.json // will do, since a cli reproducer may name only files an installation ships. const requireReproducer = (slug, { project = true } = {}) => { @@ -1232,8 +1286,10 @@ async function main() { }; switch (command) { case "new": - newReproducer(slug, title, template); + newReproducer(slug, title, template, values.withVb6); return 0; + case "vb6": + return runVb6(slug); case "pack": requireReproducer(slug); console.log(pack(slug)); diff --git a/scripts/check_cli.mjs b/scripts/check_cli.mjs index ab422bc3..d5122161 100644 --- a/scripts/check_cli.mjs +++ b/scripts/check_cli.mjs @@ -26,10 +26,10 @@ // // Only invocations that stop while reading the command line belong here. Each // runs as a child process, all of them at once, each with a time limit, in an -// empty folder of its own and with TB_IDE and PUPPETEER_EXECUTABLE_PATH naming -// files that do not exist. So a case that gets past the command line fails on -// a message of a different kind rather than starting a twinBASIC IDE or a -// browser, and a default path relative to the working folder, such as +// empty folder of its own and with TB_IDE, PUPPETEER_EXECUTABLE_PATH and VB6_EXE +// naming files that do not exist. So a case that gets past the command line fails +// on a message of a different kind rather than starting a twinBASIC IDE, a +// browser or VB6, and a default path relative to the working folder, such as // tbdocs's `docs`, finds nothing. No tree, no browser, no install; about a // second. @@ -755,6 +755,7 @@ try { ...process.env, TB_IDE: path.join(scratch, "no-ide", "twinBASIC.exe"), PUPPETEER_EXECUTABLE_PATH: path.join(scratch, "no-browser", "chrome.exe"), + VB6_EXE: path.join(scratch, "no-vb6", "VB6.EXE"), }; delete env.TBBUILD_SHOW; const results = new Array(CASES.length); diff --git a/scripts/check_examples.mjs b/scripts/check_examples.mjs index bc1e1c06..26140271 100644 --- a/scripts/check_examples.mjs +++ b/scripts/check_examples.mjs @@ -26,7 +26,7 @@ // // This is the tool that asks the compiler. It is NEVER part of build.bat, // check.bat, test.bat or either CI workflow, for three reasons that are not -// going to change: an IDE cold start is 8-11 s where a whole site build is ~4 s; +// going to change: an IDE cold start is 6-8 s where a whole site build is ~4 s; // `npm install` has to remain sufficient to build the docs, and a twinBASIC // install is not on that path; and CI has no Windows box, no private desktop // and no CDP-reachable WebView2. It is `examples.bat`, run by a person, the same diff --git a/scripts/lib/cli-cases.mjs b/scripts/lib/cli-cases.mjs index 206264bd..4a00a9a5 100644 --- a/scripts/lib/cli-cases.mjs +++ b/scripts/lib/cli-cases.mjs @@ -105,6 +105,13 @@ const CASES = [ { tool: "scripts/tbrun.mjs", args: ["no-such-dir", "--arch", "win64"], exit: 2, stderr: /^not a directory: .*no-such-dir\ntbrun takes an exported source tree / }, { tool: "scripts/bug_repro.mjs", args: [], exit: 2, stderr: /^usage: node scripts\/bug_repro\.mjs / }, { tool: "scripts/bug_repro.mjs", args: ["compile", "--help", "--bogus"], exit: 0, stdout: /^usage: node scripts\/bug_repro\.mjs / }, + { tool: "scripts/vb6run.mjs", args: [], exit: 2, stderr: /^give a file to run, or --docs\nusage: node scripts\/vb6run\.mjs / }, + { tool: "scripts/vb6run.mjs", args: ["x.bas", "--help"], exit: 0, stdout: /^usage: node scripts\/vb6run\.mjs / }, + { tool: "scripts/vb6run.mjs", args: ["--docs", "x.bas"], exit: 2, stderr: /^--docs takes no file\nusage: node scripts\/vb6run\.mjs / }, + { tool: "scripts/vb6run.mjs", args: ["--vb6"], exit: 2, stderr: /^--vb6 needs a value\nusage: node scripts\/vb6run\.mjs / }, + { tool: "scripts/vb6run.mjs", args: ["--docs", "--timeout"], exit: 2, stderr: /^--timeout needs a value\nusage: node scripts\/vb6run\.mjs / }, + { tool: "scripts/vb6run.mjs", args: ["no-such-file.bas"], exit: 2, stderr: "cannot read no-such-file.bas: no such file\n" }, + { tool: "scripts/vb6run.mjs", args: ["--docs", "--vb6", "no-such/VB6.EXE"], exit: 2, stderr: /^no such file: no-such\/VB6\.EXE\nno VB6 found: pass --vb6 / }, { tool: "scripts/addin_test.mjs", args: ["--help"], exit: 0, stdout: /^usage: node scripts\/addin_test\.mjs / }, { tool: "scripts/addin_test.mjs", args: ["--ide"], exit: 2, stderr: "--ide needs a value\n" }, { tool: "scripts/addin_test.mjs", args: ["--ide", ""], exit: 2, stderr: "--ide needs a non-empty value\n" }, @@ -363,6 +370,7 @@ const HELP_TOOLS = { "scripts/sweep_attributes.mjs": null, "scripts/tbbuild.mjs": null, "scripts/tbrun.mjs": null, + "scripts/vb6run.mjs": null, }; const literal = (text) => text.replace(/[.*+?^${}()|[\]\\/]/g, "\\$&"); for (const [tool, start] of Object.entries(HELP_TOOLS)) { @@ -435,6 +443,7 @@ const REFUSALS = { "scripts/sweep_attributes.mjs": ["out"], "scripts/tbbuild.mjs": ["ide"], "scripts/tbrun.mjs": ["ide"], + "scripts/vb6run.mjs": ["vb6"], }; // The cases whose folder must stay empty, as for a help request: a refusal // starts no IDE or browser and writes nothing, and a tool that read the flag as @@ -593,6 +602,24 @@ bad("scripts/tbrun.mjs", ["no-such-dir", "--quiet", "1.5"], thenUsage(NOT_WHOLE( ); bad(tool, ["run", "no-such-bug"], "no such reproducer: bugs/no-such-bug (no src/Settings)\n"); bad(tool, ["verify", "no-such-bug"], "no such reproducer: bugs/no-such-bug (no src/Settings and no repro.json)\n"); + // The VB6 side of a reproducer: `vb6` builds vb6/ and needs no IDE, and `new --with-vb6` makes it. + // The refusals come before VB6 is looked for, so none of these needs VB6 or a vb6/ folder. + bad(tool, ["vb6"], thenUsage("vb6 needs a slug", tool)); + bad(tool, ["vb6", "no-such-bug", "other"], thenUsage("unexpected argument: other", tool)); + bad(tool, ["vb6", "Bad_Slug"], thenUsage(slugMessage("Bad_Slug"), tool)); + bad(tool, ["vb6", "filed"], thenUsage(FILED_MESSAGE, tool)); + bad(tool, ["vb6", "no-such-bug", "--timeout", "0"], thenUsage(NOT_ABOVE_ZERO("--timeout", 0), tool)); + bad(tool, ["vb6", "no-such-bug", "--vb6="], thenUsage("--vb6 needs a non-empty value", tool)); + bad(tool, ["vb6", "no-such-bug", "--llvm"], thenUsage("--llvm does not apply to vb6", tool)); + bad(tool, ["vb6", "no-such-bug", "--ide", "x"], thenUsage("--ide does not apply to vb6", tool)); + bad(tool, ["vb6", "no-such-bug", "--show"], thenUsage("--show does not apply to vb6", tool)); + bad(tool, ["vb6", "no-such-bug", "--with-vb6"], thenUsage("--with-vb6 does not apply to vb6", tool)); + bad(tool, ["pack", "no-such-bug", "--vb6", "x"], thenUsage("--vb6 does not apply to pack", tool)); + bad(tool, ["run", "no-such-bug", "--vb6", "x"], thenUsage("--vb6 does not apply to run", tool)); + bad(tool, ["verify", "--vb6", "x"], thenUsage("--vb6 does not apply to verify", tool)); + bad(tool, ["pack", "no-such-bug", "--with-vb6"], thenUsage("--with-vb6 does not apply to pack", tool)); + bad(tool, ["new", "no-such-bug", "title", "--vb6", "x"], thenUsage("--vb6 does not apply to new", tool)); + bad(tool, ["vb6", "no-such-bug"], "no such reproducer: bugs/no-such-bug (no src/Settings and no repro.json)\n"); // `file` moves things, so these are the refusals only: every one is decided from the // command line or from a reproducer that does not exist, before anything is read or written. const fileNeeds = "file needs a slug and an issue number: file <slug> <issue>"; @@ -625,6 +652,24 @@ bad("scripts/tbrun.mjs", ["no-such-dir", "--quiet", "1.5"], thenUsage(NOT_WHOLE( bad(tool, ["file", "no-such-bug", "12"], "no such reproducer: bugs/no-such-bug\n"); } +// vb6run reads its command line before it reads its file or looks for VB6, and +// follows the message with its usage. +{ + const tool = "scripts/vb6run.mjs"; + const NOT_SECONDS = (v) => `--timeout expects a number greater than 0 and at most 2147483, got: ${v}`; + bad(tool, ["x.bas", "--timeout", "0"], thenUsage(NOT_SECONDS(0), tool)); + bad(tool, ["x.bas", "--timeout=-1"], thenUsage(NOT_SECONDS(-1), tool)); + bad(tool, ["x.bas", "--timeout", "abc"], thenUsage(NOT_SECONDS("abc"), tool)); + bad(tool, ["x.bas", "--only", "x"], thenUsage("--only applies to --docs", tool)); + bad(tool, ["--docs", "--only="], thenUsage("--only needs a non-empty value", tool)); + bad( + tool, + ["--docs", "--only", "("], + new RegExp(`^${literal("--only expects a regular expression, got: ( (")}.+\\)\\nusage: node ${literal(tool)} `), + ); + bad(tool, ["x.bas", "y.bas"], thenUsage("unexpected argument: y.bas", tool)); +} + bad("scripts/addin_test.mjs", ["--only", "("], REGEX_REASON("--only", "(")); bad("scripts/addin_test.mjs", ["--port", "0"], NOT_PORT(0) + "\n"); bad("scripts/addin_test.mjs", ["--port=1.5"], NOT_PORT(1.5) + "\n"); diff --git a/scripts/lib/example-batches.mjs b/scripts/lib/example-batches.mjs index 5e820af0..bd2dd84a 100644 --- a/scripts/lib/example-batches.mjs +++ b/scripts/lib/example-batches.mjs @@ -223,11 +223,12 @@ export function makeBatches(fences, { batchSize = DEFAULT_BATCH, jobs = DEFAULT_ // // waitForCompile reads the IDE's own window: the status bar's counters and the // Problems panel for the project it has open, once the tB Services indicator -// reads OPERATIONAL and the sample has been the same for five seconds. That is -// the IDE's live analysis, not a build, and an IDE under load can sit -// OPERATIONAL with an empty panel before it has published anything. A batch -// read then reports every sample clean -- and with no reason to doubt it, since -// a project with no errors looks exactly the same. +// reads OPERATIONAL and either the page's traffic shows the compile has ended +// and the sample agrees with it, or the sample has been the same for five +// seconds. That is the IDE's live analysis, not a build, and an IDE under load +// can sit OPERATIONAL with an empty panel before it has published anything. A +// batch read then reports every sample clean -- and with no reason to doubt +// it, since a project with no errors looks exactly the same. // // So every batch carries a file whose diagnostic is KNOWN, and a batch that // does not report it is not believed. The same idea as sweep_attributes.mjs's diff --git a/scripts/lib/example-run.mjs b/scripts/lib/example-run.mjs index dd4cbb3b..400d066f 100644 --- a/scripts/lib/example-run.mjs +++ b/scripts/lib/example-run.mjs @@ -33,7 +33,7 @@ export const isRunFence = (f) => !!f.flags?.has(RUN_MARKER) && !f.flags.has(HIDD // `Else` or a colon. Read from logicalLines, whose comments and string contents // are already gone, so `' End` and `"End"` are not matches. const ENDS_RUN = /(?:^|:|\bThen|\bElse)\s*End$/i; -const PROMPTS = /\b(MsgBox|InputBox)\b/i; +export const PROMPTS = /\b(MsgBox|InputBox)\b/i; /** * Why a run fence's own text cannot be run, or null. diff --git a/scripts/lib/tb-click.mjs b/scripts/lib/tb-click.mjs index 31ed865e..8fd94ed7 100644 --- a/scripts/lib/tb-click.mjs +++ b/scripts/lib/tb-click.mjs @@ -61,6 +61,36 @@ function named(target) { // ------------------------------------------------------------------ mouse +// How a message names an element: its id, or its tag and classes, then the +// start of its text. +const DESCRIBE_JS = `(n) => { + if (!n || !n.tagName) return "nothing"; + const cls = (n.getAttribute("class") || "").trim(); + const name = n.id ? "#" + n.id : n.tagName.toLowerCase() + (cls ? "." + cls.split(/\\s+/).join(".") : ""); + const text = (n.textContent || "").trim().replace(/\\s+/g, " "); + return text ? name + " " + JSON.stringify(text.length > 40 ? text.slice(0, 40) + "..." : text) : name; +}`; + +// Whether all of an element is on screen: inside the viewport, and inside every +// ancestor that clips what overflows it, through shadow roots. +const SHOWN_JS = `(e) => { + const r = e.getBoundingClientRect(); + const within = (left, top, width, height) => + r.left >= left - 1 && r.top >= top - 1 && r.right <= left + width + 1 && r.bottom <= top + height + 1; + if (!within(0, 0, innerWidth, innerHeight)) return false; + for (let a = e.parentElement ?? e.getRootNode().host; a; a = a.parentElement ?? a.getRootNode().host) { + const s = getComputedStyle(a); + if (s.display === "contents" || (s.overflowX === "visible" && s.overflowY === "visible")) continue; + const b = a.getBoundingClientRect(); + if (!within(b.left + a.clientLeft, b.top + a.clientTop, a.clientWidth, a.clientHeight)) return false; + } + return true; +}`; + +// The page global that holds a click's check on its press, from the call that +// aims to the call that reads where the press landed. +const PRESS = "__tbClickPress"; + /** A real left click at a point: the pointer moves there, presses and releases. */ export async function clickAt(c, x, y, { clickCount = 1 } = {}) { await c.send("Input.dispatchMouseEvent", { type: "mouseMoved", x, y }); @@ -71,22 +101,39 @@ export async function clickAt(c, x, y, { clickCount = 1 } = {}) { /** * Click the centre of a target (see targetJs), as a person would: scrolled into - * view first, and only if the target is what is actually at that point. + * view first if any of it is hidden, only if the target is what is actually at + * that point, and checked where the press lands. * - * Both were learned on Sample 10, whose tool window is taller than it is - * shown: its eleventh button had a size and a place, but that place was under - * the window's own bottom edge, and the click went to the window's resize - * handle and did nothing. The element under the point is found through every - * shadow root, since a tool window is one. + * The first two were learned on Sample 10, whose tool window is taller than it + * is shown: its eleventh button had a size and a place, but that place was + * under the window's own bottom edge, and the click went to the window's + * resize handle and did nothing. The element under the point is found through + * every shadow root, since a tool window is one. A target in full view is not + * scrolled, because centring it scrolls whatever holds it: in the code editor, + * a click on the error panel scrolled the code. When something covers the + * centre of a target in full view, it is scrolled to the centre and tried again. * * Waits up to `timeout` milliseconds for the target to be there, have a size * and be uncovered, because what an add-in adds is drawn a moment after it is * in the page's data: a list view that already held Sample 15's results had * not yet drawn their rows when a click came under a millisecond later. * + * The press is checked because the page can change between the call that aims + * and the press. The IDE's error panel goes on moving after it is drawn in an + * editor the debugger has just opened, and a press aimed at its Stop landed on + * the panel's header: the run went on, and the click looked ignored. So the + * call that aims also installs a one-shot listener on the window, in the + * capture phase, which records the element the press lands on before the + * page's own handlers on it can run. The press is on target when it lands in + * the target, or in what the target's selector finds by then, in case the page + * drew the target again. The release is not checked: a control may act on the + * press and close before it. + * * Throws, naming the target, when it is still not clickable after that: there * is no such element, it has no size (it is in a hidden tool window, say), or - * something else covers its centre. + * something else covers its centre. Throws, naming what was pressed instead, + * when the press missed. A press the listener never saw, because a listener of + * the page's own on the window stopped it first, is not reported. * * @param {object} [o] * @param {number} [o.timeout] milliseconds to wait (default 5000) @@ -96,24 +143,66 @@ export async function click(c, target, { timeout = 5000, clickCount = 1 } = {}) const until = Date.now() + timeout; for (;;) { const p = await c.evaluate(`(() => { - const e = ${targetJs(target)}; + const describe = ${DESCRIBE_JS}; + const shown = ${SHOWN_JS}; + const find = () => ${targetJs(target)}; + const e = find(); if (!e) return { error: "there is no such element" }; - e.scrollIntoView({ block: "center", inline: "center" }); - const r = e.getBoundingClientRect(); - if (!r.width || !r.height) return { error: "it has no size; is it in a hidden tool window?" }; - const x = r.x + r.width / 2, y = r.y + r.height / 2; - let hit = document.elementFromPoint(x, y); - while (hit && hit.shadowRoot) { - const inner = hit.shadowRoot.elementFromPoint(x, y); - if (!inner || inner === hit) break; - hit = inner; + // The target's centre, if it is the target that is there. + const aim = () => { + const r = e.getBoundingClientRect(); + if (!r.width || !r.height) return { error: "it has no size; is it in a hidden tool window?" }; + const x = r.x + r.width / 2, y = r.y + r.height / 2; + let hit = document.elementFromPoint(x, y); + while (hit && hit.shadowRoot) { + const inner = hit.shadowRoot.elementFromPoint(x, y); + if (!inner || inner === hit) break; + hit = inner; + } + return hit && (hit === e || e.contains(hit)) ? { x, y } : { error: "its centre is covered by " + describe(hit) }; + }; + let at = shown(e) ? aim() : null; + if (!at || at.error) { + e.scrollIntoView({ block: "center", inline: "center" }); + at = aim(); } - if (hit && (hit === e || e.contains(hit))) return { x, y }; - const what = !hit ? "nothing" : hit.id ? "#" + hit.id - : hit.tagName.toLowerCase() + (hit.className ? "." + String(hit.className).trim().split(/\\s+/).join(".") : ""); - return { error: "its centre is covered by " + what }; + if (at.error) return at; + window.${PRESS}?.stop(); + const check = { landed: null }; + const on = (ev) => { + check.stop(); + const path = ev.composedPath(); + let hit = path.includes(e); + if (!hit) { + try { + const now = find(); + hit = !!now && path.includes(now); + } catch {} + } + check.landed = { hit, what: describe(path[0]) }; + }; + check.stop = () => window.removeEventListener("pointerdown", on, true); + window.addEventListener("pointerdown", on, true); + window.${PRESS} = check; + return at; })()`); - if (!p.error) return clickAt(c, p.x, p.y, { clickCount }); + if (!p.error) { + await clickAt(c, p.x, p.y, { clickCount }); + const landed = await c.evaluate(`(() => { + const check = window.${PRESS}; + if (!check) return null; + check.stop(); + delete window.${PRESS}; + return check.landed; + })()`); + if (landed && !landed.hit) { + throw new Error( + `cannot click ${named(target)}: the press landed on ${landed.what}; ` + + "the target moved, or something covered it, between aiming and pressing", + ); + } + return; + } if (Date.now() >= until) throw new Error(`cannot click ${named(target)}: ${p.error}`); await sleep(100); } diff --git a/scripts/lib/tb-ide.mjs b/scripts/lib/tb-ide.mjs index f833ea63..dc71b836 100644 --- a/scripts/lib/tb-ide.mjs +++ b/scripts/lib/tb-ide.mjs @@ -16,6 +16,7 @@ import { fileURLToPath } from "node:url"; import { attach } from "./tb-cdp.mjs"; import { click } from "./tb-click.mjs"; import { consoleMark, keepClears, keptClears, linesSince, readConsole } from "./tb-ide-console.mjs"; +import { watchCompiles } from "./tb-wire.mjs"; export const sleep = (ms) => new Promise((r) => setTimeout(r, ms)); @@ -371,6 +372,12 @@ export function waitForExit(pid, timeoutMs) { * launchIde's single argument never provokes. Such a page is marked * `c.pageBlocked`, and waitForCompile passes that on, so the failure names the * likely cause; `--show` puts the dialog where a person can read it. + * + * `c.wire` follows the page's compiles from its own traffic, through CDP's + * Network domain (tb-wire.mjs), so that waitForCompile can tell when a compile + * has ended without waiting for the status bar to stay still. A page that did + * not answer `Page.enable` would not answer `Network.enable` either, and it + * gets none. */ export async function attachIde(port, { tries = 60 } = {}) { for (let i = 0; i < tries; i++) { @@ -396,6 +403,16 @@ export async function attachIde(port, { tries = 60 } = {}) { } catch { c.pageBlocked = true; } + c.wire = null; + if (!c.pageBlocked) { + const wire = watchCompiles(c); + try { + await c.send("Network.enable"); + c.wire = wire; + } catch { + /* waitForCompile falls back to the status bar alone */ + } + } return c; } return null; @@ -481,6 +498,20 @@ const BUILD_STATE_JS = `JSON.stringify({ h: document.getElementById("hintCount")?.textContent ?? "", i: document.getElementById("infoCount")?.textContent ?? "", p: typeof projectFilePath !== "undefined" ? projectFilePath : null, + // The files waitForCompile waits for c.wire to see: every .twin file outside + // References (1) and Packages (7), which the compiler reports none for. + src: (() => { + if (typeof fs === "undefined" || !fs || !fs.tree || !fs.tree.rootFolder) return null; + const root = fs.tree.rootFolder; + if (!root.entries || !Object.keys(root.entries).length) return null; + const out = []; + root.enumerateContent(true, (n) => { + if (n.isFolder) return n.specialItemId === 1 || n.specialItemId === 7 ? -2 : true; + if (String(n.name).toLowerCase().endsWith(".twin")) out.push("twinbasic:" + n.getFullPath()); + return true; + }); + return out; + })(), crash: ${CRASH_JS}, rows: (() => { const out = []; @@ -589,6 +620,12 @@ export async function awaitCrashName(c, crash, { timeout = 5000 } = {}) { */ export const COMPILE_TIMEOUT = 180 * 1000; +// How long a compile that the wire saw end must stay the latest one before +// waitForCompile believes it. Every keystroke starts a compile a few ms after +// it, so a wait that begins just after an edit could otherwise take the compile +// before the edit's for the answer. +const EARLY_QUIET_MS = 300; + /** * Wait for the project to open and its compile to settle. * @@ -599,6 +636,14 @@ export const COMPILE_TIMEOUT = 180 * 1000; * sampling happens to catch it, which is why BUILD_STATE_JS reads the console * too, and that is what actually decides a crash. * + * The wait ends when the sample has stood still for five seconds, or sooner + * when `c.wire` has seen the compile end and the sample agrees with it: the + * same counts, and a row for each. A compile the wire had already seen end + * when the wait began does not count. A wait that follows an action --- an + * Apply, an edit --- could otherwise begin before the action's compile and + * take the one before it, so it waits for a newer compile, or for the sample + * to stand still. + * * @param {object} c a tb-cdp connection * @param {object} o * @param {string} o.project the project the IDE was started on. It is @@ -607,21 +652,38 @@ export const COMPILE_TIMEOUT = 180 * 1000; * never reported open. * @param {number} o.timeout milliseconds * @returns {Promise<{loaded: boolean, crash: object | null, drops: number, last: string | null, - * blocked: boolean}>} + * blocked: boolean, early: boolean}>} * `last` is the final sample, as the JSON string readBuildState returned; - * `blocked` is attachIde's `pageBlocked` + * `blocked` is attachIde's `pageBlocked`; `early` is true when `c.wire` saw + * the compile end and the sample agreed with it, and false when the sample + * stood still for five seconds instead */ export async function waitForCompile(c, { project, timeout }) { const want = normPath(path.resolve(project)); const t0 = Date.now(); + const wire = c.wire ?? null; + const before = wire?.mark(); let last = null, - stable = 0, + stableSince = 0, loaded = false, seenUp = false, drops = 0, - crash = null; + crash = null, + agreed = null, + early = false; + // Samples come once a second, as they always have, and only those count a + // drop of the status: a sample taken early, because the wire saw a compile + // end, could otherwise count one flap twice. Standing still is measured in + // time, not in samples, for the same reason. + let due = t0 + 1000; + let next = due; while (Date.now() - t0 < timeout) { - await sleep(1000); + const ms = Math.max(0, next - Date.now()); + await (wire ? wire.changed(ms) : sleep(ms)); + const now = Date.now(); + const scheduled = now >= due; + if (scheduled) due = now + 1000; + next = due; let s; try { s = await readBuildState(c); @@ -641,13 +703,35 @@ export async function waitForCompile(c, { project, timeout }) { } const up = v.st === "tB Services: OPERATIONAL"; if (up) seenUp = true; - else if (seenUp && ++drops >= 2) break; - if (up && s === last) { - if (++stable >= 5) break; - } else stable = 0; + else if (seenUp && scheduled && ++drops >= 2) break; + if (wire) { + // The wire's compile ends with its last source file, and the sample must + // show the same counts before it is believed: the page draws a little + // behind its traffic. Then the compile must still be the latest after + // EARLY_QUIET_MS, since each keystroke starts a compile of its own. + wire.expect(v.src); + let w = up ? wire.check(v.src) : null; + if (w && before.done && w.seq <= before.seq) w = null; + const counts = [v.e, v.w, v.h, v.i].map(Number); + const total = w ? w.counts.reduce((a, b) => a + b, 0) : -1; + if (w && w.counts.every((n, k) => n === counts[k]) && v.rows.length === total) { + if (agreed?.seq !== w.seq) agreed = { seq: w.seq, at: now }; + else if (now - agreed.at >= EARLY_QUIET_MS) { + last = s; + early = true; + break; + } + next = Math.min(next, agreed.at + EARLY_QUIET_MS); + } else { + agreed = null; + if (w && now - w.at < 2000) next = Math.min(next, now + 50); + } + } + if (!up || s !== last) stableSince = now; + else if (now - stableSince >= 5000) break; last = s; } - return { loaded, crash, drops, last, blocked: !!c.pageBlocked }; + return { loaded, crash, drops, last, blocked: !!c.pageBlocked, early }; } /** diff --git a/scripts/lib/tb-wire.mjs b/scripts/lib/tb-wire.mjs new file mode 100644 index 00000000..1ed83594 --- /dev/null +++ b/scripts/lib/tb-wire.mjs @@ -0,0 +1,86 @@ +// The IDE page's compiles, followed through CDP's Network domain. Used by +// attachIde and waitForCompile in tb-ide.mjs. + +export function watchCompiles(c) { + let gen = 0; + let cur = null; + let seq = 0; + let expected = []; + let waiters = []; + const socks = new Set(); + const wake = () => { + const w = waiters; + waiters = []; + for (const f of w) f(); + }; + const complete = (uris) => cur && cur.gen === gen && uris.length > 0 && uris.every((u) => cur.done.has(u)); + const take = (o, id) => { + if (o.event === "compilationStarted") { + socks.add(id); + cur = { seq: ++seq, gen, done: new Map() }; + } else if (o.method === "textDocument/publishDiagnostics" && cur && o.params?.uri) { + socks.add(id); + const p = o.params; + const was = complete(expected); + cur.done.set(p.uri, { n: [p.errorCount, p.warningCount, p.hintCount, p.infoCount].map(Number), at: Date.now() }); + if (!was && complete(expected)) wake(); + } + }; + c.on((m) => { + const p = m.params; + if (m.method === "Network.webSocketCreated") { + if (/\/(root|fs|language|debugger)$/.test(p?.url ?? "")) { + socks.add(p.requestId); + gen++; + } + } else if (m.method === "Network.webSocketClosed") { + if (socks.delete(p?.requestId)) gen++; + } else if (m.method === "Network.webSocketFrameReceived") { + const r = p?.response; + if (r?.payloadData) for (const o of objects(r)) take(o, p.requestId); + } + }); + return { + expect(uris) { + expected = Array.isArray(uris) ? uris : []; + }, + mark() { + return { seq: cur?.seq ?? 0, done: complete(expected) }; + }, + check(uris) { + if (!Array.isArray(uris) || !complete(uris)) return null; + const counts = [0, 0, 0, 0]; + for (const { n } of cur.done.values()) for (let k = 0; k < 4; k++) counts[k] += n[k] || 0; + return { seq: cur.seq, counts, at: Math.max(...uris.map((u) => cur.done.get(u).at)) }; + }, + changed(ms) { + return new Promise((resolve) => { + const done = () => { + clearTimeout(t); + waiters = waiters.filter((f) => f !== done); + resolve(); + }; + const t = setTimeout(done, ms); + waiters.push(done); + }); + }, + }; +} + +function objects(r) { + const b = r.opcode === 2 ? Buffer.from(r.payloadData, "base64") : Buffer.from(r.payloadData, "utf8"); + try { + if (b.length > 8 && b.readUInt32LE(0) === 0xffeaeaea) { + const out = []; + for (let i = 4; i + 4 <= b.length; ) { + const n = b.readInt32LE(i); + out.push(JSON.parse(b.toString("utf8", i + 4, i + 4 + n))); + i += 4 + n; + } + return out; + } + return b[0] === 0x7b ? [JSON.parse(b.toString("utf8"))] : []; + } catch { + return []; + } +} diff --git a/scripts/lib/vb6.mjs b/scripts/lib/vb6.mjs new file mode 100644 index 00000000..f021ff1c --- /dev/null +++ b/scripts/lib/vb6.mjs @@ -0,0 +1,1111 @@ +// What scripts/vb6run.mjs needs to build and run Visual Basic 6 code, none of it +// the command line: finding VB6, the Debug.Print rewrite, the generated +// modules, the project, `/make`, running the exe and reading what it wrote. +// +// WHY THIS EXISTS. A documented sample says what it prints in twinBASIC. Where +// twinBASIC claims to be compatible with VB6, the question worth asking is what +// the same code prints in VB6, and the only way to find out is to build it +// there. This is that build, made repeatable. +// +// ----------------------------------------------------- what had to be learned +// +// 1. VB6.EXE IS NEVER STARTED THROUGH A SHELL. In Git Bash a single-slash +// `/make` or `/out` is rewritten as a path, and VB6 answers every switch it +// does not know with a MODAL MESSAGE BOX on the user's desktop. It is spawned +// here with an argument array and no `shell` option. `/make ... /out <log>` +// writes a compile error to the log in place of a box. +// 2. A COMPILED EXE SHOWS A MODAL BOX for an unhandled run-time error, for +// MsgBox and for InputBox. Three things stand between a sample and a box: the +// generated dispatcher runs every sample under an error handler, a sample that +// calls MsgBox or InputBox or contains `End` is refused before it is built +// (example-run.mjs's runFenceProblem, the refusal check_run makes), and the +// project is built with `Unattended=-1`, VB6's own "Unattended Execution", +// which sends a message box or a run-time error to the Windows event log +// instead of the screen. +// 3. Debug.Print WRITES NOTHING IN A COMPILED EXE. Each Debug.Print in the sample +// is rewritten to `Print #511,` against a file the generated Main opens, and +// `Print #` has the argument syntax of Debug.Print (`;`, `,`, Spc, Tab), so the +// text is the same. VB6 writes the file in the ANSI code page: it is read back +// as Windows-1252. +// 4. THE OUTPUT IS FLUSHED AFTER EVERY SAMPLE, because a sample that never +// returns is ended by its pid at the time limit and an exe that is killed +// loses what VB6 had buffered. The dispatcher closes and reopens the file +// around each sample, so only the sample that hangs loses its output. +// 5. `Resume` AFTER A PROCEDURE'S OWN HANDLER. A procedure that handles an error +// with `On Error Resume Next` returns with Err still set, in VB6 and in +// twinBASIC, so the dispatcher cannot test Err after the call: its own +// `On Error GoTo` handler is reached only by an error the sample did not +// handle (the same design as example-run.mjs's dispatcherText). +// 6. A COMPILE ERROR STOPS VB6 AT THE FIRST FAILING MODULE, so a batch of +// samples is built, the module the log names is dropped, and the rest is built +// again, until a project builds. +// +// 7. A GROUP OF FENCES IS A PROJECT OF ITS OWN. A projname= group's files are +// translated into VB6 classes and modules (translateTwinFile) and its run +// fences are modules beside them. Each component keeps the fence's line +// numbers, the other components' lines blank, so VB6's line, which counts +// from 0 and skips the Attribute lines and the form header of a class, is the +// fence's line less one. The output file is open whenever sample code runs, +// so a Class_Terminate that prints, run as the sample's Sub ends, is captured. +// +// 8. A BUG REPRODUCER'S VB6 PROJECT IS BUILT AS A PROJECT, NOT AS SAMPLES. bug_repro.mjs +// keeps one in bugs/<slug>/vb6/ and builds it in a temp copy with the same `/make` +// and the same Unattended Execution (runRepro): Probe.vbp builds Probe.exe, which +// writes out.txt beside itself and handles its own errors. +// +// The probes for the rewrite and the translation are in vb6Probes() at the end. + +import { execFileSync, spawn } from "node:child_process"; +import { + copyFileSync, + existsSync, + mkdirSync, + mkdtempSync, + readdirSync, + readFileSync, + rmSync, + writeFileSync, +} from "node:fs"; +import { tmpdir } from "node:os"; +import path from "node:path"; +import { PROMPTS, RUN_DONE, RUN_TAG, parseRun } from "./example-run.mjs"; +import { logicalLines } from "./twin-api.mjs"; +import { fileEntry, readZip, zipFiles } from "./zip.mjs"; + +// ------------------------------------------------------------------- finding + +/** Where VB6 is installed, after `--vb6` and `VB6_EXE`. */ +export const VB6_DEFAULTS = [ + "C:\\Program Files (x86)\\Microsoft Visual Studio\\VB98\\VB6.EXE", + "C:\\Program Files\\Microsoft Visual Studio\\VB98\\VB6.EXE", +]; + +/** The message that says how to point the tool at VB6. */ +export const NO_VB6 = + "no VB6 found: pass --vb6 <path to VB6.EXE>, set VB6_EXE, or install it at\n " + VB6_DEFAULTS.join("\n "); + +/** + * VB6.EXE, or null: the path given, else `VB6_EXE`, else the two standard + * install folders. A path that was given and is not a file is not replaced by + * a later candidate, so a typo is reported rather than hidden. + */ +export function findVb6(explicit, env = process.env) { + const given = explicit ?? env.VB6_EXE; + if (given) return existsSync(given) ? path.resolve(given) : null; + return VB6_DEFAULTS.find((p) => existsSync(p)) ?? null; +} + +// ------------------------------------------------------------------ encoding + +// Windows-1252 differs from ISO 8859-1 only in 0x80..0x9F. Node's own TextDecoder +// is not used for it: a Node built with small ICU decodes that range as ISO 8859-1. +// biome-ignore format: a table, eight to a line +const ANSI_HIGH_CODES = [ + 0x20ac, 0x81, 0x201a, 0x192, 0x201e, 0x2026, 0x2020, 0x2021, + 0x2c6, 0x2030, 0x160, 0x2039, 0x152, 0x8d, 0x17d, 0x8f, + 0x90, 0x2018, 0x2019, 0x201c, 0x201d, 0x2022, 0x2013, 0x2014, + 0x2dc, 0x2122, 0x161, 0x203a, 0x153, 0x9d, 0x17e, 0x178, +]; +const ANSI_HIGH = new Map(ANSI_HIGH_CODES.map((code, i) => [String.fromCodePoint(code), 0x80 + i])); + +/** Text as the bytes VB6 reads: Windows-1252, with `?` for what the page cannot hold. */ +export function encodeAnsi(text) { + const out = []; + for (const ch of String(text)) { + const code = ch.codePointAt(0); + if (code < 0x80 || (code >= 0xa0 && code <= 0xff)) out.push(code); + else out.push(ANSI_HIGH.get(ch) ?? 0x3f); + } + return Buffer.from(out); +} + +/** The text of bytes VB6 wrote. */ +export const decodeAnsi = (buf) => + Array.from(Buffer.from(buf), (b) => String.fromCodePoint(b >= 0x80 && b < 0xa0 ? ANSI_HIGH_CODES[b - 0x80] : b)).join( + "", + ); + +/** The lines of a text, a closing newline not counting as one more. */ +export function splitLines(text) { + const lines = String(text).split(/\r?\n/); + if (lines.length && lines[lines.length - 1] === "") lines.pop(); + return lines; +} + +// --------------------------------------------------------------- the rewrite + +/** The file number the sample's output goes to: 511 is in the range VB6 keeps private to the process. */ +export const OUT_FILE = 511; + +// A word, as the rewrite reads one. A type character (`$`, `%`...) is left to be the next token. +const WORD = /[A-Za-z_][A-Za-z0-9_]*/y; +const MEMBER_PRINT = /^\s*\.\s*Print(?![A-Za-z0-9_])/i; + +function rewriteLine(line, fileNumber) { + let out = ""; + let count = 0; + let i = 0; + // Whether a statement may start here: the start of the line, after `:`, after + // `Then` and after `Else`. It is what makes `Rem` a comment and nothing else. + let statement = true; + // Whether the last token was a dot, so `Foo.Debug.Print` is a member of Foo's. + let afterDot = false; + while (i < line.length) { + const c = line[i]; + if (c === '"') { + // A string literal; `""` is a quote inside it. VB6's strings end with the line. + let j = i + 1; + while (j < line.length) { + if (line[j] === '"') { + if (line[j + 1] === '"') { + j += 2; + continue; + } + break; + } + j++; + } + out += line.slice(i, j + 1); + i = j + 1; + statement = false; + afterDot = false; + } else if (c === "'") { + out += line.slice(i); + break; + } else if (c === ":") { + out += c; + i++; + statement = true; + afterDot = false; + } else if (c === " " || c === "\t") { + out += c; + i++; + } else if (/[A-Za-z_]/.test(c)) { + WORD.lastIndex = i; + const word = WORD.exec(line)[0]; + const rest = line.slice(i + word.length); + if (statement && /^rem$/i.test(word)) { + out += line.slice(i); + break; + } + if (!afterDot && /^debug$/i.test(word) && MEMBER_PRINT.test(rest)) { + const printed = MEMBER_PRINT.exec(rest)[0]; + // The comma stays when nothing follows it: `Print #n,` is an empty line, and + // `Print #n` with no comma is a syntax error. + out += `Print #${fileNumber},`; + count++; + i += word.length + printed.length; + statement = false; + } else { + out += word; + i += word.length; + statement = /^(?:then|else)$/i.test(word); + } + afterDot = false; + } else if (/[0-9]/.test(c) && statement && out.trim() === "") { + // A line number is a label: a statement still follows it. + const m = /^[0-9]+/.exec(line.slice(i))[0]; + out += m; + i += m.length; + } else { + out += c; + i++; + statement = false; + afterDot = c === "."; + } + } + return { text: out, count }; +} + +/** + * The source with every `Debug.Print` statement rewritten to `Print #<n>,`. + * + * A `Debug.Print` inside a string literal or after a comment mark (`'` or + * `Rem`) is left alone; one after a `:` separator, after `Then` or after `Else` + * is rewritten. The lines are kept one for one, so a VB6 line number is the + * source's. @returns {{text: string, count: number}} + */ +export function rewriteDebugPrint(src, fileNumber = OUT_FILE) { + let count = 0; + const text = String(src) + .split(/\r?\n/) + .map((line) => { + const r = rewriteLine(line, fileNumber); + count += r.count; + return r.text; + }) + .join("\n"); + return { text, count }; +} + +// ----------------------------------------------------------- generated source + +/** The module and file names the generated project uses. */ +export const HARNESS = "tbxHarness"; +export const USER_MODULE = "tbxUser"; +export const BODY_SUB = "tbxBody"; +export const USER_MAIN = "tbxUserMain"; +const PROJECT = "vb6run"; +const OUT_NAME = "vb6run.out"; +const MAKE_LOG = "make.log"; + +const crlf = (text) => String(text).replace(/\r?\n/g, "\r\n"); + +// A `Sub Main` header in a logical line: the thing that makes a file a whole module. +const MAIN_HEADER = /^(\s*(?:(?:Public|Private|Friend|Static)\s+)*Sub\s+)Main(?![A-Za-z0-9_])/i; + +/** Whether the source declares `Sub Main`, comments and string contents not counting. */ +export const declaresMain = (src) => logicalLines(src).some(({ text }) => MAIN_HEADER.test(text)); + +/** + * One generated module for a text. + * + * With `whole` the text is a module that declares `Sub Main`: it keeps its own + * `Attribute VB_Name` line, or gets one, and its `Sub Main` becomes + * `Sub tbxUserMain`, because the project's startup procedure has to be the + * generated one. Without it the text is the body of `Public Sub tbxBody`. + * + * VB6 numbers a module's lines from 0 and does not count its `Attribute` + * lines, so the line in its error message is the line of the file less one for + * each of those, less one more. `lineDelta` is what to add to VB6's line to get + * the line of the text given: 0 for statements, which sit two lines into the + * module, below the `Attribute` line and the `Sub`. + * + * @returns {{name: string, text: string, lineDelta: number, call: string}} + * `call` is the procedure the dispatcher calls + */ +export function moduleFor(src, { name, whole = false } = {}) { + const body = rewriteDebugPrint(src).text.replace(/\n+$/, ""); + if (!whole) { + return { + name, + text: crlf(`Attribute VB_Name = "${name}"\nPublic Sub ${BODY_SUB}()\n${body}\nEnd Sub\n`), + lineDelta: 0, + call: `${name}.${BODY_SUB}`, + }; + } + const lines = body.split("\n"); + const own = /^\s*Attribute\s+VB_Name\s*=\s*"([^"]+)"/i.exec(lines[0] ?? ""); + const moduleName = own ? own[1] : name; + if (!own) lines.unshift(`Attribute VB_Name = "${moduleName}"`); + let hidden = 0; + while (hidden < lines.length && /^\s*Attribute\s/i.test(lines[hidden])) hidden++; + let renamed = false; + const text = lines.map((l) => { + if (renamed || !MAIN_HEADER.test(l.replace(/'.*$/, ""))) return l; + renamed = true; + return l.replace(MAIN_HEADER, `$1${USER_MAIN}`); + }); + return { + name: moduleName, + text: crlf(`${text.join("\n")}\n`), + lineDelta: hidden + 1 - (own ? 0 : 1), + call: `${moduleName}.${USER_MAIN}`, + }; +} + +// ----------------------------------------------------- twinBASIC file to VB6 + +/** + * The header VB6 writes at the top of a class module in a Standard EXE. The + * first four lines are the form file's, and VB6 never counts them or the + * `Attribute` lines in a line number. + */ +export const classHeader = (name) => [ + "VERSION 1.0 CLASS", + "BEGIN", + " MultiUse = -1 'True", + "END", + `Attribute VB_Name = "${name}"`, + "Attribute VB_GlobalNameSpace = False", + "Attribute VB_Creatable = False", + "Attribute VB_PredeclaredId = False", + "Attribute VB_Exposed = False", +]; + +// What to add to the line of a VB6 error in a class module to get the line of the text it +// was made from: see translateTwinFile. +const CLASS_LINE_DELTA = 1; + +// A block's opening and closing line, as a logical line has them (comments gone, strings +// blanked). The name has to be the whole of what follows, so `Class Foo(Of T)` is not an +// opener: it stays in the file's top level, where VB6 refuses it, and so does a stray +// `End Class`. Public, Private and Friend before the keyword are accepted and dropped. +const BLOCK_OPEN = /^\s*(?:(?:Public|Private|Friend)\s+)?(Class|Module)\s+([A-Za-z_][A-Za-z0-9_]*)\s*$/i; +const BLOCK_CLOSE = /^\s*End\s+(Class|Module)\s*$/i; + +/** + * The blocks of a twinBASIC file that have a VB6 form: every `Class <Name>` and + * `Module <Name>` up to its `End`, found outside comments and strings. + * + * @returns {{kind: "cls"|"bas", name: string, from: number, to: number}[]} + * `from` and `to` are the lines, counted from 1, of the opening and closing line + */ +export function findBlocks(text) { + const blocks = []; + let open = null; + for (const { text: line, line: at } of logicalLines(text)) { + if (!open) { + const m = BLOCK_OPEN.exec(line); + if (m) open = { kind: m[1].toLowerCase() === "class" ? "cls" : "bas", name: m[2], from: at }; + } else { + const m = BLOCK_CLOSE.exec(line); + if (m && (m[1].toLowerCase() === "class") === (open.kind === "cls")) { + blocks.push({ ...open, to: at }); + open = null; + } + } + } + return blocks; +} + +/** + * VB6 components for the text of a twinBASIC file. + * + * Each block is a component of its own, a `.cls` for a Class and a `.bas` for a + * Module, with its opening and closing line left out. What is outside every + * block (Declare, Type, Enum, Const, procedures) is one more `.bas`, named + * `topName`, when anything but blank lines and comments is there. Nothing else + * is translated: a construct VB6 has no form for (an Interface, a CoClass, a + * generic, an attribute line) stays where it is, and VB6 refuses it. + * + * Every component has the lines of the text, one for one, with the other + * components' lines blank, so a line VB6 reports is a line of the text: + * `lineDelta` is what to add to VB6's line to get it. `Debug.Print` is + * rewritten, as in moduleFor. + * + * @returns {{name: string, kind: "cls"|"bas", text: string, lineDelta: number}[]} + */ +export function translateTwinFile(src, { topName }) { + const lines = rewriteDebugPrint(src).text.replace(/\n+$/, "").split("\n"); + const blocks = findBlocks(src); + const owner = new Array(lines.length + 1).fill(-1); // by line, from 1 + blocks.forEach((b, i) => { + for (let l = b.from; l <= Math.min(b.to, lines.length); l++) owner[l] = i; + }); + const components = []; + // `from`..`to` of a block are its own lines, kept apart from the rest: they are dropped, as + // lines, by being left blank. + const shape = (keep, upTo, header) => { + const body = []; + for (let l = 1; l <= upTo; l++) body.push(keep(l) ? lines[l - 1] : ""); + return crlf(`${[...header, ...body].join("\n")}\n`); + }; + blocks.forEach((b, i) => { + const keep = (l) => owner[l] === i && l !== b.from && l !== b.to; + const header = b.kind === "cls" ? classHeader(b.name) : [`Attribute VB_Name = "${b.name}"`]; + components.push({ + name: b.name, + kind: b.kind, + text: shape(keep, b.to - 1, header), + lineDelta: b.kind === "cls" ? CLASS_LINE_DELTA : 1, + }); + }); + const keepTop = (l) => owner[l] === -1; + const top = lines.filter((_, k) => keepTop(k + 1)); + const topCode = logicalLines(top.join("\n")).some(({ text }) => text.trim() !== ""); + if (topCode) { + components.push({ + name: topName, + kind: "bas", + text: shape(keepTop, lines.length, [`Attribute VB_Name = "${topName}"`]), + lineDelta: 1, + }); + } + return components; +} + +/** + * One `.bas` for text that is a module's declarations and procedures, with the + * lines of the text kept (a VB6 line less one is the text's), and `Debug.Print` + * rewritten. + */ +export function declarationsModule(src, name) { + const body = rewriteDebugPrint(src).text.replace(/\n+$/, ""); + return { name, kind: "bas", text: crlf(`Attribute VB_Name = "${name}"\n${body}\n`), lineDelta: 1 }; +} + +/** + * The generated `Sub Main`: for each module in turn it writes a begin marker, + * calls the module's procedure under an `On Error GoTo` handler of its own, and + * writes the error, if one reached the handler, and an end marker. The markers + * are example-run.mjs's, so parseRun reads them. + * + * `Command$` is the index of the first sample to run, which is how a run goes on + * after the sample that did not return. + * + * @param {string[]} calls the procedure each sample's module exposes, in order + */ +export function harnessText(calls) { + const out = [ + `Attribute VB_Name = "${HARNESS}"`, + "Option Explicit", + "", + "Private tbxOut As String", + "", + "Private Sub tbxOpen()", + " On Error Resume Next", + ` Close #${OUT_FILE}`, + ` Open tbxOut For Append As #${OUT_FILE}`, + "End Sub", + "", + "Private Sub tbxMark(ByVal s As String)", + " tbxOpen", + ` Print #${OUT_FILE}, s`, + ` Close #${OUT_FILE}`, + "End Sub", + "", + "Sub Main()", + " Dim tbxStart As Long, tbxNum As Long, tbxDesc As String", + " tbxStart = Val(Command$)", + ` tbxOut = App.Path & "\\${OUT_NAME}"`, + ]; + calls.forEach((call, i) => { + out.push( + ` If tbxStart > ${i} Then GoTo tbxSkip${i}`, + ` tbxMark "${RUN_TAG} begin ${i}"`, + " tbxOpen", + " Err.Clear", + " tbxNum = 0", + ` On Error GoTo tbxError${i}`, + ` ${call}`, + ` GoTo tbxNext${i}`, + `tbxError${i}:`, + " tbxNum = Err.Number", + ' tbxDesc = Replace(Replace(Err.Description, vbCr, " "), vbLf, " ")', + ` Resume tbxNext${i}`, + `tbxNext${i}:`, + " On Error GoTo 0", + ` If tbxNum <> 0 Then tbxMark "${RUN_TAG} error " & tbxNum & " " & tbxDesc`, + ` tbxMark "${RUN_TAG} end ${i}"`, + `tbxSkip${i}:`, + ); + }); + out.push(` tbxMark "${RUN_DONE}"`, "End Sub", ""); + return crlf(out.join("\n")); +} + +/** The project file. `Unattended=-1` is why a box VB6 would show is written to the event log instead. */ +export function projectText(components) { + return crlf( + [ + "Type=Exe", + `Module=${HARNESS}; ${HARNESS}.bas`, + ...components.map((c) => + c.kind === "cls" ? `Class=${c.name}; ${c.name}.cls` : `Module=${c.name}; ${c.name}.bas`, + ), + 'Startup="Sub Main"', + `ExeName32="${PROJECT}.exe"`, + 'Command32=""', + `Name="${PROJECT}"`, + 'HelpContextID="0"', + 'CompatibleMode="0"', + "MajorVer=1", + "MinorVer=0", + "RevisionVer=0", + "AutoIncrementVer=0", + "StartMode=0", + "Unattended=-1", + "Retained=0", + "CompilationType=0", + "OptimizationType=0", + "", + ].join("\n"), + ); +} + +// ----------------------------------------------------------------- the folder + +/** A new work folder under the OS temp folder. */ +export const makeWorkDir = () => mkdtempSync(path.join(tmpdir(), "vb6run-")); + +/** + * Write the project for these generated modules into `dir`, replacing what was + * there from an earlier build. + * + * @param {{name: string, text: string, call: string}[]} modules the samples, which the + * generated Main calls in order + * @param {{name: string, kind: "cls"|"bas", text: string}[]} support components the + * samples use, built into the project and never called + */ +export function writeProject(dir, modules, support = []) { + mkdirSync(dir, { recursive: true }); + for (const f of [MAKE_LOG, `${PROJECT}.exe`, OUT_NAME]) rmSync(path.join(dir, f), { force: true }); + writeFileSync(path.join(dir, `${HARNESS}.bas`), encodeAnsi(harnessText(modules.map((m) => m.call)))); + const all = [...support, ...modules]; + for (const m of all) writeFileSync(path.join(dir, `${m.name}.${m.kind ?? "bas"}`), encodeAnsi(m.text)); + writeFileSync(path.join(dir, `${PROJECT}.vbp`), encodeAnsi(projectText(all))); +} + +// ------------------------------------------------------------------- spawning + +/** + * Run `exe` with an argument array and no shell, for at most `timeoutMs`, and + * end it by its pid and the processes under it when it runs over. Nothing is + * shown: the window is hidden and stdio is ignored. + * + * @returns {Promise<{status: number|null, timedOut: boolean, error?: string}>} + */ +export function runLimited(exe, args, { cwd, timeoutMs }) { + return new Promise((resolve) => { + let timedOut = false; + let settled = false; + const done = (r) => { + if (settled) return; + settled = true; + clearTimeout(timer); + resolve({ timedOut, ...r }); + }; + const child = spawn(exe, args, { cwd, stdio: "ignore", windowsHide: true }); + const timer = setTimeout(() => { + timedOut = true; + try { + execFileSync("taskkill", ["/PID", String(child.pid), "/T", "/F"], { stdio: "ignore", windowsHide: true }); + } catch { + child.kill(); + } + }, timeoutMs); + child.on("error", (err) => done({ status: null, error: err.message })); + child.on("close", (status) => done({ status })); + }); +} + +/** + * Build the project in `dir` with `VB6.EXE /make`. + * + * @returns {Promise<{built: boolean, log: string, timedOut: boolean, error?: string}>} + */ +export async function make(vb6, dir, { timeoutMs = 120000, project = PROJECT } = {}) { + const r = await runLimited(vb6, ["/make", `${project}.vbp`, "/out", MAKE_LOG], { cwd: dir, timeoutMs }); + const logPath = path.join(dir, MAKE_LOG); + const log = existsSync(logPath) ? decodeAnsi(readFileSync(logPath)) : ""; + return { built: existsSync(path.join(dir, `${project}.exe`)), log, timedOut: r.timedOut, error: r.error }; +} + +/** + * Run the built exe from sample number `start`, and read what it wrote. The + * generated project is `vb6run.exe`, which writes `vb6run.out` and takes `start` + * as its command line; a reproducer's is `project: "Probe"`, which writes + * `outName` and takes `args` (none by default). + * + * @returns {Promise<{lines: string[], status: number|null, timedOut: boolean, error?: string}>} + */ +export async function runExe( + dir, + { start = 0, timeoutMs = 30000, project = PROJECT, outName = OUT_NAME, args = [String(start)] } = {}, +) { + const outPath = path.join(dir, outName); + rmSync(outPath, { force: true }); + const r = await runLimited(path.join(dir, `${project}.exe`), args, { cwd: dir, timeoutMs }); + const lines = existsSync(outPath) ? splitLines(decodeAnsi(readFileSync(outPath))) : []; + return { lines, status: r.status, timedOut: r.timedOut, error: r.error }; +} + +// ------------------------------------------------------- a reproducer's project + +// scripts/bug_repro.mjs keeps a VB6 project beside a bug's twinBASIC one, in +// bugs/<slug>/vb6/, to show what VB6 does where the bug report says twinBASIC +// differs. The convention: it builds `Probe.exe` from `Probe.vbp`, and writes what +// it finds to `out.txt` beside the exe, with every error handled. The folder holds +// sources only. It is built in a copy under the OS temp folder, so no exe or +// output ever lands in the repository, and the copy's project gets Unattended +// Execution, as the generated project of vb6run does: a message box, or an error +// the program did not handle, goes to the event log in place of the desktop. + +/** The project, exe and output of a reproducer's VB6 project. */ +export const REPRO_PROJECT = "Probe"; +export const REPRO_OUT = "out.txt"; + +/** The files of a VB6 project that are sources: the project, its modules, classes and forms (`.frx` is a form's binary part). */ +export const REPRO_SOURCE_EXTENSIONS = [".vbp", ".bas", ".cls", ".frm", ".frx"]; + +/** + * The files in a reproducer's vb6/ folder, by name: the sources, and the others + * (an exe, an output, a log, a folder), which are never zipped or built. + */ +export function reproFiles(dir) { + const sources = []; + const others = []; + for (const e of readdirSync(dir, { withFileTypes: true }).sort((a, b) => (a.name < b.name ? -1 : 1))) { + const source = e.isFile() && REPRO_SOURCE_EXTENSIONS.includes(path.extname(e.name).toLowerCase()); + (source ? sources : others).push(e.name); + } + return { sources, others }; +} + +/** + * What stops a reproducer's VB6 project from being built and run, or null: no + * `Probe.vbp`, or a source that calls `MsgBox` or `InputBox`, which would open a + * modal box on the desktop of whoever runs it (the check vb6run makes on a + * sample). Comments and string contents are not read. + */ +export function reproProblem(dir) { + const { sources } = reproFiles(dir); + if (!sources.includes(`${REPRO_PROJECT}.vbp`)) return `has no ${REPRO_PROJECT}.vbp`; + for (const name of sources) { + if (/\.(?:vbp|frx)$/i.test(name)) continue; + for (const { text, line } of logicalLines(decodeAnsi(readFileSync(path.join(dir, name))))) { + const prompt = PROMPTS.exec(text); + if (prompt) { + return `${name}, line ${line} calls ${prompt[1]}, which opens a modal box on the desktop of whoever runs the exe`; + } + } + } + return null; +} + +/** The files of a reproducer's VB6 zip, as zipFiles takes them: its sources, flat, in name order. */ +export function reproZipFiles(dir) { + return reproFiles(dir).sources.map((name) => fileEntry(name, path.join(dir, name))); +} + +/** + * The text of a project file with `Unattended=-1`, in the general section, before + * any `[Section]`. A line it already has is replaced. + */ +export function unattended(vbp) { + const lines = String(vbp).split(/\r?\n/); + if (lines[lines.length - 1] === "") lines.pop(); + const kept = lines.filter((l) => !/^\s*Unattended\s*=/i.test(l)); + const section = kept.findIndex((l) => /^\s*\[/.test(l)); + kept.splice(section < 0 ? kept.length : section, 0, "Unattended=-1"); + return `${kept.join("\r\n")}\r\n`; +} + +/** + * Build and run the VB6 project in `dir` (a reproducer's vb6/ folder), in a copy + * of its sources under the OS temp folder, which is removed unless `keep`. + * + * @returns {Promise<{built: boolean, log: string, lines: string[], status: number|null, timedOut: boolean, work: string, kept: boolean}>} + * `lines` is what out.txt held; a VB6 that did not finish building throws + */ +export async function runRepro(vb6, dir, { timeoutMs = 30000, keep = false } = {}) { + const work = mkdtempSync(path.join(tmpdir(), "bugrepro-vb6-")); + try { + for (const name of reproFiles(dir).sources) copyFileSync(path.join(dir, name), path.join(work, name)); + const vbp = path.join(work, `${REPRO_PROJECT}.vbp`); + writeFileSync(vbp, encodeAnsi(unattended(decodeAnsi(readFileSync(vbp))))); + const made = await make(vb6, work, { project: REPRO_PROJECT }); + if (made.timedOut || made.error) { + throw new Error(`VB6 did not finish building${made.error ? `: ${made.error}` : " in time"}\n${made.log}`); + } + const result = { built: made.built, log: made.log, lines: [], status: null, timedOut: false, work, kept: keep }; + if (!made.built) return result; + const ran = await runExe(work, { + timeoutMs: Math.min(timeoutMs, 2147483647), + project: REPRO_PROJECT, + outName: REPRO_OUT, + args: [], + }); + if (ran.error) throw new Error(`could not run the built exe: ${ran.error}`); + return { ...result, lines: ran.lines, status: ran.status, timedOut: ran.timedOut }; + } finally { + if (!keep) rmSync(work, { recursive: true, force: true }); + } +} + +// ------------------------------------------------------------------ the build + +/** + * The error in a make log, and the module it names, if that is one of `names`. + * VB6 reports one error and stops. Its line is `Compile Error in File '<path>', + * Line <n> : <message>`, and the first line of the log is empty. + * + * @returns {{module: string|null, line: number|null, message: string}} + * `line` is VB6's own (see moduleFor), `message` the text after the colon, or + * the log's first line when it does not read that way + */ +export function parseMakeLog(log, names) { + const text = String(log).replace(/\r/g, "").trim(); + const m = /Error in File '([^']*)', Line (\d+) : ([^\n]*)/i.exec(text); + if (!m) return { module: null, line: null, message: text.split("\n")[0] ?? "" }; + const file = m[1].slice(Math.max(m[1].lastIndexOf("\\"), m[1].lastIndexOf("/")) + 1); + const base = file.replace(/\.(?:bas|cls)$/i, "").toLowerCase(); + return { + module: names.find((n) => n.toLowerCase() === base) ?? null, + line: Number(m[2]), + message: m[3].trim(), + }; +} + +/** + * Build samples into one project, dropping the module VB6's log names until the + * project builds. + * + * @param {string} vb6 + * @param {string} dir + * With `support`, components the samples use (a group's classes and modules), + * an error in one of them cannot be dropped: nothing in the group can be built, + * and the result carries it as `supportError`. + * + * @param {{name: string, text: string, call: string}[]} modules + * @returns {Promise<{built: boolean, modules: object[], refused: Map<string, {line: number|null, message: string, log: string}>, supportError: null | {component: object, line: number|null, message: string}, log: string}>} + * `refused` maps a dropped module's name to VB6's first error; `modules` is what built + */ +export async function buildBatch(vb6, dir, modules, { timeoutMs, support = [] } = {}) { + let active = [...modules]; + const refused = new Map(); + for (;;) { + writeProject(dir, active, support); + const r = await make(vb6, dir, { timeoutMs }); + if (r.built) return { built: true, modules: active, refused, supportError: null, log: r.log }; + if (r.timedOut || r.error) { + throw new Error(`VB6 did not finish building${r.error ? `: ${r.error}` : " in time"}\n${r.log}`); + } + const err = parseMakeLog( + r.log, + [...support, ...active].map((m) => m.name), + ); + if (/[\\/]tbxHarness\.bas'/i.test(r.log)) throw new Error(`the generated Sub Main does not build:\n${r.log}`); + const component = support.find((m) => m.name === err.module); + if (component) { + return { + built: false, + modules: [], + refused, + supportError: { component, line: err.line, message: err.message }, + log: r.log, + }; + } + // A log that names no module of the project: with one module left it is that one's, and + // otherwise nothing says which to drop, so the build cannot go on. + const culprit = + active.find((m) => m.name === err.module) ?? (active.length === 1 && !support.length ? active[0] : null); + if (!culprit) + throw new Error(`VB6 could not build the project, and its log names no sample:\n${r.log || "(empty log)"}`); + refused.set(culprit.name, { line: err.line, message: err.message, log: r.log }); + active = active.filter((m) => m !== culprit); + if (!active.length) return { built: false, modules: [], refused, supportError: null, log: r.log }; + } +} + +/** + * Run a built batch, sample by sample, and go on after one that does not return. + * + * @param {number} count samples in the built project + * @returns {Promise<{items: ReturnType<typeof parseRun>["items"], hung: number[]}>} + * `hung` lists the samples that began and never ended + */ +export async function runBatch(dir, count, { timeoutMs } = {}) { + const items = Array.from({ length: count }, () => ({ began: false, ended: false, output: [], error: null })); + const hung = []; + let start = 0; + while (start < count) { + const r = await runExe(dir, { start, timeoutMs }); + if (r.error) throw new Error(`could not run the built exe: ${r.error}`); + const parsed = parseRun(r.lines, count); + parsed.items.forEach((it, i) => { + if (it.began) items[i] = it; + }); + if (parsed.done) break; + // The run stopped before it finished: the last sample to begin is the one it was in. + const last = parsed.items.map((it) => it.began && !it.ended).lastIndexOf(true); + if (last < start) { + // Nothing began: the exe never got going (it was killed, or it died), and rerunning cannot help. + if (!parsed.items.some((it) => it.began)) hung.push(start); + break; + } + hung.push(last); + start = last + 1; + } + return { items, hung }; +} + +// -------------------------------------------------------------------- probes + +/** + * Probes for the Debug.Print rewrite, run by test/example-batches.test.mjs. + * Each case is a source, and the text it must become, with #511 as the file. + * + * @returns {{name: string, ok: boolean, detail?: string}[]} + */ +export function vb6Probes() { + const P = `Print #${OUT_FILE}`; + // biome-ignore format: a table, one case per line + const rewrites = [ + ["a plain statement", 'Debug.Print "a"', `${P}, "a"`], + ["a lower-case spelling", 'debug.print "a"', `${P}, "a"`], + ["an upper-case spelling", 'DEBUG.PRINT "a"', `${P}, "a"`], + ["spaces around the dot", 'Debug . Print "a"', `${P}, "a"`], + ["a semicolon list", 'Debug.Print "a"; 1; "b"', `${P}, "a"; 1; "b"`], + ["a comma list", "Debug.Print 1, 2", `${P}, 1, 2`], + ["Spc and Tab", "Debug.Print Spc(3); Tab(9); 1", `${P}, Spc(3); Tab(9); 1`], + ["a trailing semicolon", 'Debug.Print "a";', `${P}, "a";`], + ["a bare Debug.Print", "Debug.Print", `${P},`], + ["a bare Debug.Print with trailing space", "Debug.Print ", `${P}, `], + ["a bare Debug.Print before a comment", "Debug.Print ' blank", `${P}, ' blank`], + ["a bare Debug.Print before a separator", "Debug.Print: x = 1", `${P},: x = 1`], + ["an indented statement", ' Debug.Print "a"', ` ${P}, "a"`], + ["a string holding Debug.Print", 'x = "Debug.Print 1"', 'x = "Debug.Print 1"'], + ["a string with a doubled quote", 'x = "a""Debug.Print"" b"', 'x = "a""Debug.Print"" b"'], + ["a string holding Debug.Print, then a statement", 'Debug.Print "Debug.Print"', `${P}, "Debug.Print"`], + ["a comment holding Debug.Print", "x = 1 ' Debug.Print 2", "x = 1 ' Debug.Print 2"], + ["a comment line", "' Debug.Print 2", "' Debug.Print 2"], + ["a Rem line", "Rem Debug.Print 2", "Rem Debug.Print 2"], + ["a Rem line in lower case, indented", " rem Debug.Print 2", " rem Debug.Print 2"], + ["a Rem after a separator", "x = 1: Rem Debug.Print 2", "x = 1: Rem Debug.Print 2"], + ["a Rem after Then", "If x Then Rem Debug.Print 2", "If x Then Rem Debug.Print 2"], + ["a name that starts with Rem", "Remainder = 1: Debug.Print Remainder", `Remainder = 1: ${P}, Remainder`], + ["a statement after a separator", "x = 1: Debug.Print x", `x = 1: ${P}, x`], + ["two statements", 'Debug.Print 1: Debug.Print "b"', `${P}, 1: ${P}, "b"`], + ["a single-line If", "If x Then Debug.Print x", `If x Then ${P}, x`], + ["a single-line If with Else", 'If x Then Debug.Print "a" Else Debug.Print "b"', `If x Then ${P}, "a" Else ${P}, "b"`], + ["a single-line If with a bare Else branch", "If x Then Debug.Print x Else Debug.Print", `If x Then ${P}, x Else ${P},`], + ["a bare Debug.Print before Else", "If x Then Debug.Print Else y = 1", `If x Then ${P}, Else y = 1`], + ["a line number", '10 Debug.Print "a"', `10 ${P}, "a"`], + ["a label", 'Done: Debug.Print "a"', `Done: ${P}, "a"`], + ["a member of another object", "Foo.Debug.Print 1", "Foo.Debug.Print 1"], + ["a longer name", "Debug.PrintX 1", "Debug.PrintX 1"], + ["a date literal before it", "d = #1/2/2000#: Debug.Print d", `d = #1/2/2000#: ${P}, d`], + ["a line continuation", 'Debug.Print "a"; _\n "b"', `${P}, "a"; _\n "b"`], + ["a name that starts with Debug", "Debugger.Print 1", "Debugger.Print 1"], + ["a string with an apostrophe", `Debug.Print "it's"`, `${P}, "it's"`], + ["nothing to rewrite", "x = 1", "x = 1"], + ["Windows line endings", 'Debug.Print 1\r\nDebug.Print 2', `${P}, 1\n${P}, 2`], + ]; + const out = rewrites.map(([name, src, want]) => { + const got = rewriteDebugPrint(src).text; + return { + name: `vb6 rewrite: ${name}`, + ok: got === want, + detail: `got ${JSON.stringify(got)}, want ${JSON.stringify(want)}`, + }; + }); + const counted = rewriteDebugPrint('Debug.Print 1: Debug.Print "Debug.Print"\n\' Debug.Print\nDebug.Print'); + out.push({ name: "vb6 rewrite: counts what it rewrote", ok: counted.count === 3, detail: String(counted.count) }); + const kept = rewriteDebugPrint("a\nb\nDebug.Print\n").text; + out.push({ + name: "vb6 rewrite: keeps a closing newline and the line count", + ok: kept === `a\nb\n${P},\n`, + detail: JSON.stringify(kept), + }); + + const bytes = encodeAnsi("caf\u00e9 \u20ac \u4e2d"); + out.push({ + name: "vb6 encoding: Windows-1252 out, `?` for what it lacks", + ok: + bytes.equals(Buffer.from([0x63, 0x61, 0x66, 0xe9, 0x20, 0x80, 0x20, 0x3f])) && + decodeAnsi(bytes.subarray(0, 6)) === "caf\u00e9 \u20ac", + detail: bytes.toString("hex"), + }); + + const whole = moduleFor('Attribute VB_Name = "M"\nPublic Sub Main()\nDebug.Print 1\nEnd Sub\n', { + name: USER_MODULE, + whole: true, + }); + out.push({ + name: "vb6 module: a whole module keeps its name, loses its Main and its Debug.Print", + ok: + whole.name === "M" && + whole.call === `M.${USER_MAIN}` && + whole.lineDelta === 2 && + /Sub tbxUserMain/.test(whole.text) && + !/Debug\.Print/.test(whole.text), + detail: whole.text, + }); + const unnamed = moduleFor("Sub Main()\nEnd Sub", { name: USER_MODULE, whole: true }); + out.push({ + name: "vb6 module: a whole module with no name line is given one, and the line delta says so", + ok: + unnamed.name === USER_MODULE && + unnamed.lineDelta === 1 && + unnamed.text.startsWith(`Attribute VB_Name = "${USER_MODULE}"\r\n`), + detail: unnamed.text, + }); + const body = moduleFor("Debug.Print 1\nx = 2", { name: "tbxM3" }); + out.push({ + name: "vb6 module: statements become a Sub, two lines in", + ok: body.lineDelta === 0 && body.call === "tbxM3.tbxBody" && body.text.split("\r\n")[2] === `${P}, 1`, + detail: body.text, + }); + const log = + "\r\nCompile Error in File 'C:\\Temp\\vb6run-x\\tbxM2.bas', Line 3 : Syntax error\r\nBuild of 'vb6run.exe' failed.\r\n"; + const parsed = parseMakeLog(log, ["tbxM1", "tbxM2"]); + out.push({ + name: "vb6 log: the module, VB6 line and message of the first error", + ok: parsed.module === "tbxM2" && parsed.line === 3 && parsed.message === "Syntax error", + detail: JSON.stringify(parsed), + }); + out.push({ + name: "vb6 module: Sub Main is found outside comments and strings only", + ok: + declaresMain("Public Sub Main()\nEnd Sub") && + !declaresMain('\' Sub Main()\nx = "Sub Main()"') && + !declaresMain("Sub MainMenu()\nEnd Sub"), + }); + + // The translation of a twinBASIC file into VB6 components. + const tr = (src) => translateTwinFile(src, { topName: "tbxTop0" }); + const shape = (cs) => cs.map((c) => `${c.name}.${c.kind}`).join(" "); + const lines = (c) => c.text.split("\r\n"); + const check = (name, ok, detail) => out.push({ name: `vb6 translate: ${name}`, ok, detail }); + + const cls = tr("Class Foo\n Public X As Long\n Debug.Print 1\nEnd Class\n"); + check("a class block is a .cls with the VB6 class header", shape(cls) === "Foo.cls", shape(cls)); + check( + "the header is VB6's, and the Class and End Class lines are blank", + JSON.stringify(lines(cls[0]).slice(0, 11)) === + JSON.stringify([...classHeader("Foo"), "", " Public X As Long"]) && + lines(cls[0])[11] === ` ${P}, 1` && + lines(cls[0])[12] === "", + JSON.stringify(lines(cls[0])), + ); + check( + "the class header text", + classHeader("Foo").join("|") === + 'VERSION 1.0 CLASS|BEGIN| MultiUse = -1 \'True|END|Attribute VB_Name = "Foo"|Attribute VB_GlobalNameSpace = False|Attribute VB_Creatable = False|Attribute VB_PredeclaredId = False|Attribute VB_Exposed = False', + ); + const mod = tr("Module Util\n Public Function F() As Long\n End Function\nEnd Module"); + check( + "a module block is a .bas named by it, with one Attribute line", + shape(mod) === "Util.bas" && lines(mod[0])[0] === 'Attribute VB_Name = "Util"' && lines(mod[0])[1] === "", + JSON.stringify(lines(mod[0])), + ); + const top = tr("Public Const A As Long = 1\nClass Foo\nEnd Class\nPublic Function F() As Long\nEnd Function\n"); + check("the file's top level is one .bas, after the blocks", shape(top) === "Foo.cls tbxTop0.bas", shape(top)); + check( + "the top level keeps the line numbers: the block's lines are blank in it", + JSON.stringify(lines(top[1]).slice(1, 6)) === + JSON.stringify(["Public Const A As Long = 1", "", "", "Public Function F() As Long", "End Function"]), + JSON.stringify(lines(top[1])), + ); + check( + "Public, Private and Friend before Class and Module are accepted", + shape( + tr( + "Public Class A\nEnd Class\nPrivate Class B\nEnd Class\nFriend Module C\nEnd Module\nPrivate Module D\nEnd Module", + ), + ) === "A.cls B.cls C.bas D.bas", + ); + const strc = tr('Class A\n Debug.Print "End Class"\n \' End Class\n x = 1\nEnd Class\nClass B\nEnd Class'); + check( + "End Class in a string or a comment does not end a block", + shape(strc) === "A.cls B.cls" && + lines(strc[0]).some((l) => l.includes("x = 1")) && + !lines(strc[1]).some((l) => l.includes("x = 1")), + shape(strc), + ); + const opener = tr('Debug.Print "Class A"\n\' Class B\nx = 1'); + check("Class in a string or a comment opens nothing", shape(opener) === "tbxTop0.bas", shape(opener)); + const generic = tr("Class Box(Of T)\nEnd Class"); + check( + "a generic class is not a block: VB6 refuses it where it stands", + shape(generic) === "tbxTop0.bas", + shape(generic), + ); + const unclosed = tr("Class A\n x = 1"); + check("a class that is never closed is not a block", shape(unclosed) === "tbxTop0.bas", shape(unclosed)); + const wrongEnd = tr("Class A\nEnd Module\nEnd Class"); + check("End Module does not close a Class", shape(wrongEnd) === "A.cls", shape(wrongEnd)); + const commentsOnly = tr("' only a comment\n\nClass A\nEnd Class"); + check("a top level with only comments is no component", shape(commentsOnly) === "A.cls", shape(commentsOnly)); + const iface = tr('[InterfaceId("x")]\nInterface I\nEnd Interface\nClass A\nEnd Class'); + check( + "an Interface stays in the top level", + shape(iface) === "A.cls tbxTop0.bas" && lines(iface[1]).includes("Interface I"), + shape(iface), + ); + check( + "a block's lines map back: the line delta is 1 for a class, a module and the top level", + cls[0].lineDelta === 1 && mod[0].lineDelta === 1 && top[1].lineDelta === 1, + ); + const decl = declarationsModule("Public Const A = 1\nDebug.Print 2", "tbxTop2"); + check( + "declarations are one .bas, Debug.Print rewritten", + decl.kind === "bas" && lines(decl)[2] === `${P}, 2`, + JSON.stringify(lines(decl)), + ); + const proj = projectText([ + { name: "Foo", kind: "cls" }, + { name: "Util", kind: "bas" }, + ]); + check( + "the project lists a class as Class= and a module as Module=", + proj.includes("Class=Foo; Foo.cls\r\n") && proj.includes("Module=Util; Util.bas\r\n"), + ); + out.push(...reproProbes()); + return out; +} + +/** + * Probes for a reproducer's VB6 project (bug_repro.mjs): which files go into its + * zip, what refuses it, and the project file the build copy gets. They write a + * folder under the OS temp folder and remove it. + * + * @returns {{name: string, ok: boolean, detail?: string}[]} + */ +function reproProbes() { + const out = []; + const check = (name, ok, detail) => out.push({ name: `vb6 reproducer: ${name}`, ok, detail }); + const dir = mkdtempSync(path.join(tmpdir(), "vb6-repro-probe-")); + const put = (name, text) => writeFileSync(path.join(dir, name), text); + try { + put("Probe.vbp", 'Type=Exe\r\nModule=Module1; Module1.bas\r\nStartup="Sub Main"\r\nExeName32="Probe.exe"\r\n'); + put( + "Module1.bas", + 'Attribute VB_Name = "Module1"\r\nSub Main()\r\n \' MsgBox is only mentioned\r\n x = "InputBox"\r\nEnd Sub\r\n', + ); + put("Widget.cls", "VERSION 1.0 CLASS\r\nBEGIN\r\nEND\r\n"); + put("Form1.frm", "VERSION 5.00\r\n"); + put("Form1.frx", "binary"); + // What a build or a run leaves behind, and what an editor does, none of which is a source. + for (const name of ["Probe.exe", "out.txt", "make.log", "Probe.vbw", "notes.md", "Module1.bas.bak"]) put(name, "x"); + mkdirSync(path.join(dir, "Sub.bas")); + const want = ["Form1.frm", "Form1.frx", "Module1.bas", "Probe.vbp", "Widget.cls"]; + const files = reproFiles(dir); + check("only sources are listed, by name", files.sources.join(" ") === want.join(" "), files.sources.join(" ")); + check( + "an exe, an output, a log, a folder and an editor's files are not", + ["Probe.exe", "out.txt", "make.log", "Probe.vbw", "notes.md", "Module1.bas.bak", "Sub.bas"].every((n) => + files.others.includes(n), + ), + files.others.join(" "), + ); + const zipped = readZip(zipFiles(reproZipFiles(dir))); + check( + "the zip holds the sources and nothing else, flat", + zipped.map((f) => f.name).join(" ") === want.join(" "), + zipped.map((f) => f.name).join(" "), + ); + check( + "the zip holds each file's own bytes", + zipped.every((f) => f.data.equals(readFileSync(path.join(dir, f.name)))), + ); + check("a project with Probe.vbp and no prompt is accepted", reproProblem(dir) === null, String(reproProblem(dir))); + put("Module1.bas", 'Sub Main()\r\n msgbox "x"\r\nEnd Sub\r\n'); + check( + "MsgBox in a module refuses the project, whatever its case", + /^Module1\.bas, line 2 calls msgbox/.test(reproProblem(dir) ?? ""), + String(reproProblem(dir)), + ); + put("Module1.bas", "Sub Main()\r\nEnd Sub\r\n"); + put("Widget.cls", 'VERSION 1.0 CLASS\r\nBEGIN\r\nEND\r\nSub F()\r\n x = InputBox("a")\r\nEnd Sub\r\n'); + check( + "InputBox in a class refuses it too", + /^Widget\.cls, line 5 calls InputBox/.test(reproProblem(dir) ?? ""), + String(reproProblem(dir)), + ); + put("Widget.cls", "VERSION 1.0 CLASS\r\nBEGIN\r\nEND\r\n"); + check("a class with only its header is accepted", reproProblem(dir) === null, String(reproProblem(dir))); + rmSync(path.join(dir, "Probe.vbp")); + check( + "a folder with no Probe.vbp is refused", + reproProblem(dir) === `has no ${REPRO_PROJECT}.vbp`, + String(reproProblem(dir)), + ); + } finally { + rmSync(dir, { recursive: true, force: true }); + } + const vbp = 'Type=Exe\r\nName="Probe"\r\n\r\n[MS Transaction Server]\r\nAutoRefresh=1\r\n'; + check( + "Unattended goes before the first section", + unattended(vbp) === 'Type=Exe\r\nName="Probe"\r\n\r\nUnattended=-1\r\n[MS Transaction Server]\r\nAutoRefresh=1\r\n', + JSON.stringify(unattended(vbp)), + ); + check( + "a project with no section gets it at the end, and one with Unattended has it once", + unattended('Type=Exe\nUnattended=0\nName="P"\n') === 'Type=Exe\r\nName="P"\r\nUnattended=-1\r\n', + JSON.stringify(unattended('Type=Exe\nUnattended=0\nName="P"\n')), + ); + return out; +} diff --git a/scripts/lib/zip.mjs b/scripts/lib/zip.mjs new file mode 100644 index 00000000..fa839b93 --- /dev/null +++ b/scripts/lib/zip.mjs @@ -0,0 +1,100 @@ +// A zip file written in Node, for scripts/bug_repro.mjs, which zips a reproducer's +// project for the GitHub issue that reports it. +// +// WHY IT IS WRITTEN HERE. Compress-Archive is PowerShell and 7-Zip is not on PATH; +// Git Bash's `tar -a` writes a tar archive under the .zip name and exits 0. A zip +// is a local header and the deflated bytes for each file, a central directory +// entry for each, and the end record, and zlib.crc32 is the checksum, so no +// dependency is needed. Each file keeps its own modified time, so zipping an +// unchanged set of files twice writes the same bytes. + +import { readFileSync, statSync } from "node:fs"; +import zlib from "node:zlib"; + +/** + * A zip file, as the bytes: for each file a local header and the deflated data, + * then a central directory entry for each and the end record. Each file is + * `{ name, data, mtime }`, and keeps its own modified time. + */ +export function zipFiles(files) { + const UTF8 = 0x0800; + const locals = []; + const centrals = []; + let offset = 0; + for (const { name, data, mtime } of files) { + const compressed = zlib.deflateRawSync(data, { level: 9 }); + const crc = zlib.crc32(data); + const nameBytes = Buffer.from(name, "utf8"); + const time = (mtime.getHours() << 11) | (mtime.getMinutes() << 5) | (mtime.getSeconds() >> 1); + const date = ((Math.max(mtime.getFullYear(), 1980) - 1980) << 9) | ((mtime.getMonth() + 1) << 5) | mtime.getDate(); + + const local = Buffer.alloc(30); + local.writeUInt32LE(0x04034b50, 0); + local.writeUInt16LE(20, 4); // version needed: deflate + local.writeUInt16LE(UTF8, 6); + local.writeUInt16LE(8, 8); // method: deflate + local.writeUInt16LE(time, 10); + local.writeUInt16LE(date, 12); + local.writeUInt32LE(crc, 14); + local.writeUInt32LE(compressed.length, 18); + local.writeUInt32LE(data.length, 22); + local.writeUInt16LE(nameBytes.length, 26); + // extra field length (28) stays 0 + + const central = Buffer.alloc(46); + central.writeUInt32LE(0x02014b50, 0); + central.writeUInt16LE(20, 4); // version made by + central.writeUInt16LE(20, 6); // version needed + central.writeUInt16LE(UTF8, 8); + central.writeUInt16LE(8, 10); + central.writeUInt16LE(time, 12); + central.writeUInt16LE(date, 14); + central.writeUInt32LE(crc, 16); + central.writeUInt32LE(compressed.length, 20); + central.writeUInt32LE(data.length, 24); + central.writeUInt16LE(nameBytes.length, 28); + // extra, comment, disk, internal and external attributes (30-41) stay 0 + central.writeUInt32LE(offset, 42); // offset of the local header + + locals.push(local, nameBytes, compressed); + centrals.push(central, nameBytes); + offset += local.length + nameBytes.length + compressed.length; + } + const directory = Buffer.concat(centrals); + const end = Buffer.alloc(22); + end.writeUInt32LE(0x06054b50, 0); + end.writeUInt16LE(files.length, 8); // entries on this disk + end.writeUInt16LE(files.length, 10); // entries in all + end.writeUInt32LE(directory.length, 12); + end.writeUInt32LE(offset, 16); + + return Buffer.concat([...locals, directory, end]); +} + +/** A zip entry for a file on disk: the name it has in the zip, its bytes and its own modified time. */ +export const fileEntry = (name, file) => ({ name, data: readFileSync(file), mtime: statSync(file).mtime }); + +/** + * The files of a zip written by zipFiles, read back through its central + * directory: `{ name, data }` for each, with the data inflated. It reads no + * other zip than this writer's (no extra fields, no zip64), which is all a probe + * of what was zipped needs. + */ +export function readZip(buf) { + const endAt = buf.length - 22; + if (endAt < 0 || buf.readUInt32LE(endAt) !== 0x06054b50) throw new Error("not a zip: no end record"); + const count = buf.readUInt16LE(endAt + 10); + let at = buf.readUInt32LE(endAt + 16); + const files = []; + for (let i = 0; i < count; i++) { + if (buf.readUInt32LE(at) !== 0x02014b50) throw new Error("not a zip: bad central directory entry"); + const size = buf.readUInt32LE(at + 20); + const nameLength = buf.readUInt16LE(at + 28); + const local = buf.readUInt32LE(at + 42); + const name = buf.toString("utf8", at + 46, at + 46 + nameLength); + const start = local + 30 + buf.readUInt16LE(local + 26) + buf.readUInt16LE(local + 28); + files.push({ name, data: zlib.inflateRawSync(buf.subarray(start, start + size)) }); + at += 46 + nameLength; + } + return files; +} diff --git a/scripts/vb6run.mjs b/scripts/vb6run.mjs new file mode 100644 index 00000000..b0c670ae --- /dev/null +++ b/scripts/vb6run.mjs @@ -0,0 +1,396 @@ +#!/usr/bin/env node +// Build and run Visual Basic 6 code, so that what a documented sample prints in +// twinBASIC can be compared with what it prints in VB6. +// +// node scripts/vb6run.mjs <file | -> +// node scripts/vb6run.mjs --docs [--only <regex>] +// +// The mechanics -- finding VB6, the Debug.Print rewrite, the generated modules, +// `/make`, running the exe -- are in scripts/lib/vb6.mjs, whose opening comment +// is the list of what had to be learned, and the first line of it is the one +// that matters here: VB6.EXE is started from Node with an argument array and no +// shell, because in a shell `/make` can be rewritten as a path and VB6 answers +// each switch it does not know with a modal box on the user's desktop. +// +// `--docs` reads the documentation's check_run fences with the fence reader, +// selection rules and output comparison check_examples.mjs uses, and builds each +// of them in VB6 as a module of its own in one project. +// +// Exit codes: see USAGE. + +import { readFileSync, rmSync } from "node:fs"; +import path from "node:path"; +import { + CliError, + die, + exitOnCrash, + numberOption, + parseCli, + printHelpAndExit, + regexOption, + withUsageError, +} from "../lib/cli.mjs"; +import { DOCS_DIR } from "../lib/repo-paths.mjs"; +import { expectedOutput, isRunFence, judgeOutput, runFenceProblem, runRefusal } from "./lib/example-run.mjs"; +import { joinConcatGroups } from "./lib/example-batches.mjs"; +import { HIDDEN_MARKER, classify, collectFences, partOf } from "./lib/tb-fences.mjs"; +import { + NO_VB6, + USER_MODULE, + buildBatch, + declarationsModule, + declaresMain, + findVb6, + makeWorkDir, + moduleFor, + runBatch, + translateTwinFile, +} from "./lib/vb6.mjs"; + +exitOnCrash(); + +const USAGE = `usage: node scripts/vb6run.mjs <file | -> [--vb6 <path>] [--timeout <secs>] [--keep] [--json] + node scripts/vb6run.mjs --docs [--only <regex>] [--vb6 <path>] [--timeout <secs>] [--keep] [--json] + node scripts/vb6run.mjs -h, --help + +Builds and runs Visual Basic 6 code, to compare what a sample prints in VB6 with +what it prints in twinBASIC. VB6.EXE is started without a shell. Nothing may open +a dialog: the sample runs under an error handler the tool generates, the project +is built with Unattended Execution, and a sample that calls MsgBox or InputBox or +contains an End statement is refused without being built. + +A sample's Debug.Print statements are rewritten to Print # against a file the +generated Sub Main opens, because Debug.Print writes nothing in a compiled exe. + +<file> a .bas module, or a text file of bare statements; "-" reads the + statements from standard input. A file that defines Sub Main is a + whole module (its Sub Main is renamed, and the generated Main calls + it); any other file is the body of a generated procedure. What the + sample printed goes to stdout. A VB6 compile error, with its line + mapped back to the file, and a run-time error, as + "[vb6] error <n>: <description>", go to stderr. +--docs build the documentation's check_run fences in VB6 and compare what + each prints with what its page says twinBASIC prints. The run + fences of a projname= group are built in a project of its own with + the group's other fences, each slot=file fence translated into + VB6 classes (.cls) and modules (.bas); a construct VB6 has no form + for is left as it is, and VB6 refuses it. Each fence ends as one of: + same, differs (the lines that differ, page against VB6), not VB6 + (VB6 refuses to compile it, or the files of its group; most + twinBASIC syntax ends here, and it is informational), error (a + run-time error, or it did not return), refused (the sample cannot + be run) +--only <re> with --docs, the pages whose path under docs/ matches this regular + expression +--vb6 <path> VB6.EXE (default: $VB6_EXE, else VB98\\VB6.EXE under Program Files + (x86) or Program Files) +--timeout <s> time limit for each run of the built exe (default 30); the exe is + ended by its pid when it runs over +--keep keep the work folder, under the OS temp folder, and print where +--json print one JSON object instead of text +-h, --help print this text and exit + +Exit codes: + 0 the sample ran; with --docs, no fence differs and none raised an error + 1 a VB6 compile error, a run-time error, or a sample that did not return; with + --docs, at least one fence differs or raised an error + 2 the harness could not run: a refused command line, a file that is missing, a + sample that is refused, no VB6 (give --vb6 or set VB6_EXE), VB6 failing to + build, or a crash`; + +const usageError = { format: (err) => `${err.message}\n${USAGE}` }; + +const { values, positionals } = withUsageError( + () => + parseCli(process.argv.slice(2), { + options: { + docs: { type: "boolean", default: false }, + only: { type: "string" }, + vb6: { type: "string" }, + timeout: { type: "string" }, + keep: { type: "boolean", default: false }, + json: { type: "boolean", default: false }, + help: { type: "boolean", short: "h", default: false }, + }, + positionals: { min: 0, max: 1 }, + stopAt: ["help"], + }), + usageError, +); +if (values.help) printHelpAndExit(USAGE); + +const [file] = positionals; +const { timeoutMs, only } = withUsageError(() => { + if (values.docs && file !== undefined) throw new CliError("conflict", "--docs takes no file"); + if (!values.docs && file === undefined) throw new CliError("missing-positional", "give a file to run, or --docs"); + if (values.only !== undefined && !values.docs) throw new CliError("inapplicable", "--only applies to --docs"); + return { + timeoutMs: numberOption(values.timeout ?? "30", { option: "--timeout", above: 0, max: 2147483 }) * 1000, + only: values.only === undefined ? null : regexOption(values.only, { option: "--only", flags: "i" }), + }; +}, usageError); + +// What the input says, read before VB6 is looked for, so a missing file is reported as that. +let source = null; +if (!values.docs) { + try { + source = readFileSync(file === "-" ? 0 : file, "utf8").replace(/^/, ""); + } catch (err) { + die( + 2, + `cannot read ${file === "-" ? "standard input" : file}: ${err.code === "ENOENT" ? "no such file" : err.message}`, + ); + } +} + +const vb6 = findVb6(values.vb6); +if (!vb6) die(2, values.vb6 ? `no such file: ${values.vb6}\n${NO_VB6}` : NO_VB6); + +const work = makeWorkDir(); +const cleanup = () => { + if (values.keep) console.error(`vb6run: work folder kept in ${work}`); + else rmSync(work, { recursive: true, force: true }); +}; +const finish = (code) => { + cleanup(); + process.exit(code); +}; +const say = (text = "") => console.log(text); + +// ------------------------------------------------------------ a stand-alone sample + +async function sample() { + const problem = runFenceProblem(source); + if (problem) { + console.error(`vb6run: refused: the sample ${problem}`); + finish(2); + } + const whole = declaresMain(source); + const mod = moduleFor(source, { name: USER_MODULE, whole }); + const built = await buildBatch(vb6, work, [mod], { timeoutMs: 120000 }); + const shown = file === "-" ? "<stdin>" : file; + const result = { file: shown, whole, state: "ran", output: [], error: null }; + if (!built.built) { + const e = built.refused.get(mod.name) ?? [...built.refused.values()][0]; + const line = e.line === null ? null : Math.max(1, e.line + mod.lineDelta); + result.state = "compile error"; + result.error = { line, message: e.message }; + if (values.json) say(JSON.stringify(result, null, 2)); + else console.error(`Compile Error in File '${shown}'${line === null ? "" : `, Line ${line}`} : ${e.message}`); + finish(1); + } + const run = await runBatch(work, 1, { timeoutMs }); + const item = run.items[0]; + result.output = item.output; + let code = 0; + if (run.hung.length || !item.began) { + result.state = item.began ? "did not return" : "not run"; + result.error = { message: `${result.state} (time limit ${timeoutMs / 1000} s)` }; + code = 1; + } else if (item.error) { + result.state = "run-time error"; + result.error = item.error; + code = 1; + } + if (values.json) { + say(JSON.stringify(result, null, 2)); + } else { + for (const l of item.output) say(l); + if (item.error) console.error(`[vb6] error ${item.error.number}: ${item.error.description}`); + else if (code) console.error(`[vb6] ${result.error.message}`); + } + finish(code); +} + +// ---------------------------------------------------------------------- --docs + +// What inherits= makes of a slot, as check_examples.mjs reads it. +const PROMOTE_TO_CLASS = { module: "class", sub: "method" }; + +async function docs() { + const all = joinConcatGroups(await collectFences(DOCS_DIR)); + const fences = all.filter((f) => isRunFence(f) && (!only || only.test(f.rel))); + const results = fences.map((fence) => ({ fence, state: null, detail: [] })); + const where = (f, line = f.line) => `docs/${f.rel.split(path.sep).join("/")}:${line}`; + + // A line VB6 reported in a component or a sample, as a line of its fence and of the page. + const locate = (fence, fenceLine) => { + const page = (fence.concatParts ? partOf(fence.concatParts, fenceLine)?.pageLine : null) ?? fence.line + fenceLine; + const text = (fence.content.split(/\r?\n/)[fenceLine - 1] ?? "").trim(); + return { page, text: text ? `: ${text}` : "" }; + }; + const notVb6 = (r, fence, e, delta) => { + r.state = "not VB6"; + if (e.line === null) { + r.detail.push(e.message); + return; + } + const at = locate(fence, Math.max(1, e.line + delta)); + r.detail.push(`${e.message} (${where(fence, at.page)})${at.text}`); + }; + + // Which fences are built at all. A fence that is in a projname group is built with the group. + const plain = []; + const groups = new Map(); + for (const r of results) { + const f = r.fence; + const stated = f.keys.get("slot"); + f.base = f.keys.get("inherits") ?? null; + f.slot = stated ?? classify(f.content).slot; + if (f.base && f.slot) f.slot = PROMOTE_TO_CLASS[f.slot] ?? f.slot; + const refusal = runRefusal(f) ?? (f.slot ? null : { message: "its shape could not be inferred" }); + if (refusal) { + r.state = "refused"; + r.detail.push(refusal.message); + continue; + } + const group = f.keys.get("projname"); + if (!group) { + plain.push(r); + } else { + if (!groups.has(group)) groups.set(group, []); + groups.get(group).push(r); + } + } + + // The samples of a unit are built as modules of one project and run, and each is judged. + const judge = async (unit, dir, built) => { + for (const r of unit) { + const e = built.refused.get(r.module.name); + if (e) notVb6(r, r.fence, e, r.module.lineDelta); + } + const ran = unit.filter((r) => !r.state); + if (!ran.length) return; + const run = await runBatch(dir, ran.length, { timeoutMs }); + ran.forEach((r, i) => { + const item = run.items[i]; + const f = r.fence; + if (run.hung.includes(i)) { + r.state = "error"; + r.detail.push(`did not return within ${timeoutMs / 1000} s`); + } else if (!item.began) { + r.state = "error"; + r.detail.push("was not run: the run ended before it"); + } else if (item.error) { + r.state = "error"; + r.detail.push(`raised error ${item.error.number}: ${item.error.description}`); + } else { + const expected = expectedOutput(f); + const problems = judgeOutput(expected, item.output); + r.output = item.output; + if (!expected.stated) { + r.state = "ran"; + r.detail.push("the page states no output to compare"); + } else if (problems.length) { + r.state = "differs"; + for (const p of problems) { + r.detail.push(p.line ? `${where(f, p.line)}: ${p.message}` : `${p.message}\n${p.detail ?? ""}`.trim()); + } + } else { + r.state = "same"; + } + } + }); + }; + + if (plain.length) { + plain.forEach((r, i) => { + r.module = moduleFor(r.fence.content, { name: `tbxM${i}` }); + }); + const dir = path.join(work, "plain"); + const built = await buildBatch( + vb6, + dir, + plain.map((r) => r.module), + { timeoutMs: 120000 }, + ); + await judge(plain, dir, built); + } + + // A projname group is one program: the fences of that name, on any page, that are not run fences + // are its files, built into a project of its own, and the run fences are modules in it. A group + // is never batched with another, because class and module names collide between groups. + let n = 0; + for (const [name, unit] of groups) { + const dir = path.join(work, `group-${++n}`); + const support = []; + let problem = null; + all + .filter((f) => f.keys.get("projname") === name && !f.flags.has(HIDDEN_MARKER) && !f.isResource && !isRunFence(f)) + .forEach((f, k) => { + const slot = f.keys.get("slot") ?? classify(f.content).slot; + if (slot === "file") { + for (const c of translateTwinFile(f.content, { topName: `tbxTop${k}` })) support.push({ ...c, fence: f }); + } else if (slot === "module") { + support.push({ ...declarationsModule(f.content, `tbxTop${k}`), fence: f }); + } else { + problem ??= `${where(f)} is slot=${slot}, which the group cannot take into VB6`; + } + }); + if (problem) { + for (const r of unit) { + r.state = "refused"; + r.detail.push(problem); + } + continue; + } + unit.forEach((r, i) => { + r.module = moduleFor(r.fence.content, { name: `tbxM${i}` }); + }); + const built = await buildBatch( + vb6, + dir, + unit.map((r) => r.module), + { timeoutMs: 120000, support }, + ); + if (built.supportError) { + // Nothing in the group can be built: every run fence ends as the error in its files does. + const { component, line, message } = built.supportError; + for (const r of unit) notVb6(r, component.fence, { line, message }, component.lineDelta); + continue; + } + await judge(unit, dir, built); + } + + const STATES = ["same", "differs", "not VB6", "error", "refused", "ran"]; + const counts = Object.fromEntries(STATES.map((s) => [s, results.filter((r) => r.state === s).length])); + const summary = + `vb6run: ${results.length} check_run fence(s): ${counts.same} same, ${counts.differs} differs, ` + + `${counts["not VB6"]} not VB6, ${counts.error} error, ${counts.refused} refused` + + (counts.ran ? `, ${counts.ran} ran with nothing to compare` : ""); + const bad = counts.differs + counts.error; + + if (values.json) { + say( + JSON.stringify( + { + summary: counts, + fences: results.map((r) => ({ + id: r.fence.id, + page: where(r.fence), + state: r.state, + detail: r.detail, + output: r.output ?? null, + })), + }, + null, + 2, + ), + ); + } else { + for (const r of results) { + say(`${r.state.padEnd(8)} ${where(r.fence)} (${r.fence.id})`); + if (r.state !== "same") for (const d of r.detail) say(` ${d.split("\n").join("\n ")}`); + } + say(); + say(summary); + } + finish(bad ? 1 : 0); +} + +try { + await (values.docs ? docs() : sample()); +} catch (err) { + console.error(`vb6run: ${err.message}`); + finish(2); +} diff --git a/test/example-batches.test.mjs b/test/example-batches.test.mjs index f219b2c4..949cbc6f 100644 --- a/test/example-batches.test.mjs +++ b/test/example-batches.test.mjs @@ -1,19 +1,34 @@ // Runs check_examples.mjs's probes: the fence classifier, the markup, the // batching, the splitting and crash isolation, the canaries and the report. +// Also runs vb6run.mjs's probes (scripts/lib/vb6.mjs): the Debug.Print rewrite, +// the generated modules, the reading of VB6's make log and the Windows-1252 +// encoding. vb6run.mjs is the run side of the same samples, built in VB6, and +// shares check_run's fence reader and output comparison with check_examples.mjs. // -// check_examples.mjs runs them before every run, but that needs a twinBASIC +// check_examples.mjs runs its probes before every run, but that needs a twinBASIC // install to be worth starting, so it runs only by hand. The probes need no -// IDE -- crash isolation is driven through a fake lane -- so they run here -// too, where CI runs them. +// IDE -- crash isolation is driven through a fake lane -- and the VB6 ones need +// no VB6, so they run here too, where CI runs them. // // Runs with a bare `node --test test/example-batches.test.mjs`: no tree, no build. import assert from "node:assert/strict"; import { test } from "node:test"; import { runProbes } from "../scripts/lib/example-batches.mjs"; +import { vb6Probes } from "../scripts/lib/vb6.mjs"; test("check_examples' probes pass", async () => { const said = []; const passed = await runProbes((...a) => said.push(a.join(" "))); assert.ok(passed, said.join("\n")); }); + +test("vb6run's probes pass", () => { + const probes = vb6Probes(); + assert.ok(probes.length > 0, "vb6Probes() returned no probes"); + const failed = probes.filter((p) => !p.ok); + assert.deepEqual( + failed.map((p) => `${p.name}: ${p.detail ?? ""}`), + [], + ); +}); diff --git a/test/ide/assert.test.mjs b/test/ide/assert.test.mjs index 2b424e77..5824d0ce 100644 --- a/test/ide/assert.test.mjs +++ b/test/ide/assert.test.mjs @@ -16,7 +16,7 @@ import path from "node:path"; import { before, test } from "node:test"; import { fileURLToPath } from "node:url"; import { consoleMark, linesSince } from "../../scripts/lib/tb-ide-console.mjs"; -import { click, waitFor } from "../../scripts/lib/tb-operate.mjs"; +import { afterReveal, click, waitFor } from "../../scripts/lib/tb-operate.mjs"; import { scenario } from "../addin/scenario.mjs"; const HERE = path.dirname(fileURLToPath(import.meta.url)); @@ -28,6 +28,8 @@ const STATE_JS = `(() => ({ running: !!context.codeExecuting.value, panel: [...document.querySelectorAll(".errorWidgetButton")].map((b) => b.textContent.trim()), }))()`; +// Resolves once the page has drawn two more frames. +const TWO_FRAMES_JS = "new Promise((r) => requestAnimationFrame(() => requestAnimationFrame(r)))"; const BEFORE = ["Executing 'Main'...", "main start", "test start"]; const AFTER = ["test after assert", "All PadLeft tests passed."]; @@ -44,6 +46,18 @@ scenario("the debugger at a failed assertion", (lane) => { assert.ok(await waitFor(c, async () => (await state()).panel.length, { timeout: 60 * 1000 }), "no error panel"); assert.deepEqual(await printed(), BEFORE); } + // In an editor the stop has just opened, the panel goes on moving after it + // is drawn: the file's decorations bring code lenses above the failing line, + // which push the panel down 48 px, and when they come within 700 ms of the + // IDE's last reveal of the line, it reveals the line again (main.js, BETA + // 995). A click aimed before then lands on the panel's header and stops + // nothing. So wait for the decorations, then for the reveals to end, then two + // frames, since the editor draws what they changed a frame or more later. + async function panelStill() { + assert.ok(await waitFor(c, () => c.evaluate("!awaitingDocumentDecorations")), "the file's decorations never came"); + assert.ok(await afterReveal(c), "the IDE was still revealing the failing line 10 s later"); + await c.evaluate(TWO_FRAMES_JS, { awaitPromise: true }); + } async function stopped() { assert.ok(await waitFor(c, async () => !(await state()).running), "the run did not stop"); // The program's lines, without the time taken and the debugger's own line. @@ -56,6 +70,7 @@ scenario("the debugger at a failed assertion", (lane) => { test("the panel's Stop ends only the assertion: the test and the runner go on", async () => { await runToFailure(); + await panelStill(); await click(c, { css: ".errorWidgetButton", text: "Stop" }); assert.deepEqual(await stopped(), [...BEFORE, ...AFTER]); }); diff --git a/test/repro-templates/vb6/Module1.bas b/test/repro-templates/vb6/Module1.bas new file mode 100644 index 00000000..0c4bd186 --- /dev/null +++ b/test/repro-templates/vb6/Module1.bas @@ -0,0 +1,20 @@ +Attribute VB_Name = "Module1" +Option Explicit + +' The VB6 side of a bug reproducer: what VB6 does where the report says twinBASIC differs. +' Build and run it with: node scripts/bug_repro.mjs vb6 <slug> +' Probe.vbp builds Probe.exe, which writes what it finds to out.txt beside the exe. +' Handle every error, and never call MsgBox or InputBox: an unhandled error or a box +' opens a modal window on the desktop of whoever runs the exe. + +Sub Main() + On Error GoTo Fail + Open App.Path & "\out.txt" For Output As #9 + Print #9, "probe ran" + Close #9 + Exit Sub +Fail: + On Error Resume Next + Print #9, "unhandled error " & Err.Number & ": " & Err.Description + Close #9 +End Sub diff --git a/test/repro-templates/vb6/Probe.vbp b/test/repro-templates/vb6/Probe.vbp new file mode 100644 index 00000000..4d210b0e --- /dev/null +++ b/test/repro-templates/vb6/Probe.vbp @@ -0,0 +1,7 @@ +Type=Exe +Module=Module1; Module1.bas +Startup="Sub Main" +ExeName32="Probe.exe" +Name="Probe" +CompilationType=0 +OptimizationType=0