AI_Slop/DVX_GUI
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions
DVX_GUI/src/test/formrt/testFormRt.c
Scott Duensing f20cec7333 Pathname and drive letter enhancements.
2026-10-13 13:49:12 -05:00

10602 lines
352 KiB
C
Raw Blame History

// The MIT License (MIT)
//
// Copyright (C) 2026 Scott Duensing
//
// Permission is hereby granted, free of charge, to any person obtaining a copy
// of this software and associated documentation files (the "Software"), to
// deal in the Software without restriction, including without limitation the
// rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
// sell copies of the Software, and to permit persons to whom the Software is
// furnished to do so, subject to the following conditions:
//
// The above copyright notice and this permission notice shall be included in
// all copies or substantial portions of the Software.
//
// THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
// IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
// FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
// AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
// LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
// FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
// IN THE SOFTWARE.
// testFormRt.c -- suite T5: DVX BASIC form runtime on the host backend
//
// Every case compiles BASIC + .frm text in-process, loads it through
// the real formrt, drives it with dvxtest input and asserts on runtime
// state and PRINT output.
#include "frtHarness.h"
#include "frtStubs.h"
#include "../../apps/kpunch/dvxbasic/compiler/basEvents.h"
#include "../../apps/kpunch/dvxbasic/compiler/opcodes.h"
#include "../../apps/kpunch/dvxbasic/compiler/compiler.h"
#include "../../apps/kpunch/dvxbasic/basBuild.h"
#include "../../apps/kpunch/dvxbasic/basRes.h"
#include "../../apps/kpunch/dvxbasic/runtime/screen.h"
#include "thirdparty/stb_ds_wrap.h"
#include "canvas/canvas.h"
#include "timer/timer.h"
#include "dvxRes.h"
#include "shellApp.h"
#include "dvxCur.h"
#include "dvxDlg.h"
#include "platform/dvxPlatHost.h"
#include "dvxWgtP.h"
#include "dvxVideo.h"
#include "dvxWm.h"
#include "../../libs/kpunch/serial/seclink/secLink.h"
#include "../../libs/kpunch/hlpfile/hlpFormat.h"
#include <inttypes.h>
#include <dlfcn.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <strings.h>
#include <unistd.h>
#define SCREEN_W 800
#define SCREEN_H 600
#define SCREEN_BPP 32
#define SCREEN_BPP_16 16
#define FORM_W 400
#define FORM_H 300
#define TIMER_INTERVAL_MS 100
#define TIMER_TICKS 3
#define RESET_CYCLES 50
#define FRM_TEXT_MAX 16384
#define POPUP_OFF_X 5
#define POPUP_OFF_Y 7
#define MENU_ID_BASE 10000
// New-case constants: the stub UART identity (mirrors frtStubs.c), the
// fake SQL handles and row count, one-past the resource handle limit
// for the exhaustion probe, and an extern result wider than 16 bits.
#define SER_STUB_BASE 0x3F8
#define SER_STUB_IRQ 4
#define SER_STUB_UART 4
#define SQL_FAKE_DB 7
#define SQL_FAKE_RS 42
#define SQL_FAKE_ROWS 2
#define RES_HANDLE_PROBE 9
#define FRT_EXT_WIDE_RESULT 0x12345
#define FRT_EXT_BIN_MAX 64 // frtExtXor result buffer
#define FRT_FIT_BIG_W 600 // caseFormWindowMembers: the size FitWidth / FitHeight shrink from
#define FRT_FIT_BIG_H 400
#define FRT_SRC_BUF_LEN 4096 // a test program built with snprintf
#define FRT_DRAW_WANT_LEN 128 // caseDrawThemed: the expected output
#define FRT_VBAR_X 100 // caseDrawThemed Form1_Draw: the upright DrawScrollBar's left column
#define FRT_VBAR_END_Y 79 // and its last row (length 80 from 0)
#define FRT_CBAR_X 60 // Form1_Ctrl: the control-style DrawScrollBar's left column
#define FRT_CBAR_Y 40 // a row inside its trough
#define FRT_HBAR_Y 82 // caseDrawThemed Form1_HBar: the horizontal DrawScrollBar's top row (it starts at x 0)
#define FRT_HBAR_END 95 // and its last column (length 96)
#define FRT_HBAR_THUMB_X 31 // its thumb's first column: arrow 16 + pos 20 * (track 64 - thumb 16) / range 64
#define FRT_HBAR_THUMB_END 46 // and last: 16 * 64 / 80 = 12 wide, raised to the 16 minimum
#define FRT_HBAR_TROUGH_X 20 // a column of the trough left of the thumb
#define FRT_SARROW_X 40 // caseDrawThemed Form1_HBar: DrawScrollArrow's button (16 square, pointing right)
#define FRT_SARROW_Y 30
#define FRT_PAINT_PUMPS 3 // event pumps that paint a newly shown window
#define FRT_EXT_BIN_NULL (-1) // frtExtXor key: return NULL
#define FRT_EXT_BIN_NOLEN 99 // frtExtXor key: leave *outLen alone
#define FRT_EXT_LEN_WEIGHT 100 // frtExtBinSum: weight of the first length
#define FRT_EXT_TAG_WEIGHT 10000 // frtExtBinSum: weight of the text length
#define FRT_EXT_LEN2_WEIGHT 1000000 // frtExtBinSum: weight of the second length
#define FRT_MIN_W_PROBE 50
#define FRT_HUGE_DIM 1000000000
#define FRT_MAX_DIM 32767
#define FRT_PROBE_BIAS 1000 // frtProbeRetIntStr result = bias + argument length
#define FRT_PROBE_ARG "abc"
#define FRT_PROBE_BAS_ARG "hello"
#define FRT_PROBE_NUM_BUF 16
#define FRT_SEVENTH_WEIGHT 100 // frtExtSeven: the seventh argument counts this much
#define FRT_TERM_COLS 100 // caseTermBind: the Terminal's new size
#define FRT_TERM_ROWS 30
#define FRT_BIND_MAX 64 // caseTermBind: bytes the bound stream keeps
#define FRT_APPS_DIR FRT_INCLUDE_DIR "/../../apps/kpunch"
#define FRT_APP_PATH_MAX 512
#define FRT_CLASS_WRAP_LEN (BAS_MAX_IDENT + 64) // the BEGINCLASS / ENDCLASS lines around a class module, separators and NUL
// Clipboard / color dialog / drag and drop cases.
#define FRT_COLOR_START 0x123456
#define FRT_DRAG_BAD_ACTION 7
#define FRT_FORM_EDGE 30 // above the form's content bottom (empty form area, clear of the resize border)
// Program-port cases (menu keys, Default/Cancel, list methods).
#define SETTLE_FRAMES_FRT 2 // frames for a key-released button's Click
#define MENU_SHORTCUT_COUNT 3 // Shortcut items of caseMenuShortcuts
#define FRT_ICON_FRM_LEN 4096 // caseProgramIcon: its .frm, with the files' paths
#define SCAN_B 0x30 // scancode of B
#define KEY_CTRL_B 0x02 // Ctrl+B's ASCII code
#define LV_SECOND_COL_X 140 // inside the second column of "Name,14|Size,12" (from the list's left edge)
#define LV_HEADER_Y 6 // inside the header row (from the list's top edge)
#define FRT_CHOICE_MANY 300 // DlgChoice items in caseDialogWrappers (over 64, over 1024 bytes)
#define FRT_CHOICE_ITEM_LEN 16 // room for one "|keyword nnn"
#define FRT_HELP_OUT_MAX 256 // caseHelpPane: the expected PRINT output
#define FRT_SRC_BUF 32768 // a case's BASIC source with an include file in front
#define FRT_GUTTER_X 4 // inside a TextArea's line-number gutter (from its left edge)
#define FRT_LINE_Y 4 // inside a TextArea's first line (from its top edge)
#define FRT_PARDSGN_FRM FRT_INCLUDE_DIR "/../../test/dos/fixtures/pardsgn/pardsgn.frm"
#define FRT_PARDSGN_TICKS 50 // clock steps the fixture gets to run its checks
#define FRT_PARDSGN_TICK_MS 100
#define FRT_DYN_TYPE "frtdyn" // caseDynamicControl's widget type
#define FRT_DYN_BAS "FrtDyn"
#define FRT_DYN_LEVEL 9
#define FRT_DYN_TEXT 64
#define SIZE_TEST_CHARS 10 // caseSizeUnits: SizeChars(10)
#define SIZE_PERCENT_MAX 100 // SizePercent's cap
// Widget-independent line prefix of every round-trip form.
#define RT_FORM_HEADER \
"VERSION DVX 1.00\n" \
"Begin Form Form1\n" \
" Caption = \"Round Trip\"\n" \
" Width = 400\n" \
" Height = 300\n" \
" Resizable = True\n" \
" AutoSize = False\n" \
" Centered = True\n" \
" Layout = \"VBox\"\n" \
" HelpTopic = \"formHelp\"\n"
// Menu block shared by the round-trip forms: a bar menu and a popup so
// ContextMenu has something to bind to. Menus are asserted by state
// (the runtime keeps no name for menu headers), so the serializer
// leaves them out and the comparison starts at the first control.
#define RT_FORM_MENUS \
" Begin Menu mnuPop\n" \
" Caption = \"Popup\"\n" \
" Visible = False\n" \
" Begin Menu mnuPopItem\n" \
" Caption = \"Pop Item\"\n" \
" End\n" \
" End\n"
// BASIC-facing entry points live in formrt.c without a header (they
// are reached through DECLARE LIBRARY on DOS).
static void caseObjectRefs(void);
void CommAttach(int32_t handle, const char *termCtrlName, int32_t channel, int32_t encrypt);
void CommClose(int32_t handle);
void CommDetach(int32_t handle);
int32_t CommHandshake(int32_t handle, const char *passphrase);
int32_t CommIsReady(int32_t handle);
int32_t CommOpen(int32_t com, int32_t baud, int32_t dataBits, const char *parity, int32_t stopBits, int32_t handshake);
int32_t CommPending(int32_t handle);
int32_t CommPoll(int32_t handle);
const uint8_t *CommRecv(int32_t handle, int32_t channel, int32_t *outLen);
int32_t CommRecvEncrypted(int32_t handle, int32_t channel);
int32_t CommSend(int32_t handle, const uint8_t *data, int32_t len, int32_t channel, int32_t encrypt);
int32_t CommSetPlain(int32_t handle, int32_t channel, int32_t plain);
int32_t DlgChoice(const char *title, const char *prompt, const char *items, int32_t defaultIdx);
int32_t DlgColor(const char *title, int32_t defaultColor);
const char *DlgFileOpen(const char *title, const char *filter);
const char *DlgFileOpenIn(const char *title, const char *filter, const char *folder);
const char *DlgFileSave(const char *title, const char *filter);
const char *DlgFileSaveIn(const char *title, const char *filter, const char *folder);
const char *DlgInputBox(const char *title, const char *prompt, const char *defaultText);
int32_t DlgInputCancelled(void);
int32_t DlgIntInput(const char *title, const char *prompt, int32_t defaultVal, int32_t minVal, int32_t maxVal);
int32_t DlgIntInputStep(const char *title, const char *prompt, int32_t defaultVal, int32_t minVal, int32_t maxVal, int32_t stepVal);
int32_t DlgPromptSave(const char *title);
int32_t HelpCompile(const char *inputFile, const char *outputFile);
const char *HelpCompileMessages(void);
void HelpView(const char *hlpFile);
void HelpViewTopic(const char *hlpFile, const char *topicId);
int32_t ResAddData(const char *path, const char *name, int32_t type, const uint8_t *data, int32_t len);
int32_t ResAddFile(const char *path, const char *name, int32_t type, const char *srcFile);
int32_t ResAddText(const char *path, const char *name, const char *text);
void ResClose(int32_t handle);
int32_t ResCount(int32_t handle);
int32_t ResExtract(const char *path, const char *name, const char *outFile);
const uint8_t *ResGetData(const char *path, const char *name, int32_t *outLen);
const char *ResGetText(const char *path, const char *name);
const char *ResName(int32_t handle, int32_t index);
int32_t ResOpen(const char *path);
int32_t ResRemove(const char *path, const char *name);
int32_t ResSize(int32_t handle, int32_t index);
int32_t ResType(int32_t handle, int32_t index);
void SerAttach(int32_t com, const char *termCtrlName);
int32_t SerAvailable(int32_t com);
void SerClose(int32_t com);
void SerDetach(int32_t com);
void SerFlush(int32_t com);
int32_t SerGetBase(int32_t com);
int32_t SerGetCts(int32_t com);
int32_t SerGetDcd(int32_t com);
int32_t SerGetDsr(int32_t com);
int32_t SerGetDtr(int32_t com);
int32_t SerGetIrq(int32_t com);
int32_t SerGetRts(int32_t com);
int32_t SerGetUart(int32_t com);
int32_t SerOpen(int32_t com, int32_t baud, int32_t dataBits, const char *parity, int32_t stopBits, int32_t handshake);
const uint8_t *SerRead(int32_t com, int32_t *outLen);
void SerSetBase(int32_t com, int32_t base);
void SerSetDtr(int32_t com, int32_t on);
void SerSetIrq(int32_t com, int32_t irq);
void SerSetRts(int32_t com, int32_t on);
int32_t SerWrite(int32_t com, const uint8_t *data, int32_t len);
int32_t SQLAffected(int32_t db);
void SQLClose(int32_t db);
int32_t SQLEof(int32_t rs);
const char *SQLError(int32_t db);
int32_t SQLExec(int32_t db, const char *sql);
const char *SQLField(int32_t rs, const char *colName);
int32_t SQLFieldCount(int32_t rs);
double SQLFieldDbl(int32_t rs, int32_t col);
int32_t SQLFieldInt(int32_t rs, int32_t col);
const char *SQLFieldName(int32_t rs, int32_t col);
const char *SQLFieldText(int32_t rs, int32_t col);
void SQLFreeResult(int32_t rs);
int32_t SQLNext(int32_t rs);
int32_t SQLOpen(const char *path);
int32_t SQLQuery(int32_t db, const char *sql);
typedef struct {
int32_t seen;
int32_t result;
char title[64];
char button[16];
} DialogCtxT;
// caseNewArgs' message box script
typedef struct {
FrtAppT *app;
int32_t seen;
bool firedDuring; // NewArgs ran while the box was open
} NewArgsDlgT;
// Modal-dialog driver: type text and accept with OK, or cancel with
// Esc when no text is given.
typedef struct {
const char *typeText;
int32_t seen;
bool busy; // re-entry guard: tType pumps frames, which re-fires the script
} FileDlgCtxT;
// caseVisibleKeepsModal's dialog script: the app and how often it ran.
static FrtAppT *sModalCheckApp = NULL;
static int32_t sModalChecks = 0;
// frmParse unit-test recorder.
typedef struct {
int32_t forms;
int32_t formProps;
int32_t menus;
int32_t menuProps;
int32_t menuEnds;
int32_t ctrls;
int32_t ctrlProps;
int32_t ctrlEnds;
int32_t lastMenuLevel;
char lastType[FRM_MAX_TOKEN_LEN];
char lastKey[FRM_MAX_TOKEN_LEN];
char lastVal[FRM_MAX_LINE_LEN];
char tail[64];
bool failFormBegin;
} ParseRecT;
// Cases in their own files (testLibBas.c, testFrmModel.c, testUserCtl.c,
// testUcDesign.c)
void frtFrmModelCases(void);
void frtLibBasCases(void);
void frtUcDesignCases(void);
void frtUserCtlCases(void);
static bool appBuild(FrtAppT *app, const char *frmPath, const char *clsPath, const char *stubs, const char *tests);
static BasValueT callIntM(FrtAppT *app, BasControlT *ctrl, const char *method, const int32_t *vals, int32_t count);
static void caseAppBasDemo(void);
static void caseAppCommandLine(void);
static void caseAppIconEd(void);
static void caseAppNotepad(void);
static void caseAppNotepadCloseRequest(void);
static void caseBoxLayoutProps(void);
static void caseBuildProject(void);
static void caseClipboard(void);
static void caseCommonMethods(void);
static void caseControlArrays(void);
static void caseControlMembers2(void);
static void caseCreateFormDynamic(void);
static void caseCustomEvents(void);
static void caseDataBinding(void);
static void caseDefaultCancelButtons(void);
static void caseDesignerLive(void);
static void caseDesignerRegistry(void);
static void caseDialogWrappers(void);
static void caseDragDrop(void);
static void caseDrawMethods(void);
static void caseDrawPaint(void);
static void caseDrawScale(void);
static void caseDrawThemed(void);
static void caseDynamicControl(void);
static void caseEditorMembers(void);
static void caseEventLoopExits(void);
static void caseEvents(void);
static void caseExternCalls(void);
static void caseExternLive(void);
static void caseExternMarshal(void);
static void caseFormInstances(void);
static void caseFormShowHide(void);
static void caseFormVars(void);
static void caseFormWindowMembers(void);
static void caseFrameMissed(void);
static void caseFrmLoadEdges(void);
static void caseFrmParserUnit(void);
static void caseHandlerContext(void);
static void caseHandlerError(void);
static void caseHelpHooks(void);
static void caseHelpPane(void);
static void caseHelpTopic(void);
static void caseListTreeMethods(void);
static void caseLoadForm2(void);
static void caseMenuBarRuntime(void);
static void caseMenuCaption(void);
static void caseMenuRuntime(void);
static void caseMenus(void);
static void caseMenuShortcuts(void);
static void caseMethodRetIntStr(void);
static void caseMethodSignatures(void);
static void caseModalShow(void);
static void caseMsgBox(void);
static void caseNewArgs(void);
static void caseParDsgnFixture(void);
static void casePendingUnloadDrain(void);
static void casePictureLoadSave(void);
static void casePopupMenu(void);
static void caseProgramIcon(void);
static void caseProgramScreen(void);
static void caseProgramScreenModes(void);
static void casePropEdges(void);
static void casePropTables(void);
static void caseQueryUnloadCancel(void);
static void caseRefValidation(void);
static void caseRemoveContainerFromHandler(void);
static void caseResetCycles(void);
static void caseResources(void);
static void caseRoundTrip(void);
static void caseRunSimple(void);
static void caseRuntimeError(void);
static void caseScreenMembers(void);
static void caseScreenObject(void);
static void caseSerialLoopback(void);
static void caseSerialUnresolved(void);
static void caseSetEvent(void);
static void caseSqlWrappers(void);
static void caseTermBind(void);
static void caseTextBoxProps(void);
static void caseTimers(void);
static void caseToolbarClearFromHandler(void);
static void caseTwoRuntimes(void);
static void caseUnloadDeferred(void);
static void caseValidateCancel(void);
static void caseVisibleKeepsModal(void);
static void caseWidgetParity(void);
static void caseWindowState(void);
static WidgetT *childAt(WidgetT *w, int32_t idx);
static const char *commRecvText(int32_t handle, int32_t channel);
static int32_t commSendText(int32_t handle, const char *text, int32_t channel, int32_t encrypt);
static void dialogClick(AppContextT *ctx, WindowT *modal, void *userCtx);
static void dragCallMethod(FrtAppT *app, BasControlT *ctrl, int32_t action);
static void drawThemedHBarCheck(WidgetT *pic);
static void errorDialogCheck(AppContextT *ctx, WindowT *modal, void *userCtx);
static bool expectBuild(FrtAppT *app, const char *bas, const char *const *frms, int32_t frmCount);
static void fileDialogType(AppContextT *ctx, WindowT *modal, void *userCtx);
static WidgetT *firstFocusable(WidgetT *root);
static bool frtDynCall(WidgetT *w, int32_t methodIdx, const WgtValueT *args, int32_t argc, WgtValueT *ret);
static WidgetT *frtDynCreate(WidgetT *parent, const WgtIfaceT *iface);
static bool frtDynGet(WidgetT *w, int32_t propIdx, WgtValueT *out);
static bool frtDynSet(WidgetT *w, int32_t propIdx, const WgtValueT *value);
static int32_t frtProbeRetIntStr(WidgetT *w, const char *text);
static void newArgsDuringDialog(AppContextT *ctx, WindowT *modal, void *userCtx);
static void outContains(const FrtAppT *app, const char *needle);
static void parseOnCtrlBegin(void *userData, const char *typeName, const char *name);
static void parseOnCtrlEnd(void *userData);
static void parseOnCtrlProp(void *userData, const char *key, const char *value);
static bool parseOnFormBegin(void *userData, const char *name);
static void parseOnFormEnd(void *userData, const char *rest, int32_t restLen);
static void parseOnFormProp(void *userData, const char *key, const char *value);
static void parseOnMenuBegin(void *userData, const char *name, int32_t level);
static void parseOnMenuEnd(void *userData);
static void parseOnMenuProp(void *userData, const char *key, const char *value);
static const char *roundTripValue(const char *basName, const WgtPropDescT *p, char *buf, int32_t bufSize);
static const char *serReadText(int32_t com);
static int32_t serWriteText(int32_t com, const char *text);
static void setStrProp(FrtAppT *app, BasControlT *ctrl, const char *propName, const char *text);
static int32_t sqlFakeAffected(int32_t db);
static void sqlFakeClose(int32_t db);
static bool sqlFakeEof(int32_t rs);
static const char *sqlFakeError(int32_t db);
static bool sqlFakeExec(int32_t db, const char *sql);
static const char *sqlFakeFieldByName(int32_t rs, const char *name);
static int32_t sqlFakeFieldCount(int32_t rs);
static double sqlFakeFieldDbl(int32_t rs, int32_t col);
static int32_t sqlFakeFieldInt(int32_t rs, int32_t col);
static const char *sqlFakeFieldName(int32_t rs, int32_t col);
static const char *sqlFakeFieldText(int32_t rs, int32_t col);
static void sqlFakeFree(int32_t rs);
static bool sqlFakeNext(int32_t rs);
static int32_t sqlFakeOpen(const char *path);
static int32_t sqlFakeQuery(int32_t db, const char *sql);
static void termBindUnbound(void *ctx);
static int32_t termBindWrite(void *ctx, const uint8_t *data, int32_t len);
static void unloadModalCheck(AppContextT *ctx, WindowT *modal, void *userCtx);
static void visibleKeepsModalCheck(AppContextT *ctx, WindowT *modal, void *userCtx);
static bool writeText(const char *path, const char *text);
int main(void);
// Extern-call targets: exported (non-static, -rdynamic) so DECLARE
// LIBRARY declarations resolve them through basExternResolve's
// dlsym(NULL, ...). The host basNativeCall stub never actually calls
// them; only their addresses matter.
int32_t frtExtBinSum(const uint8_t *d, int32_t len, const char *tag, const uint8_t *d2, int32_t len2);
double frtExtDbl(double d, float s);
int32_t frtExtFlag(int32_t a);
int32_t frtExtInt(int32_t a);
int32_t frtExtLong(int32_t a, int32_t b);
double frtExtMix(const char *s, double d, int32_t n, float f);
int32_t frtExtSeven(int32_t a, int32_t b, int32_t c, int32_t d, int32_t e, int32_t f, int32_t g);
const char *frtExtStr(const char *s);
void frtExtSub(int32_t a);
const uint8_t *frtExtXor(const uint8_t *data, int32_t len, int32_t key, int32_t *outLen);
// caseTermBind: what the bound stream received, and how often it was
// told the binding ended.
static char sBindText[FRT_BIND_MAX];
static int32_t sBindLen = 0;
static int32_t sBindUnbound = 0;
// errorDialogCheck: how often a modal box came up, and the last one's
// title
typedef struct {
int32_t seen;
char title[64];
} ErrorDlgT;
// caseDynamicControl: a control class with a dynamic interface; Title
// is stored here, Level reads 9, Ping returns its argument count and
// records the argument kinds (S / I / F / B).
static char sFrtDynTitle[FRT_DYN_TEXT];
static char sFrtDynArgTypes[FRT_DYN_TEXT];
static int32_t sFrtDynType = -1;
static const WidgetClassT sFrtDynClass = { .version = WGT_CLASS_VERSION };
static const WgtPropDescT sFrtDynProps[] = {
{ "Title", WGT_IFACE_STRING, WGT_DYN_ACCESS, WGT_DYN_ACCESS, NULL },
{ "Level", WGT_IFACE_INT, WGT_DYN_ACCESS, NULL, NULL },
};
static const WgtMethodDescT sFrtDynMethods[] = {
{ "Ping", WGT_SIG_DYNAMIC, WGT_DYN_ACCESS },
};
static const WgtDynIfaceT sFrtDynHooks = {
.create = frtDynCreate,
.getProp = frtDynGet,
.setProp = frtDynSet,
.callMethod = frtDynCall
};
static const WgtIfaceT sFrtDynIface = {
.basName = FRT_DYN_BAS,
.props = sFrtDynProps,
.propCount = DVX_ARRAY_LEN(sFrtDynProps),
.methods = sFrtDynMethods,
.methodCount = DVX_ARRAY_LEN(sFrtDynMethods),
.dyn = &sFrtDynHooks
};
// Test-only method table: a status-returning string method
// (WGT_SIG_RET_INT_STR) that no shipped widget has to provide.
static char sProbeArg[FRT_APP_PATH_MAX];
static const WgtMethodDescT sProbeMethods[] = {
{ "Probe", WGT_SIG_RET_INT_STR, (void *)frtProbeRetIntStr }
};
// Build a shipped BASIC app's .frm with stubs spliced in at the start of
// its code section (standing in for the app's commdlg.bas module, so the
// dialogs are scripted) and test SUBs appended at the end. The real
// fileops.bas, help.bas and print.bas are the module source, as in the
// apps' projects (HelpView resolves to the stub library; the file
// operations and printing functions are only declared, the tests never
// call them).
static bool appBuild(FrtAppT *app, const char *frmPath, const char *clsPath, const char *stubs, const char *tests) {
int32_t len = 0;
int32_t fopsLen = 0;
int32_t helpLen = 0;
int32_t printLen = 0;
int32_t clsLen = 0;
char *frm = platformReadFile(frmPath, &len);
char *fopsBas = platformReadFile(FRT_INCLUDE_DIR "/fileops.bas", &fopsLen);
char *helpOnly = platformReadFile(FRT_INCLUDE_DIR "/help.bas", &helpLen);
char *printBas = platformReadFile(FRT_INCLUDE_DIR "/print.bas", &printLen);
char *cls = clsPath ? platformReadFile(clsPath, &clsLen) : NULL;
size_t helpCap = (size_t)fopsLen + (size_t)helpLen + (size_t)printLen + (size_t)clsLen + FRT_CLASS_WRAP_LEN;
char *helpBas = (fopsBas && helpOnly && printBas) ? (char *)malloc(helpCap) : NULL;
TEST_TRUE(frm != NULL);
TEST_TRUE(helpBas != NULL);
TEST_TRUE(!clsPath || cls != NULL);
// The modules, then the class module wrapped as the project builder
// wraps it
if (helpBas) {
char className[BAS_MAX_IDENT] = "";
if (cls) {
basExtractClassName(cls, clsLen, clsPath, className, (int32_t)sizeof(className));
}
snprintf(helpBas, helpCap, cls ? "%s\n%s\n%s\nBEGINCLASS \"%s\"\n%s\nENDCLASS\n" : "%s\n%s\n%s", fopsBas, helpOnly, printBas, className, cls ? cls + basClassCodePos(cls, clsLen) : "");
}
free(fopsBas);
free(helpOnly);
free(printBas);
free(cls);
if (!frm || !helpBas) {
free(frm);
free(helpBas);
return false;
}
int32_t codeOff = basFindFormEndPos(frm, len);
size_t stubLen = strlen(stubs);
size_t testLen = strlen(tests);
char *all = (char *)malloc((size_t)len + stubLen + testLen + 1);
bool ok = false;
if (all) {
memcpy(all, frm, (size_t)codeOff);
memcpy(all + codeOff, stubs, stubLen);
memcpy(all + codeOff + stubLen, frm + codeOff, (size_t)(len - codeOff));
memcpy(all + len + stubLen, tests, testLen + 1);
const char *frms[1] = { all };
ok = expectBuild(app, helpBas, frms, 1);
}
free(all);
free(frm);
free(helpBas);
return ok;
}
static BasValueT callIntM(FrtAppT *app, BasControlT *ctrl, const char *method, const int32_t *vals, int32_t count) {
BasValueT args[8];
for (int32_t i = 0; i < count; i++) {
args[i] = basValLong(vals[i]);
}
return basFormRtCallMethod(app->rt, ctrl, method, args, count);
}
// basdemo: the DATA demo runs twice (RESTORE rewinds), the Graphics menu
// opened twice keeps one form with its 4 controls, and the dynamic form
// gets its caption.
static void caseAppBasDemo(void) {
tCase("app basdemo: DATA twice, Graphics twice, DynForm caption, Objects");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
static const char stubs[] =
"\n"
"CONST DVX_SAVE_YES = 1\n"
"FUNCTION DlgFileSave$(BYVAL title AS STRING, BYVAL filter AS STRING) AS STRING\n"
" DlgFileSave$ = \"\"\n"
"END FUNCTION\n"
"FUNCTION DlgInputBox$(BYVAL t AS STRING, BYVAL p AS STRING, BYVAL d AS STRING) AS STRING\n"
" DlgInputBox$ = d\n"
"END FUNCTION\n"
"FUNCTION DlgChoice(BYVAL t AS STRING, BYVAL p AS STRING, BYVAL i AS STRING, BYVAL d AS INTEGER) AS INTEGER\n"
" DlgChoice = d\n"
"END FUNCTION\n"
"FUNCTION DlgIntInput(BYVAL t AS STRING, BYVAL p AS STRING, BYVAL d AS LONG, BYVAL a AS LONG, BYVAL b AS LONG) AS LONG\n"
" DlgIntInput = d\n"
"END FUNCTION\n";
static const char tests[] =
"\n"
"SUB BasicDemo_B1\n"
" btnData_Click\n"
" btnData_Click\n"
" PRINT \"B1 ok\"\n"
"END SUB\n"
"SUB BasicDemo_B2\n"
" mnuGraphics_Click\n"
" mnuGraphics_Click\n"
" mnuDynamic_Click\n"
" PRINT \"B2 ok\"\n"
"END SUB\n"
"SUB BasicDemo_B3\n"
" mnuObjects_Click\n"
" PRINT \"B3 ok\"\n"
"END SUB\n";
FrtAppT app;
if (!appBuild(&app, FRT_APPS_DIR "/basdemo/basdemo.frm", FRT_APPS_DIR "/basdemo/shape.cls", stubs, tests)) {
tShutdown();
return;
}
frtStart(&app, "BasicDemo");
TEST_TRUE(frtFire(&app, "BasicDemo", "B1"));
TEST_TRUE(frtFire(&app, "BasicDemo", "B2"));
TEST_TRUE(frtFire(&app, "BasicDemo", "B3"));
TEST_STR_EQ(frtOut(&app), "B1 ok\nB2 ok\nB3 ok\n");
TEST_EQ(app.dialogsDismissed, 0);
BasFormT *main = frtForm(&app, "BasicDemo");
BasFormT *gfx = frtForm(&app, "GraphicsForm");
BasFormT *dyn = frtForm(&app, "DynForm");
// Each DATA run prints the three colors and the re-read first one.
const char *out = (main && frtCtrl(main, "OutArea")) ? wgtGetText(frtCtrl(main, "OutArea")->widget) : NULL;
int32_t firsts = 0;
for (const char *p = out; p && (p = strstr(p, "first = Red")) != NULL; p++) {
firsts++;
}
TEST_EQ(firsts, 2);
// The Objects demo: two Shapes from the class module through a
// Collection and FOR EACH
TEST_TRUE(out && strstr(out, "square of size 2, area 4") != NULL);
TEST_TRUE(out && strstr(out, "Shapes: 2, total area") != NULL);
TEST_TRUE(out && strstr(out, "The one called ROUND is a circle") != NULL);
TEST_TRUE(out && strstr(out, "TypeName(s) = Shape, s Is shapes(2): yes") != NULL);
TEST_TRUE(gfx != NULL);
TEST_EQ(gfx ? (int32_t)arrlen(gfx->controls) : -1, 4);
TEST_TRUE(dyn && dyn->window);
TEST_STR_EQ((dyn && dyn->window) ? dyn->window->title : "", "Dynamic Form (built in code)");
frtDestroy(&app);
tShutdown();
}
// The document programs open the file named on their command line
// (COMMAND$(1)) when they start: Notepad (a text file, and a missing one
// reported with the window left empty), Image Viewer and Icon Editor (an
// icon-sized picture).
static void caseAppCommandLine(void) {
static const char stubs[] =
"\n"
"CONST DVX_SAVE_YES = 1\n"
"CONST DVX_SAVE_NO = 2\n"
"CONST DVX_SAVE_CANCEL = 3\n"
"FUNCTION DlgPromptSave(BYVAL title AS STRING) AS INTEGER\n"
" DlgPromptSave = DVX_SAVE_NO\n"
"END FUNCTION\n"
"FUNCTION DlgFileSave$(BYVAL title AS STRING, BYVAL filter AS STRING) AS STRING\n"
" DlgFileSave$ = \"\"\n"
"END FUNCTION\n"
"FUNCTION DlgFileOpen$(BYVAL title AS STRING, BYVAL filter AS STRING) AS STRING\n"
" DlgFileOpen$ = \"\"\n"
"END FUNCTION\n";
static const struct {
const char *frm;
const char *form;
const char *test;
const char *arg; // NULL: the text file written below
const char *expected; // %s = the argument
int32_t dismissed; // error boxes
} runs[] = {
{ "/notepad/notepad.frm", "NotepadForm", "SUB NotepadForm_C\n PRINT NotepadForm.Caption; LEN(Editor.Text); dirty\nEND SUB\n", NULL, "%s - Notepad5 False \n", 0 },
{ "/notepad/notepad.frm", "NotepadForm", "SUB NotepadForm_C\n PRINT NotepadForm.Caption; LEN(Editor.Text); dirty\nEND SUB\n", "/nonexistent/dir/x.txt", "Untitled - Notepad0 False \n", 1 },
{ "/imgview/imgview.frm", "ImgViewForm", "SUB ImgViewForm_C\n PRINT ImgViewForm.Caption; ImgDisplay.Picture = COMMAND$(1)\nEND SUB\n", FRT_APPS_DIR "/imgview/ICON32.BMP", "%s - Image ViewerTrue \n", 0 },
{ "/iconed/iconed.frm", "IconEd", "SUB IconEd_C\n PRINT filePath = COMMAND$(1); iconW; dirty\nEND SUB\n", FRT_APPS_DIR "/iconed/ICON32.BMP", "True 32 False \n", 0 }
};
char textPath[FRT_APP_PATH_MAX];
char frmPath[FRT_APP_PATH_MAX];
char expect[FRT_APP_PATH_MAX * 2];
for (int32_t i = 0; i < DVX_ARRAY_LEN(runs); i++) {
FrtAppT app;
const char *arg = runs[i].arg;
tCase("app command line: the named file opens at start");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
snprintf(textPath, sizeof(textPath), "%s/cmdLine.txt", tTempDir());
TEST_TRUE(writeText(textPath, "\n\nabc\n"));
snprintf(frmPath, sizeof(frmPath), "%s%s", FRT_APPS_DIR, runs[i].frm);
if (!arg) {
arg = textPath;
}
if (!appBuild(&app, frmPath, NULL, stubs, runs[i].test)) {
tShutdown();
return;
}
TEST_TRUE(basVmSetCommand(app.vm, arg));
frtStart(&app, runs[i].form);
TEST_TRUE(frtFire(&app, runs[i].form, "C"));
snprintf(expect, sizeof(expect), runs[i].expected, arg);
TEST_STR_EQ(frtOut(&app), expect);
TEST_EQ(app.dialogsDismissed, runs[i].dismissed);
frtDestroy(&app);
tShutdown();
}
}
// iconed: a declined size change keeps the old menu check, a 16x16 icon
// saves as 16x16 and reloads, a failed save keeps the icon dirty, and a
// non-image file or an image that is not an icon size is rejected
// without touching the icon.
static void caseAppIconEd(void) {
tCase("app iconed: size change, save/reload, bad paths");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
static const char stubs[] =
"\n"
"CONST DVX_SAVE_YES = 1\n"
"CONST DVX_SAVE_NO = 2\n"
"CONST DVX_SAVE_CANCEL = 3\n"
"DIM SHARED scriptPath AS STRING\n"
"FUNCTION DlgPromptSave(BYVAL title AS STRING) AS INTEGER\n"
" DlgPromptSave = DVX_SAVE_YES\n"
"END FUNCTION\n"
"FUNCTION DlgFileSave$(BYVAL title AS STRING, BYVAL filter AS STRING) AS STRING\n"
" DlgFileSave$ = scriptPath\n"
"END FUNCTION\n"
"FUNCTION DlgFileOpen$(BYVAL title AS STRING, BYVAL filter AS STRING) AS STRING\n"
" DlgFileOpen$ = scriptPath\n"
"END FUNCTION\n";
static const char testsFmt[] =
"\n"
"SUB IconEd_I1\n"
" curColor = &H00FF0000\n"
" SetIconPixel 0, 0\n"
" mnuSize16.Checked = True\n"
" mnuSize16_Click\n"
" PRINT \"I1\"; iconW; mnuSize16.Checked; mnuSize32.Checked\n"
"END SUB\n"
"SUB IconEd_I2\n"
" mnuSize16.Checked = True\n"
" mnuSize16_Click\n"
" curColor = &H000000FF\n"
" SetIconPixel 3, 4\n"
" scriptPath = \"%s\"\n"
" mnuSave_Click\n"
" PRINT \"I2\"; iconW; dirty\n"
"END SUB\n"
"SUB IconEd_I3\n"
" SetIconPixel 5, 5\n"
" scriptPath = \"/nonexistent/dir/x.png\"\n"
" mnuSave_Click\n"
" PRINT \"I3\"; dirty\n"
"END SUB\n"
"SUB IconEd_I4\n"
" dirty = False\n"
" scriptPath = \"%s\"\n"
" mnuOpen_Click\n"
" PRINT \"I4\"; iconW; filePath = \"%s\"\n"
"END SUB\n"
"SUB IconEd_I5\n"
" mnuSize32.Checked = True\n"
" mnuSize32_Click\n"
" scriptPath = \"%s\"\n"
" mnuOpen_Click\n"
" PRINT \"I5\"; iconW; mnuSize16.Checked; HEX$(pixels(3, 4)); \" \"; HEX$(pixels(0, 0)); dirty\n"
"END SUB\n"
"SUB IconEd_I6\n"
" IF cvPalette.Save(\"%s\") <> 0 THEN\n"
" PRINT \"palette save failed\"\n"
" END IF\n"
" scriptPath = \"%s\"\n"
" mnuOpen_Click\n"
" PRINT \"I6\"; iconW; cvPreview.ImageWidth; HEX$(cvPreview.GetPixel(3, 4)); filePath = \"%s\"\n"
"END SUB\n";
static const char *const steps[] = { "I1", "I2", "I3", "I4", "I5", "I6" };
static const char *const answers[] = { "No", "Yes", "OK", "OK", "Yes", "OK" };
char pngPath[FRT_APP_PATH_MAX];
char txtPath[FRT_APP_PATH_MAX];
char bigPath[FRT_APP_PATH_MAX];
char tests[sizeof(testsFmt) + 7 * FRT_APP_PATH_MAX];
DialogCtxT dlg;
FrtAppT app;
snprintf(pngPath, sizeof(pngPath), "%s/iconedOut.png", tTempDir());
snprintf(txtPath, sizeof(txtPath), "%s/iconedNotImage.txt", tTempDir());
TEST_TRUE(writeText(txtPath, "not an image\n"));
snprintf(bigPath, sizeof(bigPath), "%s/iconedNotIcon.png", tTempDir());
snprintf(tests, sizeof(tests), testsFmt, pngPath, txtPath, pngPath, pngPath, bigPath, bigPath, pngPath);
if (!appBuild(&app, FRT_APPS_DIR "/iconed/iconed.frm", NULL, stubs, tests)) {
tShutdown();
return;
}
memset(&dlg, 0, sizeof(dlg));
tDialogScript(dialogClick, &dlg);
frtStart(&app, "IconEd");
for (int32_t i = 0; i < DVX_ARRAY_LEN(steps); i++) {
snprintf(dlg.button, sizeof(dlg.button), "%s", answers[i]);
TEST_TRUE(frtFire(&app, "IconEd", steps[i]));
}
tDialogScript(NULL, NULL);
// I1 No, I2 Yes (size change of a dirty icon), I3 save error, I4 load
// error; I5 changes the size of a clean icon without asking; I6 opens
// an image that is not an icon size: refused, the icon and its
// preview stay as they were.
TEST_EQ(dlg.seen, 5);
TEST_STR_EQ(frtOut(&app), "I132 False True \nI216 False \nI3True \nI416 True \nI516 True FF C0C0C0False \nI616 16 FFTrue \n");
frtDestroy(&app);
tShutdown();
}
// notepad: a cancelled Save As keeps AskSave at 1, a save clears the dirty
// flag and names the file in the caption, leading blank lines survive an
// open, and a save to a bad path reports the error without halting.
static void caseAppNotepad(void) {
tCase("app notepad: AskSave, save, open, bad path");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
static const char stubs[] =
"\n"
"CONST DVX_SAVE_YES = 1\n"
"CONST DVX_SAVE_NO = 2\n"
"CONST DVX_SAVE_CANCEL = 3\n"
"DIM SHARED scriptPrompt AS INTEGER\n"
"DIM SHARED scriptPath AS STRING\n"
"FUNCTION DlgPromptSave(BYVAL title AS STRING) AS INTEGER\n"
" DlgPromptSave = scriptPrompt\n"
"END FUNCTION\n"
"FUNCTION DlgFileSave$(BYVAL title AS STRING, BYVAL filter AS STRING) AS STRING\n"
" DlgFileSave$ = scriptPath\n"
"END FUNCTION\n"
"FUNCTION DlgFileOpen$(BYVAL title AS STRING, BYVAL filter AS STRING) AS STRING\n"
" DlgFileOpen$ = scriptPath\n"
"END FUNCTION\n";
static const char testsFmt[] =
"\n"
"SUB NotepadForm_T1\n"
" Editor.Text = \"hello world\"\n"
" Editor_Change\n"
" scriptPrompt = DVX_SAVE_YES\n"
" scriptPath = \"\"\n"
" PRINT \"T1\"; AskSave()\n"
"END SUB\n"
"SUB NotepadForm_T2\n"
" scriptPath = \"%s\"\n"
" PRINT \"T2\"; AskSave(); dirty\n"
" PRINT NotepadForm.Caption\n"
"END SUB\n"
"SUB NotepadForm_T3\n"
" scriptPrompt = DVX_SAVE_NO\n"
" scriptPath = \"%s\"\n"
" mnuOpen_Click\n"
" PRINT \"T3\"; LEN(Editor.Text); dirty\n"
"END SUB\n"
"SUB NotepadForm_T4\n"
" currentFile = \"/nonexistent/dir/x.txt\"\n"
" Editor.Text = \"changed\"\n"
" Editor_Change\n"
" mnuSave_Click\n"
" PRINT \"T4\"; dirty\n"
"END SUB\n";
static const char *const steps[] = { "T1", "T2", "T3", "T4" };
char outPath[FRT_APP_PATH_MAX];
char inPath[FRT_APP_PATH_MAX];
char tests[sizeof(testsFmt) + 2 * FRT_APP_PATH_MAX];
FrtAppT app;
snprintf(outPath, sizeof(outPath), "%s/notepadOut.txt", tTempDir());
snprintf(inPath, sizeof(inPath), "%s/notepadIn.txt", tTempDir());
TEST_TRUE(writeText(inPath, "\n\nabc\n"));
snprintf(tests, sizeof(tests), testsFmt, outPath, inPath);
if (!appBuild(&app, FRT_APPS_DIR "/notepad/notepad.frm", NULL, stubs, tests)) {
tShutdown();
return;
}
frtStart(&app, "NotepadForm");
for (int32_t i = 0; i < DVX_ARRAY_LEN(steps); i++) {
TEST_TRUE(frtFire(&app, "NotepadForm", steps[i]));
}
char expect[sizeof(tests)];
snprintf(expect, sizeof(expect), "T11 \nT20 False \n%s - Notepad\nT35 False \nT4True \n", outPath);
TEST_STR_EQ(frtOut(&app), expect);
TEST_EQ(app.dialogsDismissed, 1);
frtDestroy(&app);
tShutdown();
}
// Exit DVX asks each app to close through dvxRequestWindowClose, inside
// a dispatch frame. For the real notepad that must run QueryUnload and
// its save prompt (a real message box here, as commdlg's is): Cancel
// keeps the form and its window, No and Yes unload it (Yes saving), and a
// clean document closes without a prompt. A prompt shows up in
// windowsCreated, which is how the shell tells Cancel from no response.
static void caseAppNotepadCloseRequest(void) {
static const char stubs[] =
"\n"
"CONST DVX_SAVE_YES = 1\n"
"CONST DVX_SAVE_NO = 2\n"
"CONST DVX_SAVE_CANCEL = 3\n"
"DIM SHARED scriptPath AS STRING\n"
"FUNCTION DlgPromptSave(BYVAL title AS STRING) AS INTEGER\n"
" SELECT CASE MsgBox(\"Save changes?\", 3, title)\n"
" CASE 3\n"
" DlgPromptSave = DVX_SAVE_YES\n"
" CASE 4\n"
" DlgPromptSave = DVX_SAVE_NO\n"
" CASE ELSE\n"
" DlgPromptSave = DVX_SAVE_CANCEL\n"
" END SELECT\n"
"END FUNCTION\n"
"FUNCTION DlgFileSave$(BYVAL title AS STRING, BYVAL filter AS STRING) AS STRING\n"
" DlgFileSave$ = scriptPath\n"
"END FUNCTION\n"
"FUNCTION DlgFileOpen$(BYVAL title AS STRING, BYVAL filter AS STRING) AS STRING\n"
" DlgFileOpen$ = scriptPath\n"
"END FUNCTION\n";
static const char testsFmt[] =
"\n"
"SUB NotepadForm_Dirty\n"
" scriptPath = \"%s\"\n"
" Editor.Text = \"unsaved\"\n"
" Editor_Change\n"
"END SUB\n";
static const struct {
bool dirty;
const char *answer;
bool kept;
bool saved;
} runs[] = {
{ false, "Cancel", false, false },
{ true, "Cancel", true, false },
{ true, "No", false, false },
{ true, "Yes", false, true }
};
char outPath[FRT_APP_PATH_MAX];
char tests[sizeof(testsFmt) + FRT_APP_PATH_MAX];
for (int32_t i = 0; i < DVX_ARRAY_LEN(runs); i++) {
FrtAppT app;
DialogCtxT dlg;
tCase("app notepad: close request runs QueryUnload and the save prompt");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
snprintf(outPath, sizeof(outPath), "%s/notepadClose.txt", tTempDir());
remove(outPath);
snprintf(tests, sizeof(tests), testsFmt, outPath);
if (!appBuild(&app, FRT_APPS_DIR "/notepad/notepad.frm", NULL, stubs, tests)) {
tShutdown();
return;
}
frtStart(&app, "NotepadForm");
if (runs[i].dirty) {
TEST_TRUE(frtFire(&app, "NotepadForm", "Dirty"));
}
BasFormT *form = frtForm(&app, "NotepadForm");
WindowT *win = form ? form->window : NULL;
TEST_TRUE(win != NULL);
if (!win) {
frtDestroy(&app);
tShutdown();
return;
}
uint32_t created = tCtx()->windowsCreated;
char title[MAX_TITLE_LEN];
snprintf(title, sizeof(title), "%s", win->title);
memset(&dlg, 0, sizeof(dlg));
snprintf(dlg.button, sizeof(dlg.button), "%s", runs[i].answer);
tDialogScript(dialogClick, &dlg);
tCtx()->dispatchDepth++;
dvxRequestWindowClose(tCtx(), win);
tCtx()->dispatchDepth--;
tPump(1);
tDialogScript(NULL, NULL);
TEST_EQ(tCtx()->windowsCreated != created, runs[i].dirty);
TEST_EQ(dlg.seen > 0, runs[i].dirty);
TEST_EQ(frtForm(&app, "NotepadForm") != NULL, runs[i].kept);
TEST_EQ(tFindWindow(title) != NULL && tFindWindow(title)->visible, runs[i].kept);
TEST_EQ(access(outPath, F_OK) == 0, runs[i].saved);
frtDestroy(&app);
tShutdown();
}
}
// Padding / Spacing of a form (its content box) and Alignment / Padding /
// Spacing of a box control, from the .frm and from code (0 = no gap).
static void caseBoxLayoutProps(void) {
tCase("box layout: form Padding/Spacing, HBox Alignment/Padding/Spacing");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm =
"Begin Form Form1\n"
" Caption = \"Boxes\"\n"
" Spacing = 8\n"
" Padding = 6\n"
" Begin HBox Box1\n"
" Alignment = Right\n"
" Spacing = 7\n"
" Padding = 3\n"
" Begin CommandButton Cmd1\n"
" Caption = \"A\"\n"
" End\n"
" End\n"
"End\n"
"\n"
"Sub Form1_Test\n"
" Print Me.Spacing; Me.Padding; Box1.Alignment; Box1.Spacing; Box1.Padding\n"
" Me.Spacing = 5\n"
" Box1.Padding = 0\n"
" Box1.Alignment = \"Center\"\n"
" Print Me.Spacing; Box1.Padding; Box1.Alignment\n"
"End Sub\n";
FrtAppT app;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
BasFormT *form = frtForm(&app, "Form1");
BasControlT *box = form ? frtCtrl(form, "Box1") : NULL;
BasControlT *cmd = form ? frtCtrl(form, "Cmd1") : NULL;
TEST_TRUE(form != NULL && box != NULL && cmd != NULL);
if (form && box && cmd) {
TEST_EQ(form->contentBox->spacing, wgtPixels(8));
TEST_EQ(form->contentBox->padding, wgtPixels(6));
TEST_EQ(box->widget->align, AlignEndE);
TEST_EQ(box->widget->spacing, wgtPixels(7));
TEST_EQ(cmd->widget->y, box->widget->y + 3);
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form1", "Test"));
TEST_STR_EQ(frtOut(&app), "8 6 2 7 3 \n5 0 1 \n");
TEST_EQ(form->contentBox->spacing, wgtPixels(5));
TEST_EQ(box->widget->padding, 0);
TEST_EQ(box->widget->align, AlignCenterE);
// Padding = 0 is no padding, not the default
tPump(1);
TEST_EQ(cmd->widget->y, box->widget->y);
}
frtDestroy(&app);
tShutdown();
}
static void caseBuildProject(void) {
tCase("basBuild project concat, source map and build errors");
char dir[DVX_MAX_PATH];
char path[DVX_MAX_PATH];
snprintf(dir, sizeof(dir), "frtBuildProj");
platformMkdirRecursive(dir);
// Module of 3 lines, then a form whose code section starts on file
// line 4 (three definition lines before it).
snprintf(path, sizeof(path), "%s/main.bas", dir);
TEST_TRUE(writeText(path, "PRINT 1\nPRINT 2\nPRINT 3\n"));
snprintf(path, sizeof(path), "%s/f1.frm", dir);
const char *frmText = "Begin\tForm F1\n Caption = \"x\"\nEnd\nSub F1_Load\nEnd Sub\n";
TEST_TRUE(writeText(path, frmText));
PrefsHandleT *prefs = prefsCreate();
BasProjectSourceT ps;
prefsSetString(prefs, BAS_INI_SECTION_MODULES, "File0", "main.bas");
prefsSetString(prefs, BAS_INI_SECTION_FORMS, "File0", "f1.frm");
TEST_TRUE(basBuildConcatProject(prefs, dir, &ps));
TEST_TRUE(strstr(ps.source, "BEGINMODULE \"\"\n") != NULL);
TEST_TRUE(strstr(ps.source, "BEGINFORM \"F1\"\n") != NULL);
TEST_EQ((int32_t)arrlen(ps.frmTexts), 1);
TEST_STR_EQ(ps.frmTexts[0], frmText);
const char *mapPath = NULL;
int32_t mapLine = 0;
// BEGINMODULE (line 1), main.bas (2-4), ENDMODULE (5), BEGINFORM (6),
// the form's code (7-8), ENDFORM (9)
TEST_TRUE(basBuildMapLine(ps.map, 3, &mapPath, &mapLine));
TEST_TRUE(mapPath && strstr(mapPath, "main.bas") != NULL);
TEST_EQ(mapLine, 2);
TEST_TRUE(!basBuildMapLine(ps.map, 5, &mapPath, &mapLine));
TEST_TRUE(!basBuildMapLine(ps.map, 6, &mapPath, &mapLine));
TEST_TRUE(basBuildMapLine(ps.map, 8, &mapPath, &mapLine));
TEST_TRUE(mapPath && strstr(mapPath, "f1.frm") != NULL);
TEST_EQ(mapLine, 5);
basBuildFreeProject(&ps);
// A .frm with no Begin Form line is an error, not a module.
snprintf(path, sizeof(path), "%s/bad.frm", dir);
TEST_TRUE(writeText(path, "Sub X\nEnd Sub\n"));
prefsSetString(prefs, BAS_INI_SECTION_FORMS, "File0", "bad.frm");
TEST_TRUE(!basBuildConcatProject(prefs, dir, &ps) && strstr(ps.error, "No Begin Form") != NULL);
basBuildFreeProject(&ps);
prefsClose(prefs);
// Directory helper and project open.
char out[DVX_MAX_PATH];
TEST_TRUE(platformPathDirName("a/b/c.dbp", out, sizeof(out)));
TEST_STR_EQ(out, "a/b");
TEST_TRUE(platformPathDirName("c.dbp", out, sizeof(out)));
TEST_STR_EQ(out, ".");
TEST_TRUE(platformPathDirName("C:\\c.dbp", out, sizeof(out)));
TEST_STR_EQ(out, "C:" DVX_PATH_SEP);
TEST_TRUE(platformPathDirName("C:c.dbp", out, sizeof(out)));
TEST_STR_EQ(out, "C:");
TEST_TRUE(platformPathDirName("/c.dbp", out, sizeof(out)));
TEST_STR_EQ(out, "/");
TEST_TRUE(!basBuildOpenProject("frtBuildProj/none.dbp", &prefs, out, sizeof(out)));
// An unreadable icon is reported by name, not as a write failure.
static const uint8_t stubBytes[] = { 0x7F, 0x44, 0x58, 0x45 };
static const char modSrc[] = "PRINT 1\n";
char selfPath[DVX_MAX_PATH];
BasBuildSpecT spec;
BasCompilerT *compiler = basCompilerCreate(modSrc, (int32_t)strlen(modSrc));
TEST_TRUE(basCompile(compiler));
BasModuleT *module = basCompilerBuildModule(compiler);
basCompilerDestroy(compiler);
TEST_TRUE(module != NULL);
snprintf(selfPath, sizeof(selfPath), "%s/self.bin", dir);
TEST_TRUE(writeText(selfPath, "SELF"));
TEST_EQ(dvxResAppend(selfPath, BAS_RES_STUB, DVX_RES_BINARY, stubBytes, sizeof(stubBytes)), 0);
memset(&spec, 0, sizeof(spec));
spec.module = module;
spec.projectDir = dir;
spec.iconPath = "missing.bmp";
spec.selfPath = selfPath;
const char *failure = basBuildApp("frtBuildProj/out.app", &spec);
TEST_TRUE(failure != NULL && strstr(failure, "Cannot read icon file") != NULL);
basModuleFree(module);
unlink(selfPath);
snprintf(path, sizeof(path), "%s/main.bas", dir);
unlink(path);
snprintf(path, sizeof(path), "%s/f1.frm", dir);
unlink(path);
snprintf(path, sizeof(path), "%s/bad.frm", dir);
unlink(path);
unlink("frtBuildProj/out.app");
rmdir(dir);
}
static void caseClipboard(void) {
tCase("Clipboard object: Clear, GetFormat, GetText, SetText (text only)");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm =
"Begin Form Form1\n"
" Caption = \"Clip\"\n"
"End\n"
"\n"
"Sub Form1_Test\n"
" Clipboard.Clear\n"
" Print \"fmt0=\"; Clipboard.GetFormat(vbCFText)\n"
" Clipboard.SetText \"hello\"\n"
" Print \"fmt1=\"; Clipboard.GetFormat(vbCFText); \" other=\"; Clipboard.GetFormat(2)\n"
" Print \"a=\"; Clipboard.GetText(); \" b=\"; Clipboard.GetText; \" c=[\"; Clipboard.GetText(2); \"]\"\n"
" Clipboard.SetText \"world\", vbCFText\n"
" Print \"d=\"; Clipboard.GetText(vbCFText)\n"
"End Sub\n"
"Sub Form1_BadFormat\n"
" Clipboard.SetText \"x\", 2\n"
"End Sub\n"
"Sub Form1_BadMethod\n"
" Clipboard.Paste\n"
"End Sub\n"
"Sub Form1_BadProp\n"
" Clipboard.Text = \"x\"\n"
"End Sub\n";
FrtAppT app;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form1", "Test"));
TEST_STR_EQ(frtOut(&app), "fmt0=False \nfmt1=True other=False \na=hello b=hello c=[]\nd=world\n");
int32_t len = 0;
TEST_STR_EQ(dvxClipboardGet(&len), "world");
const char *bad[] = { "BadFormat", "BadMethod", "BadProp" };
for (int32_t i = 0; i < DVX_ARRAY_LEN(bad); i++) {
frtFire(&app, "Form1", bad[i]);
TEST_TRUE(app.rt->terminated);
frtClearError(&app);
}
TEST_STR_EQ(dvxClipboardGet(&len), "world");
dvxClipboardClear();
frtDestroy(&app);
tShutdown();
}
static void caseCommonMethods(void) {
tCase("common methods");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm =
"Begin Form Form1\n"
" Caption = \"CM\"\n"
" Begin TextBox Txt1\n"
" End\n"
" Begin CommandButton Cmd1\n"
" Caption = \"Go\"\n"
" End\n"
" Begin Toolbar Tb1\n"
" End\n"
"End\n"
"\n"
"Sub Form1_Test\n"
" Txt1.SetFocus\n"
" Cmd1.Refresh\n"
" Cmd1.SetReadOnly True\n"
" Cmd1.SetEnabled False\n"
" Cmd1.SetVisible False\n"
" Me.CreateMenu \"dyn\"\n"
" Me.AddMenuItem \"dyn\", \"dynItem\", \"Dynamic\"\n"
" Me.AddMenuSeparator \"dyn\"\n"
" Me.AddSubMenu \"dyn\", \"dynSub\", \"More\"\n"
" Me.AddMenuItem \"dynSub\", \"dynSubItem\", \"Nested\"\n"
" Tb1.AddButton \"TbImg\", \"" FRT_FIXTURE_DIR "/icon.bmp\"\n"
" Tb1.AddTextButton \"TbTxt\", \"Text\"\n"
" Tb1.AddSeparator\n"
" Print \"count=\"; Tb1.ButtonCount()\n"
" Print \"pm=\"; Cmd1.Caption\n"
"End Sub\n"
"Sub Form1_Destroy\n"
" Me.DestroyMenu \"dyn\"\n"
" Me.DestroyMenu \"dyn\"\n"
"End Sub\n";
FrtAppT app;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
frtFire(&app, "Form1", "Test");
BasFormT *form = frtForm(&app, "Form1");
BasControlT *txt = frtCtrl(form, "Txt1");
BasControlT *cmd = frtCtrl(form, "Cmd1");
BasControlT *tb = frtCtrl(form, "Tb1");
TEST_EQ(app.mainResult, BAS_VM_HALTED);
TEST_TRUE(!app.rt->terminated);
TEST_TRUE(txt && cmd && tb);
if (txt && cmd && tb) {
TEST_PTR_EQ(wgtGetFocused(), txt->widget);
TEST_TRUE(cmd->widget->readOnly);
TEST_TRUE(!cmd->widget->enabled);
TEST_TRUE(!cmd->widget->visible);
TEST_EQ(form->popupMenuCount, 2);
TEST_EQ(form->menuIdMapCount, 3);
TEST_STR_EQ(form->popupMenus[0].name, "dyn");
TEST_STR_EQ(form->popupMenus[1].name, "dynSub");
TEST_TRUE(form->popupMenus[0].ownsMenu);
TEST_TRUE(!form->popupMenus[1].ownsMenu);
TEST_EQ(form->popupMenus[0].menu->itemCount, 3);
TEST_TRUE(form->popupMenus[0].menu->items[1].separator);
TEST_PTR_EQ(form->popupMenus[0].menu->items[2].subMenu, form->popupMenus[1].menu);
TEST_STR_EQ(form->menuIdMap[0].name, "dynItem");
TEST_STR_EQ(form->menuIdMap[1].name, "dynSub");
TEST_STR_EQ(form->menuIdMap[2].name, "dynSubItem");
TEST_TRUE(frtCtrl(form, "TbImg") != NULL);
TEST_TRUE(frtCtrl(form, "TbTxt") != NULL);
TEST_STR_EQ(wgtGetText(frtCtrl(form, "TbTxt")->widget), "Text");
outContains(&app, "count=3 ");
outContains(&app, "pm=Go");
}
// DestroyMenu on the root drops the alias too; on a stale name it is
// a no-op.
frtFire(&app, "Form1", "Destroy");
TEST_TRUE(!app.rt->terminated);
TEST_EQ(form->popupMenuCount, 0);
TEST_EQ(form->menuIdMapCount, 0);
frtDestroy(&app);
tShutdown();
}
static void caseControlArrays(void) {
tCase("control arrays pass Index");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm =
"Begin Form Form1\n"
" Caption = \"Arr\"\n"
" Begin CommandButton Btn\n"
" Index = 0\n"
" Caption = \"Zero\"\n"
" End\n"
" Begin CommandButton Btn\n"
" Index = 1\n"
" Caption = \"One\"\n"
" End\n"
" Begin CommandButton Btn\n"
" Index = 5\n"
" Caption = \"Five\"\n"
" End\n"
"End\n"
"\n"
"Sub Btn_Click(Index As Integer)\n"
" Print \"click=\"; Index\n"
"End Sub\n"
"Sub Form1_Test\n"
" Btn(1).Caption = \"Uno\"\n"
" Print \"cap=\"; Btn(5).Caption\n"
"End Sub\n";
FrtAppT app;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
frtFire(&app, "Form1", "Test");
BasFormT *form = frtForm(&app, "Form1");
BasControlT *b0 = frtCtrlIdx(form, "Btn", 0);
BasControlT *b1 = frtCtrlIdx(form, "Btn", 1);
BasControlT *b5 = frtCtrlIdx(form, "Btn", 5);
TEST_EQ(app.mainResult, BAS_VM_HALTED);
TEST_TRUE(b0 && b1 && b5);
TEST_PTR_EQ(frtCtrl(form, "Btn"), NULL);
if (b0 && b1 && b5) {
int32_t sx = 0;
int32_t sy = 0;
TEST_STR_EQ(wgtGetText(b1->widget), "Uno");
outContains(&app, "cap=Five");
frtOutClear(&app);
tWidgetCenter(b5->widget, &sx, &sy);
tClick(sx, sy);
tWidgetCenter(b0->widget, &sx, &sy);
tClick(sx, sy);
TEST_STR_EQ(frtOut(&app), "click=5 \nclick=0 \n");
}
frtDestroy(&app);
tShutdown();
}
// Control members of round 2 from BASIC: TextBox SelStart / SelLength /
// SelText / SelectAll, SpinButton RealValue / SetRealRange, Image
// MaskColor / UseMaskColor, the Data members without a database,
// ScrollPane.ScrollToControl, and the TextArea Colorize event (ByRef
// Colors written back through the runtime).
static void caseControlMembers2(void) {
tCase("TextBox Sel*, SpinButton RealValue, Image MaskColor, Data members, ScrollToControl, Colorize");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm =
"Begin Form Form1\n"
" Caption = \"Members\"\n"
" Begin TextBox Text1\n"
" End\n"
" Begin SpinButton Spn1\n"
" End\n"
" Begin Image Img1\n"
" End\n"
" Begin Data Dat1\n"
" End\n"
" Begin ScrollPane Sp1\n"
" Begin Label Lbl1\n"
" Caption = \"Inside\"\n"
" End\n"
" End\n"
" Begin TextArea Area1\n"
" End\n"
"End\n"
"\n"
"Sub Form1_Run\n"
" Text1.Text = \"hello world\"\n"
" Text1.SelStart = 6\n"
" Text1.SelLength = 5\n"
" Print Text1.SelText; \"|\";\n"
" Text1.SelText = \"there\"\n"
" Text1.SelectAll\n"
" Print Text1.Text; Text1.SelLength\n"
" Spn1.RealMode = True\n"
" Spn1.SetRealRange 0.5, 2.5\n"
" Spn1.RealValue = 9\n"
" Print Spn1.RealValue\n"
" Img1.MaskColor = vbRed\n"
" Img1.UseMaskColor = True\n"
" Print Img1.MaskColor = vbRed; Img1.UseMaskColor\n"
" Print Dat1.RecordCount; Dat1.FieldCount; \"[\"; Dat1.FieldName(0); Dat1.GetField(\"x\"); Dat1.GetCell(0, 0); \"]\"\n"
" Sp1.ScrollToControl Lbl1\n"
" Sp1.ScrollToControl \"Lbl1\"\n"
" Area1.Text = \"kkk\"\n"
" Area1.SetSyntaxMode \"custom\"\n"
"End Sub\n"
"Sub Form1_Count\n"
" Print Area1.Tag\n"
"End Sub\n"
"Sub Area1_Colorize(LineText As String, Colors As String)\n"
" Area1.Tag = LineText\n"
" Colors = String$(Len(LineText), \"1\")\n"
"End Sub\n"
"Sub Form1_BadScroll\n"
" Text1.ScrollToControl Lbl1\n"
"End Sub\n";
FrtAppT app;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form1", "Run"));
TEST_STR_EQ(frtOut(&app), "world|hello there11 \n2.5 \nTrue True \n0 0 []\n");
tPump(FRT_PAINT_PUMPS);
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form1", "Count"));
TEST_STR_EQ(frtOut(&app), "kkk\n");
// The handler's Colors comes back to the widget (ByRef String)
BasControlT *area = frtCtrl(frtForm(&app, "Form1"), "Area1");
WgtValueT colorArgs[2];
colorArgs[0] = wgtValueStr("ab");
colorArgs[1] = wgtValueStr("00");
TEST_TRUE(area && wgtFireEvent(area->widget, "Colorize", colorArgs, 2));
TEST_STR_EQ(colorArgs[1].s, "11");
TEST_TRUE(!app.rt->terminated);
frtFire(&app, "Form1", "BadScroll");
TEST_TRUE(app.rt->terminated);
frtDestroy(&app);
tShutdown();
}
static void caseCreateFormDynamic(void) {
tCase("CreateForm/CreateControl at runtime");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm = "Begin Form Form1\n Caption = \"Main\"\nEnd\n";
FrtAppT app;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
BasFormT *f2 = (BasFormT *)basFormRtCreateForm(app.rt, "Form2", 200, 150);
TEST_TRUE(f2 != NULL);
TEST_PTR_EQ(basFormRtCreateForm(app.rt, "Form2", 300, 300), f2);
BasFormT *f3 = (BasFormT *)basFormRtCreateForm(app.rt, "Form3", 0, 0);
TEST_TRUE(f3 != NULL);
TEST_EQ(f3->frmWidth, BAS_DEFAULT_FORM_W);
TEST_PTR_EQ(basFormRtCreateForm(app.rt, NULL, 10, 10), NULL);
TEST_PTR_EQ(basFormRtCreateForm(NULL, "F", 10, 10), NULL);
BasControlT *btn = (BasControlT *)basFormRtCreateCtrl(app.rt, f2, "CommandButton", "B1");
TEST_TRUE(btn != NULL && btn->widget != NULL);
BasControlT *frame = (BasControlT *)basFormRtCreateCtrl(app.rt, f2, "Frame", "Fr1");
BasControlT *inner = (BasControlT *)basFormRtCreateCtrlEx(app.rt, f2, "TextBox", "T1", frame);
TEST_TRUE(frame != NULL && inner != NULL);
TEST_PTR_EQ(childAt(frame->widget, 0), inner->widget);
basFormRtShowForm(app.rt, f2, false);
tPump(1);
TEST_TRUE(f2->window->visible);
basFormRtHideForm(app.rt, f2);
tPump(1);
TEST_TRUE(!f2->window->visible);
// Direct type names (already-canonical widget names) resolve too.
TEST_TRUE(basFormRtCreateCtrl(app.rt, f2, "button", "RawB") != NULL);
// Unloading the modal form (from the dialog script, while Show runs)
// clears the modal gate and ends the Show.
sModalCheckApp = &app;
sModalChecks = 0;
tDialogScript(unloadModalCheck, f3);
basFormRtShowForm(app.rt, f3, true);
tPump(1);
TEST_EQ(sModalChecks, 1);
TEST_PTR_EQ(tCtx()->modalWindow, NULL);
TEST_PTR_EQ(frtForm(&app, "Form3"), NULL);
sModalCheckApp = NULL;
frtDialogsDefault(&app);
// The window factory's auto-size and explicit-position paths.
WidgetT *auxRoot = NULL;
WidgetT *auxBox = NULL;
WindowT *auxWin = basFormRtCreateFormWindow(tCtx(), "AutoT", "HBox", false, false, true, 0, 0, 0, 0, &auxRoot, &auxBox);
TEST_TRUE(auxWin != NULL);
dvxDestroyWindow(tCtx(), auxWin);
auxWin = basFormRtCreateFormWindow(tCtx(), "PosT", "VBox", false, false, false, 100, 80, 50, 60, &auxRoot, &auxBox);
TEST_TRUE(auxWin != NULL && auxWin->x == 50 && auxWin->y == 60);
dvxDestroyWindow(tCtx(), auxWin);
tPump(1);
// A windowless form raises on Show/Hide and control creation.
BasFormT ghost;
memset(&ghost, 0, sizeof(ghost));
snprintf(ghost.name, sizeof(ghost.name), "Ghost");
basFormRtShowForm(app.rt, &ghost, false);
frtClearError(&app);
basFormRtHideForm(app.rt, &ghost);
frtClearError(&app);
TEST_PTR_EQ(basFormRtCreateCtrlEx(app.rt, &ghost, "TextBox", "G1", NULL), NULL);
frtClearError(&app);
// Unknown method on a form reference names the form in the error.
BasFormT *form1 = frtForm(&app, "Form1");
basFormRtCallMethod(app.rt, form1, "NoSuchMethod", NULL, 0);
TEST_TRUE(app.rt->terminated);
frtClearError(&app);
// Unknown type / NULL form raise runtime errors and halt; clear each.
TEST_PTR_EQ(basFormRtCreateCtrl(app.rt, f2, "Sprocket", "S1"), NULL);
TEST_TRUE(app.rt->terminated);
frtClearError(&app);
TEST_PTR_EQ(basFormRtCreateCtrl(app.rt, NULL, "TextBox", "T2"), NULL);
frtClearError(&app);
basFormRtShowForm(app.rt, NULL, false);
frtClearError(&app);
basFormRtHideForm(app.rt, NULL);
frtClearError(&app);
frtDestroy(&app);
tShutdown();
}
// Named events a widget fires with wgtFireEvent reach CtrlName_Event
// through onEvent with their arguments; parameters a handler changes are
// written back (ByRef), Strings included.
// Universal names go to the universal callbacks. Also the PictureBox's
// BorderStyle (the canvas border-less mode) from the .frm and from code.
static void caseCustomEvents(void) {
tCase("custom events through onEvent, ByRef write-back, PictureBox BorderStyle");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm =
"Begin Form Form1\n"
" Caption = \"Custom\"\n"
" Begin ListView Lv1\n"
" End\n"
" Begin CommandButton Cmd1\n"
" Caption = \"Go\"\n"
" End\n"
" Begin PictureBox Pic1\n"
" BorderStyle = None\n"
" End\n"
"End\n"
"Sub Lv1_ColumnClick(Column As Integer)\n"
" If Column = 2 Then Print \"col\"\n"
" Column = 7\n"
"End Sub\n"
"Sub Cmd1_Click\n"
" Print \"click\"\n"
"End Sub\n"
"Sub Cmd1_ItemOpen(Index As Integer, Label As String, Ok As Boolean)\n"
" If Index = 5 And Label = \"x\" And Ok Then Print \"open\"\n"
" Label = \"changed\"\n"
" Ok = False\n"
"End Sub\n"
"Sub Form1_Border\n"
" If Pic1.BorderStyle = 0 Then Print \"none\";\n"
" Pic1.BorderStyle = 1\n"
" If Pic1.BorderStyle = 1 Then Print \" fixed\";\n"
" Pic1.BorderStyle = \"None\"\n"
" If Pic1.BorderStyle = 0 Then Print \" none\"\n"
"End Sub\n";
FrtAppT app;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
BasFormT *form = frtForm(&app, "Form1");
BasControlT *lv = form ? frtCtrl(form, "Lv1") : NULL;
BasControlT *cmd = form ? frtCtrl(form, "Cmd1") : NULL;
BasControlT *pic = form ? frtCtrl(form, "Pic1") : NULL;
TEST_TRUE(lv && cmd && pic);
if (lv && cmd && pic) {
WgtValueT args[3];
frtOutClear(&app);
args[0] = wgtValueInt(2);
TEST_TRUE(wgtFireEvent(lv->widget, "ColumnClick", args, 1));
TEST_STR_EQ(frtOut(&app), "col\n");
TEST_EQ(args[0].i, 7);
frtOutClear(&app);
TEST_TRUE(wgtFireEvent(cmd->widget, "click", NULL, 0));
TEST_STR_EQ(frtOut(&app), "click\n");
frtOutClear(&app);
args[0] = wgtValueInt(5);
args[1] = wgtValueStr("x");
args[2] = wgtValueBool(true);
TEST_TRUE(wgtFireEvent(cmd->widget, "ItemOpen", args, 3));
TEST_STR_EQ(frtOut(&app), "open\n");
TEST_STR_EQ(args[1].s, "changed");
TEST_EQ(args[2].type, WGT_IFACE_BOOL);
TEST_EQ(args[2].i, 0);
// No handler: the arguments stay as they were
args[0] = wgtValueInt(5);
TEST_TRUE(wgtFireEvent(cmd->widget, "NoHandlerEvent", args, 1));
TEST_EQ(args[0].i, 5);
WgtValueT v;
TEST_TRUE(wgtGetProp(pic->widget, "BorderStyle", &v) && v.i == 0);
TEST_EQ(pic->widget->contentOffX, 0);
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form1", "Border"));
TEST_STR_EQ(frtOut(&app), "none fixed none\n");
}
frtDestroy(&app);
tShutdown();
}
static void caseDataBinding(void) {
tCase("Data control binding without a database behind it");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm =
"Begin Form Form1\n"
" Caption = \"DB\"\n"
" Begin Data Dat1\n"
" End\n"
" Begin TextBox Txt1\n"
" DataSource = \"Dat1\"\n"
" DataField = \"name\"\n"
" End\n"
" Begin DBGrid Grd1\n"
" DataSource = \"Dat1\"\n"
" End\n"
" Begin Data Det1\n"
" MasterSource = \"Dat1\"\n"
" MasterField = \"id\"\n"
" End\n"
"End\n"
"\n"
"Sub Dat1_Reposition\n"
" Print \"repo\"\n"
"End Sub\n";
FrtAppT app;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
BasFormT *form = frtForm(&app, "Form1");
BasControlT *dat = frtCtrl(form, "Dat1");
BasControlT *txt = frtCtrl(form, "Txt1");
TEST_TRUE(dat != NULL && txt != NULL);
TEST_TRUE(!app.rt->terminated);
// Every navigation method is a no-op without a database but must
// dispatch cleanly, and Refresh re-runs the bound-control update.
static const char *const moves[] = { "Refresh", "MoveFirst", "MoveNext", "MovePrevious", "MoveLast", "AddNew", "Update", "Delete" };
for (int32_t i = 0; i < DVX_ARRAY_LEN(moves); i++) {
callIntM(&app, dat, moves[i], NULL, 0);
TEST_TRUE(!app.rt->terminated);
}
tPump(1);
// LostFocus write-back path on the bound TextBox.
callIntM(&app, txt, "SetFocus", NULL, 0);
tPump(1);
BasControlT *grd = frtCtrl(form, "Grd1");
callIntM(&app, grd, "SetFocus", NULL, 0);
tPump(1);
TEST_TRUE(!app.rt->terminated);
frtDestroy(&app);
tShutdown();
}
// CommandButton Default / Cancel: Enter presses the Default button unless
// a button has the focus (which Enter pressed itself), Escape the Cancel
// button wherever the focus is.
static void caseDefaultCancelButtons(void) {
tCase("CommandButton Default and Cancel: Enter and Escape on the form");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm =
"Begin Form Form1\n"
" Caption = \"Dialog\"\n"
" Begin TextBox Text1\n"
" End\n"
" Begin CommandButton CmdOther\n"
" Caption = \"Other\"\n"
" End\n"
" Begin CommandButton CmdOk\n"
" Caption = \"OK\"\n"
" Default = True\n"
" End\n"
" Begin CommandButton CmdCancel\n"
" Caption = \"Cancel\"\n"
" Cancel = True\n"
" End\n"
"End\n"
"\n"
"Sub CmdOther_Click\n"
" Print \"other\"\n"
"End Sub\n"
"Sub CmdOk_Click\n"
" Print \"ok\"; CmdOk.Default; CmdCancel.Cancel; CmdOther.Default\n"
"End Sub\n"
"Sub CmdCancel_Click\n"
" Print \"cancel\"\n"
"End Sub\n";
FrtAppT app;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
BasFormT *form = frtForm(&app, "Form1");
BasControlT *text = form ? frtCtrl(form, "Text1") : NULL;
BasControlT *other = form ? frtCtrl(form, "CmdOther") : NULL;
TEST_TRUE(text != NULL && other != NULL);
if (text && other) {
frtOutClear(&app);
wgtSetFocused(text->widget);
tKeyEnter();
tKeyEsc();
tPump(SETTLE_FRAMES_FRT);
TEST_STR_EQ(frtOut(&app), "okTrue True False \ncancel\n");
frtOutClear(&app);
wgtSetFocused(other->widget);
tKeyEnter();
tPump(SETTLE_FRAMES_FRT);
TEST_STR_EQ(frtOut(&app), "other\n");
}
frtDestroy(&app);
tShutdown();
}
// The design surface and the live control tree: CallByName, Controls,
// Parent / Container, MoveBefore, LoadFormText, DesignMode with
// DesignMouse / DesignKey and the selection handles.
static void caseDesignerLive(void) {
tCase("designer: CallByName, Controls, Container, MoveBefore, LoadFormText, DesignMode");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm =
"Begin Form Form1\n"
" Caption = \"Dsgn\"\n"
" Width = 400\n"
" Height = 300\n"
" Begin CommandButton Command1\n"
" Caption = \"One\"\n"
" End\n"
" Begin Frame Frame1\n"
" Caption = \"Box\"\n"
" Begin TextBox Text1\n"
" Text = \"hi\"\n"
" End\n"
" End\n"
" Begin Label Label1\n"
" Caption = \"L\"\n"
" End\n"
"End\n"
"\n"
"Sub Form1_Names\n"
" Dim c As Object\n"
" Print Me.Controls.Count;\n"
" For Each c In Me.Controls\n"
" Print c.Name; \" \";\n"
" Next\n"
" Print\n"
" Print Me.Controls(\"Text1\").Text; \" \"; Me.Controls(1).Name; \" \"; Text1.Parent.Name; \" \"; Text1.Container.Name; \" \"; Command1.Container.Name\n"
"End Sub\n"
"Sub Form1_ByName\n"
" Dim n As String\n"
" Dim col As New Collection\n"
" n = \"Text\"\n"
" Print CallByName(Command1, \"Caption\", vbGet); \" \";\n"
" CallByName Command1, \"Caption\", vbLet, \"Two\"\n"
" Print Command1.Caption; \" \"; CallByName(Text1, n, vbGet); \" \"; CallByName(Me, \"Caption\", vbGet)\n"
" col.Add \"first\"\n"
" col.Add \"second\"\n"
" Print CallByName(col, \"Count\", vbGet); CallByName(col, \"Item\", vbMethod, 2)\n"
" CallByName Text1, \"SetFocus\", vbMethod\n"
" Print IsEmpty(CallByName(Command1, \"Caption\", vbLet, \"Three\")); Command1.Caption\n"
"End Sub\n"
"Sub Form1_Move\n"
" Dim c As Object\n"
" Label1.MoveBefore Command1\n"
" Set Command1.Container = Frame1\n"
" Command1.MoveBefore Text1\n"
" For Each c In Me.Controls\n"
" Print c.Name; \" \";\n"
" Next\n"
" Print Command1.Container.Name\n"
"End Sub\n"
"Sub Form1_BadMove\n"
" Set Frame1.Container = Text1\n"
"End Sub\n"
"Sub Form1_FromText\n"
" Dim f As Object\n"
" Dim t As String\n"
" t = \"Begin Form Gen1\" & Chr$(10) & \" Caption = \" & Chr$(34) & \"Made\" & Chr$(34) & Chr$(10) & \" Begin CommandButton Go\" & Chr$(10) & \" Caption = \" & Chr$(34) & \"Go!\" & Chr$(34) & Chr$(10) & \" End\" & Chr$(10) & \"End\" & Chr$(10)\n"
" Set f = LoadFormText(t)\n"
" Print f.Caption; f.Controls.Count; f.Controls(1).Caption; TypeName(f)\n"
" Unload f\n"
"End Sub\n"
"Sub Form1_Design\n"
" Me.DesignMode = True\n"
" Me.DesignSelection = \"Command1\"\n"
" Print Me.DesignMode; Me.DesignSelection\n"
"End Sub\n"
"Sub Form1_EndDesign\n"
" Me.DesignMode = False\n"
"End Sub\n"
"Sub Form1_DesignMouse(Action As Integer, Button As Integer, X As Integer, Y As Integer, CtrlName As String, Handle As Integer)\n"
" If Action <> 2 Then Print \"dm\"; Action; Button; CtrlName; Handle\n"
"End Sub\n"
"Sub Form1_DesignKey(KeyCode As Integer, Shift As Integer)\n"
" Print \"dk\"; KeyCode\n"
"End Sub\n"
"Sub Command1_Click\n"
" Print \"clicked\"\n"
"End Sub\n";
FrtAppT app;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form1", "Names"));
TEST_STR_EQ(frtOut(&app), "4 Command1 Frame1 Text1 Label1 \nhi Command1 Form1 Frame1 Form1\n");
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form1", "ByName"));
TEST_STR_EQ(frtOut(&app), "One Two hi Dsgn\n2 second\nTrue Three\n");
BasFormT *form = frtForm(&app, "Form1");
BasControlT *cmd = form ? frtCtrl(form, "Command1") : NULL;
BasControlT *frame = form ? frtCtrl(form, "Frame1") : NULL;
BasControlT *text = form ? frtCtrl(form, "Text1") : NULL;
TEST_TRUE(cmd && frame && text);
if (!cmd || !frame || !text) {
frtDestroy(&app);
tShutdown();
return;
}
// The layout follows: the button is the frame's first child now
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form1", "Move"));
TEST_STR_EQ(frtOut(&app), "Label1 Frame1 Command1 Text1 Frame1\n");
TEST_PTR_EQ(cmd->widget->parent, frame->widget);
TEST_PTR_EQ(frame->widget->firstChild, cmd->widget);
TEST_PTR_EQ(cmd->widget->nextSibling, text->widget);
// A control cannot go inside a non-container
TEST_TRUE(frtFire(&app, "Form1", "BadMove"));
TEST_TRUE(app.rt->terminated);
frtClearError(&app);
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form1", "FromText"));
TEST_STR_EQ(frtOut(&app), "Made1 Go!Form\n");
TEST_PTR_EQ(frtForm(&app, "Gen1"), NULL);
// Design mode: the window takes the mouse and keys, no Click fires
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form1", "Design"));
TEST_STR_EQ(frtOut(&app), "True Command1\n");
tPump(2);
int32_t cx;
int32_t cy;
int32_t hx;
int32_t hy;
tWidgetCenter(cmd->widget, &cx, &cy);
frtOutClear(&app);
tClick(cx, cy);
tPump(2);
TEST_STR_EQ(frtOut(&app), "dm1 1 Command1-1 \ndm3 1 Command1-1 \n");
// The SE handle of the selection, painted black over the widgets
basDsgnHandleOrigin(cmd->widget, BAS_DSGN_HANDLE_SE, &hx, &hy);
int32_t bpp = tCtx()->display.format.bytesPerPixel;
uint32_t pixel = 0;
uint32_t black = packColor(&tCtx()->display, 0, 0, 0);
memcpy(&pixel, form->window->contentBuf + (hy + 1) * form->window->contentPitch + (hx + 1) * bpp, (size_t)bpp);
TEST_EQ(pixel, black);
TEST_EQ(basDsgnHandleAt(cmd->widget, hx + 1, hy + 1), BAS_DSGN_HANDLE_SE);
TEST_EQ(basDsgnCursorAt(cmd->widget, hx + 1, hy + 1), CURSOR_RESIZE_DIAG_NWSE);
frtOutClear(&app);
tClick(cx - cmd->widget->w / 2 + (hx + 1 - cmd->widget->x), cy - cmd->widget->h / 2 + (hy + 1 - cmd->widget->y));
tPump(2);
TEST_TRUE(strstr(frtOut(&app), "dm1 1 Command14 \n") != NULL);
frtOutClear(&app);
tKey(0, 'q', 0);
tPump(2);
TEST_STR_EQ(frtOut(&app), "dk113 \n");
// Off again: the button clicks
TEST_TRUE(frtFire(&app, "Form1", "EndDesign"));
tPump(2);
frtOutClear(&app);
tClick(cx, cy);
tPump(2);
TEST_STR_EQ(frtOut(&app), "clicked\n");
frtDestroy(&app);
tShutdown();
}
// designer.bas: the control type registry from BASIC, with the shipped
// include file, as the C IDE reads it (basCtl*).
static void caseDesignerRegistry(void) {
tCase("designer.bas: control types, properties, methods, events");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *code =
"Function FindProp(t As String, p As String) As Integer\n"
" Dim i As Integer\n"
" FindProp = -1\n"
" For i = 0 To CtlPropCount(t) - 1\n"
" If CtlPropName$(t, i) = p Then FindProp = i\n"
" Next\n"
"End Function\n"
"Sub Form1_Types\n"
" Dim i As Integer\n"
" Dim found As Integer\n"
" Dim unsorted As Integer\n"
" For i = 0 To CtlTypeCount() - 1\n"
" If CtlTypeName$(i) = \"TextArea\" Then found = found + 1\n"
" If LCase$(CtlTypeName$(i - 1)) >= LCase$(CtlTypeName$(i)) Then unsorted = unsorted + 1\n"
" Next\n"
" Print found; CtlTypeName$(CtlTypeCount()) = \"\"; CtlTypeName$(-1) = \"\"; unsorted\n"
" Print CtlTypeFlags(\"Frame\"); CtlTypeFlags(\"CommandButton\"); CtlTypeFlags(\"Image\"); CtlTypeFlags(\"Nope\")\n"
" Print CtlTypeNamePrefix$(\"CommandButton\"); \" \"; CtlTypeDefaultEvent$(\"TextBox\"); \" \"; CtlTypeDefaultEvent$(\"Form\"); \" \"; CtlTypeTooltip$(\"Label\") <> \"\"\n"
" i = FindProp(\"TextArea\", \"SelText\")\n"
" Print CtlPropType(\"TextArea\", i) = CTL_PROP_STRING; (CtlPropType(\"TextArea\", FindProp(\"TextArea\", \"LineCount\")) And CTL_PROP_READONLY) <> 0\n"
" Print CtlPropType(\"Form\", FindProp(\"Form\", \"Controls\")) = CTL_PROP_OBJECT + CTL_PROP_READONLY; CtlPropType(\"Form\", FindProp(\"Form\", \"DesignMode\")) = CTL_PROP_BOOLEAN\n"
" Print FindProp(\"Menu\", \"Checked\") >= 0; FindProp(\"Menu\", \"Text\"); CtlPropType(\"TextBox\", 999); CtlPropName$(\"TextBox\", 999) = \"\"\n"
" Print CtlEventList$(\"Menu\"); \" \"; InStr(CtlEventList$(\"TextArea\"), \"|GutterClick\") > 0; InStr(CtlEventList$(\"Form\"), \"DesignMouse\") > 0\n"
" Print CtlEventParams$(\"KeyDown\"); \"|\"; CtlEventParams$(\"Click\"); \"|\"\n"
" Print InStr(CtlMethodList$(\"TextArea\"), \"|Undo|\") > 0; Left$(CtlMethodList$(\"Form\"), 9); \" \"; InStr(CtlMethodList$(\"Label\"), \"MoveBefore\") > 0; CtlMethodList$(\"Menu\") = \"\"\n"
"End Sub\n"
"Sub Form1_FrmNames\n"
" Dim t As String\n"
" t = \"Begin Form Gen1\" & Chr$(10) & \" Begin Label L1\" & Chr$(10) & \" End\" & Chr$(10) & \" Begin Menu mnuFile\" & Chr$(10) & \" End\" & Chr$(10) & \"End\" & Chr$(10) & \"Sub Gen1_Load\" & Chr$(10)\n"
" Print FrmFormName$(t); \" \"; FrmControlNames$(t); \" [\"; FrmCode$(t); \"]\"\n"
" Print ClsClassName$(\"Attribute VB_Name = \" & Chr$(34) & \"Acc\" & Chr$(34) & Chr$(10) & \"Dim x\", \"\"); \" \"; ClsClassName$(\"Dim x\", \"C:\\DIR\\THING.CLS\")\n"
"End Sub\n"
"Sub Form1_Enum\n"
" Dim t As String\n"
" Dim i As Integer\n"
" Dim j As Integer\n"
" For j = 0 To CtlTypeCount() - 1\n"
" t = CtlTypeName$(j)\n"
" For i = 0 To CtlPropCount(t) - 1\n"
" If (CtlPropType(t, i) And CTL_PROP_TYPEMASK) = CTL_PROP_ENUM And CtlPropEnum$(t, i) = \"\" Then Print \"empty enum \"; t; \".\"; CtlPropName$(t, i)\n"
" If (CtlPropType(t, i) And CTL_PROP_TYPEMASK) <> CTL_PROP_ENUM And CtlPropEnum$(t, i) <> \"\" Then Print \"stray enum \"; t; \".\"; CtlPropName$(t, i)\n"
" Next\n"
" Next\n"
" Print \"enums done\"\n"
"End Sub\n";
const char *frm = "Begin Form Form1\n Caption = \"Reg\"\nEnd\n";
int32_t len = 0;
char *inc = platformReadFile(FRT_INCLUDE_DIR "/designer.bas", &len);
char *src = (char *)malloc(FRT_SRC_BUF);
FrtAppT app;
TEST_TRUE(inc != NULL && src != NULL);
if (!inc || !src) {
free(inc);
free(src);
tShutdown();
return;
}
snprintf(src, FRT_SRC_BUF, "%s\n%s", inc, code);
free(inc);
if (!expectBuild(&app, src, &frm, 1)) {
free(src);
tShutdown();
return;
}
free(src);
basNativeHostSetLive(true);
frtStart(&app, NULL);
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form1", "Types"));
TEST_STR_EQ(frtOut(&app),
"1 True True 0 \n"
"3 2 0 -1 \n"
"Command Change Load True \n"
"True True \n"
"True True \n"
"True -1 -1 True \n"
"Click True True \n"
"KeyCode As Integer, Shift As Integer||\n"
"True Show|Hide True True \n");
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form1", "Enum"));
TEST_STR_EQ(frtOut(&app), "enums done\n");
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form1", "FrmNames"));
TEST_STR_EQ(frtOut(&app), "Gen1 L1|mnuFile [Sub Gen1_Load\n]\nAcc THING\n");
basNativeHostSetLive(false);
frtDestroy(&app);
// The C side the IDE uses
BasCtlPropT prop;
TEST_TRUE(basCtlPropFind("TextBox", "Mask", &prop) && prop.type == WGT_IFACE_STRING && prop.writable);
TEST_TRUE(basCtlPropFind(FRM_KW_FORM, BAS_PROP_CAPTION, &prop) && prop.writable);
TEST_TRUE(!basCtlPropFind("TextBox", "NoSuchProp", &prop));
TEST_TRUE(basCtlIsContainer("Frame") && !basCtlIsContainer("Label"));
TEST_STR_EQ(basCtlDefaultEvent(FRM_KW_FORM), BAS_EVT_LOAD);
TEST_STR_EQ(basCtlEventParams("TextArea", BAS_EVT_GUTTERCLICK), "LineNumber As Integer");
TEST_STR_EQ(basCtlEventParams(NULL, BAS_EVT_COLUMNCLICK), "Column As Integer");
TEST_STR_EQ(basCtlEventParams("HelpPane", BAS_EVT_LINKCLICK), "Topic As String");
TEST_STR_EQ(basCtlEventParams("TextBox", BAS_EVT_KEYDOWN), "KeyCode As Integer, Shift As Integer");
TEST_STR_EQ(basCtlEventParams("Data", BAS_EVT_VALIDATE), "Cancel As Integer");
TEST_STR_EQ(basCtlEventParams("TextBox", "NoSuchEvent"), "");
TEST_TRUE(basEventParams(BAS_EVT_GUTTERCLICK) == NULL);
tShutdown();
}
static void caseDialogWrappers(void) {
tCase("choice/input/file dialog wrappers incl. no-runtime guards");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
// No form runtime yet: every wrapper takes its guard path.
TEST_EQ(DlgChoice("t", "p", "A|B", 0), -1);
TEST_STR_EQ(DlgInputBox("t", "p", "d"), "");
TEST_EQ(DlgInputCancelled(), -1);
TEST_EQ(DlgIntInput("t", "p", 7, 0, 10), 7);
TEST_EQ(DlgInputCancelled(), -1);
TEST_EQ(DlgIntInputStep("t", "p", 7, 0, 10, 5), 7);
TEST_EQ(DlgPromptSave("t"), DVX_SAVE_NO);
TEST_STR_EQ(DlgFileOpen("t", "*.txt"), "");
TEST_STR_EQ(DlgFileSave("t", ""), "");
TEST_STR_EQ(DlgFileOpenIn("t", "", "x"), "");
TEST_STR_EQ(DlgFileSaveIn("t", "", "x"), "");
TEST_EQ(DlgColor("t", FRT_COLOR_START), -1);
const char *frm = "Begin Form Form1\n Caption = \"Dlg\"\nEnd\n";
FrtAppT app;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
DialogCtxT dlg;
memset(&dlg, 0, sizeof(dlg));
snprintf(dlg.button, sizeof(dlg.button), "OK");
tDialogScript(dialogClick, &dlg);
TEST_EQ(DlgChoice("Pick", "p", "A|B|C", 1), 1);
TEST_EQ(DlgChoice("Pick", "p", "", 0), -1);
TEST_EQ(DlgChoice("Pick", "p", NULL, 0), -1);
// A list far longer than a fixed buffer (an index of hundreds of
// keywords): every item reaches the dialog
char *many = (char *)malloc(FRT_CHOICE_MANY * FRT_CHOICE_ITEM_LEN);
int32_t pos = 0;
TEST_TRUE(many != NULL);
if (many) {
for (int32_t i = 0; i < FRT_CHOICE_MANY; i++) {
pos += snprintf(many + pos, FRT_CHOICE_ITEM_LEN, i ? "|keyword %03d" : "keyword %03d", (int)i);
}
TEST_EQ(DlgChoice("Pick", "p", many, FRT_CHOICE_MANY - 1), FRT_CHOICE_MANY - 1);
free(many);
}
TEST_EQ(DlgColor("Color", FRT_COLOR_START), FRT_COLOR_START);
TEST_STR_EQ(dlg.title, "Color");
TEST_STR_EQ(DlgInputBox("T", "P", "dflt"), "dflt");
TEST_EQ(DlgInputCancelled(), 0);
TEST_EQ(DlgIntInput("T", "P", 5, 0, 9), 5);
TEST_EQ(DlgInputCancelled(), 0);
TEST_EQ(DlgIntInputStep("T", "P", 20, 0, 100, 10), 20);
TEST_EQ(DlgInputCancelled(), 0);
snprintf(dlg.button, sizeof(dlg.button), "Cancel");
TEST_EQ(DlgIntInputStep("T", "P", 20, 0, 100, 10), 20);
TEST_EQ(DlgInputCancelled(), -1);
TEST_EQ(DlgColor("Color", FRT_COLOR_START), -1);
TEST_STR_EQ(DlgInputBox("T", "P", "dflt"), "");
TEST_EQ(DlgInputCancelled(), -1);
TEST_EQ(DlgPromptSave("T"), DVX_SAVE_CANCEL);
snprintf(dlg.button, sizeof(dlg.button), "Yes");
TEST_EQ(DlgPromptSave("T"), DVX_SAVE_YES);
snprintf(dlg.button, sizeof(dlg.button), "No");
TEST_EQ(DlgPromptSave("T"), DVX_SAVE_NO);
// Typing into the VM-facing InputBox callback.
FileDlgCtxT typer;
memset(&typer, 0, sizeof(typer));
typer.typeText = "abc";
tDialogScript(fileDialogType, &typer);
BasStringT *typed = app.vm->ui.inputBox(app.vm->ui.ctx, "P", "T", "");
TEST_TRUE(typed != NULL && strcmp(typed->data, "abc") == 0);
basStringUnref(typed);
// Esc cancels: the VM callback reports NULL, the wrappers "".
memset(&typer, 0, sizeof(typer));
tDialogScript(fileDialogType, &typer);
TEST_PTR_EQ(app.vm->ui.inputBox(app.vm->ui.ctx, "P", "T", "d"), NULL);
// File dialogs: cancel through every filter form parseFileFilters
// accepts (none, old-style single pattern, piped labels).
memset(&typer, 0, sizeof(typer));
tDialogScript(fileDialogType, &typer);
TEST_STR_EQ(DlgFileOpen("Open", NULL), "");
TEST_STR_EQ(DlgFileOpen("Open", "*.txt"), "");
TEST_STR_EQ(DlgFileSave("Save", "Text (*.txt)|All (*.*)"), "");
TEST_TRUE(typer.seen >= 3);
// Accepting the save dialog with a typed name returns the path.
memset(&typer, 0, sizeof(typer));
typer.typeText = "ts_save_pick.txt";
tDialogScript(fileDialogType, &typer);
const char *savePick = DlgFileSave("Save", NULL);
TEST_TRUE(strstr(savePick, "ts_save_pick.txt") != NULL);
// The In forms start in the folder given: a typed name lands there
TEST_EQ(platformMkdirRecursive("ts_in_dir"), 0);
memset(&typer, 0, sizeof(typer));
typer.typeText = "ts_in_pick.txt";
tDialogScript(fileDialogType, &typer);
savePick = DlgFileSaveIn("Save", NULL, "ts_in_dir");
TEST_TRUE(strstr(savePick, "ts_in_dir") != NULL && strstr(savePick, "ts_in_pick.txt") != NULL);
memset(&typer, 0, sizeof(typer));
tDialogScript(fileDialogType, &typer);
TEST_STR_EQ(DlgFileOpenIn("Open", "", "ts_in_dir"), "");
TEST_TRUE(typer.seen >= 1);
// MsgBox default title.
memset(&dlg, 0, sizeof(dlg));
snprintf(dlg.button, sizeof(dlg.button), "OK");
tDialogScript(dialogClick, &dlg);
basFormRtMsgBox(app.rt, "hello", 0, NULL);
TEST_STR_EQ(dlg.title, "DVX BASIC");
tDialogScript(NULL, NULL);
frtDestroy(&app);
// The shipped include declares every wrapper.
int32_t len = 0;
char *commdlg = platformReadFile(FRT_INCLUDE_DIR "/commdlg.bas", &len);
TEST_TRUE(commdlg != NULL);
if (commdlg && expectBuild(&app, commdlg, &frm, 1)) {
frtDestroy(&app);
}
free(commdlg);
tShutdown();
}
static void caseDragDrop(void) {
tCase("drag and drop: DragMode, Drag, DragIcon, DragOver, DragDrop, Esc");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm =
"Begin Form Form1\n"
" Caption = \"Drag\"\n"
" Width = 400\n"
" Height = 300\n"
" Begin Label Src\n"
" Caption = \"Source\"\n"
" DragMode = 1\n"
" End\n"
" Begin TextBox Dst\n"
" End\n"
" Begin CommandButton Cmd1\n"
" Caption = \"Go\"\n"
" End\n"
"End\n"
"\n"
"Sub Src_Click\n"
" Print \"SrcClick\"\n"
"End Sub\n"
"Sub Src_MouseDown(Button As Integer, X As Integer, Y As Integer)\n"
" Print \"SrcDown\"\n"
"End Sub\n"
"Sub Dst_DragOver(Source As Control, X As Integer, Y As Integer, State As Integer)\n"
" Print \"Over \"; Source.Name; \" \"; State\n"
"End Sub\n"
"Sub Dst_DragDrop(Source As Control, X As Integer, Y As Integer)\n"
" Print \"Drop \"; Source.Name; \" \"; X; Y\n"
"End Sub\n"
"Sub Form1_DragDrop(Source As Control, X As Integer, Y As Integer)\n"
" Print \"FormDrop \"; Source.Name\n"
"End Sub\n"
"Sub Form1_DragOver(Source As Control, X As Integer, Y As Integer, State As Integer)\n"
" Print \"FormOver \"; State\n"
"End Sub\n"
"Sub Cmd1_MouseDown(Button As Integer, X As Integer, Y As Integer)\n"
" Cmd1.Drag vbBeginDrag\n"
"End Sub\n"
"Sub Cmd1_Click\n"
" Print \"CmdClick\"\n"
"End Sub\n"
"Sub Form1_Props\n"
" Print \"mode=\"; Src.DragMode; Cmd1.DragMode; \"[\"; Src.DragIcon; \"]\"\n"
" Cmd1.DragMode = vbAutomatic\n"
" Cmd1.DragMode = 5\n"
" Print \"mode2=\"; Cmd1.DragMode\n"
"End Sub\n"
"Sub Form1_BadAction\n"
" Src.Drag 7\n"
"End Sub\n";
FrtAppT app;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
BasFormT *form = frtForm(&app, "Form1");
BasControlT *src = frtCtrl(form, "Src");
BasControlT *dst = frtCtrl(form, "Dst");
BasControlT *cmd = frtCtrl(form, "Cmd1");
WindowT *win = form ? form->window : NULL;
int32_t sx = 0;
int32_t sy = 0;
int32_t dx = 0;
int32_t dy = 0;
int32_t cx = 0;
int32_t cy = 0;
char expect[64];
TEST_TRUE(src && dst && cmd && win);
if (!(src && dst && cmd && win)) {
frtDestroy(&app);
tShutdown();
return;
}
// Every form window's own key handler (Default / Cancel buttons), which
// a drag takes over and gives back.
void (*formKey)(WindowT *w, int32_t key, int32_t mod) = win->onKey;
int32_t fx = win->x + win->w / 2;
int32_t fy = win->y + win->contentY + win->contentH - FRT_FORM_EDGE;
tWidgetCenter(src->widget, &sx, &sy);
tWidgetCenter(dst->widget, &dx, &dy);
tWidgetCenter(cmd->widget, &cx, &cy);
snprintf(expect, sizeof(expect), "Drop Src %d %d \n", (int)(dst->widget->w / 2), (int)(dst->widget->h / 2));
// Properties, from the .frm and from code.
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form1", "Props"));
TEST_STR_EQ(frtOut(&app), "mode=1 0 []\nmode2=0 \n");
// DragMode automatic: the press drags (no Click or MouseDown), the
// outline moves onto Dst (vbEnter), the release drops there.
frtOutClear(&app);
tDrag(sx, sy, dx, dy);
outContains(&app, "Over Src 0 \n");
outContains(&app, expect);
TEST_TRUE(strstr(frtOut(&app), "SrcClick") == NULL);
TEST_TRUE(strstr(frtOut(&app), "SrcDown") == NULL);
TEST_TRUE(win->onMouse == widgetOnMouse);
TEST_TRUE(win->onKey == formKey);
// Over, then Leave onto the form, dropped on the form.
frtOutClear(&app);
tMouseMove(sx, sy);
tMouseDown(sx, sy, MOUSE_LEFT);
tMouseMove(dx, dy);
tMouseMove(dx + 1, dy);
tMouseMove(fx, fy);
tMouseUp(fx, fy, MOUSE_LEFT);
TEST_STR_EQ(frtOut(&app), "Over Src 0 \nOver Src 2 \nOver Src 1 \nFormOver 0 \nFormDrop Src\n");
// Escape cancels: no drop on the release.
frtOutClear(&app);
tMouseMove(sx, sy);
tMouseDown(sx, sy, MOUSE_LEFT);
tMouseMove(dx, dy);
tKeyEsc();
tMouseUp(dx, dy, MOUSE_LEFT);
TEST_STR_EQ(frtOut(&app), "Over Src 0 \n");
TEST_TRUE(win->onMouse == widgetOnMouse);
// The cursor: the no-drop sign over Cmd1 (no DragDrop handler), the
// arrow over Dst and the form (they have one); the usual cursor
// again once the drag is over.
tMouseMove(sx, sy);
tMouseDown(sx, sy, MOUSE_LEFT);
tMouseMove(cx, cy);
TEST_EQ(app.rt->ctx->cursorId, CURSOR_NO_DROP);
tMouseMove(dx, dy);
TEST_EQ(app.rt->ctx->cursorId, CURSOR_ARROW);
tMouseMove(cx, cy);
TEST_EQ(app.rt->ctx->cursorId, CURSOR_NO_DROP);
tMouseMove(fx, fy);
TEST_EQ(app.rt->ctx->cursorId, CURSOR_ARROW);
tMouseMove(cx, cy);
tKeyEsc();
TEST_TRUE(app.rt->ctx->cursorId != CURSOR_NO_DROP);
tMouseUp(cx, cy, MOUSE_LEFT);
TEST_TRUE(app.rt->ctx->cursorId != CURSOR_NO_DROP);
// Manual: Cmd1's MouseDown calls Drag; its release drops, no Click.
frtOutClear(&app);
tAdvanceClock(TIMER_INTERVAL_MS);
tDrag(cx, cy, dx, dy);
outContains(&app, "Drop Cmd1 ");
TEST_TRUE(strstr(frtOut(&app), "CmdClick") == NULL);
// Back in DragMode manual, Src clicks as usual.
frtOutClear(&app);
tAdvanceClock(TIMER_INTERVAL_MS);
src->dragMode = BAS_DRAGMODE_MANUAL;
tWidgetCenter(src->widget, &sx, &sy);
tClick(sx, sy);
TEST_STR_EQ(frtOut(&app), "SrcClick\nSrcDown\n");
// From code with the button up: vbEndDrag drops where the mouse is,
// 0 cancels, and the next click drops a drag begun from code.
frtOutClear(&app);
tMouseMove(dx, dy);
dragCallMethod(&app, src, BAS_DRAG_BEGIN);
dragCallMethod(&app, src, BAS_DRAG_END);
TEST_STR_EQ(frtOut(&app), expect);
frtOutClear(&app);
dragCallMethod(&app, src, BAS_DRAG_BEGIN);
dragCallMethod(&app, src, BAS_DRAG_CANCEL);
tClick(dx, dy);
TEST_TRUE(strstr(frtOut(&app), "Drop") == NULL);
frtOutClear(&app);
dragCallMethod(&app, src, BAS_DRAG_BEGIN);
tMouseMove(dx + 1, dy);
tAdvanceClock(TIMER_INTERVAL_MS);
tClick(dx, dy);
outContains(&app, expect);
// DragIcon: a readable picture is the feedback; a missing one falls
// back to the outline. Both drops still land.
setStrProp(&app, src, BAS_PROP_DRAGICON, FRT_FIXTURE_DIR "/icon.bmp");
// Read back, a picture property is a Picture object for the file
BasValueT icon = basFormRtGetProp(app.rt, src, BAS_PROP_DRAGICON);
const char *iconPath = basFormRtPicturePath(app.rt, icon);
TEST_TRUE(iconPath != NULL && strstr(iconPath, "icon.bmp") != NULL);
basValRelease(&icon);
frtOutClear(&app);
dragCallMethod(&app, src, BAS_DRAG_BEGIN);
dragCallMethod(&app, src, BAS_DRAG_END);
TEST_STR_EQ(frtOut(&app), expect);
setStrProp(&app, src, BAS_PROP_DRAGICON, FRT_FIXTURE_DIR "/noSuchIcon.bmp");
frtOutClear(&app);
dragCallMethod(&app, src, BAS_DRAG_BEGIN);
dragCallMethod(&app, src, BAS_DRAG_END);
TEST_STR_EQ(frtOut(&app), expect);
// A form created during the drag is hooked like the others and
// given back its handlers when the drag ends.
dragCallMethod(&app, src, BAS_DRAG_BEGIN);
BasFormT *late = (BasFormT *)basFormRtCreateForm(app.rt, "LateForm", 100, 80);
TEST_TRUE(late && late->window && late->window->onMouse != widgetOnMouse);
dragCallMethod(&app, src, BAS_DRAG_CANCEL);
TEST_TRUE(late && late->window && late->window->onMouse == widgetOnMouse && late->window->onKey == formKey);
// Removing the dragged control cancels its drag.
frtOutClear(&app);
dragCallMethod(&app, src, BAS_DRAG_BEGIN);
basFormRtRemoveCtrl(app.rt, form, "Src");
TEST_TRUE(win->onMouse == widgetOnMouse);
tAdvanceClock(TIMER_INTERVAL_MS);
tClick(dx, dy);
TEST_TRUE(strstr(frtOut(&app), "Drop") == NULL);
// An unknown Drag action is a runtime error.
TEST_TRUE(!app.rt->terminated);
frtFire(&app, "Form1", "BadAction");
TEST_TRUE(app.rt->terminated);
frtClearError(&app);
frtDestroy(&app);
tShutdown();
}
// DrawFocusRect on a PictureBox: libdvx's dotted focus pattern
// (drawFocusRectDots) in the given color or ForeColor, in the object's
// scale. At 16 bpp Point reads white and black back exactly, so a dot
// compares equal to ForeColor and the gap to BackColor (parhlp's check).
static void caseDrawFocusRect(void) {
tCase("DrawFocusRect drawing method");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm =
"Begin Form Form1\n"
" Caption = \"Focus\"\n"
" Begin PictureBox Pic\n"
" End\n"
"End\n"
"Sub Form1_T ()\n"
" Pic.Resize 40, 20\n"
" Pic.BackColor = RGB(0, 0, 255)\n"
" Pic.Cls\n"
" Pic.DrawFocusRect 0, 0, 10, 6, RGB(255, 0, 0)\n"
" Print Pic.Point(0, 0); Pic.Point(1, 0); Pic.Point(2, 0); Pic.Point(1, 5); Pic.Point(0, 2); Pic.Point(0, 1); Pic.Point(9, 1)\n"
" Pic.ForeColor = RGB(0, 255, 0)\n"
" Pic.DrawFocusRect 20, 10, -6, -4\n"
" Print Pic.Point(14, 6); Pic.Point(15, 6)\n"
"End Sub\n";
FrtAppT app;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
TEST_TRUE(frtFire(&app, "Form1", "T"));
TEST_STR_EQ(frtOut(&app),
"255 16711680 255 255 255 16711680 255 \n"
"65280 16711680 \n");
frtDestroy(&app);
tShutdown();
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP_16);
const char *frm16 =
"Begin Form Form1\n"
" Caption = \"Focus16\"\n"
" Begin PictureBox Pic\n"
" Visible = False\n"
" End\n"
"End\n"
"Sub Form1_T ()\n"
" Pic.Resize 20, 8\n"
" Pic.BackColor = RGB(255, 255, 255)\n"
" Pic.ForeColor = RGB(0, 0, 0)\n"
" Pic.Cls\n"
" Pic.DrawFocusRect 0, 0, 20, 8\n"
" Print Pic.Point(0, 0); Pic.Point(1, 0); Pic.Point(2, 0); Pic.Point(1, 0) = Pic.BackColor\n"
"End Sub\n";
if (!expectBuild(&app, "", &frm16, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
TEST_TRUE(frtFire(&app, "Form1", "T"));
TEST_STR_EQ(frtOut(&app), "0 16777215 0 True \n");
frtDestroy(&app);
tShutdown();
}
// Form / PictureBox drawing methods (Phase 4): the QBasic drawing code
// on canvases, with RGB colours.
static void caseDrawMethods(void) {
tCase("Form and PictureBox drawing methods");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm =
"Begin Form Form1\n"
" Caption = \"Draw\"\n"
" Begin PictureBox Pic\n"
" End\n"
" Begin PictureBox Pic2\n"
" End\n"
"End\n"
"Sub Form1_T ()\n"
" Pic.Resize 40, 30\n"
" Pic.BackColor = RGB(0, 0, 255)\n"
" Pic.Line (0, 0)-(9, 0), RGB(255, 0, 0)\n"
" Pic.Line (10, 10)-(20, 20), RGB(0, 255, 0), BF\n"
" Pic.Circle (30, 15), 5, RGB(255, 255, 0)\n"
" Pic.PSet (1, 5), RGB(255, 0, 0)\n"
" Print Pic.Point(5, 0); Pic.Point(15, 15); Pic.Point(39, 29); Pic.Point(35, 15); Pic.Point(99, 99)\n"
" Print Pic.CurrentX; Pic.CurrentY; Pic.ScaleWidth; Pic.ScaleHeight; Pic.TextWidth(\"abc\"); Pic.TextHeight(\"a\")\n"
" Pic.DrawWidth = 3\n"
" Pic.PSet (25, 25), 0\n"
" Pic.DrawWidth = 1\n"
" Pic.FillStyle = 0\n"
" Pic.FillColor = RGB(255, 0, 255)\n"
" Pic.Circle (5, 20), 4, RGB(255, 255, 255)\n"
" Pic.Line (30, 0)-(39, 5), RGB(255, 255, 255), B\n"
" Print Pic.Point(26, 25); Pic.Point(5, 20); Pic.Point(34, 2); Pic.Point(30, 0)\n"
" Pic.CurrentX = 0\n"
" Pic.CurrentY = 0\n"
" Pic.ForeColor = RGB(255, 255, 255)\n"
" Pic.Print \"Hi\";\n"
" Print Pic.CurrentX; Pic.CurrentY;\n"
" Pic.Print\n"
" Print Pic.CurrentX; Pic.CurrentY\n"
" Pic2.Resize 40, 30\n"
" Pic2.PaintPicture \"Pic\", 0, 0\n"
" Pic2.PaintPicture \"Pic\", 0, 0, 20, 15, 10, 10, 20, 20\n"
" Print Pic2.Point(30, 15); Pic2.Point(5, 5)\n"
" Pic.Cls\n"
" Print Pic.Point(15, 15); Pic.CurrentX; Pic.AutoRedraw\n"
" Me.Line (0, 0)-(5, 5), RGB(255, 0, 0)\n"
" Me.Circle (20, 20), 5\n"
" Dim lowest As Double\n"
" lowest = -2147483648#\n"
" Pic.Print Tab(lowest); \"z\"\n"
"End Sub\n";
FrtAppT app;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
TEST_TRUE(frtFire(&app, "Form1", "T"));
TEST_STR_EQ(frtOut(&app),
"255 65280 16711680 65535 -1 \n"
"1 5 40 30 24 16 \n"
"0 16711935 16711935 16777215 \n"
"16 0 0 16 \n"
"16711680 65280 \n"
"16711680 0 False \n");
BasFormT *form = frtForm(&app, "Form1");
TEST_TRUE(form != NULL && form->formCtrl.draw != NULL);
frtDestroy(&app);
tShutdown();
}
// AutoRedraw and Paint (round 2): Paint fires when the form is shown, on
// Refresh and (round 3) after a PictureBox size change; AutoRedraw True
// stops it; AutoRedraw = False set by the program clears to BackColor
// before Paint.
static void caseDrawPaint(void) {
tCase("Paint events and AutoRedraw");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm =
"Begin Form Form1\n"
" Caption = \"Paint\"\n"
" Begin PictureBox Pic\n"
" End\n"
"End\n"
"Dim Shared fp As Integer\n"
"Dim Shared pp As Integer\n"
"Sub Form1_Paint ()\n"
" fp = fp + 1\n"
"End Sub\n"
"Sub Pic_Paint ()\n"
" pp = pp + 1\n"
"End Sub\n"
"Sub Form1_T ()\n"
" Print fp > 0; pp > 0\n"
" fp = 0\n"
" pp = 0\n"
" Pic.Resize 20, 20\n"
" Pic.PSet (1, 1), RGB(255, 0, 0)\n"
" Pic.Refresh\n"
" Print fp; pp; Pic.Point(1, 1)\n"
" Pic.AutoRedraw = True\n"
" Pic.Refresh\n"
" Print pp; Pic.AutoRedraw\n"
" Pic.AutoRedraw = False\n"
" Pic.Refresh\n"
" Print pp; Pic.Point(1, 1)\n"
" Me.Refresh\n"
" Print fp\n"
" pp = 0\n"
" Pic.Width = 40\n"
" Pic.Width = 40\n"
" Pic.Height = 30\n"
" Print pp\n"
"End Sub\n";
FrtAppT app;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
// The Resize method and a Width / Height that changes repaint (Paint);
// setting the same size again does not
frtStart(&app, NULL);
TEST_TRUE(frtFire(&app, "Form1", "T"));
TEST_STR_EQ(frtOut(&app),
"True True \n"
"0 2 255 \n"
"2 True \n"
"3 16777215 \n"
"1 \n"
"2 \n");
frtDestroy(&app);
tShutdown();
}
// ScaleMode, ScaleLeft / Top / Width / Height, Scale and hatched
// FillStyles on a PictureBox (round 2).
static void caseDrawScale(void) {
tCase("Scale, ScaleMode and hatch fills");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm =
"Begin Form Form1\n"
" Caption = \"Scale\"\n"
" Begin PictureBox Pic\n"
" End\n"
"End\n"
"Sub Form1_T ()\n"
" Pic.Resize 40, 30\n"
" Pic.BackColor = RGB(255, 255, 255)\n"
" Print Pic.ScaleMode; Pic.ScaleWidth\n"
" Pic.ScaleMode = 1\n"
" Print Pic.ScaleWidth; Pic.ScaleHeight; Pic.TextHeight(\"a\")\n"
" Pic.PSet (150, 150), RGB(255, 0, 0)\n"
" Pic.ScaleMode = 3\n"
" Print Pic.Point(10, 10)\n"
" Pic.Scale (0, 0)-(4, 3)\n"
" Print Pic.ScaleMode; Pic.ScaleWidth; Pic.ScaleHeight; Pic.TextWidth(\"ab\")\n"
" Pic.Line (1, 1)-(2, 2), RGB(0, 255, 0), BF\n"
" Print Pic.Point(1.5, 1.5)\n"
" Pic.Scale (0, 3)-(4, 0)\n"
" Pic.PSet (0.2, 0.2), RGB(0, 0, 255)\n"
" Print Pic.ScaleTop; Pic.ScaleHeight\n"
" Pic.ScaleLeft = -2\n"
" Print Pic.ScaleMode; Pic.ScaleLeft\n"
" Pic.Scale\n"
" Print Pic.ScaleMode; Pic.ScaleWidth; Pic.Point(2, 28)\n"
" Pic.Cls\n"
" Pic.FillColor = RGB(0, 0, 0)\n"
" Pic.FillStyle = 2\n"
" Pic.Line (0, 0)-(39, 29), RGB(255, 0, 0), B\n"
" Print Pic.Point(5, 8); Pic.Point(5, 9)\n"
" Pic.Cls\n"
" Pic.FillStyle = 6\n"
" Pic.Circle (20, 15), 12, RGB(255, 0, 0)\n"
" Print Pic.Point(16, 13); Pic.Point(17, 13)\n"
" Pic.Cls\n"
" Pic.FillStyle = 4\n"
" Pic.Line (0, 0)-(39, 29), RGB(255, 0, 0), B\n"
" Print Pic.Point(3, 5); Pic.Point(4, 5); Pic.FillStyle\n"
" Pic.CurrentX = 0\n"
" Pic.CurrentY = 0\n"
" Pic.Scale (0, 0)-(20, 15)\n"
" Pic.Print \"x\"\n"
" Print Pic.CurrentX; Pic.CurrentY\n"
" Pic.FillStyle = 9\n"
"End Sub\n";
FrtAppT app;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
frtFire(&app, "Form1", "T");
TEST_STR_EQ(frtOut(&app),
"3 40 \n"
"600 450 240 \n"
"255 \n"
"0 4 3 1.6 \n"
"65280 \n"
"3 -3 \n"
"0 -2 \n"
"3 40 16711680 \n"
"0 16777215 \n"
"0 16777215 \n"
"0 16777215 4 \n"
"0 8 \n");
TEST_TRUE(app.rt->terminated);
frtClearError(&app);
frtDestroy(&app);
tShutdown();
}
// The drawing members that draw DVX's own look through libdvx on a
// PictureBox (DrawBevel, DrawButtonFace, DrawArrow, DrawScrollBar upright
// and horizontal, DrawScrollArrow, PrintAccel), the measuring ones
// (AccelKey, TextWidthAccel, ScrollBarClick along either axis and in a
// scale), PaintPicture's vbGrayCopy and vbTransparentCopy, and the
// errors for bad arguments.
static void caseDrawThemed(void) {
tCase("DrawBevel / DrawButtonFace / DrawArrow / DrawScrollBar / DrawScrollArrow / PrintAccel / AccelKey / vbGrayCopy / ScrollBarsNeeded / FontScale");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm =
"Begin Form Form1\n"
" Caption = \"Themed\"\n"
" Begin PictureBox Pic1\n"
" Width = 120\n"
" Height = 100\n"
" End\n"
"End\n"
"\n"
"Sub Form1_Draw\n"
" Pic1.DrawBevel 0, 0, 20, 20\n"
" Pic1.DrawBevel 30, 0, 20, 20, True, vbRed, 3\n"
" Pic1.DrawButtonFace 60, 0, 20, 20, True, vbGreen\n"
" Pic1.DrawArrow 10, 40, 4, dvxArrowDown, vbBlue\n"
" Pic1.DrawScrollBar 100, 0, 80, 5, 10, 50\n"
" Pic1.CurrentX = 0\n"
" Pic1.CurrentY = 60\n"
" Pic1.PrintAccel \"&Go\"\n"
" Print Pic1.Point(40, 10) = vbRed; Pic1.Point(70, 10) = vbGreen; Pic1.Point(10, 40) = vbBlue; Pic1.CurrentX = Pic1.TextWidthAccel(\"&Go\")\n"
" Print Pic1.AccelKey(\"&File\"); \"|\"; Pic1.AccelKey(\"None\"); \"|\"; Pic1.TextWidthAccel(\"&File\") = Pic1.TextWidth(\"File\")\n"
" Print Pic1.ScrollBarClick(80, 2, 5, 10, 50); Pic1.ScrollBarClick(80, 78, 5, 10, 50); vbLeftButton\n"
"End Sub\n"
"Sub Form1_Gray\n"
" Pic1.Cls\n"
" Pic1.PaintPicture LoadPicture(\"" FRT_FIXTURE_DIR "/icon.bmp\"), 0, 0, 32, 32, 0, 0, 32, 32, vbGrayCopy\n"
" c = Pic1.Point(16, 16)\n"
" Print (c And &HFF) = ((c \\ &H100) And &HFF)\n"
"End Sub\n"
"Sub Form1_Keyed\n"
" Pic1.BackColor = vbBlue\n"
" Pic1.PaintPicture LoadPicture(\"" FRT_FIXTURE_DIR "/icon.bmp\"), 0, 0, 32, 32, 0, 0, 32, 32, vbTransparentCopy\n"
" Print Pic1.Point(0, 0) = vbBlue\n"
"End Sub\n"
"Sub Form1_HBar\n"
" Pic1.Cls\n"
" Pic1.DrawScrollBar 0, 82, 96, 20, 16, 80, True\n"
" Pic1.DrawScrollArrow 40, 30, 16, dvxArrowRight\n"
" Print Pic1.ScrollBarClick(96, 2, 20, 16, 80, True); Pic1.ScrollBarClick(96, 94, 20, 16, 80, True); Pic1.ScrollBarClick(96, 20, 20, 16, 80, True); Pic1.ScrollBarClick(96, 70, 20, 16, 80, True); Pic1.ScrollBarClick(96, 40, 20, 16, 80, True)\n"
" Pic1.Scale (0, 0)-(Pic1.ScaleWidth * 2, Pic1.ScaleHeight / 2)\n"
" Print Pic1.ScrollBarClick(192, 20, 20, 16, 80, True); Pic1.ScrollBarClick(192, 20, 20, 16, 80)\n"
" Pic1.Scale\n"
" Pic1.Scale (0, 100)-(Pic1.ScaleWidth, 100 + Pic1.ScaleHeight)\n"
" Print Pic1.ScrollBarClick(80, 78, 5, 10, 50)\n"
"End Sub\n"
"Sub Form1_Ctrl\n"
" Pic1.Scale\n"
" Pic1.Cls\n"
" Pic1.Line (0, 0)-(39, 39), vbRed, BF\n"
" Pic1.DrawBevel 0, 0, 40, 40, True, -1\n"
" Pic1.DrawScrollBar 60, 0, 80, 5, 10, 50, False, True\n"
" Print Pic1.Point(20, 20) = vbRed; Pic1.ScrollBarClick(80, 2, 5, 10, 50, False, True); Pic1.ScrollBarClick(80, 78, 5, 10, 50, False, True); Pic1.ScrollBarClick(80, 60, 5, 10, 50, False, True)\n"
"End Sub\n"
"Sub Form1_Needs\n"
" Pic1.Scale\n"
" Print Pic1.ScrollBarsNeeded(50, 50, 100, 100) = vbSBNone; Pic1.ScrollBarsNeeded(50, 200, 100, 100) = vbVertical; Pic1.ScrollBarsNeeded(200, 50, 100, 100) = vbHorizontal; Pic1.ScrollBarsNeeded(200, 200, 100, 100) = vbBoth\n"
" Print Pic1.ScrollBarsNeeded(90, 200, 100, 100); Pic1.ScrollBarsNeeded(200, 90, 100, 100); vbBoth\n"
" Pic1.Scale (0, 0)-(Pic1.ScaleWidth * 2, Pic1.ScaleHeight / 2)\n"
" Print Pic1.ScrollBarsNeeded(180, 100, 200, 50)\n"
" Pic1.Scale\n"
"End Sub\n"
"Sub Form1_FontScale\n"
" Dim x As Integer\n"
" Dim y As Integer\n"
" Dim bad As Integer\n"
" Pic1.Scale\n"
" Pic1.Cls\n"
" Pic1.CurrentX = 0\n"
" Pic1.CurrentY = 0\n"
" Pic1.Print \"A\";\n"
" Pic1.FontScale = 3\n"
" Pic1.CurrentX = 20\n"
" Pic1.CurrentY = 0\n"
" Pic1.Print \"A\";\n"
" For y = 0 To 15\n"
" For x = 0 To 7\n"
" If Pic1.Point(20 + 3 * x, 3 * y) <> Pic1.Point(x, y) Or Pic1.Point(22 + 3 * x, 3 * y + 2) <> Pic1.Point(x, y) Then bad = bad + 1\n"
" Next\n"
" Next\n"
" Print bad; Pic1.Point(3, 7) <> Pic1.BackColor; Pic1.CurrentX; Pic1.TextWidth(\"AB\"); Pic1.TextHeight(\"A\"); Pic1.FontScale\n"
" Pic1.FontScale = 1\n"
"End Sub\n"
"Sub Form1_BadFontScale\n"
" Pic1.FontScale = 9\n"
"End Sub\n"
"Sub Form1_BadArrow\n"
" Pic1.DrawArrow 10, 10, 4, 9\n"
"End Sub\n"
"Sub Form1_BadBevel\n"
" Pic1.DrawBevel 1, 2\n"
"End Sub\n"
"Sub Form1_BadScrollArrow\n"
" Pic1.DrawScrollArrow 1, 2, 16, dvxArrowUp, vbRed\n"
"End Sub\n"
"Sub Form1_BadScrollBar\n"
" Pic1.DrawScrollBar 0, 0, 50, 0, 1, 2, True, True, 9\n"
"End Sub\n"
"Sub Form1_BadBarClick\n"
" Print Pic1.ScrollBarClick(50, 2, 0, 1, 2, True, True, 9)\n"
"End Sub\n"
"Sub Form1_BadNeeds\n"
" Print Pic1.ScrollBarsNeeded(50, 2, 0)\n"
"End Sub\n";
const char *bad[] = { "BadArrow", "BadBevel", "BadScrollArrow", "BadScrollBar", "BadBarClick", "BadNeeds", "BadFontScale" };
FrtAppT app;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
BasFormT *form = frtForm(&app, "Form1");
BasControlT *pic = form ? frtCtrl(form, "Pic1") : NULL;
TEST_TRUE(pic != NULL);
if (!pic) {
frtDestroy(&app);
tShutdown();
return;
}
char want[FRT_DRAW_WANT_LEN];
snprintf(want, sizeof(want), "True True True True \nf||True \n4 6 %d \n", (int)MOUSE_LEFT);
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form1", "Draw"));
TEST_STR_EQ(frtOut(&app), want);
TEST_EQ(wgtCanvasGetPixel(pic->widget, 0, 0), tCtx()->colors.windowHighlight);
TEST_EQ(wgtCanvasGetPixel(pic->widget, 30, 0), tCtx()->colors.windowShadow);
TEST_EQ(wgtCanvasGetPixel(pic->widget, 19, 19), tCtx()->colors.windowShadow);
TEST_EQ(wgtCanvasGetPixel(pic->widget, FRT_VBAR_X, FRT_VBAR_END_Y), tCtx()->colors.windowShadow);
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form1", "Gray"));
TEST_TRUE(frtFire(&app, "Form1", "Keyed"));
TEST_STR_EQ(frtOut(&app), "True \nTrue \n");
// A horizontal bar: arrows one item, the trough a page (left and
// right of the thumb), the thumb nothing; its length and offset in
// the horizontal scale (a vertical bar in the same numbers is far
// longer); an offset counts from the bar, not the scale's origin.
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form1", "HBar"));
TEST_STR_EQ(frtOut(&app), "19 21 4 36 20 \n19 4 \n6 \n");
drawThemedHBarCheck(pic->widget);
// DrawBevel's face -1 keeps the inside; a control's scroll bar (as
// ListBox's: WGT_SB_W wide, its rule for arrows and trough)
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form1", "Ctrl"));
TEST_STR_EQ(frtOut(&app), "True 4 6 15 \n");
TEST_TRUE(wgtCanvasGetPixel(pic->widget, FRT_CBAR_X + WGT_SB_W - 1, FRT_CBAR_Y) != wgtCanvasGetPixel(pic->widget, FRT_CBAR_X + WGT_SB_W, FRT_CBAR_Y));
TEST_TRUE(!app.rt->terminated);
frtOutClear(&app);
// Each bar alone, both, one bar making the other needed, and sizes in
// the object's scale (raw, the last would need only the vertical bar)
TEST_TRUE(frtFire(&app, "Form1", "Needs"));
TEST_STR_EQ(frtOut(&app), "True True True True \n3 3 3 \n3 \n");
TEST_TRUE(!app.rt->terminated);
frtOutClear(&app);
// FontScale 3: every dot of the glyph a 3 x 3 block (the "A" printed
// at 1 and at 3 compared), Print and TextWidth / TextHeight at that size
TEST_TRUE(frtFire(&app, "Form1", "FontScale"));
TEST_STR_EQ(frtOut(&app), "0 True 44 48 48 3 \n");
TEST_TRUE(!app.rt->terminated);
frtDestroy(&app);
for (int32_t i = 0; i < (int32_t)DVX_ARRAY_LEN(bad); i++) {
if (!expectBuild(&app, "", &frm, 1)) {
break;
}
frtStart(&app, NULL);
frtFire(&app, "Form1", bad[i]);
if (!app.rt->terminated) {
printf(" drawing error case %s did not stop the program\n", bad[i]);
}
TEST_TRUE(app.rt->terminated);
frtDestroy(&app);
}
tShutdown();
}
// A control whose interface is dynamic (WgtDynIfaceT, as a BASIC
// UserControl will be): the .frm, property reads and writes and a
// WGT_SIG_DYNAMIC method with mixed arguments all go through the hooks.
static void caseDynamicControl(void) {
tCase("a dynamic-interface control from a .frm and from BASIC code");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
if (sFrtDynType < 0) {
sFrtDynType = wgtRegisterClass(&sFrtDynClass);
wgtRegisterIface(FRT_DYN_TYPE, &sFrtDynIface);
wgtIfaceSetType(FRT_DYN_TYPE, sFrtDynType);
}
const char *frm =
"Begin Form Form1\n"
" Caption = \"Dyn\"\n"
" Begin " FRT_DYN_BAS " Dyn1\n"
" Title = \"start\"\n"
" End\n"
"End\n"
"Sub Form1_Dyn\n"
" If Dyn1.Title = \"start\" Then Print \"t1\";\n"
" Dyn1.Title = 42\n"
" If Dyn1.Title = \"42\" Then Print \" t2\";\n"
" If Dyn1.Level = 9 Then Print \" lv\";\n"
" If Dyn1.Ping(\"a\", 2, 2.5, True) = 4 Then Print \" ping\"\n"
"End Sub\n";
FrtAppT app;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form1", "Dyn"));
TEST_STR_EQ(frtOut(&app), "t1 t2 lv ping\n");
TEST_STR_EQ(sFrtDynArgTypes, "SIDB");
frtDestroy(&app);
tShutdown();
}
// The code editor members from BASIC: TextArea selection, lines,
// clipboard commands, ReplaceSelection, syntax colours, line markers,
// MaxLength and GutterClick; TextBox Mask.
static void caseEditorMembers(void) {
tCase("TextArea editor members, GutterClick and TextBox Mask from BASIC");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm =
"Begin Form Form1\n"
" Caption = \"Ed\"\n"
" Width = 400\n"
" Height = 300\n"
" Begin TextArea Ed\n"
" Weight = 1\n"
" End\n"
" Begin TextBox Phone\n"
" End\n"
"End\n"
"\n"
"Sub Form1_Edit\n"
" Ed.Text = \"one\" & Chr$(10) & \"two three\" & Chr$(10) & \"four\"\n"
" Ed.SetShowLineNumbers True\n"
" Print Ed.LineCount; Ed.GetLine(2); \"|\"; Ed.MaxLength\n"
" Ed.SetCursor 2, 5\n"
" Print Ed.CursorLine; Ed.CursorCol; Ed.SelStart\n"
" Ed.SelLength = 5\n"
" Print Ed.SelText; Ed.SelLength\n"
" Ed.SelText = \"3\"\n"
" Print Ed.GetLine(2); \"|\"\n"
" Ed.SelStart = 0\n"
" Ed.SelLength = 3\n"
" Ed.Cut\n"
" Print \"[\"; Ed.GetLine(1); \"]\"\n"
" Ed.Undo\n"
" Ed.CursorToEnd\n"
" Ed.Paste\n"
" Print Ed.GetLine(3); \"|\"\n"
" Ed.SelectAll\n"
" Ed.Copy\n"
" Print Ed.SelLength = Len(Ed.Text); Clipboard.GetText() = Ed.Text\n"
" Ed.SetCursor 1, 1\n"
" Print Ed.FindNext(\"two\", False, True); Ed.ReplaceSelection(\"two\", \"2\", False, True); Ed.GetLine(2)\n"
" Ed.SetSyntaxColor 1, RGB(255, 0, 0)\n"
" Print Ed.GetSyntaxColor(1) = RGB(255, 0, 0); Ed.GetSyntaxColor(0)\n"
" Ed.SetSyntaxColor 1, -1\n"
" Ed.SetLineMarker 2, RGB(200, 0, 0), -1\n"
" Ed.ClearLineMarkers\n"
" Ed.MaxLength = 4\n"
" Print Ed.MaxLength; Ed.Text\n"
" Ed.MaxLength = 0\n"
" Phone.Text = \"5551234\"\n"
" Phone.Mask = \"(###) ###-####\"\n"
" Print Phone.Text; \" \"; Phone.Mask\n"
" Phone.Mask = \"\"\n"
" Print Phone.Text; \" [\"; Phone.Mask; \"]\"\n"
"End Sub\n"
"Sub Form1_Lines\n"
" Ed.Text = \"a\" & Chr$(10) & \"b\" & Chr$(10) & \"c\"\n"
"End Sub\n"
"Sub Ed_GutterClick(LineNumber As Integer)\n"
" Print \"gutter\"; LineNumber\n"
"End Sub\n";
FrtAppT app;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form1", "Edit"));
TEST_STR_EQ(frtOut(&app),
"3 two three|65536 \n"
"2 5 8 \n"
"three5 \n"
"two 3|\n"
"[]\n"
"fourone|\n"
"True True \n"
"True True 2 3\n"
"True -1 \n"
"4 one\n\n"
"(555) 123-4___ (###) ###-####\n"
"(555) 123-4___ []\n");
// A click in the line-number gutter: GutterClick with the line
BasFormT *form = frtForm(&app, "Form1");
BasControlT *ed = form ? frtCtrl(form, "Ed") : NULL;
TEST_TRUE(ed != NULL);
if (ed) {
int32_t cx;
int32_t cy;
TEST_TRUE(frtFire(&app, "Form1", "Lines"));
tPump(2);
tWidgetCenter(ed->widget, &cx, &cy);
frtOutClear(&app);
tClick(cx - ed->widget->w / 2 + FRT_GUTTER_X, cy - ed->widget->h / 2 + FRT_LINE_Y + tCtx()->font.charHeight);
TEST_STR_EQ(frtOut(&app), "gutter2 \n");
}
frtDestroy(&app);
tShutdown();
}
static void caseEventLoopExits(void) {
tCase("basFormRtEventLoop exit conditions");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm =
"Begin Form Form1\n"
" Caption = \"Loop\"\n"
" Begin CommandButton Quit\n"
" Caption = \"Quit\"\n"
" End\n"
"End\n"
"\n"
"Sub Quit_Click\n"
" Unload Me\n"
"End Sub\n";
FrtAppT app;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
// Guard paths first: NULL runtime and a stopped context return at once.
basFormRtEventLoop(NULL);
tCtx()->running = false;
basFormRtEventLoop(app.rt);
tCtx()->running = true;
// Queue a click on the Quit button, then enter the loop: the click is
// consumed inside the loop, the handler unloads the last form, and
// the loop exits on the empty form list.
BasFormT *form = frtForm(&app, "Form1");
BasControlT *quit = frtCtrl(form, "Quit");
int32_t sx = 0;
int32_t sy = 0;
tWidgetCenter(quit->widget, &sx, &sy);
hostMousePush(sx, sy, 0);
hostMousePush(sx, sy, MOUSE_LEFT);
hostMousePush(sx, sy, 0);
basFormRtEventLoop(app.rt);
TEST_EQ((int32_t)arrlen(app.rt->forms), 0);
frtDestroy(&app);
// A runtime error inside a handler terminates the loop.
const char *frmErr =
"Begin Form Form1\n"
" Caption = \"LoopErr\"\n"
" Begin CommandButton Boom\n"
" Caption = \"Boom\"\n"
" End\n"
"End\n"
"\n"
"Sub Boom_Click\n"
" NoSuchCtrl.Text = \"x\"\n"
"End Sub\n";
if (!expectBuild(&app, "", &frmErr, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
form = frtForm(&app, "Form1");
BasControlT *boom = frtCtrl(form, "Boom");
tWidgetCenter(boom->widget, &sx, &sy);
hostMousePush(sx, sy, 0);
hostMousePush(sx, sy, MOUSE_LEFT);
hostMousePush(sx, sy, 0);
basFormRtEventLoop(app.rt);
TEST_TRUE(app.rt->terminated);
TEST_TRUE(app.dialogsDismissed >= 1);
frtDestroy(&app);
tShutdown();
}
static void caseEvents(void) {
tCase("every BAS_EVENT_LIST event reaches its handler");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm =
"Begin Form Form1\n"
" Caption = \"Ev\"\n"
" Width = 400\n"
" Height = 300\n"
" Begin TextBox Txt1\n"
" End\n"
" Begin CommandButton Cmd1\n"
" Caption = \"Go\"\n"
" End\n"
" Begin Label Lbl1\n"
" Caption = \"Label\"\n"
" End\n"
" Begin ListBox Lst1\n"
" End\n"
" Begin Timer Tmr1\n"
" Interval = 100\n"
" Enabled = False\n"
" End\n"
" Begin Data Dat1\n"
" End\n"
"End\n"
"\n"
"Sub Form1_Load\n"
" Print \"Load\"\n"
"End Sub\n"
"Sub Form1_Unload\n"
" Print \"Unload\"\n"
"End Sub\n"
"Sub Form1_QueryUnload(Cancel As Integer)\n"
" Print \"QueryUnload=\"; Cancel\n"
"End Sub\n"
"Sub Form1_Resize\n"
" Print \"Resize\"\n"
"End Sub\n"
"Sub Form1_Activate\n"
" Print \"Activate\"\n"
"End Sub\n"
"Sub Form1_Deactivate\n"
" Print \"Deactivate\"\n"
"End Sub\n"
"Sub Cmd1_Click\n"
" Print \"Click\"\n"
"End Sub\n"
"Sub Lst1_DblClick\n"
" Print \"DblClick\"\n"
"End Sub\n"
"Sub Txt1_Change\n"
" Print \"Change=\"; Txt1.Text\n"
"End Sub\n"
"Sub Tmr1_Timer\n"
" Print \"Timer\"\n"
"End Sub\n"
"Sub Txt1_GotFocus\n"
" Print \"GotFocus\"\n"
"End Sub\n"
"Sub Txt1_LostFocus\n"
" Print \"LostFocus\"\n"
"End Sub\n"
"Sub Txt1_KeyPress(KeyAscii As Integer)\n"
" Print \"KeyPress=\"; KeyAscii\n"
"End Sub\n"
"Sub Txt1_KeyDown(KeyCode As Integer, Shift As Integer)\n"
" Print \"KeyDown=\"; KeyCode; Shift\n"
"End Sub\n"
"Sub Txt1_KeyUp(KeyCode As Integer, Shift As Integer)\n"
" Print \"KeyUp=\"; KeyCode; Shift\n"
"End Sub\n"
"Sub Lbl1_MouseDown(Button As Integer, X As Integer, Y As Integer)\n"
" Print \"MouseDown=\"; Button; X; Y\n"
"End Sub\n"
"Sub Lbl1_MouseUp(Button As Integer, X As Integer, Y As Integer)\n"
" Print \"MouseUp=\"; Button; X; Y\n"
"End Sub\n"
"Sub Lbl1_MouseMove(Button As Integer, X As Integer, Y As Integer)\n"
" Print \"MouseMove=\"; Button; X; Y\n"
"End Sub\n"
"Sub Lst1_Scroll(Delta As Integer)\n"
" Print \"Scroll=\"; Delta\n"
"End Sub\n"
"Sub Dat1_Reposition\n"
" Print \"Reposition\"\n"
"End Sub\n"
"Sub Txt1_Validate(Cancel As Integer)\n"
" Print \"Validate=\"; Cancel\n"
"End Sub\n";
FrtAppT app;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
BasFormT *form = frtForm(&app, "Form1");
BasControlT *txt = frtCtrl(form, "Txt1");
BasControlT *cmd = frtCtrl(form, "Cmd1");
BasControlT *lbl = frtCtrl(form, "Lbl1");
BasControlT *lst = frtCtrl(form, "Lst1");
BasControlT *tmr = frtCtrl(form, "Tmr1");
BasControlT *dat = frtCtrl(form, "Dat1");
int32_t sx = 0;
int32_t sy = 0;
TEST_TRUE(txt && cmd && lbl && lst && tmr && dat);
if (!(txt && cmd && lbl && lst && tmr && dat)) {
frtDestroy(&app);
tShutdown();
return;
}
// Lifecycle: Resize fires from the .frm geometry apply, Load after
// the controls exist, Activate on Show.
outContains(&app, "Resize\n");
outContains(&app, "Load\n");
outContains(&app, "Activate\n");
TEST_TRUE(strstr(frtOut(&app), "Resize") < strstr(frtOut(&app), "Load"));
TEST_TRUE(strstr(frtOut(&app), "Load") < strstr(frtOut(&app), "Activate"));
// Click / DblClick through the full input path.
frtOutClear(&app);
tWidgetCenter(cmd->widget, &sx, &sy);
tClick(sx, sy);
outContains(&app, "Click\n");
// DblClick comes from list-type widgets on a selected row; drive the
// wired callback directly.
frtOutClear(&app);
lst->widget->onDblClick(lst->widget);
TEST_STR_EQ(frtOut(&app), "DblClick\n");
// Focus + keys on the text box (the button holds focus first).
tWidgetClick(cmd->widget);
frtOutClear(&app);
tWidgetCenter(txt->widget, &sx, &sy);
tClick(sx, sy);
TEST_PTR_EQ(wgtGetFocused(), txt->widget);
outContains(&app, "GotFocus\n");
frtOutClear(&app);
tType("a");
outContains(&app, "KeyPress=97 \n");
outContains(&app, "KeyDown=97 0 \n");
outContains(&app, "KeyUp=");
outContains(&app, "Change=a\n");
// LostFocus when the button takes focus.
frtOutClear(&app);
tWidgetCenter(cmd->widget, &sx, &sy);
tClick(sx, sy);
outContains(&app, "LostFocus\n");
// Mouse events on a plain widget carry button and widget-relative
// coordinates.
frtOutClear(&app);
tWidgetCenter(lbl->widget, &sx, &sy);
tMouseMove(sx, sy);
tMouseDown(sx, sy, MOUSE_LEFT);
tMouseUp(sx, sy, MOUSE_LEFT);
tPump(1);
char expect[64];
snprintf(expect, sizeof(expect), "MouseDown=1 %d %d \n", (int)(lbl->widget->w / 2), (int)(lbl->widget->h / 2));
outContains(&app, expect);
snprintf(expect, sizeof(expect), "MouseUp=1 %d %d \n", (int)(lbl->widget->w / 2), (int)(lbl->widget->h / 2));
outContains(&app, expect);
outContains(&app, "MouseMove=0 ");
// Scroll carries the wheel delta (the list has nothing to scroll, so
// drive the wired callback directly).
frtOutClear(&app);
lst->widget->onScroll(lst->widget, 3);
TEST_STR_EQ(frtOut(&app), "Scroll=3 \n");
// Timer through the fake clock.
frtOutClear(&app);
wgtTimerStart(tmr->widget);
tAdvanceClock(TIMER_INTERVAL_MS);
TEST_STR_EQ(frtOut(&app), "Timer\n");
wgtTimerStop(tmr->widget);
// Reposition and Validate come from the Data control's change and
// validate hooks; drive the wired callbacks directly.
frtOutClear(&app);
dat->widget->onChange(dat->widget);
TEST_STR_EQ(frtOut(&app), "Reposition\n");
frtOutClear(&app);
TEST_TRUE(txt->widget->onValidate(txt->widget));
TEST_STR_EQ(frtOut(&app), "Validate=0 \n");
// Deactivate / Activate on a focus change between two windows.
frtOutClear(&app);
WindowT *other = dvxCreateWindow(tCtx(), "Other", 10, 10, 100, 100, false);
dvxRaiseWindow(tCtx(), other);
tPump(1);
outContains(&app, "Deactivate\n");
frtOutClear(&app);
dvxRaiseWindow(tCtx(), form->window);
tPump(1);
outContains(&app, "Activate\n");
// Resize from the window manager.
frtOutClear(&app);
dvxResizeWindow(tCtx(), form->window, FORM_W + 20, FORM_H + 20);
tPump(1);
outContains(&app, "Resize\n");
// QueryUnload (Cancel = 0) then Unload on the close box.
frtOutClear(&app);
tAltF4();
tPump(1);
TEST_STR_EQ(frtOut(&app), "QueryUnload=0 \nUnload\n");
TEST_PTR_EQ(frtForm(&app, "Form1"), NULL);
frtDestroy(&app);
tShutdown();
}
static void caseExternCalls(void) {
tCase("DECLARE LIBRARY through basExternResolve/basExternCall");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
// The host trampoline (basNativeHost) calls nothing and returns 0,
// so every value comes back as the zero of its declared type; the
// marshaling paths (string dup, double/single slots, narrows)
// still all run.
const char *bas =
"DECLARE LIBRARY \"test\"\n"
" DECLARE FUNCTION frtExtInt(BYVAL a AS INTEGER) AS INTEGER\n"
" DECLARE FUNCTION frtExtLong(BYVAL a AS LONG, BYVAL b AS LONG) AS LONG\n"
" DECLARE FUNCTION frtExtDbl(BYVAL d AS DOUBLE, BYVAL s AS SINGLE) AS DOUBLE\n"
" DECLARE FUNCTION frtExtStr(BYVAL s AS STRING) AS STRING\n"
" DECLARE FUNCTION frtExtFlag(BYVAL a AS INTEGER) AS BOOLEAN\n"
" DECLARE SUB frtExtSub(BYVAL a AS INTEGER)\n"
"END DECLARE\n"
"PRINT frtExtInt(5)\n"
"PRINT frtExtLong(1, 2)\n"
"PRINT frtExtDbl(1.5, 2.5)\n"
"DIM sng AS SINGLE\n"
"sng = 2.5\n"
"PRINT frtExtDbl(1.5, sng)\n"
"PRINT \"[\" & frtExtStr(\"abc\") & \"]\"\n"
"PRINT frtExtFlag(1)\n"
"frtExtSub 3\n"
"PRINT \"done\"\n";
const char *frm = "Begin Form Form1\n Caption = \"Ext\"\nEnd\n";
FrtAppT app;
if (!expectBuild(&app, bas, &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
TEST_STR_EQ(frtOut(&app), "0 \n0 \n0 \n0 \n[]\nFalse \ndone\n");
TEST_TRUE(basExternResolve(NULL, "test", "frtExtInt") != NULL);
TEST_PTR_EQ(basExternResolve(NULL, "test", "frtExtNoSuchSymbol"), NULL);
frtDestroy(&app);
// An unresolvable name raises catchable error 453.
const char *basMissing =
"DECLARE LIBRARY \"test\"\n"
" DECLARE SUB frtExtNope()\n"
"END DECLARE\n"
"ON ERROR GOTO H\n"
"frtExtNope\n"
"PRINT \"no\"\n"
"END\n"
"H:\n"
"PRINT \"e\"; ERR\n"
"END\n";
if (!expectBuild(&app, basMissing, &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
outContains(&app, "453");
frtDestroy(&app);
tShutdown();
}
// basNativeHostSetLive: the host makes the calls (x86-64 registers, and
// the stack past six integer arguments), so each value is the C
// function's real result. A native SUB called as a statement leaves
// nothing behind: a thousand of them in a row do not fill the stack.
static void caseExternLive(void) {
tCase("DECLARE LIBRARY calls made for real on the host");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *bas =
"DECLARE LIBRARY \"test\"\n"
" DECLARE FUNCTION frtExtInt(BYVAL a AS INTEGER) AS INTEGER\n"
" DECLARE FUNCTION frtExtLong(BYVAL a AS LONG, BYVAL b AS LONG) AS LONG\n"
" DECLARE FUNCTION frtExtDbl(BYVAL d AS DOUBLE, BYVAL s AS SINGLE) AS DOUBLE\n"
" DECLARE FUNCTION frtExtMix(BYVAL s AS STRING, BYVAL d AS DOUBLE, BYVAL n AS LONG, BYVAL f AS SINGLE) AS DOUBLE\n"
" DECLARE FUNCTION frtExtStr(BYVAL s AS STRING) AS STRING\n"
" DECLARE FUNCTION frtExtFlag(BYVAL a AS INTEGER) AS BOOLEAN\n"
" DECLARE FUNCTION frtExtSeven(BYVAL a AS LONG, BYVAL b AS LONG, BYVAL c AS LONG, BYVAL d AS LONG, BYVAL e AS LONG, BYVAL f AS LONG, BYVAL g AS LONG) AS LONG\n"
" DECLARE SUB frtExtSub(BYVAL a AS LONG)\n"
" DECLARE FUNCTION frtExtXor$(BYVAL d AS BINARY STRING, BYVAL key AS LONG) AS BINARY STRING\n"
" DECLARE FUNCTION frtExtBinSum(BYVAL d AS BINARY STRING, BYVAL tag AS STRING, BYVAL d2 AS BINARY STRING) AS LONG\n"
"END DECLARE\n"
"DIM i AS LONG\n"
"DIM b AS STRING\n"
"b = frtExtXor$(\"A\" + CHR$(0) + \"B\", 1)\n"
"PRINT LEN(b); ASC(MID$(b, 1, 1)); ASC(MID$(b, 2, 1)); ASC(MID$(b, 3, 1))\n"
"PRINT LEN(frtExtXor$(b, -1)); LEN(frtExtXor$(b, 99)); frtExtXor$(CHR$(1) + CHR$(1), 1) = CHR$(0) + CHR$(0)\n"
"PRINT frtExtBinSum(CHR$(0) + CHR$(0) + CHR$(5), \"xy\", CHR$(0))\n"
"PRINT frtExtInt(5); frtExtLong(-1, 3); frtExtDbl(1.5, 2.5)\n"
"PRINT frtExtMix(\"abcd\", 0.5, 10, 0.25)\n"
"PRINT \"[\" & frtExtStr(\"abc\") & \"]\"; frtExtFlag(1)\n"
"PRINT frtExtSeven(1, 2, 3, 4, 5, 6, 7)\n"
"FOR i = 1 TO 1000\n"
" frtExtSub i\n"
" CALL frtExtSub(i)\n"
"NEXT i\n"
"PRINT \"subs\"\n";
const char *frm = "Begin Form Form1\n Caption = \"Ext\"\nEnd\n";
FrtAppT app;
if (!expectBuild(&app, bas, &frm, 1)) {
tShutdown();
return;
}
basNativeHostSetLive(true);
frtStart(&app, NULL);
basNativeHostSetLive(false);
TEST_STR_EQ(frtOut(&app), "3 64 1 67 \n0 0 True \n1020305 \n6 2 4 \n14.75 \n[abc]True \n721 \nsubs\n");
frtDestroy(&app);
tShutdown();
}
static void caseExternMarshal(void) {
tCase("DECLARE LIBRARY marshalling words and return narrowing");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
BasNativeWordT words[BAS_EXTERN_MAX_NATIVE_WORDS];
BasValueT args[2];
BasValueT r;
union { double d; uint32_t u[2]; } dconv;
union { float f; uint32_t u; } fconv;
// DOUBLE takes two words, SINGLE one word holding the float bits.
args[0] = basValDouble(1.5);
args[1] = basValSingle(2.5f);
r = basExternCall(NULL, (void *)frtExtDbl, "test", "frtExtDbl", args, 2, BAS_TYPE_DOUBLE, 0);
dconv.d = 1.5;
fconv.f = 2.5f;
TEST_EQ(basNativeHostLastArgs(words, BAS_EXTERN_MAX_NATIVE_WORDS), 3);
TEST_EQ(words[0], dconv.u[0]);
TEST_EQ(words[1], dconv.u[1]);
TEST_EQ(words[2], fconv.u);
TEST_EQ(r.type, BAS_TYPE_DOUBLE);
// SINGLE returns come back as Single, not Double.
basNativeHostSetResult(0, 2.5);
r = basExternCall(NULL, (void *)frtExtDbl, "test", "frtExtDbl", args, 0, BAS_TYPE_SINGLE, 0);
TEST_EQ(r.type, BAS_TYPE_SINGLE);
TEST_TRUE(r.sngVal == 2.5f);
// INTEGER narrows to 16 bits; LONG keeps all 32.
basNativeHostSetResult(FRT_EXT_WIDE_RESULT, 0.0);
r = basExternCall(NULL, (void *)frtExtInt, "test", "frtExtInt", args, 0, BAS_TYPE_INTEGER, 0);
TEST_EQ(basValToNumber(r), (double)(int16_t)FRT_EXT_WIDE_RESULT);
r = basExternCall(NULL, (void *)frtExtLong, "test", "frtExtLong", args, 0, BAS_TYPE_LONG, 0);
TEST_EQ(basValToNumber(r), (double)FRT_EXT_WIDE_RESULT);
// A BINARY STRING argument is the pointer and its length (zero bytes
// counted); a BINARY STRING result adds the length pointer last, and
// a callee that never sets it returns "".
args[0].type = BAS_TYPE_STRING;
args[0].strVal = basStringNew("a\0b", 3);
args[1] = basValLong(7);
r = basExternCall(NULL, (void *)frtExtXor, "test", "frtExtXor", args, 2, BAS_TYPE_STRING, 1u | BAS_EXTERN_BINARY_RET);
TEST_EQ(basNativeHostLastArgs(words, BAS_EXTERN_MAX_NATIVE_WORDS), 4);
TEST_TRUE(words[0] != 0);
TEST_EQ(words[1], 3);
TEST_EQ(words[2], 7);
TEST_TRUE(words[3] != 0);
TEST_EQ(r.type, BAS_TYPE_STRING);
TEST_EQ(r.strVal->len, 0);
basValRelease(&r);
// The same string as plain STRING: one word
r = basExternCall(NULL, (void *)frtExtStr, "test", "frtExtStr", args, 1, BAS_TYPE_LONG, 0);
TEST_EQ(basNativeHostLastArgs(words, BAS_EXTERN_MAX_NATIVE_WORDS), 1);
basValRelease(&args[0]);
// sql.bas declares the int32_t-returning SQL functions AS LONG, so
// a wide column value comes through intact.
char *sqlBas = NULL;
int32_t sqlSize = 0;
sqlBas = (char *)platformReadFile(FRT_INCLUDE_DIR "/sql.bas", &sqlSize);
TEST_TRUE(sqlBas != NULL);
if (sqlBas) {
const char *mainSrc = "PRINT SQLFieldInt(1, 0); SQLAffected(1)\n";
size_t srcLen = strlen(sqlBas) + strlen(mainSrc) + 2;
char *src = (char *)malloc(srcLen);
const char *frm = "Begin Form Form1\n Caption = \"Ext\"\nEnd\n";
FrtAppT app;
snprintf(src, srcLen, "%s\n%s", sqlBas, mainSrc);
if (expectBuild(&app, src, &frm, 1)) {
frtStart(&app, NULL);
TEST_STR_EQ(frtOut(&app), "74565 74565 \n");
frtDestroy(&app);
}
free(src);
free(sqlBas);
}
// The compiler coerces each argument to its DECLAREd type: a Double
// passed to a LONG parameter is one word, not two.
const char *bas =
"DECLARE LIBRARY \"test\"\n"
" DECLARE FUNCTION frtExtLong(BYVAL a AS LONG, BYVAL b AS LONG) AS LONG\n"
"END DECLARE\n"
"DIM d AS DOUBLE\n"
"d = 2\n"
"PRINT frtExtLong(d, 7)\n";
const char *frm2 = "Begin Form Form1\n Caption = \"Ext\"\nEnd\n";
FrtAppT app2;
basNativeHostSetResult(0, 0.0);
if (expectBuild(&app2, bas, &frm2, 1)) {
frtStart(&app2, NULL);
TEST_EQ(basNativeHostLastArgs(words, BAS_EXTERN_MAX_NATIVE_WORDS), 2);
TEST_EQ(words[0], 2);
TEST_EQ(words[1], 7);
frtDestroy(&app2);
}
tShutdown();
}
// New FormName: each copy has its own window, controls, menus,
// form-level variables and Me; its events run against it; the form's
// name stays the first copy; unloading a copy keeps the others. A
// FUNCTION As the form makes and returns a copy.
static void caseFormInstances(void) {
tCase("form instancing: New FormName copies");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *bas =
"Function MakeCopy() As Form1\n"
" Dim c As Form1\n"
" Set c = New Form1\n"
" c.Caption = \"Copy\"\n"
" c.Text1.Text = \"copytext\"\n"
" Set MakeCopy = c\n"
"End Function\n";
const char *frm =
"Begin Form Form1\n"
" Caption = \"Main\"\n"
" Begin Menu mnuFile\n"
" Caption = \"&File\"\n"
" Begin Menu mnuAdd\n"
" Caption = \"&Add\"\n"
" End\n"
" End\n"
" Begin TextBox Text1\n"
" End\n"
" Begin CommandButton Cmd1\n"
" Caption = \"Go\"\n"
" End\n"
"End\n"
"\n"
"Dim Shared clicks As Integer\n"
"Dim Shared other As Form1\n"
"\n"
"Sub Form1_Load\n"
" Text1.Text = \"loaded\"\n"
"End Sub\n"
"\n"
"Sub Cmd1_Click\n"
" clicks = clicks + 1\n"
" Text1.Text = \"c\" & clicks\n"
" Print Me.Caption; clicks\n"
"End Sub\n"
"\n"
"Sub mnuAdd_Click\n"
" clicks = clicks + 10\n"
" Print Me.Caption; clicks\n"
"End Sub\n"
"\n"
"Sub Form1_Test\n"
" Set other = MakeCopy()\n"
" Dim f As New Form1\n"
" f.Caption = \"Third\"\n"
" Print Me.Caption; \"|\"; other.Caption; \"|\"; f.Caption; \"|\"; Text1.Text; \"|\"; other.Text1.Text; \"|\"; f.Text1.Text; \"|\"; Form1.Caption\n"
" Unload f\n"
"End Sub\n"
"\n"
"Sub Form1_Drop\n"
" Unload other\n"
" Set other = Nothing\n"
" Print Form1.Caption; \" \"; Text1.Text\n"
"End Sub\n";
FrtAppT app;
if (!expectBuild(&app, bas, &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form1", "Test"));
TEST_STR_EQ(frtOut(&app), "Main|Copy|Third|loaded|copytext|loaded|Main\n");
// The third copy was unloaded by the handler; the first and the copy
// in gCopy remain, each with its own window and controls.
BasFormT *first = NULL;
BasFormT *copy = NULL;
int32_t count = 0;
for (int32_t i = 0; i < (int32_t)arrlen(app.rt->forms); i++) {
if (strcasecmp(app.rt->forms[i]->name, "Form1") == 0) {
count++;
first = first ? first : app.rt->forms[i];
copy = (app.rt->forms[i] != first) ? app.rt->forms[i] : copy;
}
}
TEST_EQ(count, 2);
TEST_PTR_EQ(frtForm(&app, "Form1"), first);
TEST_TRUE(copy != NULL && copy->window != NULL && copy->window != first->window);
TEST_TRUE(copy != NULL && copy->window != NULL && !copy->window->visible);
if (first && copy) {
BasControlT *btn1 = frtCtrl(first, "Cmd1");
BasControlT *btn2 = frtCtrl(copy, "Cmd1");
TEST_TRUE(btn1 != NULL && btn2 != NULL && btn1 != btn2);
TEST_TRUE(copy->formVars != NULL && copy->formVars != first->formVars);
TEST_TRUE(copy->window->menuBar != NULL && copy->window->menuBar != first->window->menuBar);
// Clicks on each copy count in that copy's own variable and
// write to its own Text1
frtOutClear(&app);
btn2->widget->onClick(btn2->widget);
btn2->widget->onClick(btn2->widget);
btn1->widget->onClick(btn1->widget);
MenuT *file = copy->window->menuBar->menus[0];
copy->window->onMenu(copy->window, file->items[0].id);
TEST_STR_EQ(frtOut(&app), "Copy1 \nCopy2 \nMain1 \nCopy12 \n");
TEST_STR_EQ(wgtGetText(frtCtrl(copy, "Text1")->widget), "c2");
TEST_STR_EQ(wgtGetText(frtCtrl(first, "Text1")->widget), "c1");
// Unloading the copy keeps the first
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form1", "Drop"));
tPump(1);
TEST_STR_EQ(frtOut(&app), "Main c1\n");
TEST_PTR_EQ(frtForm(&app, "Form1"), first);
count = 0;
for (int32_t i = 0; i < (int32_t)arrlen(app.rt->forms); i++) {
count += (strcasecmp(app.rt->forms[i]->name, "Form1") == 0) ? 1 : 0;
}
TEST_EQ(count, 1);
}
frtDestroy(&app);
tShutdown();
}
static void caseFormShowHide(void) {
tCase("Show modal / non-modal and Hide");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm1 =
"Begin Form Form1\n"
" Caption = \"One\"\n"
"End\n";
// Show True returns when the form is hidden: its first Paint hides it.
const char *frm2 =
"Begin Form Form2\n"
" Caption = \"Two\"\n"
"End\n"
"\n"
"Sub Form2_Paint\n"
" Static painted As Boolean\n"
" If Not painted Then\n"
" painted = True\n"
" Print \"modal=\"; Form2.Visible\n"
" Form2.Hide\n"
" End If\n"
"End Sub\n";
const char *frms[2] = { frm1, frm2 };
const char *bas =
"Form2.Show True\n"
"Print \"hidden=\"; Form2.Visible\n"
"Form2.Show\n"
"Form2.Visible = False\n"
"Form2.Visible = True\n";
FrtAppT app;
if (!expectBuild(&app, bas, frms, 2)) {
tShutdown();
return;
}
basFormRtLoadAllForms(app.rt, "Form1");
tPump(1);
BasFormT *f1 = frtForm(&app, "Form1");
BasFormT *f2 = frtForm(&app, "Form2");
TEST_TRUE(f1 && f2);
TEST_TRUE(f1->window->visible);
TEST_TRUE(!f2->window->visible);
TEST_PTR_EQ(tCtx()->modalWindow, NULL);
// Step the program one statement at a time by checking state after
// each phase: the whole main runs to completion here, so assert the
// printed snapshots plus the final state.
frtRunMain(&app);
tPump(1);
TEST_EQ(app.mainResult, BAS_VM_HALTED);
outContains(&app, "modal=True \n");
outContains(&app, "hidden=False \n");
TEST_TRUE(f2->window->visible);
TEST_PTR_EQ(tCtx()->modalWindow, NULL);
// Modal gate directly: Show True sets it while the form is up (the
// dialog script checks, then hides the form), Hide clears it.
sModalCheckApp = &app;
sModalChecks = 0;
tDialogScript(visibleKeepsModalCheck, f2);
basFormRtShowForm(app.rt, f2, true);
TEST_EQ(sModalChecks, 1);
TEST_PTR_EQ(tCtx()->modalWindow, NULL);
TEST_TRUE(!f2->window->visible);
sModalCheckApp = NULL;
frtDialogsDefault(&app);
frtDestroy(&app);
tShutdown();
}
static void caseFormVars(void) {
tCase("form-scope variables are per form and reset on reload");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm1 =
"Begin Form Form1\n"
" Caption = \"One\"\n"
"End\n"
"\n"
"Dim Shared counter As Integer\n"
"Dim Shared label As String\n"
"label = \"one\"\n"
"Sub Form1_Load\n"
" counter = counter + 1\n"
" Print \"F1:\"; counter; label\n"
"End Sub\n"
"Sub Form1_Bump\n"
" counter = counter + 10\n"
" Print \"F1:\"; counter\n"
"End Sub\n";
const char *frm2 =
"Begin Form Form2\n"
" Caption = \"Two\"\n"
"End\n"
"\n"
"Dim Shared counter As Integer\n"
"Dim Shared label As String\n"
"label = \"two\"\n"
"Sub Form2_Load\n"
" counter = counter + 2\n"
" Print \"F2:\"; counter; label\n"
"End Sub\n";
const char *frms[2] = { frm1, frm2 };
const char *bas =
"Unload Form2\n"
"Load Form2\n";
FrtAppT app;
if (!expectBuild(&app, bas, frms, 2)) {
tShutdown();
return;
}
frtStart(&app, "Form1");
TEST_EQ(app.mainResult, BAS_VM_HALTED);
TEST_STR_EQ(frtOut(&app), "F1:1 one\nF2:2 two\nF2:2 two\n");
BasFormT *f1 = frtForm(&app, "Form1");
TEST_TRUE(f1 && f1->formVarCount == 2);
frtOutClear(&app);
basFormRtFireEvent(app.rt, f1, "Form1", "Bump");
TEST_STR_EQ(frtOut(&app), "F1:11 \n");
frtDestroy(&app);
tShutdown();
}
// Form and control members of round 2: Tag, MousePointer (controls, the
// form, Screen; the pointer each shows), Screen / Form.ActiveControl,
// Form.Icon, FitWidth / FitHeight, SaveScreenshot, the mouse button and
// pointer constants, and the errors for bad values.
static void caseFormWindowMembers(void) {
tCase("Tag, MousePointer, ActiveControl, Icon, FitWidth / FitHeight, SaveScreenshot");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
char shotPath[DVX_MAX_PATH];
char src[FRT_SRC_BUF_LEN];
snprintf(shotPath, sizeof(shotPath), "%s/frtShot.bmp", tTempDir());
unlink(shotPath);
snprintf(src, sizeof(src),
"Sub Form1_Read\n"
" Print Text1.Tag; \"|\"; Form1.Tag; \"|\"; Text1.MousePointer; Form1.MousePointer\n"
" Text1.Tag = \"t2\"\n"
" Form1.Tag = \"f2\"\n"
" Print Text1.Tag; Form1.Tag\n"
"End Sub\n"
"Sub Form1_Focus\n"
" Form2.Show\n"
" Form1.Show\n"
" Text2.SetFocus\n"
" Print Screen.ActiveControl.Name; \" \"; Form1.ActiveControl.Name; \" \"; Form2.ActiveControl Is Nothing\n"
"End Sub\n"
"Sub Form1_Pointers\n"
" Text2.MousePointer = vbSizeWE\n"
" Print vbLeftButton; vbRightButton; vbMiddleButton; vbArrow; vbCrosshair; vbNoDrop; vbSyntaxType\n"
"End Sub\n"
"Sub Form1_ScreenPointer\n"
" Screen.MousePointer = vbSizeNS\n"
" Print Screen.MousePointer\n"
"End Sub\n"
"Sub Form1_ScreenDefault\n"
" Screen.MousePointer = vbDefault\n"
"End Sub\n"
"Sub Form1_SetIcon\n"
" Form1.Icon = LoadPicture(\"%s/icon.bmp\")\n"
" Print Form1.Icon.Width > 0\n"
"End Sub\n"
"Sub Form1_ClearIcon\n"
" Form1.Icon = \"\"\n"
" Print Form1.Icon.Width\n"
"End Sub\n"
"Sub Form1_Fit\n"
" Form1.Width = 600\n"
" Form1.Height = 400\n"
" Form1.FitWidth\n"
" Me.FitHeight\n"
"End Sub\n"
"Sub Form1_Shot\n"
" Me.SaveScreenshot \"%s\"\n"
"End Sub\n"
"Sub Form1_BadPointer\n"
" Text1.MousePointer = 3\n"
"End Sub\n"
"Sub Form1_BadIcon\n"
" Form1.Icon = \"/no/such/icon.bmp\"\n"
"End Sub\n"
"Sub Form1_BadShot\n"
" Me.SaveScreenshot \"/no/such/dir/x.bmp\"\n"
"End Sub\n",
FRT_FIXTURE_DIR, shotPath);
const char *frm1 =
"Begin Form Form1\n"
" Caption = \"Members\"\n"
" Tag = \"f1\"\n"
" MousePointer = 2\n"
" Begin TextBox Text1\n"
" Tag = \"t1\"\n"
" MousePointer = 12\n"
" End\n"
" Begin TextBox Text2\n"
" End\n"
"End\n";
const char *frm2 =
"Begin Form Form2\n"
" Caption = \"Other\"\n"
"End\n";
const char *frms[2] = { frm1, frm2 };
const char *bad[] = { "BadPointer", "BadIcon", "BadShot" };
FrtAppT app;
if (!expectBuild(&app, src, frms, 2)) {
tShutdown();
return;
}
frtStart(&app, "Form1");
BasFormT *form = frtForm(&app, "Form1");
BasControlT *text1 = form ? frtCtrl(form, "Text1") : NULL;
BasControlT *text2 = form ? frtCtrl(form, "Text2") : NULL;
TEST_TRUE(text1 != NULL && text2 != NULL);
if (!text1 || !text2) {
frtDestroy(&app);
tShutdown();
return;
}
WindowT *win = form->window;
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form1", "Read"));
TEST_STR_EQ(frtOut(&app), "t1|f1|12 2 \nt2f2\n");
// ActiveControl: the focused control; Nothing on a form without it
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form1", "Focus"));
TEST_STR_EQ(frtOut(&app), "Text2 Text2 True \n");
// The pointer over a control is its own, else the form's
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form1", "Pointers"));
TEST_STR_EQ(frtOut(&app), "1 2 4 1 2 12 6 \n");
TEST_EQ(win->onCursorQuery(win, text1->widget->x + 1, text1->widget->y + 1), CURSOR_NO_DROP);
TEST_EQ(win->onCursorQuery(win, text2->widget->x + 1, text2->widget->y + 1), CURSOR_RESIZE_H);
TEST_EQ(win->onCursorQuery(win, 0, 0), CURSOR_CROSSHAIR);
// Screen.MousePointer wins over every control
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form1", "ScreenPointer"));
TEST_STR_EQ(frtOut(&app), "7 \n");
TEST_EQ(win->onCursorQuery(win, text1->widget->x + 1, text1->widget->y + 1), CURSOR_RESIZE_V);
TEST_TRUE(frtFire(&app, "Form1", "ScreenDefault"));
TEST_EQ(win->onCursorQuery(win, text1->widget->x + 1, text1->widget->y + 1), CURSOR_NO_DROP);
// Icon: a picture for the minimized window, "" puts DVX's back
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form1", "SetIcon"));
TEST_TRUE(win->iconData != NULL);
TEST_TRUE(frtFire(&app, "Form1", "ClearIcon"));
TEST_TRUE(win->iconData == NULL);
TEST_STR_EQ(frtOut(&app), "True \n0 \n");
// FitWidth / FitHeight shrink-wrap one side each
TEST_TRUE(frtFire(&app, "Form1", "Fit"));
TEST_TRUE(win->w < FRT_FIT_BIG_W && win->h < FRT_FIT_BIG_H);
// SaveScreenshot writes the window's picture
TEST_TRUE(frtFire(&app, "Form1", "Shot"));
TEST_TRUE(!app.rt->terminated);
TEST_TRUE(access(shotPath, F_OK) == 0);
unlink(shotPath);
frtDestroy(&app);
for (int32_t i = 0; i < (int32_t)DVX_ARRAY_LEN(bad); i++) {
if (!expectBuild(&app, src, frms, 2)) {
break;
}
frtStart(&app, "Form1");
frtFire(&app, "Form1", bad[i]);
if (!app.rt->terminated) {
printf(" form member error case %s did not stop the program\n", bad[i]);
}
TEST_TRUE(app.rt->terminated);
frtDestroy(&app);
}
tShutdown();
}
// game.bas FrameMissed reads FRAMEWAIT's own pacer (the game library is
// linked into this test, so FRAMEWAIT runs, on the real-time clock): 0
// before the first FRAMEWAIT and after it, at least 4 once the program
// got back to FRAMEWAIT 55 ms late at 100 frames a second, and 0 again
// after a new rate starts the clock over.
static void caseFrameMissed(void) {
tCase("game.bas FrameMissed counts the frames FRAMEWAIT skipped");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *bas =
"DECLARE LIBRARY \"game\"\n"
" DECLARE FUNCTION FrameMissed() AS LONG\n"
"END DECLARE\n"
"DECLARE LIBRARY \"test\"\n"
" DECLARE FUNCTION usleep(BYVAL us AS LONG) AS LONG\n"
"END DECLARE\n"
"PRINT FrameMissed()\n"
"FRAMEWAIT 100\n"
"PRINT FrameMissed()\n"
"PRINT usleep(55000)\n"
"FRAMEWAIT 100\n"
"PRINT FrameMissed() >= 4\n"
"FRAMEWAIT 50\n"
"PRINT FrameMissed()\n";
const char *frm = "Begin Form Form1\n Caption = \"Frames\"\nEnd\n";
FrtAppT app;
if (!expectBuild(&app, bas, &frm, 1)) {
tShutdown();
return;
}
hostClockSetRealTime(true);
basNativeHostSetLive(true);
frtStart(&app, NULL);
basNativeHostSetLive(false);
hostClockSetRealTime(false);
TEST_STR_EQ(frtOut(&app), "0 \n0 \n0 \nTrue \n0 \n");
frtDestroy(&app);
tShutdown();
}
static void caseFrmLoadEdges(void) {
tCase(".frm load edges: version, unknown type, geometry, late lines, nesting");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
// A .frm claiming a too-new VB version is refused whole.
const char *frmVer = "VERSION 9.99\nBegin Form FormV\nEnd\n";
FrtAppT app;
if (!expectBuild(&app, "", &frmVer, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
TEST_PTR_EQ(frtForm(&app, "FormV"), NULL);
TEST_TRUE(!app.rt->terminated);
TEST_PTR_EQ(basFormRtLoadFrm(app.rt, NULL, 0), NULL);
frtDestroy(&app);
// Unknown widget type: loud error, form discarded.
const char *frmBad = "Begin Form FormU\n Begin Sprocket S1\n End\nEnd\n";
if (!expectBuild(&app, "", &frmBad, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
TEST_TRUE(app.rt->terminated);
TEST_PTR_EQ(frtForm(&app, "FormU"), NULL);
frtClearError(&app);
frtDestroy(&app);
// Geometry, layout, control arrays, popup context menus.
const char *frmGeo =
"Begin Form Form1\n"
" Caption = \"Geo\"\n"
" Width = 320\n"
" Height = 200\n"
" Left = 30\n"
" Top = 40\n"
" Centered = False\n"
" Resizable = False\n"
" HelpTopic = \"geoHelp\"\n"
" ContextMenu = \"mnuPop\"\n"
" Begin Menu mnuPop\n"
" Caption = \"Pop\"\n"
" Visible = False\n"
" Begin Menu mnuPopA\n"
" Caption = \"A\"\n"
" End\n"
" End\n"
" Begin Frame Fr\n"
" Layout = \"HBox\"\n"
" Begin TextBox T\n"
" Index = 2\n"
" ContextMenu = \"mnuPop\"\n"
" End\n"
" End\n"
"End\n";
if (!expectBuild(&app, "", &frmGeo, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
BasFormT *form = frtForm(&app, "Form1");
TEST_TRUE(form != NULL);
TEST_EQ(form->window->x, 30);
TEST_EQ(form->window->y, 40);
TEST_TRUE(!form->window->resizable);
TEST_STR_EQ(form->helpTopic, "geoHelp");
TEST_TRUE(form->window->contextMenu != NULL);
TEST_TRUE(frtCtrlIdx(form, "T", 2) != NULL);
BasControlT *t = frtCtrlIdx(form, "T", 2);
TEST_TRUE(t->widget->contextMenu != NULL);
TEST_TRUE(!app.rt->terminated);
// Cross-form indexed lookup with no current form context.
TEST_TRUE(basFormRtFindCtrlIdx(app.rt, NULL, "T", 2) != NULL);
// A SetEvent override naming a missing SUB consumes the event.
basFormRtSetEvent(app.rt, t, "Click", "NoSuchHandler");
tWidgetClick(t->widget);
tPump(1);
TEST_TRUE(!app.rt->terminated);
// Direct .frm load caches the source; unload then reload by name.
const char *frmExtra = "Begin Form FormX\n Caption = \"X\"\nEnd\n";
BasFormT *fx = basFormRtLoadFrm(app.rt, frmExtra, (int32_t)strlen(frmExtra));
TEST_TRUE(fx != NULL);
basFormRtUnloadForm(app.rt, fx);
tPump(1);
TEST_TRUE(basFormRtLoadForm(app.rt, "FormX") != NULL);
// An Index below 0 is no index, the rule the designer saves by
const char *frmNeg = "Begin Form FormN\n Begin CommandButton B\n Index = -3\n End\nEnd\n";
BasFormT *fn = basFormRtLoadFrm(app.rt, frmNeg, (int32_t)strlen(frmNeg));
BasControlT *negB = fn ? frtCtrl(fn, "B") : NULL;
TEST_TRUE(negB != NULL);
TEST_EQ(negB ? negB->index : 0, FRM_NO_INDEX);
frtDestroy(&app);
// AutoSize forms fit at load and again on Show.
const char *frmAuto =
"Begin Form FormA\n"
" AutoSize = True\n"
" Begin Label L\n"
" Caption = \"fit\"\n"
" End\n"
"End\n";
if (!expectBuild(&app, "", &frmAuto, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
BasFormT *fa = frtForm(&app, "FormA");
TEST_TRUE(fa != NULL && fa->frmAutoSize);
basFormRtShowForm(app.rt, fa, false);
tPump(1);
frtDestroy(&app);
// A bad ENUM value in the .frm raises the bad-property error.
const char *frmBadEnum =
"Begin Form FormE\n"
" Begin Label L\n"
" Alignment = \"Wat\"\n"
" End\n"
"End\n";
if (!expectBuild(&app, "", &frmBadEnum, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
TEST_TRUE(app.rt->terminated);
frtClearError(&app);
frtDestroy(&app);
// A block's lines after the blocks inside it are the block's, as the
// designer's model reads them (testFrmModel): a Frame's Index and
// Caption after its child, a Frame's Caption after a menu block in it.
const char *frmLate =
"Begin Form FormL\n"
" Begin Frame Fr\n"
" Begin Label L\n"
" End\n"
" Index = 2\n"
" Caption = \"late\"\n"
" End\n"
" Begin Frame Box\n"
" Begin Menu mnuInner\n"
" End\n"
" Caption = \"after\"\n"
" End\n"
"End\n";
if (!expectBuild(&app, "", &frmLate, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
BasFormT *fl = frtForm(&app, "FormL");
BasControlT *fr2 = fl ? frtCtrlIdx(fl, "Fr", 2) : NULL;
BasControlT *lab = fl ? frtCtrl(fl, "L") : NULL;
BasControlT *box = fl ? frtCtrl(fl, "Box") : NULL;
bool inside = false;
for (const WidgetT *w = lab ? lab->widget : NULL; w; w = w->parent) {
inside = inside || (fr2 && w == fr2->widget);
}
TEST_TRUE(fr2 && lab && box);
TEST_STR_EQ(fr2 ? wgtGetText(fr2->widget) : "", "late");
TEST_TRUE(inside);
TEST_STR_EQ(box ? wgtGetText(box->widget) : "", "after");
TEST_TRUE(!app.rt->terminated);
frtDestroy(&app);
// Nesting deeper than the parser allows: rejected, form discarded.
char deep[FRM_TEXT_MAX];
int32_t pos = snprintf(deep, sizeof(deep), "Begin Form FormD\n");
for (int32_t i = 0; i < FRM_MAX_NESTING + 2; i++) {
pos += snprintf(deep + pos, sizeof(deep) - pos, "Begin Frame F%d\n", (int32_t)i);
}
for (int32_t i = 0; i < FRM_MAX_NESTING + 3; i++) {
pos += snprintf(deep + pos, sizeof(deep) - pos, "End\n");
}
const char *frmDeep = deep;
if (!expectBuild(&app, "", &frmDeep, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
TEST_PTR_EQ(frtForm(&app, "FormD"), NULL);
frtClearError(&app);
frtDestroy(&app);
tShutdown();
}
static void caseFrmParserUnit(void) {
tCase("frmParser callbacks, key/value and quote helpers");
const char *src =
"VERSION DVX 1.00\n"
"Begin Form F\n"
" Cap = \"x\"\n"
" Begin Menu M1\n"
" Caption = \"&File\"\n"
" Begin Menu M2\n"
" Caption = \"Sub\"\n"
" End\n"
" End\n"
" Begin TextBox T\n"
" Text = \"hi\"\n"
" End\n"
"End\n"
"Sub Form_Load\nEnd Sub\n";
ParseRecT rec;
FrmParserCbsT cbs;
memset(&rec, 0, sizeof(rec));
memset(&cbs, 0, sizeof(cbs));
cbs.userData = &rec;
cbs.onFormBegin = parseOnFormBegin;
cbs.onFormProp = parseOnFormProp;
cbs.onMenuBegin = parseOnMenuBegin;
cbs.onMenuEnd = parseOnMenuEnd;
cbs.onMenuProp = parseOnMenuProp;
cbs.onCtrlBegin = parseOnCtrlBegin;
cbs.onCtrlEnd = parseOnCtrlEnd;
cbs.onCtrlProp = parseOnCtrlProp;
cbs.onFormEnd = parseOnFormEnd;
TEST_TRUE(frmParse(src, (int32_t)strlen(src), &cbs));
TEST_EQ(rec.forms, 1);
TEST_EQ(rec.formProps, 1);
TEST_EQ(rec.menus, 2);
TEST_EQ(rec.menuProps, 2);
TEST_EQ(rec.menuEnds, 2);
TEST_EQ(rec.ctrls, 1);
TEST_EQ(rec.ctrlProps, 1);
TEST_EQ(rec.ctrlEnds, 1);
TEST_EQ(rec.lastMenuLevel, 1);
TEST_STR_EQ(rec.lastType, "TextBox");
TEST_STR_EQ(rec.lastKey, "Text");
TEST_STR_EQ(rec.lastVal, "\"hi\"");
TEST_TRUE(strstr(rec.tail, "Sub Form_Load") != NULL);
// onFormBegin refusing the form aborts the parse.
memset(&rec, 0, sizeof(rec));
rec.failFormBegin = true;
TEST_TRUE(!frmParse(src, (int32_t)strlen(src), &cbs));
// A too-new VB version line refuses the input; callbacks may all be
// NULL for a probe parse.
const char *vbNew = "VERSION 9.99\nBegin Form F\nEnd\n";
memset(&rec, 0, sizeof(rec));
TEST_TRUE(!frmParse(vbNew, (int32_t)strlen(vbNew), &cbs));
FrmParserCbsT quiet;
memset(&quiet, 0, sizeof(quiet));
TEST_TRUE(frmParse(src, (int32_t)strlen(src), &quiet));
// Key/value and quote helpers.
char key[FRM_MAX_TOKEN_LEN];
char val[FRM_MAX_LINE_LEN];
frmParseKeyValue("Alpha = beta gamma ", key, sizeof(key), val, sizeof(val));
TEST_STR_EQ(key, "Alpha");
TEST_STR_EQ(val, "beta gamma");
frmParseKeyValue("NoEquals", key, sizeof(key), val, sizeof(val));
TEST_STR_EQ(val, "");
char q[32];
snprintf(q, sizeof(q), "\"quoted\"");
frmStripQuotes(q);
TEST_STR_EQ(q, "quoted");
snprintf(q, sizeof(q), "bare");
frmStripQuotes(q);
TEST_STR_EQ(q, "bare");
snprintf(q, sizeof(q), "\"open");
frmStripQuotes(q);
TEST_STR_EQ(q, "open");
// An End with trailing blanks or a comment still closes its block,
// and Begin may be followed by a tab.
const char *endWs =
"Begin\tForm F\n"
" Begin CommandButton B\n"
" End \n"
" Begin CommandButton C\n"
" End\t' closes C\n"
" Cap = 1\n"
"End\n"
"tail\n";
memset(&rec, 0, sizeof(rec));
TEST_TRUE(frmParse(endWs, (int32_t)strlen(endWs), &cbs));
TEST_EQ(rec.forms, 1);
TEST_EQ(rec.ctrlEnds, 2);
TEST_EQ(rec.formProps, 1);
TEST_TRUE(strstr(rec.tail, "tail") != NULL);
// An over-long key is cut cleanly; the rest of it does not leak
// into the value.
char longKey[FRM_MAX_TOKEN_LEN * 2];
memset(longKey, 'K', sizeof(longKey) - 1);
longKey[sizeof(longKey) - 1] = '\0';
char longLine[FRM_MAX_TOKEN_LEN * 3];
snprintf(longLine, sizeof(longLine), "%s = v", longKey);
frmParseKeyValue(longLine, key, sizeof(key), val, sizeof(val));
TEST_EQ((int32_t)strlen(key), FRM_MAX_TOKEN_LEN - 1);
TEST_STR_EQ(val, "v");
// basRes.h Begin Form scanners accept any blanks between the words.
char formName[BAS_MAX_IDENT];
TEST_TRUE(basExtractFormName("' c\nBegin\tForm Foo\n", formName, sizeof(formName)));
TEST_STR_EQ(formName, "Foo");
TEST_TRUE(!basExtractFormName("Begin Formless X\n", formName, sizeof(formName)));
const char *tabForm = "Begin \tForm X\n Begin Frame F\n End\nEnd ' done\ncode\n";
TEST_STR_EQ(tabForm + basFindFormEndPos(tabForm, (int32_t)strlen(tabForm)), "code\n");
// End followed directly by a comment closes the block for the scanner
// exactly as for the compiler; "End <word>" closes neither.
const char *quoteEnd = "Begin Form X\n Begin Frame F\n End Frame\n End\nEnd'form\nSub A\nEnd Sub\n";
TEST_STR_EQ(quoteEnd + basFindFormEndPos(quoteEnd, (int32_t)strlen(quoteEnd)), "Sub A\nEnd Sub\n");
TEST_TRUE(frmIsEndLine("End", 3));
TEST_TRUE(frmIsEndLine("end 'x", 6));
TEST_TRUE(frmIsEndLine("End'x", 5));
TEST_TRUE(!frmIsEndLine("End Sub", 7));
TEST_TRUE(!frmIsEndLine("Ending", 6));
TEST_TRUE(frmParseBool("True"));
TEST_TRUE(frmParseBool("-1"));
TEST_TRUE(!frmParseBool("0"));
TEST_TRUE(!frmParseBool("banana"));
TEST_TRUE(frmParseBoolDefault("banana", true));
TEST_TRUE(!frmParseBoolDefault("False", true));
// Index: a number, or no index when empty or below 0
TEST_EQ(frmParseIndex("7"), 7);
TEST_EQ(frmParseIndex("0"), 0);
TEST_EQ(frmParseIndex("-3"), FRM_NO_INDEX);
TEST_EQ(frmParseIndex(""), FRM_NO_INDEX);
}
// Gap closure: a bare control name is the control -- its VB default
// property where a value is needed or assigned (Text1 = "x", Print Text1,
// If Text1 = Text2 compares the texts), the control itself as an argument
// (col.Add Text1) and with Is; a picture property reads as a Picture
// object whose value is its file name; LoadPicture's size and colour
// arguments; a class object's default member read and assigned.
static void caseGapClosure(void) {
tCase("gap closure: control default properties, Picture objects, LoadPicture arguments, PaintPicture raster operations");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm =
"Begin Form Form1\n"
" Caption = \"Gaps\"\n"
" Begin TextBox Text1\n"
" End\n"
" Begin TextBox Text2\n"
" End\n"
" Begin Label Label1\n"
" Caption = \"cap\"\n"
" End\n"
" Begin Image Img\n"
" End\n"
" Begin PictureBox Pic\n"
" End\n"
" Begin PictureBox Pic2\n"
" End\n"
"End\n"
"\n"
"Sub Form1_Rop\n"
" Pic.Resize 4, 4\n"
" Pic2.Resize 4, 4\n"
" Pic2.Line (0, 0)-(3, 3), RGB(255, 0, 0), BF\n"
" Pic.Line (0, 0)-(3, 3), RGB(0, 0, 255), BF\n"
" Pic.PaintPicture Pic2, 0, 0, 1, 1, 0, 0, 1, 1, vbSrcPaint\n"
" Pic.PaintPicture Pic2, 1, 0, 1, 1, 0, 0, 1, 1, vbSrcAnd\n"
" Pic.PaintPicture Pic2, 2, 0, 1, 1, 0, 0, 1, 1, vbSrcInvert\n"
" Pic.PaintPicture Pic2, 3, 0, 1, 1, 0, 0, 1, 1, vbDstInvert\n"
" Pic.PaintPicture Pic2, 0, 1, 1, 1, 0, 0, 1, 1\n"
" Pic.PaintPicture Pic2, 1, 1, 1, 1, 0, 0, 1, 1, vbNotSrcCopy\n"
" Print Pic.Point(0, 0); Pic.Point(1, 0); Pic.Point(2, 0); Pic.Point(3, 0); Pic.Point(0, 1); Pic.Point(1, 1); Pic.Point(2, 1)\n"
"End Sub\n"
"Sub Form1_Use\n"
" Dim col As New Collection\n"
" Text1 = \"hello\"\n"
" Text2 = \"hello\"\n"
" Print Text1; \" \"; Text1.Text; \" \"; Label1 & \"!\"; Len(Text1); Text1 = Text2; Text1 Is Text2\n"
" col.Add Text1\n"
" col.Add Label1\n"
" Print TypeName(col(1)); \" \"; col(1) Is Text1; \" \"; col(2)\n"
" Label1 = 5\n"
" Print Label1.Caption; UCase$(Text1)\n"
" Img.Picture = \"" FRT_FIXTURE_DIR "/icon.bmp\"\n"
" Print TypeName(Img.Picture); InStr(Img.Picture, \"icon.bmp\") > 0; Img.Picture.Width\n"
" Dim p As Object\n"
" Set p = LoadPicture(\"" FRT_FIXTURE_DIR "/icon.bmp\", vbLPLarge, vbLPColor)\n"
" Set p = LoadPicture(\"" FRT_FIXTURE_DIR "/icon.bmp\", vbLPCustom, vbLPDefault, 32, 32)\n"
" Print p.Width; vbLPLargeShell\n"
"End Sub\n"
"Sub Form1_Bad\n"
" On Error GoTo failed\n"
" Dim p As Object\n"
" Set p = LoadPicture(\"" FRT_FIXTURE_DIR "/icon.bmp\", 9)\n"
" Exit Sub\n"
"failed:\n"
" Print \"err\"; Err\n"
"End Sub\n";
FrtAppT app;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form1", "Use"));
TEST_STR_EQ(frtOut(&app), "hello hello cap!5 True False \nTextBox True cap\n5HELLO\nPictureTrue 847 \n847 3 \n");
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form1", "Bad"));
TEST_STR_EQ(frtOut(&app), "err5 \n");
// Source red over destination blue: OR, AND, XOR, NOT destination,
// copy, NOT source (one pixel untouched)
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form1", "Rop"));
TEST_STR_EQ(frtOut(&app), "16711935 0 16711935 65535 255 16776960 16711680 \n");
frtDestroy(&app);
tShutdown();
}
// A SetEvent handler for a control on a form made by CreateForm runs with
// Me = that form (each job window of a program can share one handler), and
// module code can call a form's procedures.
static void caseHandlerContext(void) {
tCase("SetEvent handler Me on a CreateForm form; module calls a form SUB");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *bas =
"Sub ModuleCalls\n"
" Form1Hello\n"
"End Sub\n";
const char *frm =
"Begin Form Form1\n"
" Caption = \"Context\"\n"
"End\n"
"\n"
"Sub Form1Hello\n"
" Print \"hello\"\n"
"End Sub\n"
"Sub Form1_Make\n"
" Dim f As Form\n"
" Dim b As Control\n"
" Set f = CreateForm(\"Job7\", 200, 100)\n"
" Set b = CreateControl(f, \"CommandButton\", \"JobCancel\")\n"
" SetEvent b, \"Click\", \"AnyCancel\"\n"
" f.Show\n"
" ModuleCalls\n"
"End Sub\n"
"Sub AnyCancel\n"
" Print \"me=\"; Me.Name\n"
"End Sub\n";
FrtAppT app;
if (!expectBuild(&app, bas, &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form1", "Make"));
BasFormT *job = frtForm(&app, "Job7");
BasControlT *btn = job ? frtCtrl(job, "JobCancel") : NULL;
TEST_TRUE(btn != NULL);
if (btn) {
btn->widget->onClick(btn->widget);
}
TEST_STR_EQ(frtOut(&app), "hello\nme=Job7\n");
frtDestroy(&app);
tShutdown();
}
// An untrapped runtime error in an event handler is shown and ends the
// program, as in module-level code and in VB: the one error path
// (title, VM message, halt). A trapped error is not reported; the IDE
// (suppressErrorDialog) gets the halt and the message without a box.
static void caseHandlerError(void) {
tCase("an untrapped error in an event handler is shown and ends the program");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm =
"Begin Form Form1\n"
" Caption = \"Err\"\n"
"End\n"
"\n"
"Sub Form1_Divide\n"
" Dim z As Integer\n"
" Print \"before\"\n"
" Print 1 \\ z\n"
" Print \"after\"\n"
"End Sub\n"
"Sub Form1_Trapped\n"
" Dim z As Integer\n"
" On Error Resume Next\n"
" Print 1 \\ z\n"
" Print \"trapped\"\n"
"End Sub\n";
const char *bas = "Dim z As Integer\nPrint 1 \\ z\nPrint \"unreached\"\n";
const char *plain = "Begin Form Form1\n Caption = \"Mod\"\nEnd\n";
FrtAppT app;
ErrorDlgT dlg;
char *log;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
memset(&dlg, 0, sizeof(dlg));
frtStart(&app, NULL);
tDialogScript(errorDialogCheck, &dlg);
// Trapped: nothing shown, the program goes on
frtFire(&app, "Form1", "Trapped");
TEST_EQ(dlg.seen, 0);
TEST_TRUE(!app.rt->terminated);
TEST_STR_EQ(frtOut(&app), "trapped\n");
// Untrapped: the box, the log, the halt; the program ends
frtOutClear(&app);
frtFire(&app, "Form1", "Divide");
TEST_EQ(dlg.seen, 1);
TEST_STR_EQ(dlg.title, "BASIC Runtime Error");
TEST_STR_EQ(frtOut(&app), "before\n");
TEST_TRUE(app.rt->terminated);
TEST_TRUE(app.vm->ended);
TEST_TRUE(!basFormRtKeepsRunning(app.rt));
TEST_TRUE(strstr(basVmGetError(app.vm), "Division by zero") != NULL);
TEST_PTR_EQ(tCtx()->modalWindow, NULL);
log = platformReadFile(DVX_LOG_FILE, NULL);
TEST_TRUE(log && strstr(log, "BASIC RUNTIME ERROR: Runtime error 11 on line") != NULL && strstr(log, "\n Division by zero") != NULL);
free(log);
// Nothing more runs or is shown once it has ended
frtFire(&app, "Form1", "Divide");
TEST_EQ(dlg.seen, 1);
tDialogScript(NULL, NULL);
frtDestroy(&app);
// Module-level code: the same box
if (expectBuild(&app, bas, &plain, 1)) {
memset(&dlg, 0, sizeof(dlg));
basFormRtLoadAllForms(app.rt, NULL);
tDialogScript(errorDialogCheck, &dlg);
basFormRtRunSimple(app.rt);
tDialogScript(NULL, NULL);
TEST_EQ(dlg.seen, 1);
TEST_STR_EQ(dlg.title, "BASIC Runtime Error");
TEST_TRUE(app.rt->terminated);
TEST_TRUE(strstr(frtOut(&app), "unreached") == NULL);
frtDestroy(&app);
}
// The IDE: halted, the message kept, no box
if (expectBuild(&app, "", &frm, 1)) {
frtStart(&app, NULL);
app.rt->suppressErrorDialog = true;
memset(&dlg, 0, sizeof(dlg));
tDialogScript(errorDialogCheck, &dlg);
frtFire(&app, "Form1", "Divide");
tDialogScript(NULL, NULL);
TEST_EQ(dlg.seen, 0);
TEST_TRUE(app.rt->terminated);
TEST_TRUE(app.vm->ended);
TEST_TRUE(strstr(basVmGetError(app.vm), "Division by zero") != NULL);
frtDestroy(&app);
}
tShutdown();
}
static void caseHelpHooks(void) {
tCase("HelpCompile and HelpView through the stub library");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const FrtStubApiT *api = frtStubsOpen();
if (!api) {
TEST_TRUE(api != NULL);
tShutdown();
return;
}
basFormRtTestReset();
const char *frm = "Begin Form Form1\n Caption = \"Help\"\nEnd\n";
FrtAppT app;
if (!expectBuild(&app, "", &frm, 1)) {
frtStubsClose();
tShutdown();
return;
}
frtStart(&app, NULL);
TEST_EQ(HelpCompile("guide.dhs", "out.hlp"), -1);
TEST_STR_EQ(api->hlpcLastOutput(), "out.hlp");
TEST_STR_EQ(HelpCompileMessages(), "");
api->hlpcRc(2);
TEST_EQ(HelpCompile("guide.dhs", "fail.hlp"), 0);
TEST_STR_EQ(HelpCompileMessages(), FRT_STUB_HLPC_ERROR "\n");
TEST_EQ(HelpCompile(NULL, "x.hlp"), 0);
TEST_TRUE(HelpCompileMessages()[0] != '\0');
TEST_EQ(HelpCompile("x.dhs", NULL), 0);
// A bare help file name resolves against the app directory.
char expected[DVX_MAX_PATH * 2];
HelpView("topic.hlp");
snprintf(expected, sizeof(expected), "%s" DVX_PATH_SEP "topic.hlp", app.vm->appPath);
TEST_STR_EQ(api->shellLastArgs(), expected);
// A path with a directory component passes through unchanged.
HelpView("/tmp/abs.hlp");
TEST_STR_EQ(api->shellLastArgs(), "/tmp/abs.hlp");
HelpView(NULL);
// "" is the system help (the DVX user guide)
HelpView("");
TEST_STR_EQ(api->shellLastArgs(), DVX_SYSTEM_HELP_FILE_LITERAL);
// HelpViewTopic: the same path rules, then the topic; a path with
// blanks is quoted so the topic stays a separate argument
HelpViewTopic("topic.hlp", "a.topic");
snprintf(expected, sizeof(expected), "%s" DVX_PATH_SEP "topic.hlp a.topic", app.vm->appPath);
TEST_STR_EQ(api->shellLastArgs(), expected);
HelpViewTopic("/tmp/my help.hlp", "b.topic");
TEST_STR_EQ(api->shellLastArgs(), "\"/tmp/my help.hlp\" b.topic");
HelpViewTopic("/tmp/abs.hlp", "");
TEST_STR_EQ(api->shellLastArgs(), "/tmp/abs.hlp");
HelpViewTopic("", "c.topic");
TEST_STR_EQ(api->shellLastArgs(), DVX_SYSTEM_HELP_FILE_LITERAL " c.topic");
HelpViewTopic("x.hlp", NULL);
TEST_STR_EQ(api->shellLastArgs(), DVX_SYSTEM_HELP_FILE_LITERAL " c.topic");
frtDestroy(&app);
basFormRtTestReset();
frtStubsClose();
tShutdown();
}
// A help viewer's pieces from BASIC (hlpfile.bas called for real, the
// HelpPane control): topics, table of contents, index, search, records
// and wrapping; ShowTopic / Topic / LinkTopic / Clear; a click on a link
// fires LinkClick, whose handler shows the target topic. The CONSTs of
// hlpfile.bas must match hlpFormat.h.
static void caseHelpPane(void) {
tCase("HelpPane control and hlpfile.bas from BASIC");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
// The module: hlpfile.bas, then code that uses its CONSTs (the
// harness compiles form code before the module)
static const char moduleCode[] =
"SUB CheckRecords(BYVAL h AS LONG)\n"
" Chk HlpRecordType(h, 0) = HLP_REC_HEADING1 AND HlpRecordText$(h, 0) = \"Extra\", \"heading\"\n"
" Chk HlpRecordType(h, 1) = HLP_REC_LINK AND HlpRecordLink$(h, 1) = \"fx.welcome\" AND HlpRecordText$(h, 1) = \"Back to welcome\", \"link\"\n"
"END SUB\n"
"SUB PrintConsts\n"
" PRINT HLP_REC_TEXT; HLP_REC_IMAGE; HLP_REC_LINK; HLP_REC_TABLE; HLP_REC_CODE; HLP_NOTE_WARNING; HLP_IMG_RIGHT\n"
"END SUB\n";
int32_t len = 0;
char *incl = platformReadFile(FRT_INCLUDE_DIR "/hlpfile.bas", &len);
char *bas = incl ? (char *)malloc((size_t)len + sizeof(moduleCode) + 1) : NULL;
TEST_TRUE(bas != NULL);
if (bas) {
snprintf(bas, (size_t)len + sizeof(moduleCode) + 1, "%s\n%s", incl, moduleCode);
}
free(incl);
const char *frm =
"Begin Form Form1\n"
" Caption = \"Help\"\n"
" Begin HelpPane HP1\n"
" Weight = 1\n"
" End\n"
"End\n"
"\n"
"Dim Shared hlp As Long\n"
"\n"
"Sub Chk(ByVal ok As Integer, ByVal what As String)\n"
" If ok Then\n"
" Print \"ok \";\n"
" Else\n"
" Print \"FAIL:\"; what; \" \";\n"
" End If\n"
"End Sub\n"
"\n"
"Sub Form1_Open\n"
" Dim t As Long, i As Long, n As Long, found As Integer\n"
" hlp = HlpOpen(\"" DVXTEST_HELP_HLP "\")\n"
" Chk hlp > 0, \"open\"\n"
" Chk HlpOpen(\"/nonexistent/x.hlp\") = 0, \"missing\"\n"
" t = HlpFindTopic(hlp, \"fx.extra\")\n"
" Chk t >= 0 And t < HlpTopicCount(hlp), \"find\"\n"
" Chk HlpTopicTitle$(hlp, t) = \"Extra File\", \"title\"\n"
" Chk HlpTopicId$(hlp, t) = \"fx.extra\", \"id\"\n"
" Chk HlpStartTopic(hlp, \"\") = HlpFindTopic(hlp, \"fx.welcome\"), \"start\"\n"
" found = 0\n"
" For i = 0 To HlpTocCount(hlp) - 1\n"
" If HlpTocTitle$(hlp, i) = \"Guide\" Then found = (HlpTocTopic(hlp, i) = -1)\n"
" Next i\n"
" Chk found, \"toc\"\n"
" found = 0\n"
" For i = 0 To HlpIndexCount(hlp) - 1\n"
" If HlpIndexKeyword$(hlp, i) = \"zebra\" Then found = (HlpIndexTopic(hlp, i) = HlpFindTopic(hlp, \"fx.deep\"))\n"
" Next i\n"
" Chk found, \"index\"\n"
" Chk HlpSearch(hlp, \"continuation\") = 1, \"search\"\n"
" Chk HlpTopicId$(hlp, HlpSearchTopic(hlp, 0)) = \"fx.blocks\", \"result\"\n"
" n = HlpLoadTopic(hlp, t)\n"
" Chk n = 3, \"records\"\n"
" CheckRecords hlp\n"
" Chk HlpWrap$(\"aaaa bbbb cccc\", 10) = \"aaaa bbbb\" & Chr$(10) & \"cccc\", \"wrap\"\n"
" HP1.ShowTopic hlp, t\n"
" Chk HP1.Topic = t, \"topic\"\n"
" Chk HP1.LinkTopic = \"\", \"linktopic\"\n"
" Print\n"
" PrintConsts\n"
"End Sub\n"
"\n"
"Sub HP1_LinkClick(Topic As String)\n"
" Print \"link \"; Topic; \" \"; HP1.LinkTopic\n"
" HP1.ShowTopic hlp, HlpFindTopic(hlp, Topic)\n"
"End Sub\n"
"\n"
"Sub Form1_Report\n"
" Print HP1.Topic = HlpFindTopic(hlp, \"fx.welcome\")\n"
" HP1.Clear\n"
" Print HP1.Topic\n"
" HlpClose hlp\n"
" Print HlpTopicCount(hlp)\n"
"End Sub\n";
FrtAppT app;
if (!bas || !expectBuild(&app, bas, &frm, 1)) {
free(bas);
tShutdown();
return;
}
free(bas);
basNativeHostSetLive(true);
frtStart(&app, NULL);
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form1", "Open"));
char expected[FRT_HELP_OUT_MAX];
snprintf(expected, sizeof(expected), "ok ok ok ok ok ok ok ok ok ok ok ok ok ok ok ok \n%d %d %d %d %d %d %d \n", HLP_REC_TEXT, HLP_REC_IMAGE, HLP_REC_LINK, HLP_REC_TABLE, HLP_REC_CODE, HLP_NOTE_WARNING, HLP_IMG_RIGHT);
TEST_STR_EQ(frtOut(&app), expected);
// A click on the topic's link: LinkClick shows the welcome topic
BasFormT *form = frtForm(&app, "Form1");
BasControlT *hp = form ? frtCtrl(form, "HP1") : NULL;
WidgetT *link = hp ? firstFocusable(hp->widget) : NULL;
TEST_TRUE(link != NULL);
if (link) {
frtOutClear(&app);
tWidgetClick(link);
tPump(SETTLE_FRAMES_FRT);
TEST_STR_EQ(frtOut(&app), "link fx.welcome fx.welcome\n");
}
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form1", "Report"));
TEST_STR_EQ(frtOut(&app), "True \n-1 \n0 \n");
basNativeHostSetLive(false);
frtDestroy(&app);
tShutdown();
}
// F1 topic (basFormRtHelpTopic, shared by the IDE and the compiled-program
// stub): the focused control's HelpTopic, else the form's, else "".
static void caseHelpTopic(void) {
tCase("F1 help topic from the focused control or form");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm1 =
"Begin Form Form1\n"
" Caption = \"One\"\n"
" HelpTopic = \"form.one\"\n"
" Begin TextBox Txt1\n"
" HelpTopic = \"txt.one\"\n"
" End\n"
" Begin CommandButton Cmd1\n"
" Caption = \"No topic\"\n"
" End\n"
"End\n";
const char *frm2 =
"Begin Form Form2\n"
" Caption = \"Two\"\n"
" Begin CommandButton Cmd2\n"
" Caption = \"No topic\"\n"
" End\n"
"End\n";
const char *frms[2] = { frm1, frm2 };
FrtAppT app;
char topic[BAS_MAX_IDENT];
if (!expectBuild(&app, "", frms, 2)) {
tShutdown();
return;
}
frtStart(&app, "Form1");
BasFormT *form1 = frtForm(&app, "Form1");
BasFormT *form2 = frtForm(&app, "Form2");
BasControlT *txt = form1 ? frtCtrl(form1, "Txt1") : NULL;
BasControlT *cmd = form1 ? frtCtrl(form1, "Cmd1") : NULL;
BasControlT *cmd2 = form2 ? frtCtrl(form2, "Cmd2") : NULL;
TEST_TRUE(form1 && form2 && txt && cmd && cmd2);
if (form1 && form2 && txt && cmd && cmd2) {
// Focused control with a topic.
dvxRaiseWindow(tCtx(), form1->window);
wgtSetFocused(txt->widget);
tPump(1);
TEST_TRUE(basFormRtHelpTopic(app.rt, topic, sizeof(topic)));
TEST_STR_EQ(topic, "txt.one");
// A topic set at run time takes effect.
setStrProp(&app, txt, "HelpTopic", "txt.two");
TEST_TRUE(basFormRtHelpTopic(app.rt, topic, sizeof(topic)));
TEST_STR_EQ(topic, "txt.two");
// Focused control without one: the form's.
wgtSetFocused(cmd->widget);
tPump(1);
TEST_TRUE(basFormRtHelpTopic(app.rt, topic, sizeof(topic)));
TEST_STR_EQ(topic, "form.one");
// Neither: "" (the help file's default topic).
basFormRtShowForm(app.rt, form2, false);
dvxRaiseWindow(tCtx(), form2->window);
wgtSetFocused(cmd2->widget);
tPump(1);
snprintf(topic, sizeof(topic), "stale");
TEST_TRUE(basFormRtHelpTopic(app.rt, topic, sizeof(topic)));
TEST_STR_EQ(topic, "");
// A window that is not one of the program's forms.
WindowT *other = dvxCreateWindow(tCtx(), "Other", 10, 10, 100, 100, false);
dvxRaiseWindow(tCtx(), other);
tPump(1);
snprintf(topic, sizeof(topic), "kept");
TEST_TRUE(!basFormRtHelpTopic(app.rt, topic, sizeof(topic)));
TEST_STR_EQ(topic, "kept");
dvxDestroyWindow(tCtx(), other);
}
frtDestroy(&app);
tShutdown();
}
// ListView SetColumns alignment, SetRows, SelectedRows$ and ColumnClick;
// TreeView ListIndex, item tags and HasChildren.
static void caseListTreeMethods(void) {
tCase("ListView SetRows / SelectedRows / ColumnClick, TreeView ListIndex / tags");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm =
"Begin Form Form1\n"
" Caption = \"Lists\"\n"
" Begin ListView LV1\n"
" Weight = 1\n"
" End\n"
" Begin TreeView TV1\n"
" Weight = 1\n"
" End\n"
"End\n"
"\n"
"Dim Shared changes As Integer\n"
"\n"
"Sub Form1_Fill\n"
" LV1.SetColumns \"Name,14|Size,12,Right|Type\"\n"
" LV1.SetRows \"a\" & Chr$(9) & \"1\" & Chr$(9) & \"T1\" & Chr$(10) & \"b\" & Chr$(9) & \"22\" & Chr$(10) & \"c\" & Chr$(9) & \"3\" & Chr$(9) & \"T3\" & Chr$(9) & \"extra\" & Chr$(10)\n"
" Print LV1.RowCount(); LV1.GetCell(1, 1); \"[\"; LV1.GetCell(1, 2); \"]\"; LV1.GetCell(2, 2); LV1.ListIndex\n"
" LV1.SetMultiSelect True\n"
" LV1.SetItemSelected 0, True\n"
" LV1.SetItemSelected 2, True\n"
" Print \"[\"; LV1.SelectedRows(); \"]\"\n"
" LV1.ClearSelection\n"
" Print \"[\"; LV1.SelectedRows(); \"]\"\n"
" LV1.SetRows \"\"\n"
" Print LV1.RowCount(); LV1.ListIndex\n"
" LV1.SetRows \"x\" & Chr$(10) & \"y\"\n"
"End Sub\n"
"Sub LV1_ColumnClick(Column As Integer)\n"
" Print \"col\"; Column\n"
" LV1.SetSort -1, 0\n"
"End Sub\n"
"Sub Form1_Tree\n"
" TV1.AddItem \"root\"\n"
" TV1.AddChildItem 0, \"b\"\n"
" TV1.AddChildItem 0, \"c\"\n"
" TV1.SetItemTag 1, \"path-b\"\n"
" TV1.AddChildItem 1, \"b1\"\n"
" Print TV1.ItemCount(); TV1.GetItemText(2); TV1.GetItemText(3); TV1.GetItemTag(1); \"[\"; TV1.GetItemTag(3); \"]\"; TV1.HasChildren(1); TV1.HasChildren(3)\n"
" changes = 0\n"
" TV1.ListIndex = 3\n"
" Print TV1.ListIndex; changes\n"
" TV1.SetItemTag 1, \"\"\n"
" TV1.ListIndex = -1\n"
" Print \"[\"; TV1.GetItemTag(1); \"]\"; TV1.ListIndex\n"
"End Sub\n"
"Sub TV1_Change\n"
" changes = changes + 1\n"
"End Sub\n";
FrtAppT app;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form1", "Fill"));
TEST_STR_EQ(frtOut(&app), "3 22[]T30 \n[0 2]\n[]\n0 -1 \n");
// A click on the second column's header: ColumnClick 1
BasFormT *form = frtForm(&app, "Form1");
BasControlT *lv = form ? frtCtrl(form, "LV1") : NULL;
TEST_TRUE(lv != NULL);
if (lv) {
int32_t cx;
int32_t cy;
tWidgetCenter(lv->widget, &cx, &cy);
frtOutClear(&app);
tClick(cx - lv->widget->w / 2 + LV_SECOND_COL_X, cy - lv->widget->h / 2 + LV_HEADER_Y);
TEST_STR_EQ(frtOut(&app), "col1 \n");
}
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form1", "Tree"));
TEST_STR_EQ(frtOut(&app), "4 b1cpath-b[]True False \n3 1 \n[]-1 \n");
frtDestroy(&app);
tShutdown();
}
static void caseLoadForm2(void) {
tCase("Load Form2 from Form1_Load populates Form2");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm1 =
"Begin Form Form1\n"
" Caption = \"One\"\n"
" Begin Label Lbl1\n"
" Caption = \"L1\"\n"
" End\n"
"End\n"
"\n"
"Sub Form1_Load\n"
" Load Form2\n"
" Print \"F1 loaded\"\n"
" Form2.Show\n"
"End Sub\n";
const char *frm2 =
"Begin Form Form2\n"
" Caption = \"Two\"\n"
" Width = 320\n"
" Height = 200\n"
" Begin Label Lbl2\n"
" Caption = \"L2\"\n"
" End\n"
" Begin Frame Fr2\n"
" Begin CommandButton Cmd2\n"
" Caption = \"C2\"\n"
" End\n"
" End\n"
"End\n"
"\n"
"Sub Form2_Load\n"
" Print \"F2 load \"; Cmd2.Caption\n"
"End Sub\n";
const char *frms[2] = { frm1, frm2 };
FrtAppT app;
if (!expectBuild(&app, "", frms, 2)) {
tShutdown();
return;
}
// Register Form1 only through LoadAllForms's first entry: Form2 is
// cached but loaded lazily by Form1_Load.
basFormRtLoadForm(app.rt, "Form1");
tPump(1);
BasFormT *f1 = frtForm(&app, "Form1");
BasFormT *f2 = frtForm(&app, "Form2");
TEST_TRUE(f1 && f2);
if (f2) {
TEST_EQ((int32_t)arrlen(f2->controls), 3);
TEST_TRUE(frtCtrl(f2, "Lbl2") != NULL);
TEST_TRUE(frtCtrl(f2, "Cmd2") != NULL);
TEST_STR_EQ(f2->window->title, "Two");
TEST_EQ(f2->window->w, 320);
TEST_TRUE(f2->window->visible);
TEST_STR_EQ(frtOut(&app), "F2 load C2\nF1 loaded\n");
}
TEST_EQ((int32_t)arrlen(app.rt->forms), 2);
frtDestroy(&app);
tShutdown();
}
// LoadPicture: Picture objects for DragIcon and Image.Picture (file
// names still work), an empty picture, TypeName, Width / Height in
// HiMetric and Type, ScaleX / ScaleY between the scales (defaults, a
// ScaleMode, a user scale), and the errors for a missing file and a file
// that is not a picture.
static void caseLoadPicture(void) {
tCase("LoadPicture and Picture objects");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm =
"Begin Form Form1\n"
" Caption = \"Pictures\"\n"
" Begin Label Src\n"
" Caption = \"Source\"\n"
" End\n"
" Begin Image Img\n"
" End\n"
" Begin PictureBox Pic\n"
" End\n"
"End\n"
"\n"
"Sub Form1_Use\n"
" Dim p As Object\n"
" Set p = LoadPicture(\"" FRT_FIXTURE_DIR "/icon.bmp\")\n"
" Print TypeName(p); \" \"; IsObject(p); p Is LoadPicture(\"" FRT_FIXTURE_DIR "/icon.bmp\")\n"
" Set Src.DragIcon = p\n"
" Print InStr(Src.DragIcon, \"icon.bmp\") > 0\n"
" Img.Picture = p\n"
" Print InStr(Img.Picture, \"icon.bmp\") > 0\n"
" Pic.PaintPicture p, 0, 0\n"
" Set Src.DragIcon = LoadPicture()\n"
" Print \"[\"; Src.DragIcon; \"]\"; TypeName(LoadPicture(\"\"))\n"
" Src.DragIcon = \"" FRT_FIXTURE_DIR "/icon.bmp\"\n"
" Print InStr(Src.DragIcon, \"icon.bmp\") > 0\n"
" Dim e As Object\n"
" Set e = LoadPicture()\n"
" Print p.Width; p.Height; p.Type; e.Width; e.Height; e.Type; vbPicTypeBitmap; vbHimetric\n"
" Print CLng(Pic.ScaleX(p.Width, vbHimetric, vbPixels)); Pic.ScaleX(2540); Pic.ScaleY(1, vbInches, vbTwips); Pic.ScaleX(30, vbPixels, vbTwips)\n"
" Pic.ScaleMode = vbTwips\n"
" Print Pic.ScaleX(2540); Pic.ScaleY(1440, , vbCentimeters); Pic.ScaleX(1, vbCharacters, vbPoints)\n"
" Pic.ScaleMode = vbPixels\n"
" Pic.Scale (0, 0)-(Pic.ScaleWidth / 2, Pic.ScaleHeight / 4)\n"
" Print Pic.ScaleX(3, vbUser, vbPixels); Pic.ScaleY(8, vbPixels, vbUser); Pic.ScaleX(5080); Pic.ScaleX(3, vbUser)\n"
"End Sub\n"
"Sub Form1_Bad\n"
" On Error GoTo failed\n"
" Set Src.DragIcon = LoadPicture(\"" FRT_FIXTURE_DIR "/noSuchFile.bmp\")\n"
" Set Src.DragIcon = LoadPicture(\"" FRT_FIXTURE_DIR "/../frtHarness.h\")\n"
" Exit Sub\n"
"failed:\n"
" Print \"err\"; Err\n"
" Resume Next\n"
"End Sub\n"
"Sub Form1_BadScale\n"
" Print Pic.ScaleX(1, vbHimetric + 1)\n"
"End Sub\n";
FrtAppT app;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form1", "Use"));
TEST_STR_EQ(frtOut(&app), "Picture True True \nTrue \nTrue \n[]Picture\nTrue \n847 847 1 0 0 0 1 8 \n32 96 1440 450 \n1440 1.44 6 \n6 2 96 3 \n");
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form1", "Bad"));
TEST_STR_EQ(frtOut(&app), "err53 \nerr481 \n");
TEST_TRUE(!app.rt->terminated);
// vbContainerPosition (9) is not a scale DVX has
frtFire(&app, "Form1", "BadScale");
TEST_TRUE(app.rt->terminated);
frtDestroy(&app);
tShutdown();
}
// Menus made at run time: AddMenu (a menu bar on a form without one),
// AddMenuItem with a shortcut key, AddMenuRadioItem, a menu item's
// Shortcut read and changed, RemoveMenu (the bar goes with its last
// menu), and the errors.
static void caseMenuBarRuntime(void) {
tCase("AddMenu / RemoveMenu / AddMenuRadioItem / Shortcut at run time");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm =
"Begin Form Form1\n"
" Caption = \"Menus\"\n"
" Begin TextBox Text1\n"
" End\n"
"End\n"
"\n"
"Sub Form1_Build\n"
" Me.AddMenu \"mnuDyn\", \"&Dynamic\"\n"
" Me.AddMenuItem \"mnuDyn\", \"mnuAlpha\", \"&Alpha\", \"Ctrl+K\"\n"
" Me.AddMenuRadioItem \"mnuDyn\", \"mnuOne\", \"One\", True\n"
" Me.AddMenuRadioItem \"mnuDyn\", \"mnuTwo\", \"Two\"\n"
" Me.AddMenu \"mnuMore\", \"&More\"\n"
" Print mnuAlpha.Shortcut; \"|\"; mnuOne.Shortcut; \"|\"\n"
"End Sub\n"
"Sub Form1_Rekey\n"
" mnuAlpha.Shortcut = \"F5\"\n"
" mnuAlpha.Caption = \"Al&pha\"\n"
" Print mnuAlpha.Shortcut; mnuAlpha.Caption\n"
"End Sub\n"
"Sub Form1_Unkey\n"
" mnuAlpha.Shortcut = \"\"\n"
"End Sub\n"
"Sub Form1_RemoveDyn\n"
" Me.RemoveMenu \"mnuDyn\"\n"
"End Sub\n"
"Sub Form1_RemoveMore\n"
" Me.RemoveMenu \"mnuMore\"\n"
"End Sub\n"
"Sub mnuAlpha_Click\n"
" Print \"alpha\"\n"
"End Sub\n"
"Sub Form1_BadKey\n"
" mnuAlpha.Shortcut = \"Hyper+Q\"\n"
"End Sub\n"
"Sub Form1_DupMenu\n"
" Me.AddMenu \"mnuDyn\", \"Again\"\n"
"End Sub\n"
"Sub Form1_RemovePopup\n"
" Me.CreateMenu \"mnuPop\"\n"
" Me.RemoveMenu \"mnuPop\"\n"
"End Sub\n";
const char *bad[] = { "BadKey", "DupMenu", "RemovePopup" };
FrtAppT app;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
BasFormT *form = frtForm(&app, "Form1");
WindowT *win = form ? form->window : NULL;
TEST_TRUE(win != NULL && win->menuBar == NULL);
if (!win) {
frtDestroy(&app);
tShutdown();
return;
}
int32_t contentH = win->contentH;
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form1", "Build"));
TEST_STR_EQ(frtOut(&app), "Ctrl+K||\n");
TEST_TRUE(win->menuBar != NULL && win->menuBar->menuCount == 2);
TEST_TRUE(win->contentH < contentH);
if (!win->menuBar || win->menuBar->menuCount < 1) {
frtDestroy(&app);
tShutdown();
return;
}
MenuT *dyn = win->menuBar->menus[0];
TEST_EQ(dyn->itemCount, 3);
TEST_STR_EQ(dyn->items[0].label, "&Alpha\tCtrl+K");
TEST_EQ(dyn->items[1].type, MenuItemRadioE);
TEST_TRUE(dyn->items[1].checked && !dyn->items[2].checked);
TEST_TRUE(form->accel != NULL && win->accelTable == form->accel);
TEST_EQ(form->accel ? form->accel->count : 0, 1);
// A new key replaces the old one; the caption keeps the key text
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form1", "Rekey"));
TEST_STR_EQ(frtOut(&app), "F5Al&pha\n");
TEST_STR_EQ(dyn->items[0].label, "Al&pha\tF5");
TEST_EQ(form->accel ? form->accel->count : 0, 1);
frtOutClear(&app);
win->onMenu(win, dyn->items[0].id);
TEST_STR_EQ(frtOut(&app), "alpha\n");
TEST_TRUE(frtFire(&app, "Form1", "Unkey"));
TEST_STR_EQ(dyn->items[0].label, "Al&pha");
TEST_EQ(form->accel ? form->accel->count : 0, 0);
// RemoveMenu takes the menu and its items; the last one the bar
TEST_TRUE(frtFire(&app, "Form1", "RemoveDyn"));
TEST_TRUE(!app.rt->terminated);
TEST_TRUE(win->menuBar != NULL && win->menuBar->menuCount == 1);
TEST_TRUE(basFormRtFindCtrl(app.rt, form, "mnuAlpha") == NULL);
TEST_TRUE(frtFire(&app, "Form1", "RemoveMore"));
TEST_TRUE(win->menuBar == NULL);
TEST_EQ(win->contentH, contentH);
frtDestroy(&app);
for (int32_t i = 0; i < (int32_t)DVX_ARRAY_LEN(bad); i++) {
if (!expectBuild(&app, "", &frm, 1)) {
break;
}
frtStart(&app, NULL);
frtFire(&app, "Form1", "Build");
frtFire(&app, "Form1", bad[i]);
if (!app.rt->terminated) {
printf(" menu error case %s did not stop the program\n", bad[i]);
}
TEST_TRUE(app.rt->terminated);
frtDestroy(&app);
}
tShutdown();
}
// A menu item's Caption at run time: read without its key text, set with
// the key text kept.
static void caseMenuCaption(void) {
tCase("menu Caption at run time keeps the key text");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm =
"Begin Form Form1\n"
" Caption = \"Menu\"\n"
" Begin Menu mnuFile\n"
" Caption = \"&File\"\n"
" Begin Menu mnuOpen\n"
" Caption = \"&Open\"\n"
" Shortcut = \"Ctrl+O\"\n"
" End\n"
" Begin Menu mnuPlain\n"
" End\n"
" End\n"
"End\n"
"\n"
"Sub Form1_Rename\n"
" Print mnuOpen.Caption\n"
" mnuOpen.Caption = \"&Load\"\n"
" mnuPlain.Caption = \"Pla&in\"\n"
" Print mnuOpen.Caption; \"|\"; mnuPlain.Caption\n"
"End Sub\n";
FrtAppT app;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
frtFire(&app, "Form1", "Rename");
TEST_STR_EQ(frtOut(&app), "&Open\n&Load|Pla&in\n");
BasFormT *form = frtForm(&app, "Form1");
MenuT *file = (form && form->window && form->window->menuBar) ? form->window->menuBar->menus[0] : NULL;
TEST_TRUE(file != NULL);
if (file) {
TEST_STR_EQ(file->items[0].label, "&Load\tCtrl+O");
TEST_EQ(file->items[0].accelKey, 'l');
TEST_STR_EQ(file->items[1].label, "Pla&in");
}
frtDestroy(&app);
tShutdown();
}
// Menus at run time: a .frm Checked = False item is a check item; a
// nested Visible = False item starts hidden; Visible hides and shows items
// back in their places; AddMenuItem / AddMenuSeparator on a menu-bar menu
// (an MRU list) and RemoveMenuItem; submenus refuse to hide or go.
static void caseMenuRuntime(void) {
tCase("menus at run time: Checked = False, Visible, bar AddMenuItem / RemoveMenuItem");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm =
"Begin Form Form1\n"
" Caption = \"Menus\"\n"
" Begin Menu mnuFile\n"
" Caption = \"&File\"\n"
" Begin Menu mnuA\n"
" Caption = \"A\"\n"
" End\n"
" Begin Menu mnuB\n"
" Caption = \"B\"\n"
" Checked = False\n"
" End\n"
" Begin Menu mnuC\n"
" Caption = \"C\"\n"
" Visible = False\n"
" End\n"
" Begin Menu mnuD\n"
" Caption = \"D\"\n"
" End\n"
" Begin Menu mnuSub\n"
" Caption = \"Sub\"\n"
" Begin Menu mnuSubItem\n"
" Caption = \"Nested\"\n"
" End\n"
" End\n"
" End\n"
"End\n"
"\n"
"Sub mnuMru1_Click\n"
" Print \"mru1\"\n"
"End Sub\n"
"Sub Form1_Hide\n"
" Print mnuC.Visible; mnuB.Visible; mnuB.Checked\n"
" mnuB.Visible = False\n"
" mnuB.Caption = \"Bee\"\n"
" mnuB.Checked = True\n"
" Print mnuB.Visible; mnuB.Caption; mnuB.Checked\n"
"End Sub\n"
"Sub Form1_ShowC\n"
" mnuC.Visible = True\n"
"End Sub\n"
"Sub Form1_ShowB\n"
" mnuB.Visible = True\n"
"End Sub\n"
"Sub Form1_Mru\n"
" Me.AddMenuSeparator \"mnuFile\", \"mnuMruSep\"\n"
" Me.AddMenuItem \"mnuFile\", \"mnuMru1\", \"&1 one.txt\"\n"
" Me.AddMenuItem \"mnuSub\", \"mnuSub2\", \"Two\"\n"
"End Sub\n"
"Sub Form1_Unmru\n"
" Me.RemoveMenuItem \"mnuMru1\"\n"
" Me.RemoveMenuItem \"mnuMruSep\"\n"
" Me.RemoveMenuItem \"mnuNoSuch\"\n"
"End Sub\n"
"Sub Form1_RemoveSub\n"
" Me.RemoveMenuItem \"mnuSub\"\n"
"End Sub\n"
"Sub Form1_HideSub\n"
" mnuSub.Visible = False\n"
"End Sub\n";
FrtAppT app;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
BasFormT *form = frtForm(&app, "Form1");
MenuT *file = (form && form->window->menuBar) ? form->window->menuBar->menus[0] : NULL;
TEST_TRUE(file != NULL);
if (!file) {
frtDestroy(&app);
tShutdown();
return;
}
// C starts hidden; B is a check item, unchecked
TEST_EQ(file->itemCount, 4);
TEST_STR_EQ(file->items[1].label, "B");
TEST_EQ(file->items[1].type, MenuItemCheckE);
TEST_TRUE(!file->items[1].checked);
TEST_STR_EQ(file->items[2].label, "D");
// Hidden items keep their properties; shown in either order, each
// goes back to its own place
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form1", "Hide"));
TEST_STR_EQ(frtOut(&app), "False True False \nFalse BeeTrue \n");
TEST_EQ(file->itemCount, 3);
TEST_TRUE(frtFire(&app, "Form1", "ShowC"));
TEST_TRUE(frtFire(&app, "Form1", "ShowB"));
TEST_EQ(file->itemCount, 5);
TEST_STR_EQ(file->items[0].label, "A");
TEST_STR_EQ(file->items[1].label, "Bee");
TEST_TRUE(file->items[1].checked);
TEST_STR_EQ(file->items[2].label, "C");
TEST_STR_EQ(file->items[3].label, "D");
TEST_STR_EQ(file->items[4].label, "Sub");
// A recent-files list on the menu bar's File menu, and an item added
// to a .frm submenu
TEST_TRUE(frtFire(&app, "Form1", "Mru"));
TEST_TRUE(!app.rt->terminated);
TEST_EQ(file->itemCount, 7);
TEST_TRUE(file->items[5].separator);
TEST_STR_EQ(file->items[6].label, "&1 one.txt");
TEST_EQ(file->items[4].subMenu->itemCount, 2);
frtOutClear(&app);
form->window->onMenu(form->window, file->items[6].id);
TEST_STR_EQ(frtOut(&app), "mru1\n");
// Removed again (an unknown name is ignored)
TEST_TRUE(frtFire(&app, "Form1", "Unmru"));
TEST_TRUE(!app.rt->terminated);
TEST_EQ(file->itemCount, 5);
TEST_STR_EQ(file->items[4].label, "Sub");
// A submenu can be neither removed nor hidden
frtFire(&app, "Form1", "RemoveSub");
TEST_TRUE(app.rt->terminated);
TEST_EQ(file->itemCount, 5);
frtDestroy(&app);
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
frtFire(&app, "Form1", "HideSub");
TEST_TRUE(app.rt->terminated);
frtDestroy(&app);
tShutdown();
}
static void caseMenus(void) {
tCase(".frm menus: bar, check, radio, disabled, submenu, popup");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm =
"Begin Form Form1\n"
" Caption = \"Menus\"\n"
" Begin Menu mnuFile\n"
" Caption = \"&File\"\n"
" Begin Menu mnuOpen\n"
" Caption = \"&Open\"\n"
" End\n"
" Begin Menu mnuSep1\n"
" Caption = \"-\"\n"
" End\n"
" Begin Menu mnuChk\n"
" Caption = \"Check\"\n"
" Checked = True\n"
" End\n"
" Begin Menu mnuRad\n"
" Caption = \"Radio\"\n"
" RadioCheck = True\n"
" Checked = True\n"
" End\n"
" Begin Menu mnuDis\n"
" Caption = \"Disabled\"\n"
" Enabled = False\n"
" End\n"
" Begin Menu mnuSub\n"
" Caption = \"Sub\"\n"
" Begin Menu mnuSubItem\n"
" Caption = \"Nested\"\n"
" End\n"
" End\n"
" End\n"
" Begin Menu mnuPop\n"
" Caption = \"Popup\"\n"
" Visible = False\n"
" Begin Menu mnuPopItem\n"
" Caption = \"Pop Item\"\n"
" End\n"
" End\n"
" Begin Label Lbl1\n"
" Caption = \"x\"\n"
" End\n"
"End\n"
"\n"
"Sub mnuOpen_Click\n"
" Print \"open\"\n"
"End Sub\n"
"Sub mnuSubItem_Click\n"
" Print \"nested\"\n"
"End Sub\n"
"Sub mnuPopItem_Click\n"
" Print \"pop\"\n"
"End Sub\n"
"Sub Form1_Test\n"
" Print \"chk=\"; mnuChk.Checked; mnuRad.Checked; mnuDis.Enabled; mnuOpen.Enabled\n"
" mnuChk.Checked = False\n"
" mnuDis.Enabled = True\n"
" Print \"after=\"; mnuChk.Checked; mnuDis.Enabled\n"
"End Sub\n";
FrtAppT app;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
frtFire(&app, "Form1", "Test");
BasFormT *form = frtForm(&app, "Form1");
MenuBarT *bar = form ? form->window->menuBar : NULL;
TEST_EQ(app.mainResult, BAS_VM_HALTED);
TEST_TRUE(bar != NULL);
if (bar) {
TEST_EQ(bar->menuCount, 1);
MenuT *file = bar->menus[0];
TEST_STR_EQ(file->label, "&File");
TEST_EQ(file->itemCount, 6);
TEST_STR_EQ(file->items[0].label, "&Open");
TEST_TRUE(file->items[1].separator);
TEST_EQ(file->items[2].type, MenuItemCheckE);
TEST_EQ(file->items[3].type, MenuItemRadioE);
TEST_TRUE(file->items[3].checked);
TEST_STR_EQ(file->items[5].label, "Sub");
TEST_TRUE(file->items[5].subMenu != NULL);
if (file->items[5].subMenu) {
TEST_STR_EQ(file->items[5].subMenu->items[0].label, "Nested");
}
outContains(&app, "chk=True True False True \n");
outContains(&app, "after=False True \n");
TEST_TRUE(!file->items[2].checked);
TEST_TRUE(file->items[4].enabled);
// Every menu with items is named: the bar's File menu and the
// submenu (not owned: the bar owns them), the popup (owned). Ids
// dispatch Click handlers whether they come from the bar or the
// popup.
TEST_EQ(form->popupMenuCount, 3);
TEST_STR_EQ(form->popupMenus[0].name, "mnuFile");
TEST_PTR_EQ(form->popupMenus[0].menu, file);
TEST_TRUE(!form->popupMenus[0].ownsMenu);
TEST_STR_EQ(form->popupMenus[1].name, "mnuSub");
TEST_PTR_EQ(form->popupMenus[1].menu, file->items[5].subMenu);
TEST_TRUE(!form->popupMenus[1].ownsMenu);
TEST_STR_EQ(form->popupMenus[2].name, "mnuPop");
TEST_TRUE(form->popupMenus[2].ownsMenu);
frtOutClear(&app);
form->window->onMenu(form->window, file->items[0].id);
form->window->onMenu(form->window, file->items[5].subMenu->items[0].id);
form->window->onMenu(form->window, form->popupMenus[2].menu->items[0].id);
TEST_STR_EQ(frtOut(&app), "open\nnested\npop\n");
}
frtDestroy(&app);
tShutdown();
}
// Menu Shortcut (an accelerator plus its key text) and ShortcutText (the
// text only), and Checked set on an item the .frm did not make checkable.
static void caseMenuShortcuts(void) {
tCase("menu Shortcut / ShortcutText keys and labels, Checked on a plain item");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm =
"Begin Form Form1\n"
" Caption = \"Keys\"\n"
" Begin Menu mnuFile\n"
" Caption = \"&File\"\n"
" Begin Menu mnuRename\n"
" Caption = \"&Rename...\"\n"
" Shortcut = \"f2\"\n"
" End\n"
" Begin Menu mnuDelete\n"
" Caption = \"&Delete\"\n"
" ShortcutText = \"Del\"\n"
" End\n"
" Begin Menu mnuProps\n"
" Caption = \"P&roperties\"\n"
" Shortcut = \"Alt+Enter\"\n"
" End\n"
" Begin Menu mnuBoth\n"
" Caption = \"Both\"\n"
" Shortcut = \"Ctrl+B\"\n"
" ShortcutText = \"Ctrl+B or F9\"\n"
" End\n"
" Begin Menu mnuDesc\n"
" Caption = \"D&escending\"\n"
" End\n"
" End\n"
" Begin TextBox Text1\n"
" End\n"
"End\n"
"\n"
"Sub mnuRename_Click\n"
" Print \"rename\"\n"
"End Sub\n"
"Sub mnuDelete_Click\n"
" Print \"delete\"\n"
"End Sub\n"
"Sub mnuProps_Click\n"
" Print \"props\"\n"
"End Sub\n"
"Sub mnuBoth_Click\n"
" Print \"both\"\n"
"End Sub\n"
"Sub mnuDesc_Click\n"
" mnuDesc.Checked = Not mnuDesc.Checked\n"
" Print \"desc\"; mnuDesc.Checked\n"
"End Sub\n";
const char *badFrm =
"Begin Form Form2\n"
" Caption = \"Bad\"\n"
" Begin Menu mnuFile\n"
" Caption = \"&File\"\n"
" Begin Menu mnuOdd\n"
" Caption = \"Odd\"\n"
" Shortcut = \"Hyper+Q\"\n"
" End\n"
" End\n"
"End\n";
FrtAppT app;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
BasFormT *form = frtForm(&app, "Form1");
BasControlT *text = form ? frtCtrl(form, "Text1") : NULL;
MenuBarT *bar = form ? form->window->menuBar : NULL;
TEST_TRUE(bar != NULL && text != NULL);
if (bar && text) {
MenuT *file = bar->menus[0];
TEST_STR_EQ(file->items[0].label, "&Rename...\tF2");
TEST_STR_EQ(file->items[1].label, "&Delete\tDel");
TEST_STR_EQ(file->items[2].label, "P&roperties\tAlt+Enter");
TEST_STR_EQ(file->items[3].label, "Both\tCtrl+B or F9");
TEST_STR_EQ(file->items[4].label, "D&escending");
TEST_EQ(file->items[4].type, MenuItemNormalE);
TEST_TRUE(form->window->accelTable == form->accel && form->accel != NULL);
TEST_EQ(form->accel ? form->accel->count : 0, MENU_SHORTCUT_COUNT);
// F2, Alt+Enter and Ctrl+B run their items; Del reaches the text box.
frtOutClear(&app);
wgtSetFocused(text->widget);
tKey(KEY_SCAN_F2, 0, 0);
tKey(KEY_SCAN_DELETE, 0, 0);
tKey(KEY_SCAN_ENTER, 0, KEY_MOD_ALT);
tKey(SCAN_B, KEY_CTRL_B, KEY_MOD_CTRL);
TEST_STR_EQ(frtOut(&app), "rename\nprops\nboth\n");
// Checked on a plain item gives it a check mark
frtOutClear(&app);
form->window->onMenu(form->window, file->items[4].id);
TEST_EQ(file->items[4].type, MenuItemCheckE);
TEST_TRUE(file->items[4].checked);
form->window->onMenu(form->window, file->items[4].id);
TEST_TRUE(!file->items[4].checked);
TEST_STR_EQ(frtOut(&app), "descTrue \ndescFalse \n");
}
frtDestroy(&app);
// An unknown key stops the program when the form loads
if (expectBuild(&app, "", &badFrm, 1)) {
frtStart(&app, NULL);
TEST_TRUE(app.rt->terminated);
frtDestroy(&app);
}
tShutdown();
}
// WGT_SIG_RET_INT_STR: the string argument reaches the widget function
// and its int32_t status comes back to BASIC as a Long, both through
// basFormRtCallMethod and from compiled code. A test interface stands in
// for a widget, so the check does not depend on any widget module.
static void caseMethodRetIntStr(void) {
tCase("WGT_SIG_RET_INT_STR method returns its status to BASIC");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm =
"Begin Form Form1\n"
" Caption = \"Probe\"\n"
" Begin ListBox Lst\n"
" End\n"
"End\n"
"Sub Form1_Probe ()\n"
" Dim n As Long\n"
" n = Lst.Probe(\"" FRT_PROBE_BAS_ARG "\")\n"
" Print n\n"
"End Sub\n";
FrtAppT app;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
BasControlT *lst = frtCtrl(frtForm(&app, "Form1"), "Lst");
TEST_TRUE(lst != NULL);
if (lst) {
const WgtIfaceT *realIface = lst->iface;
WgtIfaceT probeIface;
BasValueT a[1];
memset(&probeIface, 0, sizeof(probeIface));
probeIface.methods = sProbeMethods;
probeIface.methodCount = (int32_t)DVX_ARRAY_LEN(sProbeMethods);
lst->iface = &probeIface;
a[0] = basValStringFromC(FRT_PROBE_ARG);
BasValueT r = basFormRtCallMethod(app.rt, lst, "Probe", a, 1);
basValRelease(&a[0]);
TEST_EQ(r.type, BAS_TYPE_LONG);
TEST_EQ(r.longVal, FRT_PROBE_BIAS + (int32_t)strlen(FRT_PROBE_ARG));
TEST_STR_EQ(sProbeArg, FRT_PROBE_ARG);
// No argument: the widget is not called and the result is 0.
sProbeArg[0] = '\0';
r = basFormRtCallMethod(app.rt, lst, "Probe", NULL, 0);
TEST_EQ(basValToInt32(r), 0);
TEST_STR_EQ(sProbeArg, "");
char want[FRT_PROBE_NUM_BUF];
snprintf(want, sizeof(want), "%d", (int)(FRT_PROBE_BIAS + strlen(FRT_PROBE_BAS_ARG)));
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form1", "Probe"));
outContains(&app, want);
TEST_STR_EQ(sProbeArg, FRT_PROBE_BAS_ARG);
lst->iface = realIface;
}
frtDestroy(&app);
tShutdown();
}
static void caseMethodSignatures(void) {
tCase("every WGT_SIG_* marshaling branch in basFormRtCallMethod");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm =
"Begin Form Form1\n"
" Caption = \"Sig\"\n"
" Begin ListBox Lst\n"
" End\n"
" Begin PictureBox Pic\n"
" End\n"
" Begin ListView Lv\n"
" End\n"
" Begin DBGrid Grd\n"
" End\n"
" Begin TextArea Ta\n"
" End\n"
" Begin TreeView Tv\n"
" End\n"
" Begin TabStrip Tab\n"
" End\n"
" Begin SpinButton Spn\n"
" End\n"
" Begin Terminal Trm\n"
" End\n"
" Begin Timer Tmr\n"
" Interval = 50\n"
" Enabled = False\n"
" End\n"
"End\n";
FrtAppT app;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
BasFormT *form = frtForm(&app, "Form1");
BasControlT *lst = frtCtrl(form, "Lst");
BasControlT *pic = frtCtrl(form, "Pic");
BasControlT *lv = frtCtrl(form, "Lv");
BasControlT *grd = frtCtrl(form, "Grd");
BasControlT *ta = frtCtrl(form, "Ta");
BasControlT *tv = frtCtrl(form, "Tv");
BasControlT *tab = frtCtrl(form, "Tab");
BasControlT *spn = frtCtrl(form, "Spn");
BasControlT *trm = frtCtrl(form, "Trm");
BasControlT *tmr = frtCtrl(form, "Tmr");
BasValueT a[5];
BasValueT r;
// STR / VOID / RET_INT / RET_STR_INT / INT / INT_BOOL /
// RET_BOOL_INT / BOOL on the list box.
a[0] = basValStringFromC("A");
callIntM(&app, lst, "SetMultiSelect", (int32_t[]){ -1 }, 1);
basFormRtCallMethod(app.rt, lst, "AddItem", a, 1);
basValRelease(&a[0]);
a[0] = basValStringFromC("B");
basFormRtCallMethod(app.rt, lst, "AddItem", a, 1);
basValRelease(&a[0]);
r = callIntM(&app, lst, "ListCount", NULL, 0);
TEST_EQ(basValToInt32(r), 2);
r = callIntM(&app, lst, "List", (int32_t[]){ 1 }, 1);
TEST_TRUE(r.type == BAS_TYPE_STRING && strcmp(r.strVal->data, "B") == 0);
basValRelease(&r);
a[0] = basValLong(1);
a[1] = basValBool(true);
basFormRtCallMethod(app.rt, lst, "SetItemSelected", a, 2);
r = callIntM(&app, lst, "IsItemSelected", (int32_t[]){ 1 }, 1);
TEST_TRUE(basValIsTruthy(r));
callIntM(&app, lst, "SelectAll", NULL, 0);
callIntM(&app, lst, "ClearSelection", NULL, 0);
callIntM(&app, lst, "RemoveItem", (int32_t[]){ 0 }, 1);
r = callIntM(&app, lst, "ListCount", NULL, 0);
TEST_EQ(basValToInt32(r), 1);
callIntM(&app, lst, "Clear", NULL, 0);
// INT3 / RET_INT_INT_INT / INT5 / INT4 / INT_INT_STR / INT_INT /
// STR on the pixel widget.
callIntM(&app, pic, "Resize", (int32_t[]){ 64, 48 }, 2);
callIntM(&app, pic, "SetPenColor", (int32_t[]){ 4 }, 1);
callIntM(&app, pic, "SetPixel", (int32_t[]){ 2, 3, 5 }, 3);
r = callIntM(&app, pic, "GetPixel", (int32_t[]){ 2, 3 }, 2);
TEST_EQ(basValToInt32(r), 5);
callIntM(&app, pic, "DrawLine", (int32_t[]){ 0, 0, 5, 5, 3 }, 5);
callIntM(&app, pic, "FillCircle", (int32_t[]){ 8, 8, 3, 6 }, 4);
a[0] = basValLong(1);
a[1] = basValLong(1);
a[2] = basValStringFromC("t");
basFormRtCallMethod(app.rt, pic, "DrawText", a, 3);
basValRelease(&a[2]);
char picPath[DVX_MAX_PATH];
snprintf(picPath, sizeof(picPath), "%s/sigPic.bmp", tTempDir());
a[0] = basValStringFromC(picPath);
basFormRtCallMethod(app.rt, pic, "Save", a, 1);
basFormRtCallMethod(app.rt, pic, "Load", a, 1);
basValRelease(&a[0]);
TEST_EQ(access(picPath, F_OK), 0);
callIntM(&app, pic, "Clear", (int32_t[]){ 0 }, 1);
// Insufficient args are dispatched as no-ops / zero returns.
callIntM(&app, pic, "SetPixel", (int32_t[]){ 1 }, 1);
r = callIntM(&app, pic, "GetPixel", NULL, 0);
TEST_EQ(basValToInt32(r), 0);
r = callIntM(&app, lst, "List", NULL, 0);
TEST_TRUE(r.type == BAS_TYPE_STRING && r.strVal->len == 0);
basValRelease(&r);
r = callIntM(&app, lst, "IsItemSelected", NULL, 0);
TEST_TRUE(!basValIsTruthy(r));
// RET_STR_INT_INT / INT_INT_STR / STR / INT_INT on the list view.
a[0] = basValStringFromC("Id|Name");
basFormRtCallMethod(app.rt, lv, "SetColumns", a, 1);
basValRelease(&a[0]);
a[0] = basValStringFromC("r0");
basFormRtCallMethod(app.rt, lv, "AddItem", a, 1);
basValRelease(&a[0]);
a[0] = basValLong(0);
a[1] = basValLong(1);
a[2] = basValStringFromC("cell");
basFormRtCallMethod(app.rt, lv, "SetCell", a, 3);
basValRelease(&a[2]);
r = callIntM(&app, lv, "GetCell", (int32_t[]){ 0, 1 }, 2);
TEST_TRUE(r.type == BAS_TYPE_STRING && strcmp(r.strVal->data, "cell") == 0);
basValRelease(&r);
r = callIntM(&app, lv, "GetCell", (int32_t[]){ 0 }, 1);
TEST_TRUE(r.type != BAS_TYPE_STRING || r.strVal->len == 0);
basValRelease(&r);
r = callIntM(&app, lv, "RowCount", NULL, 0);
TEST_EQ(basValToInt32(r), 1);
callIntM(&app, lv, "SetSort", (int32_t[]){ 0, 1 }, 2);
// STR_STR / STR_BOOL / STR_INT on the grid.
a[0] = basValStringFromC("id");
a[1] = basValStringFromC("ID");
basFormRtCallMethod(app.rt, grd, "SetColumnHeader", a, 2);
basValRelease(&a[1]);
a[1] = basValBool(false);
basFormRtCallMethod(app.rt, grd, "SetColumnVisible", a, 2);
a[1] = basValLong(40);
basFormRtCallMethod(app.rt, grd, "SetColumnWidth", a, 2);
basValRelease(&a[0]);
// STR / RET_STR / STR_BOOL_BOOL / STR_STR_BOOL / INT on the editor.
a[0] = basValStringFromC("hello world");
basFormRtCallMethod(app.rt, ta, "AppendText", a, 1);
basValRelease(&a[0]);
callIntM(&app, ta, "GoToLine", (int32_t[]){ 1 }, 1);
r = callIntM(&app, ta, "GetWordAtCursor", NULL, 0);
TEST_TRUE(r.type == BAS_TYPE_STRING);
basValRelease(&r);
a[0] = basValStringFromC("world");
a[1] = basValBool(true);
a[2] = basValBool(true);
r = basFormRtCallMethod(app.rt, ta, "FindNext", a, 3);
TEST_TRUE(basValIsTruthy(r));
basValRelease(&a[0]);
a[0] = basValStringFromC("l");
a[1] = basValStringFromC("L");
a[2] = basValBool(false);
r = basFormRtCallMethod(app.rt, ta, "ReplaceAll", a, 3);
TEST_TRUE(basValToInt32(r) >= 1);
basValRelease(&a[0]);
basValRelease(&a[1]);
// INT_STR / RET_STR_INT / INT_BOOL / RET_BOOL_INT / RET_INT on the tree.
a[0] = basValStringFromC("root");
basFormRtCallMethod(app.rt, tv, "AddItem", a, 1);
basValRelease(&a[0]);
a[0] = basValLong(0);
a[1] = basValStringFromC("kid");
basFormRtCallMethod(app.rt, tv, "AddChildItem", a, 2);
basValRelease(&a[1]);
r = callIntM(&app, tv, "GetItemText", (int32_t[]){ 1 }, 1);
TEST_TRUE(r.type == BAS_TYPE_STRING && strcmp(r.strVal->data, "kid") == 0);
basValRelease(&r);
a[0] = basValLong(0);
a[1] = basValBool(true);
basFormRtCallMethod(app.rt, tv, "SetExpanded", a, 2);
r = callIntM(&app, tv, "IsExpanded", (int32_t[]){ 0 }, 1);
TEST_TRUE(basValIsTruthy(r));
r = callIntM(&app, tv, "ItemCount", NULL, 0);
TEST_EQ(basValToInt32(r), 2);
// Tab pages, spinner ranges, terminal write/poll, timer start/stop.
a[0] = basValStringFromC("P1");
basFormRtCallMethod(app.rt, tab, "AddPage", a, 1);
basValRelease(&a[0]);
a[0] = basValStringFromC("P2");
basFormRtCallMethod(app.rt, tab, "AddPage", a, 1);
basValRelease(&a[0]);
callIntM(&app, tab, "SetActive", (int32_t[]){ 1 }, 1);
r = callIntM(&app, tab, "GetActive", NULL, 0);
TEST_EQ(basValToInt32(r), 1);
callIntM(&app, spn, "SetRange", (int32_t[]){ 0, 10 }, 2);
callIntM(&app, spn, "SetStep", (int32_t[]){ 2 }, 1);
a[0] = basValStringFromC("x");
basFormRtCallMethod(app.rt, trm, "Write", a, 1);
basValRelease(&a[0]);
callIntM(&app, trm, "Poll", NULL, 0);
callIntM(&app, trm, "Clear", NULL, 0);
callIntM(&app, tmr, "Start", NULL, 0);
TEST_TRUE(wgtTimerIsRunning(tmr->widget));
callIntM(&app, tmr, "Stop", NULL, 0);
TEST_TRUE(!wgtTimerIsRunning(tmr->widget));
// Unknown method raises and halts.
callIntM(&app, lst, "Frobnicate", NULL, 0);
TEST_TRUE(app.rt->terminated);
frtClearError(&app);
tPump(1);
frtDestroy(&app);
tShutdown();
}
// Show vbModal returns when the form is hidden or unloaded, and gives the
// input gate back to the window that had it.
static void caseModalShow(void) {
tCase("Show vbModal waits until the form is hidden or unloaded");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frms[] = {
"Begin Form Form1\n"
" Caption = \"Main\"\n"
"End\n"
"\n"
"Sub Form1_Test\n"
" Print \"before\"\n"
" Form2.Show vbModal\n"
" Print \"after\"; Form2.Visible\n"
" Form3.Show 1\n"
" Print \"after3\"\n"
"End Sub\n",
"Begin Form Form2\n"
" Caption = \"Dialog\"\n"
"End\n"
"\n"
"Sub Form2_Paint\n"
" Print \"paint\"\n"
" Me.Hide\n"
"End Sub\n",
"Begin Form Form3\n"
" Caption = \"Dialog 3\"\n"
"End\n"
"\n"
"Sub Form3_Paint\n"
" Unload Me\n"
"End Sub\n"
};
FrtAppT app;
if (!expectBuild(&app, "", frms, DVX_ARRAY_LEN(frms))) {
tShutdown();
return;
}
frtStart(&app, "Form1");
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form1", "Test"));
TEST_STR_EQ(frtOut(&app), "before\npaint\nafterFalse \nafter3\n");
TEST_PTR_EQ(tCtx()->modalWindow, NULL);
TEST_PTR_EQ(frtForm(&app, "Form3"), NULL);
frtDestroy(&app);
tShutdown();
}
static void caseMsgBox(void) {
tCase("MsgBox driven by tDialogScript");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm =
"Begin Form Form1\n"
" Caption = \"Msg\"\n"
" Begin CommandButton Cmd1\n"
" Caption = \"Ask\"\n"
" End\n"
"End\n"
"\n"
"Sub Cmd1_Click\n"
" Dim r As Integer\n"
" r = MsgBox(\"Sure?\", 3, \"Ask\")\n"
" Print \"r=\"; r\n"
" MsgBox \"Done\"\n"
" Print \"after\"\n"
"End Sub\n";
FrtAppT app;
DialogCtxT dlg;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
BasFormT *form = frtForm(&app, "Form1");
BasControlT *cmd = frtCtrl(form, "Cmd1");
int32_t sx = 0;
int32_t sy = 0;
memset(&dlg, 0, sizeof(dlg));
snprintf(dlg.button, sizeof(dlg.button), "Yes");
tDialogScript(dialogClick, &dlg);
tWidgetCenter(cmd->widget, &sx, &sy);
tClick(sx, sy);
tPump(1);
TEST_TRUE(dlg.seen >= 2);
TEST_STR_EQ(dlg.title, "DVX BASIC");
TEST_STR_EQ(frtOut(&app), "r=3 \nafter\n");
TEST_PTR_EQ(tCtx()->modalWindow, NULL);
tDialogScript(NULL, NULL);
frtDestroy(&app);
tShutdown();
}
// New launch arguments for the running program (the stub's onNewArgs):
// COMMAND$ changes and NewArgs fires on the forms that handle it; while a
// handler (here with a message box open) is running they are held and
// only the latest is given once it is done. A program without a NewArgs
// handler does not take them.
static void caseNewArgs(void) {
tCase("NewArgs: new launch arguments for a running program");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frms[2] = {
"Begin Form Form1\n"
" Caption = \"Args\"\n"
"End\n"
"\n"
"Sub Form1_NewArgs\n"
" Print \"[\"; Command$; \"]\"; Command$(1); \"|\"; Command$(2)\n"
"End Sub\n"
"\n"
"Sub Form1_Ask\n"
" MsgBox \"Busy\"\n"
" Print \"asked\"\n"
"End Sub\n",
"Begin Form Form2\n"
" Caption = \"Other\"\n"
"End\n"
"\n"
"Sub Form2_NewArgs\n"
" Print \"two \"; Command$(2)\n"
"End Sub\n"
};
FrtAppT app;
if (!expectBuild(&app, "", frms, 2)) {
tShutdown();
return;
}
frtStart(&app, NULL);
TEST_TRUE(basFormRtWantsNewArgs(app.rt));
frtOutClear(&app);
basFormRtNewArgs(app.rt, "\"my file.hlp\" topic.x");
TEST_STR_EQ(frtOut(&app), "[\"my file.hlp\" topic.x]my file.hlp|topic.x\ntwo topic.x\n");
// During a handler's message box: held, the latest given afterwards
NewArgsDlgT dlg;
memset(&dlg, 0, sizeof(dlg));
dlg.app = &app;
tDialogScript(newArgsDuringDialog, &dlg);
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form1", "Ask"));
TEST_EQ(dlg.seen, 1);
TEST_TRUE(!dlg.firedDuring);
TEST_STR_EQ(frtOut(&app), "asked\n[b.hlp second]b.hlp|second\ntwo second\n");
frtDialogsDefault(&app);
basFormRtNewArgs(NULL, "x");
frtDestroy(&app);
// No NewArgs handler: the program does not take new arguments
const char *plain = "Begin Form Form1\n Caption = \"Plain\"\nEnd\n";
if (expectBuild(&app, "", &plain, 1)) {
frtStart(&app, NULL);
TEST_TRUE(!basFormRtWantsNewArgs(app.rt));
basFormRtNewArgs(app.rt, "a b");
frtDestroy(&app);
}
TEST_TRUE(!basFormRtWantsNewArgs(NULL));
tShutdown();
}
// Controls and forms are object values: a bare control or form name where
// an object is expected (SET, IS, TYPEOF, an object parameter) is that
// control or form; TypeName / TypeOf know their types; they go into a
// Collection and through FOR EACH.
static void caseObjectRefs(void) {
tCase("control and form references: SET c = Text1, TypeName, TypeOf, Collection");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm =
"Begin Form Form1\n"
" Caption = \"Objects\"\n"
" Begin TextBox Text1\n"
" End\n"
" Begin CommandButton Command1\n"
" Caption = \"Go\"\n"
" End\n"
"End\n"
"\n"
"Sub Form1_Load\n"
" Dim c As Control\n"
" Dim f As Form\n"
" Dim col As New Collection\n"
" Set c = Text1\n"
" c.Text = \"hi\"\n"
" Print Text1.Text; \" \"; TypeName(c); \" \"; TypeName(Me); \" \"; TypeOf c Is TextBox; TypeOf c Is Control; TypeOf Me Is Form\n"
" Print c Is Text1; c Is Command1; c Is Nothing\n"
" Set f = Form1\n"
" Print f.Caption; \" \"; TypeName(f); TypeOf f Is Control\n"
" col.Add c\n"
" col.Add Me.Command1\n"
" For Each x In col\n"
" Print TypeName(x); \" \";\n"
" Next\n"
" Print\n"
" ShowIt Command1\n"
"End Sub\n"
"Sub ShowIt(o As Control)\n"
" Print \"caption \"; o.Caption\n"
"End Sub\n";
const char *frms[1] = { frm };
FrtAppT app;
if (!expectBuild(&app, "", frms, 1)) {
tShutdown();
return;
}
frtStart(&app, "Form1");
TEST_STR_EQ(frtOut(&app), "hi TextBox Form True True True \nTrue False False \nObjects FormFalse \nTextBox CommandButton \ncaption Go\n");
frtDestroy(&app);
tShutdown();
}
// The DOS feasibility fixture pardsgn on the host: its checks run from a
// Timer and put the form in design mode; a click on the Surface frame and
// a key, as the DOS script gives them, finish it with "PARDSGN PASS".
static void caseParDsgnFixture(void) {
tCase("pardsgn fixture: designer and editor checks, design-mode click and key");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
// designer.bas goes in front of the form's code, where the project
// build's module order puts it (the harness compiles forms first)
int32_t incLen = 0;
int32_t frmLen = 0;
char *inc = platformReadFile(FRT_INCLUDE_DIR "/designer.bas", &incLen);
char *frm = platformReadFile(FRT_PARDSGN_FRM, &frmLen);
char *src = (char *)malloc(FRT_SRC_BUF);
FrtAppT app;
bool built = false;
if (inc && frm && src) {
int32_t codeAt = basFindFormEndPos(frm, frmLen);
snprintf(src, FRT_SRC_BUF, "%.*s\n%s\n%s", (int)codeAt, frm, inc, frm + codeAt);
built = expectBuild(&app, "", (const char *const *)&src, 1);
}
free(inc);
free(frm);
free(src);
if (!built) {
tShutdown();
return;
}
basNativeHostSetLive(true);
frtStart(&app, NULL);
BasFormT *form = frtForm(&app, "ParDsgn");
for (int32_t i = 0; form && i < FRT_PARDSGN_TICKS && strcmp(form->window->title, "PARDSGN RUN") == 0; i++) {
tAdvanceClock(FRT_PARDSGN_TICK_MS);
tPump(1);
}
TEST_TRUE(form != NULL);
if (form) {
BasControlT *surface = frtCtrl(form, "Surface");
int32_t cx = 0;
int32_t cy = 0;
TEST_STR_EQ(form->window->title, "PARDSGN READY");
tPump(2);
tWidgetCenter(surface->widget, &cx, &cy);
tClick(cx, cy);
tPump(2);
TEST_STR_EQ(form->window->title, "PARDSGN CLICKED");
tKey(0, 'a', 0);
tPump(2);
TEST_TRUE(strncmp(form->window->title, "PARDSGN PASS ", strlen("PARDSGN PASS ")) == 0);
}
basNativeHostSetLive(false);
frtDestroy(&app);
tShutdown();
}
static void casePendingUnloadDrain(void) {
tCase("deferred unloads of several forms drain after the handler");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm1 =
"Begin Form Form1\n"
" Caption = \"One\"\n"
" Begin CommandButton Go\n"
" Caption = \"Go\"\n"
" End\n"
"End\n"
"\n"
"Sub Go_Click\n"
" Unload Form2\n"
" Load Form2\n"
" Unload Form1\n"
" Print \"tail\"\n"
"End Sub\n";
const char *frm2 =
"Begin Form Form2\n"
" Caption = \"Two\"\n"
" Begin TextBox T2\n"
" End\n"
"End\n";
const char *frms[2] = { frm1, frm2 };
FrtAppT app;
if (!expectBuild(&app, "", frms, 2)) {
tShutdown();
return;
}
frtStart(&app, NULL);
TEST_TRUE(frtForm(&app, "Form2") != NULL);
BasFormT *form = frtForm(&app, "Form1");
BasControlT *go = frtCtrl(form, "Go");
int32_t sx = 0;
int32_t sy = 0;
// The handler unloads Form2 (deferred), re-Loads it (must get the
// pending form back, not a resurrected copy), then unloads its own
// form; the tail print proves the handler finished on live memory
// and the drain then frees both forms.
tWidgetCenter(go->widget, &sx, &sy);
tClick(sx, sy);
tPump(1);
outContains(&app, "tail");
TEST_PTR_EQ(frtForm(&app, "Form1"), NULL);
TEST_PTR_EQ(frtForm(&app, "Form2"), NULL);
TEST_EQ((int32_t)arrlen(app.rt->forms), 0);
TEST_TRUE(!app.rt->terminated);
frtDestroy(&app);
// Teardown with frees still queued: basFormRtDestroy drains both
// pending queues itself.
if (!expectBuild(&app, "", frms, 2)) {
tShutdown();
return;
}
frtStart(&app, NULL);
BasFormT *f2 = frtForm(&app, "Form2");
TEST_TRUE(f2 != NULL);
app.rt->eventDepth++;
basFormRtRemoveCtrl(app.rt, f2, "T2");
basFormRtUnloadForm(app.rt, f2);
app.rt->eventDepth--;
frtDestroy(&app);
tShutdown();
}
// PictureBox Load and Save return their status to compiled BASIC in
// function form (0 = success, -1 = failure); statement form still
// compiles and ignores it. A failed Load keeps the drawing.
static void casePictureLoadSave(void) {
tCase("PictureBox Load/Save status through BASIC");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
static const char frmFmt[] =
"Begin Form Form1\n"
" Caption = \"Pic\"\n"
" Begin PictureBox Pic\n"
" End\n"
"End\n"
"Sub Form1_T ()\n"
" Dim okSave As Long\n"
" Dim badSave As Long\n"
" Dim okLoad As Long\n"
" Dim badLoad As Long\n"
" Pic.Resize 5, 3\n"
" okSave = Pic.Save(\"%s\")\n"
" badSave = Pic.Save(\"/nonexistent/dir/x.png\")\n"
" Pic.Resize 9, 9\n"
" okLoad = Pic.Load(\"%s\")\n"
" badLoad = Pic.Load(\"%s\")\n"
" Pic.Load \"%s\"\n"
" Print okSave; badSave; okLoad; badLoad; Pic.ImageWidth; Pic.ImageHeight\n"
"End Sub\n";
char pngPath[FRT_APP_PATH_MAX];
char missing[FRT_APP_PATH_MAX];
char frmText[sizeof(frmFmt) + 4 * FRT_APP_PATH_MAX];
const char *frm = frmText;
FrtAppT app;
snprintf(pngPath, sizeof(pngPath), "%s/picStatus.png", tTempDir());
snprintf(missing, sizeof(missing), "%s/picMissing.png", tTempDir());
snprintf(frmText, sizeof(frmText), frmFmt, pngPath, pngPath, missing, missing);
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
TEST_TRUE(frtFire(&app, "Form1", "T"));
TEST_STR_EQ(frtOut(&app), "0 -1 0 -1 5 3 \n");
frtDestroy(&app);
tShutdown();
}
static void casePopupMenu(void) {
tCase("PopupMenu on a control positions relative to it");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm =
"Begin Form Form1\n"
" Caption = \"Pop\"\n"
" Begin Menu mnuPop\n"
" Caption = \"Popup\"\n"
" Visible = False\n"
" Begin Menu mnuPopItem\n"
" Caption = \"Pop Item\"\n"
" End\n"
" End\n"
" Begin Label Lbl1\n"
" Caption = \"spacer\"\n"
" End\n"
" Begin CommandButton Cmd1\n"
" Caption = \"Menu\"\n"
" End\n"
"End\n"
"\n"
"Sub Cmd1_Click\n"
" Cmd1.PopupMenu \"mnuPop\", 5, 7\n"
"End Sub\n";
FrtAppT app;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
BasFormT *form = frtForm(&app, "Form1");
BasControlT *cmd = frtCtrl(form, "Cmd1");
WindowT *win = form->window;
int32_t sx = 0;
int32_t sy = 0;
tWidgetCenter(cmd->widget, &sx, &sy);
tClick(sx, sy);
tPump(1);
TEST_TRUE(tCtx()->popup.active);
TEST_TRUE(tCtx()->popup.isContextMenu);
TEST_PTR_EQ(tCtx()->popup.menu, form->popupMenus[0].menu);
TEST_EQ(tCtx()->popup.popupX, win->x + win->contentX + cmd->widget->x + POPUP_OFF_X);
TEST_EQ(tCtx()->popup.popupY, win->y + win->contentY + cmd->widget->y + POPUP_OFF_Y);
tKeyEsc();
tPump(1);
TEST_TRUE(!tCtx()->popup.active);
// Without coordinates the popup opens at the mouse position.
tMouseMove(sx + 3, sy + 4);
BasValueT menuName = basValStringFromC("mnuPop");
basFormRtCallMethod(app.rt, cmd, "PopupMenu", &menuName, 1);
basValRelease(&menuName);
tPump(1);
TEST_TRUE(tCtx()->popup.active);
TEST_EQ(tCtx()->popup.popupX, sx + 3);
TEST_EQ(tCtx()->popup.popupY, sy + 4);
tKeyEsc();
tPump(1);
frtDestroy(&app);
tShutdown();
}
// A DVX program, widget or library file is a picture: its icon (the
// program's icon32, a widget's icon24) for LoadPicture, Picture properties,
// PaintPicture and DragIcon; one without an icon is not a picture.
static void caseProgramIcon(void) {
tCase("program, widget and library files as pictures (their icons)");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
char appPath[DVX_MAX_PATH];
char wgtPath[DVX_MAX_PATH];
char libPath[DVX_MAX_PATH];
snprintf(appPath, sizeof(appPath), "%s/iconProg.app", tTempDir());
snprintf(wgtPath, sizeof(wgtPath), "%s/iconCtrl.wgt", tTempDir());
snprintf(libPath, sizeof(libPath), "%s/noIcon.lib", tTempDir());
TEST_TRUE(tWriteFile(appPath, "PROGRAM", 7));
TEST_TRUE(tWriteFile(wgtPath, "WIDGET", 6));
TEST_TRUE(tWriteFile(libPath, "LIBRARY", 7));
TEST_EQ(ResAddFile(appPath, DVX_RES_NAME_ICON, DVX_RES_ICON, FRT_FIXTURE_DIR "/icon.bmp"), -1);
TEST_EQ(ResAddFile(wgtPath, DVX_RES_NAME_WIDGET_ICON, DVX_RES_ICON, FRT_FIXTURE_DIR "/icon.bmp"), -1);
TEST_EQ(ResAddText(libPath, "name", "No icon"), -1);
char frm[FRT_ICON_FRM_LEN];
snprintf(frm, sizeof(frm),
"Begin Form Form1\n"
" Caption = \"Icons\"\n"
" Begin Label Src\n"
" Caption = \"Source\"\n"
" End\n"
" Begin Image Img\n"
" End\n"
" Begin PictureBox Pic\n"
" End\n"
"End\n"
"\n"
"Sub Form1_Use\n"
" Dim p As Object\n"
" Set p = LoadPicture(\"%s\")\n"
" Print p.Type; CLng(Pic.ScaleX(p.Width, vbHimetric, vbPixels))\n"
" Img.Picture = p\n"
" Print Img.ImageWidth; Img.ImageHeight\n"
" Pic.PaintPicture \"%s\", 0, 0\n"
" Set Src.DragIcon = p\n"
" Set p = LoadPicture(\"%s\")\n"
" Img.Picture = \"%s\"\n"
" Print CLng(Pic.ScaleY(p.Height, vbHimetric, vbPixels)); Img.ImageWidth\n"
"End Sub\n"
"Sub Form1_Bad\n"
" On Error GoTo failed\n"
" Set Src.DragIcon = LoadPicture(\"%s\")\n"
" Exit Sub\n"
"failed:\n"
" Print \"err\"; Err\n"
"End Sub\n",
appPath, appPath, wgtPath, wgtPath, libPath);
const char *frms[1] = { frm };
FrtAppT app;
if (!expectBuild(&app, "", frms, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form1", "Use"));
TEST_STR_EQ(frtOut(&app), "1 32 \n32 32 \n32 32 \n");
TEST_TRUE(!app.rt->terminated);
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form1", "Bad"));
TEST_STR_EQ(frtOut(&app), "err481 \n");
frtDestroy(&app);
tShutdown();
}
// The program screen's window (Phase 4): made by the first console
// statement at the mode's size, keys to INKEY$, Alt+Enter and FULLSCREEN
// through the exclusive API, closing it ends the program.
static void caseProgramScreen(void) {
tCase("Program screen window, keys, full screen");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *bas =
"SCREEN 13\n"
"LINE (0, 0)-(319, 199), 4, BF\n"
"PSET (5, 5), 15\n"
"PRINT \"X\"\n";
FrtAppT app;
if (!expectBuild(&app, bas, NULL, 0)) {
tShutdown();
return;
}
snprintf(app.rt->title, sizeof(app.rt->title), "%s", "Screen Test");
frtStart(&app, NULL);
tPump(1);
BasScreenWinT *sw = app.rt->screenWin;
BasScreenT *scr = app.vm->screen;
TEST_TRUE(sw != NULL && scr != NULL);
if (!sw || !scr) {
frtDestroy(&app);
tShutdown();
return;
}
WindowT *win = basFormRtScreenWindow(app.rt);
const DisplayT *d = &tCtx()->display;
int32_t bpp = d->format.bytesPerPixel;
int32_t scale = win ? win->contentW / scr->width : 1;
uint32_t red = packColor(d, scr->palette[4 * 3], scr->palette[4 * 3 + 1], scr->palette[4 * 3 + 2]);
uint32_t white = packColor(d, scr->palette[15 * 3], scr->palette[15 * 3 + 1], scr->palette[15 * 3 + 2]);
TEST_TRUE(win != NULL);
if (!win) {
frtDestroy(&app);
tShutdown();
return;
}
TEST_TRUE(strcmp(win->title, "Screen Test") == 0);
TEST_EQ(win->contentW, 320 * scale);
TEST_EQ(win->contentH, 200 * scale);
TEST_TRUE(frtOut(&app)[0] == '\0');
TEST_TRUE(basFormRtKeepsRunning(app.rt));
// The frame reached the window through the colour table
TEST_EQ(*(uint32_t *)(win->contentBuf + 100 * win->contentPitch + 100 * bpp), red);
TEST_EQ(*(uint32_t *)(win->contentBuf + 5 * scale * win->contentPitch + 5 * scale * bpp), white);
// Keys for INKEY$: characters, and extended keys as 0x100 | scan
win->onKey(win, 'q', 0);
win->onKey(win, KEY_UP, 0);
TEST_EQ(scr->keyCount, 2);
TEST_EQ(scr->keys[scr->keyHead], 'q');
TEST_EQ(scr->keys[(scr->keyHead + 1) % BAS_SCREEN_KEY_QUEUE], BAS_SCREEN_KEY_EXT | KEY_SCAN_UP);
// Keys with Alt, Ctrl or Shift have the BIOS's own codes (QBasic):
// Alt+A 30, Alt+1 120, Shift+F1 84, Ctrl+F2 95, Alt+F12 140, Alt+Home 151
int32_t first = scr->keyCount;
win->onKey(win, 'a', KEY_MOD_ALT);
win->onKey(win, '1', KEY_MOD_ALT);
win->onKey(win, KEY_F1, KEY_MOD_SHIFT);
win->onKey(win, KEY_F2, KEY_MOD_CTRL);
win->onKey(win, KEY_F12, KEY_MOD_ALT);
win->onKey(win, KEY_HOME, KEY_MOD_ALT);
static const int32_t biosCodes[] = { 30, 120, 84, 95, 140, 151 };
TEST_EQ(scr->keyCount, first + DVX_ARRAY_LEN(biosCodes));
for (int32_t i = 0; i < DVX_ARRAY_LEN(biosCodes); i++) {
TEST_EQ(scr->keys[(scr->keyHead + first + i) % BAS_SCREEN_KEY_QUEUE], BAS_SCREEN_KEY_EXT | biosCodes[i]);
}
// Alt+Enter: the whole screen, and back
win->onKey(win, KEY_ENTER, KEY_MOD_ALT);
TEST_TRUE(scr->fullScreen);
TEST_TRUE(tCtx()->exclusive.owner == win);
win->onKey(win, KEY_ENTER, KEY_MOD_ALT);
TEST_TRUE(!scr->fullScreen);
TEST_TRUE(tCtx()->exclusive.owner == NULL);
// Closing the window stops the program
win->onClose(win);
tPump(1);
TEST_TRUE(app.vm->stopRequested);
TEST_TRUE(!basFormRtKeepsRunning(app.rt));
TEST_TRUE(basFormRtScreenWindow(app.rt) == NULL);
frtDestroy(&app);
// FULLSCREEN from the program, then a mode change while full
const char *basFull =
"SCREEN 13\n"
"FULLSCREEN ON\n"
"SCREEN 12\n"
"CIRCLE (320, 240), 50, 2\n";
if (!expectBuild(&app, basFull, NULL, 0)) {
tShutdown();
return;
}
frtStart(&app, NULL);
tPump(1);
TEST_TRUE(app.vm->screen && app.vm->screen->fullScreen && app.vm->screen->mode == BAS_SCREEN_MODE_VGA16);
TEST_TRUE(tCtx()->exclusive.owner != NULL && tCtx()->exclusive.owner == basFormRtScreenWindow(app.rt));
frtDestroy(&app);
TEST_TRUE(tCtx()->exclusive.owner == NULL);
tShutdown();
}
// The program screen's window for the round 2 modes: SCREEN 2 lines
// doubled, the visual page shown, the blink timer in the window, full
// screen at the mode's shape.
static void caseProgramScreenModes(void) {
tCase("Program screen modes, pages and blinking");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *bas =
"SCREEN 2\n"
"PSET (3, 3), 1\n"
"SCREEN 2, , 0, 0\n";
FrtAppT app;
if (!expectBuild(&app, bas, NULL, 0)) {
tShutdown();
return;
}
frtStart(&app, NULL);
tPump(1);
BasScreenWinT *sw = app.rt->screenWin;
BasScreenT *scr = app.vm->screen;
WindowT *win = basFormRtScreenWindow(app.rt);
TEST_TRUE(sw != NULL && scr != NULL && win != NULL);
if (!sw || !scr || !win) {
frtDestroy(&app);
tShutdown();
return;
}
const DisplayT *d = &tCtx()->display;
int32_t bpp = d->format.bytesPerPixel;
int32_t scale = win->contentW / scr->width;
uint32_t white = packColor(d, scr->palette[3], scr->palette[4], scr->palette[5]);
TEST_EQ(scr->pixelH, 2);
TEST_EQ(win->contentH, 200 * 2 * scale);
// Framebuffer row 3 fills window rows 6 and 7 (at scale 1)
TEST_EQ(*(uint32_t *)(win->contentBuf + 3 * 2 * scale * win->contentPitch + 3 * scale * bpp), white);
TEST_EQ(*(uint32_t *)(win->contentBuf + (3 * 2 * scale + 1) * win->contentPitch + 3 * scale * bpp), white);
// The blink timer lives in the window's widget tree
TEST_TRUE(win->widgetRoot != NULL && win->widgetRoot->firstChild != NULL && win->widgetRoot->firstChild->onChange != NULL);
// Alt+Enter: full screen at 640x400
win->onKey(win, KEY_ENTER, KEY_MOD_ALT);
TEST_TRUE(scr->fullScreen);
TEST_TRUE(tCtx()->exclusive.presentRect.h > 0 && tCtx()->exclusive.presentRect.h % 400 == 0 && tCtx()->exclusive.presentRect.w % 640 == 0);
win->onKey(win, KEY_ENTER, KEY_MOD_ALT);
TEST_TRUE(!scr->fullScreen);
frtDestroy(&app);
// Pages: the window shows the visual page; blinking text through the
// window's timer
const char *basPages =
"SCREEN 7, , 1, 0\n"
"LINE (0, 0)-(319, 199), 4, BF\n"
"SCREEN 0\n"
"COLOR 20\n"
"PRINT \"X\"\n";
if (!expectBuild(&app, basPages, NULL, 0)) {
tShutdown();
return;
}
frtStart(&app, NULL);
tPump(1);
scr = app.vm->screen;
win = basFormRtScreenWindow(app.rt);
TEST_TRUE(scr != NULL && win != NULL && scr->blinkUsed);
if (scr && win && win->widgetRoot && win->widgetRoot->firstChild) {
WidgetT *timer = win->widgetRoot->firstChild;
bool was = scr->blinkHidden;
timer->onChange(timer);
TEST_TRUE(scr->blinkHidden != was);
}
frtDestroy(&app);
const char *basHidden =
"SCREEN 7, , 1, 0\n"
"LINE (0, 0)-(319, 199), 4, BF\n";
if (!expectBuild(&app, basHidden, NULL, 0)) {
tShutdown();
return;
}
frtStart(&app, NULL);
tPump(1);
scr = app.vm->screen;
win = basFormRtScreenWindow(app.rt);
TEST_TRUE(scr != NULL && win != NULL);
if (scr && win) {
uint32_t black = packColor(d, scr->palette[0], scr->palette[1], scr->palette[2]);
TEST_EQ(*(uint32_t *)(win->contentBuf + 10 * win->contentPitch + 10 * bpp), black);
}
frtDestroy(&app);
tShutdown();
}
static void casePropEdges(void) {
tCase("form/control/menu property edges and error routing");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm =
"Begin Form Form1\n"
" Caption = \"Prop\"\n"
" Begin Menu mnuFile\n"
" Caption = \"&File\"\n"
" Begin Menu mnuOpen\n"
" Caption = \"&Open\"\n"
" End\n"
" End\n"
" Begin Menu mnuPop\n"
" Caption = \"Pop\"\n"
" Visible = False\n"
" Begin Menu mnuPopA\n"
" Caption = \"A\"\n"
" End\n"
" End\n"
" Begin ListBox Lst\n"
" End\n"
" Begin CommandButton Cmd\n"
" Caption = \"Go\"\n"
" End\n"
"End\n";
FrtAppT app;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
BasFormT *form = frtForm(&app, "Form1");
BasControlT *cmd = frtCtrl(form, "Cmd");
BasControlT *lst = frtCtrl(form, "Lst");
BasValueT v;
// Menu proxies: Checked/Enabled/Name work, anything else raises.
BasControlT *mnu = (BasControlT *)basFormRtFindCtrl(app.rt, form, "mnuOpen");
TEST_TRUE(mnu != NULL && mnu->menuId > 0);
v = basFormRtGetProp(app.rt, mnu, "Checked");
TEST_TRUE(!basValIsTruthy(v));
basFormRtSetProp(app.rt, mnu, "Checked", basValBool(true));
v = basFormRtGetProp(app.rt, mnu, "Checked");
TEST_TRUE(basValIsTruthy(v));
basFormRtSetProp(app.rt, mnu, "Enabled", basValBool(false));
v = basFormRtGetProp(app.rt, mnu, "Enabled");
TEST_TRUE(!basValIsTruthy(v));
v = basFormRtGetProp(app.rt, mnu, "Name");
TEST_TRUE(v.type == BAS_TYPE_STRING && strcasecmp(v.strVal->data, "mnuOpen") == 0);
basValRelease(&v);
basFormRtGetProp(app.rt, mnu, "Wat");
TEST_TRUE(app.rt->terminated);
frtClearError(&app);
// Popup-only items resolve through the popup path.
BasControlT *pop = (BasControlT *)basFormRtFindCtrl(app.rt, form, "mnuPopA");
TEST_TRUE(pop != NULL);
basFormRtSetProp(app.rt, pop, "Checked", basValBool(true));
v = basFormRtGetProp(app.rt, pop, "Checked");
TEST_TRUE(basValIsTruthy(v));
// Form properties: write and read every branch.
BasControlT *fc = &form->formCtrl;
setStrProp(&app, fc, "Caption", "NewCap");
v = basFormRtGetProp(app.rt, fc, "Caption");
TEST_TRUE(v.type == BAS_TYPE_STRING && strcmp(v.strVal->data, "NewCap") == 0);
basValRelease(&v);
basFormRtSetProp(app.rt, fc, "Width", basValLong(360));
basFormRtSetProp(app.rt, fc, "Height", basValLong(240));
basFormRtSetProp(app.rt, fc, "Left", basValLong(12));
basFormRtSetProp(app.rt, fc, "Top", basValLong(15));
TEST_EQ(form->window->x, 12);
TEST_EQ(form->window->y, 15);
basFormRtSetProp(app.rt, fc, "Resizable", basValBool(false));
TEST_TRUE(!form->window->resizable);
basFormRtSetProp(app.rt, fc, "Visible", basValBool(false));
tPump(1);
TEST_TRUE(!form->window->visible);
basFormRtSetProp(app.rt, fc, "Visible", basValBool(true));
tPump(1);
basFormRtSetProp(app.rt, fc, "Centered", basValBool(true));
basFormRtSetProp(app.rt, fc, "AutoSize", basValBool(true));
setStrProp(&app, fc, "HelpTopic", "hlp");
TEST_STR_EQ(form->helpTopic, "hlp");
setStrProp(&app, fc, "ContextMenu", "mnuPop");
v = basFormRtGetProp(app.rt, fc, "ContextMenu");
TEST_TRUE(v.type == BAS_TYPE_STRING && strcmp(v.strVal->data, "mnuPop") == 0);
basValRelease(&v);
setStrProp(&app, fc, "ContextMenu", "");
TEST_PTR_EQ(form->window->contextMenu, NULL);
v = basFormRtGetProp(app.rt, fc, "Layout");
TEST_TRUE(v.type == BAS_TYPE_STRING);
basValRelease(&v);
v = basFormRtGetProp(app.rt, fc, "Name");
TEST_TRUE(v.type == BAS_TYPE_STRING && strcmp(v.strVal->data, "Form1") == 0);
basValRelease(&v);
v = basFormRtGetProp(app.rt, fc, "AutoSize");
TEST_TRUE(basValIsTruthy(v));
v = basFormRtGetProp(app.rt, fc, "Centered");
TEST_TRUE(basValIsTruthy(v));
v = basFormRtGetProp(app.rt, fc, "Resizable");
TEST_TRUE(!basValIsTruthy(v));
v = basFormRtGetProp(app.rt, fc, "Width");
TEST_TRUE(basValToInt32(v) > 0);
v = basFormRtGetProp(app.rt, fc, "HelpTopic");
basValRelease(&v);
// Unknown/read-only form properties raise.
setStrProp(&app, fc, "Name", "X");
TEST_TRUE(app.rt->terminated);
frtClearError(&app);
basFormRtGetProp(app.rt, fc, "Bogus");
frtClearError(&app);
// Common control properties.
basFormRtSetProp(app.rt, cmd, "Left", basValLong(3));
basFormRtSetProp(app.rt, cmd, "Top", basValLong(4));
basFormRtSetProp(app.rt, cmd, "Weight", basValLong(2));
basFormRtSetProp(app.rt, cmd, "MaxWidth", basValLong(90));
basFormRtSetProp(app.rt, cmd, "MaxHeight", basValLong(60));
basFormRtSetProp(app.rt, cmd, "Visible", basValBool(true));
basFormRtSetProp(app.rt, cmd, "Enabled", basValBool(false));
basFormRtSetProp(app.rt, cmd, "ReadOnly", basValBool(true));
basFormRtSetProp(app.rt, cmd, "BackColor", basValLong(3));
basFormRtSetProp(app.rt, cmd, "ForeColor", basValLong(5));
setStrProp(&app, cmd, "ToolTipText", "tip");
setStrProp(&app, cmd, "HelpTopic", "cmdHelp");
setStrProp(&app, cmd, "DataSource", "D");
setStrProp(&app, cmd, "DataField", "f");
v = basFormRtGetProp(app.rt, cmd, "Left");
TEST_EQ(basValToInt32(v), cmd->widget->x);
v = basFormRtGetProp(app.rt, cmd, "Top");
TEST_EQ(basValToInt32(v), cmd->widget->y);
v = basFormRtGetProp(app.rt, cmd, "Weight");
TEST_EQ(basValToInt32(v), 2);
v = basFormRtGetProp(app.rt, cmd, "MaxWidth");
TEST_EQ(basValToInt32(v), 90);
v = basFormRtGetProp(app.rt, cmd, "MaxHeight");
TEST_EQ(basValToInt32(v), 60);
v = basFormRtGetProp(app.rt, cmd, "MinWidth");
TEST_TRUE(basValToInt32(v) >= 0);
v = basFormRtGetProp(app.rt, cmd, "Enabled");
TEST_TRUE(!basValIsTruthy(v));
v = basFormRtGetProp(app.rt, cmd, "ReadOnly");
TEST_TRUE(basValIsTruthy(v));
v = basFormRtGetProp(app.rt, cmd, "BackColor");
TEST_EQ(basValToInt32(v), 3);
v = basFormRtGetProp(app.rt, cmd, "ForeColor");
TEST_EQ(basValToInt32(v), 5);
v = basFormRtGetProp(app.rt, cmd, "ToolTipText");
TEST_TRUE(v.type == BAS_TYPE_STRING && strcmp(v.strVal->data, "tip") == 0);
basValRelease(&v);
v = basFormRtGetProp(app.rt, cmd, "HelpTopic");
TEST_TRUE(v.type == BAS_TYPE_STRING && strcmp(v.strVal->data, "cmdHelp") == 0);
basValRelease(&v);
v = basFormRtGetProp(app.rt, cmd, "DataSource");
TEST_TRUE(v.type == BAS_TYPE_STRING && strcmp(v.strVal->data, "D") == 0);
basValRelease(&v);
v = basFormRtGetProp(app.rt, cmd, "DataField");
basValRelease(&v);
v = basFormRtGetProp(app.rt, cmd, "Name");
TEST_TRUE(v.type == BAS_TYPE_STRING && strcmp(v.strVal->data, "Cmd") == 0);
basValRelease(&v);
// ListCount as a common property: real count on a list widget,
// zero on a widget without item storage.
BasValueT item = basValStringFromC("x");
basFormRtCallMethod(app.rt, lst, "AddItem", &item, 1);
basValRelease(&item);
v = basFormRtGetProp(app.rt, lst, "ListCount");
TEST_EQ(basValToInt32(v), 1);
v = basFormRtGetProp(app.rt, cmd, "ListCount");
TEST_EQ(basValToInt32(v), 0);
// A ListView counts its rows too (ListCount = RowCount).
BasControlT *lvw = (BasControlT *)basFormRtCreateCtrl(app.rt, form, "ListView", "LvwCount");
TEST_TRUE(lvw != NULL);
if (lvw) {
BasValueT cols = basValStringFromC("Name,8");
basFormRtCallMethod(app.rt, lvw, "SetColumns", &cols, 1);
basValRelease(&cols);
}
for (int32_t i = 0; lvw && i < 2; i++) {
BasValueT row = basValStringFromC("r");
basFormRtCallMethod(app.rt, lvw, "AddItem", &row, 1);
basValRelease(&row);
}
v = basFormRtGetProp(app.rt, lvw, "ListCount");
TEST_EQ(basValToInt32(v), 2);
// Control ContextMenu binds by popup name.
setStrProp(&app, cmd, "ContextMenu", "mnuPop");
v = basFormRtGetProp(app.rt, cmd, "ContextMenu");
TEST_TRUE(v.type == BAS_TYPE_STRING && strcmp(v.strVal->data, "mnuPop") == 0);
basValRelease(&v);
// Unknown property and unknown control routes.
basFormRtGetProp(app.rt, cmd, "Bogus");
TEST_TRUE(app.rt->terminated);
frtClearError(&app);
basFormRtSetProp(app.rt, cmd, "Bogus", basValLong(1));
frtClearError(&app);
basFormRtGetProp(app.rt, NULL, "X");
frtClearError(&app);
basFormRtSetProp(app.rt, NULL, "X", basValLong(1));
frtClearError(&app);
basFormRtCallMethod(app.rt, NULL, "X", NULL, 0);
frtClearError(&app);
// A method call on a menu proxy (no widget behind it) raises.
basFormRtCallMethod(app.rt, mnu, "SetFocus", NULL, 0);
frtClearError(&app);
// Menu property writes only accept Checked/Enabled.
setStrProp(&app, mnu, "Wat", "x");
frtClearError(&app);
// ENUM properties by name, by number, and with a bad name; INT
// setters and a read-only interface property.
BasControlT *lbl = (BasControlT *)basFormRtCreateCtrl(app.rt, form, "Label", "Lbl1");
BasControlT *spn = (BasControlT *)basFormRtCreateCtrl(app.rt, form, "SpinButton", "Spn1");
BasControlT *ta = (BasControlT *)basFormRtCreateCtrl(app.rt, form, "TextArea", "Ta1");
TEST_TRUE(lbl != NULL && spn != NULL && ta != NULL);
setStrProp(&app, lbl, "Alignment", "Center");
v = basFormRtGetProp(app.rt, lbl, "Alignment");
TEST_EQ(basValToInt32(v), 1);
basFormRtSetProp(app.rt, lbl, "Alignment", basValLong(2));
v = basFormRtGetProp(app.rt, lbl, "Alignment");
TEST_EQ(basValToInt32(v), 2);
setStrProp(&app, lbl, "Alignment", "Wat");
TEST_TRUE(app.rt->terminated);
frtClearError(&app);
basFormRtSetProp(app.rt, spn, "Value", basValLong(5));
v = basFormRtGetProp(app.rt, spn, "Value");
TEST_EQ(basValToInt32(v), 5);
basFormRtSetProp(app.rt, ta, "CursorLine", basValLong(3));
TEST_TRUE(!app.rt->terminated);
v = basFormRtGetProp(app.rt, ta, "CursorLine");
TEST_TRUE(basValToInt32(v) >= 0);
// Dynamic popup menus through the common-method surface, including
// the argument guards and the contextMenu purge on DestroyMenu.
BasControlT *fcm = &form->formCtrl;
BasValueT ma[3];
ma[0] = basValStringFromC("dynPop");
basFormRtCallMethod(app.rt, fcm, "CreateMenu", ma, 1);
basFormRtCallMethod(app.rt, fcm, "CreateMenu", ma, 1);
basFormRtCallMethod(app.rt, fcm, "CreateMenu", NULL, 0);
ma[1] = basValStringFromC("dynIt");
ma[2] = basValStringFromC("Item");
basFormRtCallMethod(app.rt, fcm, "AddMenuItem", ma, 3);
basFormRtCallMethod(app.rt, fcm, "AddMenuItem", ma, 1);
basValRelease(&ma[1]);
basValRelease(&ma[2]);
ma[1] = basValStringFromC("dynSub");
ma[2] = basValStringFromC("Sub");
basFormRtCallMethod(app.rt, fcm, "AddSubMenu", ma, 3);
basFormRtCallMethod(app.rt, fcm, "AddSubMenu", ma, 1);
basFormRtCallMethod(app.rt, fcm, "AddMenuSeparator", ma, 1);
basFormRtCallMethod(app.rt, fcm, "AddMenuSeparator", NULL, 0);
basValRelease(&ma[0]);
basValRelease(&ma[1]);
basValRelease(&ma[2]);
ma[0] = basValStringFromC("noSuchMenu");
basFormRtCallMethod(app.rt, fcm, "PopupMenu", ma, 1);
basFormRtCallMethod(app.rt, fcm, "AddMenuSeparator", ma, 1);
basValRelease(&ma[0]);
basFormRtCallMethod(app.rt, fcm, "PopupMenu", NULL, 0);
basFormRtCallMethod(app.rt, fcm, "DestroyMenu", NULL, 0);
setStrProp(&app, cmd, "ContextMenu", "dynPop");
setStrProp(&app, fc, "ContextMenu", "dynPop");
ma[0] = basValStringFromC("dynSub");
basFormRtCallMethod(app.rt, fcm, "DestroyMenu", ma, 1);
basValRelease(&ma[0]);
ma[0] = basValStringFromC("dynPop");
basFormRtCallMethod(app.rt, fcm, "DestroyMenu", ma, 1);
basValRelease(&ma[0]);
TEST_PTR_EQ(cmd->widget->contextMenu, NULL);
TEST_PTR_EQ(form->window->contextMenu, NULL);
// Destroying the .frm popup leaves its proxy widgetless: reads on it
// now raise the no-widget error.
ma[0] = basValStringFromC("mnuPop");
basFormRtCallMethod(app.rt, fcm, "DestroyMenu", ma, 1);
basValRelease(&ma[0]);
basFormRtGetProp(app.rt, pop, "Checked");
frtClearError(&app);
frtDestroy(&app);
tShutdown();
}
static void casePropTables(void) {
tCase("property tables: readable/writable exactly as declared");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm =
"Begin Form Form1\n"
" Caption = \"Props\"\n"
" Begin ListBox Lst1\n"
" End\n"
" Begin Timer Tmr1\n"
" Enabled = False\n"
" End\n"
" Begin Menu mnuFile\n"
" Caption = \"&File\"\n"
" Begin Menu mnuOpen\n"
" Caption = \"&Open\"\n"
" End\n"
" End\n"
"End\n";
FrtAppT app;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
BasFormT *form = frtForm(&app, "Form1");
BasControlT *lst = frtCtrl(form, "Lst1");
BasControlT *tmr = frtCtrl(form, "Tmr1");
BasControlT *mnu = (BasControlT *)basFormRtFindCtrl(app.rt, form, "mnuOpen");
int32_t count = 0;
app.rt->suppressErrorDialog = true;
// Form table.
const BasPropDescT *props = basFormRtFormProps(&count);
for (int32_t i = 0; i < count; i++) {
const BasPropDescT *pd = &props[i];
BasValueT v = basFormRtGetProp(app.rt, &form->formCtrl, pd->name);
TEST_EQ(app.rt->terminated, !pd->readable);
frtClearError(&app);
basFormRtSetProp(app.rt, &form->formCtrl, pd->name, v);
TEST_EQ(app.rt->terminated, !pd->writable);
frtClearError(&app);
basValRelease(&v);
TEST_PTR_EQ(basFormRtFindFormProp(pd->name), pd);
}
TEST_PTR_EQ(basFormRtFindFormProp("NoSuchProp"), NULL);
basFormRtGetProp(app.rt, &form->formCtrl, "NoSuchProp");
TEST_TRUE(app.rt->terminated);
frtClearError(&app);
basFormRtSetProp(app.rt, &form->formCtrl, "NoSuchProp", basValLong(1));
TEST_TRUE(app.rt->terminated);
frtClearError(&app);
// Menu item table; the .frm-only menu keys (RadioCheck, Shortcut,
// ShortcutText, Visible) are not properties.
TEST_TRUE(mnu != NULL);
props = basFormRtMenuProps(&count);
for (int32_t i = 0; mnu && i < count; i++) {
const BasPropDescT *pd = &props[i];
BasValueT v = basFormRtGetProp(app.rt, mnu, pd->name);
TEST_EQ(app.rt->terminated, !pd->readable);
frtClearError(&app);
basFormRtSetProp(app.rt, mnu, pd->name, v);
TEST_EQ(app.rt->terminated, !pd->writable);
frtClearError(&app);
basValRelease(&v);
TEST_PTR_EQ(basFormRtFindMenuProp(pd->name), pd);
}
TEST_PTR_EQ(basFormRtFindMenuProp(BAS_PROP_SHORTCUTTEXT), NULL);
basFormRtGetProp(app.rt, mnu, BAS_PROP_SHORTCUTTEXT);
TEST_TRUE(app.rt->terminated);
frtClearError(&app);
// Common control table on a widget without overrides.
props = basFormRtCommonProps(&count);
for (int32_t i = 0; i < count; i++) {
const BasPropDescT *pd = &props[i];
BasValueT v = basFormRtGetProp(app.rt, lst, pd->name);
TEST_EQ(app.rt->terminated, !pd->readable);
frtClearError(&app);
basFormRtSetProp(app.rt, lst, pd->name, v);
TEST_EQ(app.rt->terminated, !pd->writable);
frtClearError(&app);
basValRelease(&v);
TEST_PTR_EQ(basFormRtFindCommonProp(pd->name), pd);
}
TEST_PTR_EQ(basFormRtFindCommonProp("NoSuchProp"), NULL);
basFormRtGetProp(app.rt, lst, "NoSuchProp");
TEST_TRUE(app.rt->terminated);
frtClearError(&app);
basFormRtSetProp(app.rt, lst, "NoSuchProp", basValLong(1));
TEST_TRUE(app.rt->terminated);
frtClearError(&app);
// ListCount reads through the widget's ListCount method.
BasValueT item = basValStringFromC("one");
basFormRtCallMethod(app.rt, lst, "AddItem", &item, 1);
basFormRtCallMethod(app.rt, lst, "AddItem", &item, 1);
basValRelease(&item);
BasValueT lc = basFormRtGetProp(app.rt, lst, "ListCount");
TEST_EQ((int32_t)basValToNumber(lc), 2);
basValRelease(&lc);
// A widget-declared property shadows the common one: Timer.Enabled
// is the running state, not wgtSetEnabled.
basFormRtSetProp(app.rt, tmr, "Enabled", basValBool(true));
TEST_TRUE(wgtTimerIsRunning(tmr->widget));
BasValueT en = basFormRtGetProp(app.rt, tmr, "Enabled");
TEST_TRUE(basValIsTruthy(en));
basValRelease(&en);
basFormRtSetProp(app.rt, tmr, "Enabled", basValBool(false));
TEST_TRUE(!wgtTimerIsRunning(tmr->widget));
// Menu proxies expose Checked/Enabled/Name only.
TEST_TRUE(!app.rt->terminated);
frtDestroy(&app);
tShutdown();
}
static void caseQueryUnloadCancel(void) {
tCase("QueryUnload cancel keeps the form");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm =
"Begin Form Form1\n"
" Caption = \"QU\"\n"
"End\n"
"\n"
"Dim Shared allow As Integer\n"
"Sub Form1_QueryUnload(Cancel As Integer)\n"
" If allow = 0 Then Cancel = 1\n"
" Print \"qu=\"; Cancel\n"
"End Sub\n"
"Sub Form1_Unload\n"
" Print \"unload\"\n"
"End Sub\n"
"Sub Form1_Allow\n"
" allow = 1\n"
"End Sub\n";
const char *bas =
"Unload Form1\n"
"Print \"still=\"; Form1.Visible\n";
FrtAppT app;
if (!expectBuild(&app, bas, &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
BasFormT *form = frtForm(&app, "Form1");
TEST_EQ(app.mainResult, BAS_VM_HALTED);
TEST_STR_EQ(frtOut(&app), "qu=1 \nstill=True \n");
TEST_TRUE(form != NULL);
TEST_TRUE(form && !form->unloading);
// The close box takes the same path.
frtOutClear(&app);
tAltF4();
tPump(1);
TEST_STR_EQ(frtOut(&app), "qu=1 \n");
TEST_PTR_EQ(frtForm(&app, "Form1"), form);
basFormRtFireEvent(app.rt, form, "Form1", "Allow");
frtOutClear(&app);
tAltF4();
tPump(1);
TEST_STR_EQ(frtOut(&app), "qu=0 \nunload\n");
TEST_PTR_EQ(frtForm(&app, "Form1"), NULL);
TEST_PTR_EQ(tFindWindow("QU"), NULL);
frtDestroy(&app);
tShutdown();
}
static void caseRefValidation(void) {
tCase("stale refs, CreateControl parents, menu/form overrides, size props");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm =
"Begin Form Form1\n"
" Caption = \"RV\"\n"
" Begin Menu mnuPop\n"
" Caption = \"Pop\"\n"
" Visible = False\n"
" Begin Menu mnuOff\n"
" Caption = \"Off\"\n"
" Enabled = False\n"
" End\n"
" End\n"
" Begin Frame Fr\n"
" Begin TextBox Tin\n"
" End\n"
" HelpTopic = \"after\"\n"
" End\n"
" Begin CommandButton Cmd1\n"
" Caption = \"B\"\n"
" End\n"
" Begin CommandButton Cmd2\n"
" Caption = \"C\"\n"
" End\n"
"End\n"
"\n"
"Sub mnuOff_Click\n"
" Print \"default menu\"\n"
"End Sub\n"
"Sub AltMenu\n"
" Print \"alt menu\"\n"
"End Sub\n"
"Sub NoArgs\n"
" Dim s As String\n"
" Print \"[\" & s & \"]\"\n"
"End Sub\n"
"Sub Form1_Load\n"
" SetEvent Me, \"Custom\", \"NoArgs\"\n"
"End Sub\n";
FrtAppT app;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
BasFormT *form = frtForm(&app, "Form1");
BasControlT *fr = form ? frtCtrl(form, "Fr") : NULL;
BasControlT *cmd1 = form ? frtCtrl(form, "Cmd1") : NULL;
BasControlT *cmd2 = form ? frtCtrl(form, "Cmd2") : NULL;
TEST_TRUE(form && fr && cmd1 && cmd2 && form->popupMenuCount == 1);
if (!(form && fr && cmd1 && cmd2 && form->popupMenuCount == 1)) {
frtDestroy(&app);
tShutdown();
return;
}
// A property after a nested child's End still reaches the parent.
BasValueT v;
TEST_STR_EQ(fr->helpTopic, "after");
// Enabled=False on a popup-menu item is applied at load.
int32_t offId = 0;
for (int32_t i = 0; i < form->menuIdMapCount; i++) {
if (strcasecmp(form->menuIdMap[i].name, "mnuOff") == 0) {
offId = form->menuIdMap[i].id;
}
}
MenuItemT *offItem = wmMenuFindItemInMenu(form->popupMenus[0].menu, offId);
TEST_TRUE(offItem && !offItem->enabled);
// SetEvent on a menu item and on the form itself is honoured, and a
// zero-parameter override gets no event args in its locals.
frtOutClear(&app);
basFormRtSetEvent(app.rt, basFormRtFindCtrl(app.rt, form, "mnuOff"), "Click", "AltMenu");
form->window->onMenu(form->window, offId);
TEST_STR_EQ(frtOut(&app), "alt menu\n");
frtOutClear(&app);
BasValueT customArg = basValLong(7);
basFormRtFireEventArgs(app.rt, form, "Form1", "Custom", &customArg, 1);
TEST_STR_EQ(frtOut(&app), "[]\n");
// CreateControl parents: the form itself and a container on the same
// form are accepted; a non-container or another form's control is not.
BasControlT *onForm = (BasControlT *)basFormRtCreateCtrlEx(app.rt, form, "TextBox", "P1", form);
TEST_TRUE(onForm && onForm->widget->parent == form->contentBox);
BasControlT *inFrame = (BasControlT *)basFormRtCreateCtrlEx(app.rt, form, "TextBox", "P2", fr);
TEST_TRUE(inFrame && inFrame->widget->parent == fr->widget);
TEST_PTR_EQ(basFormRtCreateCtrlEx(app.rt, form, "TextBox", "P3", cmd1), NULL);
TEST_TRUE(app.rt->terminated);
frtClearError(&app);
BasFormT *f2 = (BasFormT *)basFormRtCreateForm(app.rt, "Form2", FORM_W, FORM_H);
BasControlT *otherFr = f2 ? (BasControlT *)basFormRtCreateCtrl(app.rt, f2, "Frame", "OF") : NULL;
TEST_TRUE(otherFr != NULL);
TEST_PTR_EQ(basFormRtCreateCtrlEx(app.rt, form, "TextBox", "P4", otherFr), NULL);
TEST_TRUE(app.rt->terminated);
frtClearError(&app);
// Stale refs: a removed control and an unloaded form raise the
// unknown-object errors instead of touching freed memory.
BasValueT xs = basValStringFromC("x");
basFormRtRemoveCtrl(app.rt, form, "Cmd2");
basFormRtSetProp(app.rt, cmd2, "Caption", xs);
basValRelease(&xs);
TEST_TRUE(app.rt->terminated);
frtClearError(&app);
basFormRtUnloadForm(app.rt, f2);
v = basFormRtGetProp(app.rt, f2, "Caption");
TEST_TRUE(app.rt->terminated);
frtClearError(&app);
basValRelease(&v);
basFormRtShowForm(app.rt, f2, false);
frtClearError(&app);
TEST_PTR_EQ(basFormRtCreateCtrl(app.rt, f2, "TextBox", "Z"), NULL);
frtClearError(&app);
// MinWidth reads back the hint that was set; negative and huge sizes
// are clamped.
basFormRtSetProp(app.rt, cmd1, "MinWidth", basValLong(FRT_MIN_W_PROBE));
v = basFormRtGetProp(app.rt, cmd1, "MinWidth");
TEST_EQ(basValToInt32(v), FRT_MIN_W_PROBE);
basFormRtSetProp(app.rt, cmd1, "Width", basValLong(-5));
v = basFormRtGetProp(app.rt, cmd1, "MinWidth");
TEST_EQ(basValToInt32(v), 0);
basFormRtSetProp(app.rt, cmd1, "Height", basValLong(FRT_HUGE_DIM));
v = basFormRtGetProp(app.rt, cmd1, "MinHeight");
TEST_EQ(basValToInt32(v), FRT_MAX_DIM);
// DestroyMenu drops the destroyed items' name rows.
BasValueT mArgs[3];
mArgs[0] = basValStringFromC("dyn");
basFormRtCallMethod(app.rt, form, "CreateMenu", mArgs, 1);
mArgs[1] = basValStringFromC("dynItem");
mArgs[2] = basValStringFromC("Dyn");
basFormRtCallMethod(app.rt, form, "AddMenuItem", mArgs, 3);
int32_t rowsWith = form->menuIdMapCount;
basFormRtCallMethod(app.rt, form, "DestroyMenu", mArgs, 1);
TEST_EQ(form->menuIdMapCount, rowsWith - 1);
basValRelease(&mArgs[0]);
basValRelease(&mArgs[1]);
basValRelease(&mArgs[2]);
frtDestroy(&app);
// Layout on a non-container is reported, not applied to its parent.
const char *frmLayout =
"Begin Form Form1\n"
" Caption = \"L\"\n"
" Begin CommandButton B\n"
" Layout = \"HBox\"\n"
" End\n"
"End\n";
if (frtBuild(&app, "", &frmLayout, 1)) {
frtStart(&app, NULL);
TEST_TRUE(app.rt->terminated);
frtDestroy(&app);
}
tShutdown();
}
static void caseRemoveContainerFromHandler(void) {
tCase("RemoveControl on a container from a child's own Click");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm =
"Begin Form Form1\n"
" Caption = \"Rm\"\n"
" Begin Frame Fr1\n"
" Begin HBox Row1\n"
" Begin CommandButton Cmd1\n"
" Caption = \"Remove\"\n"
" End\n"
" Begin Label Lbl1\n"
" Caption = \"x\"\n"
" End\n"
" End\n"
" End\n"
" Begin Label Lbl2\n"
" Caption = \"stays\"\n"
" End\n"
"End\n"
"\n"
"Sub Cmd1_Click\n"
" RemoveControl Me, \"Fr1\"\n"
" Print \"removed \"; Lbl2.Caption\n"
"End Sub\n";
FrtAppT app;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
BasFormT *form = frtForm(&app, "Form1");
BasControlT *cmd = frtCtrl(form, "Cmd1");
int32_t sx = 0;
int32_t sy = 0;
TEST_EQ((int32_t)arrlen(form->controls), 5);
// A lookup of Lbl1 is cached; once Lbl1 is removed the cached ref must
// no longer resolve (it would read freed memory).
BasControlT *lbl1 = frtCtrl(form, "Lbl1");
BasValueT cap = basFormRtGetProp(app.rt, lbl1, "Caption");
basValRelease(&cap);
tWidgetCenter(cmd->widget, &sx, &sy);
tClick(sx, sy);
tPump(2);
TEST_STR_EQ(frtOut(&app), "removed stays\n");
app.rt->suppressErrorDialog = true;
cap = basFormRtGetProp(app.rt, lbl1, "Caption");
basValRelease(&cap);
TEST_TRUE(app.rt->terminated);
TEST_EQ((int32_t)arrlen(form->controls), 1);
TEST_PTR_EQ(frtCtrl(form, "Fr1"), NULL);
TEST_PTR_EQ(frtCtrl(form, "Cmd1"), NULL);
TEST_EQ((int32_t)arrlen(app.rt->pendingCtrlFree), 0);
TEST_TRUE(frtCtrl(form, "Lbl2") != NULL);
frtDestroy(&app);
tShutdown();
}
static void caseResetCycles(void) {
tCase("basFormRtTestReset across 50 init/shutdown cycles");
const char *frm =
"Begin Form Form1\n"
" Caption = \"Cycle\"\n"
" Begin Menu mnuPop\n"
" Caption = \"Popup\"\n"
" Visible = False\n"
" Begin Menu mnuPopItem\n"
" Caption = \"Item\"\n"
" End\n"
" End\n"
" Begin TextBox Txt1\n"
" End\n"
" Begin CommandButton Cmd1\n"
" Caption = \"Go\"\n"
" ContextMenu = \"mnuPop\"\n"
" End\n"
" Begin Timer Tmr1\n"
" Interval = 100\n"
" Enabled = True\n"
" End\n"
" Begin Terminal Term1\n"
" End\n"
"End\n"
"\n"
"Sub Cmd1_Click\n"
" Print \"click\"\n"
" Unload Form1\n"
"End Sub\n"
"Sub Tmr1_Timer\n"
" Print \"tick\"\n"
"End Sub\n";
int32_t okCycles = 0;
for (int32_t i = 0; i < RESET_CYCLES; i++) {
FrtAppT app;
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
break;
}
frtStart(&app, NULL);
BasFormT *form = frtForm(&app, "Form1");
BasControlT *cmd = frtCtrl(form, "Cmd1");
int32_t sx = 0;
int32_t sy = 0;
SerAttach(1, "Term1");
tAdvanceClock(TIMER_INTERVAL_MS);
tWidgetCenter(cmd->widget, &sx, &sy);
tClick(sx, sy);
tPump(1);
bool ok = strcmp(frtOut(&app), "tick\nclick\n") == 0 && frtForm(&app, "Form1") == NULL;
frtDestroy(&app);
tShutdown();
if (!ok) {
break;
}
okCycles++;
}
TEST_EQ(okCycles, RESET_CYCLES);
}
static void caseResources(void) {
tCase("resource files: add, open handles, read, extract, remove");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
char resPath[DVX_MAX_PATH];
char srcPath[DVX_MAX_PATH];
char outPath[DVX_MAX_PATH];
snprintf(resPath, sizeof(resPath), "%s/case.res", tTempDir());
snprintf(srcPath, sizeof(srcPath), "%s/res_src.bin", tTempDir());
snprintf(outPath, sizeof(outPath), "%s/res_out.bin", tTempDir());
unlink(resPath);
TEST_TRUE(tWriteFile(srcPath, "BINDATA", 7));
// The appender extends an existing file; seed an empty one.
TEST_TRUE(tWriteFile(resPath, "", 0));
// Argument guards.
TEST_EQ(ResAddText(NULL, "n", "t"), 0);
TEST_EQ(ResAddFile(resPath, "n", 3, "/no/such/file"), 0);
TEST_EQ(ResOpen(NULL), 0);
TEST_EQ(ResOpen("/no/such.res"), 0);
TEST_EQ(ResExtract(resPath, "n", NULL), 0);
TEST_EQ(ResRemove(NULL, "n"), 0);
// Build a two-entry resource file.
TEST_EQ(ResAddText(resPath, "greet", "hello"), -1);
TEST_EQ(ResAddText(resPath, "empty", NULL), -1);
TEST_EQ(ResAddFile(resPath, "blob", 3, srcPath), -1);
int32_t h = ResOpen(resPath);
TEST_EQ(h, 1);
TEST_EQ(ResCount(h), 3);
// The directory is sorted by name at open: blob, empty, greet.
TEST_STR_EQ(ResName(h, 2), "greet");
TEST_TRUE(ResSize(h, 2) > 0);
TEST_EQ(ResType(h, 0), 3);
TEST_STR_EQ(ResName(h, 99), "");
TEST_EQ(ResSize(h, -1), 0);
TEST_EQ(ResType(h, 99), 0);
TEST_EQ(ResCount(0), 0);
TEST_STR_EQ(ResName(9, 0), "");
ResClose(0);
ResClose(9);
TEST_STR_EQ(ResGetText(resPath, "greet"), "hello");
TEST_STR_EQ(ResGetText(resPath, "missing"), "");
TEST_STR_EQ(ResGetText(NULL, "greet"), "");
TEST_STR_EQ(ResGetText("/no/such.res", "greet"), "");
TEST_EQ(ResExtract(resPath, "blob", outPath), -1);
int32_t outSize = 0;
uint8_t *outData = (uint8_t *)platformReadFile(outPath, &outSize);
TEST_TRUE(outData != NULL && outSize == 7 && memcmp(outData, "BINDATA", 7) == 0);
free(outData);
TEST_EQ(ResExtract(resPath, "missing", outPath), 0);
TEST_EQ(ResExtract("/no/such.res", "blob", outPath), 0);
// Any bytes, zeros included, in and out (BINARY STRING in resource.bas)
static const uint8_t zeroBytes[] = { 'a', 0, 'b', 0 };
const uint8_t *bin;
int32_t binLen = -1;
TEST_EQ(ResAddData(NULL, "n", DVX_RES_BINARY, zeroBytes, 1), 0);
TEST_EQ(ResAddData(resPath, "n", DVX_RES_BINARY, NULL, 1), 0);
TEST_EQ(ResAddData(resPath, "bin0", DVX_RES_BINARY, zeroBytes, (int32_t)sizeof(zeroBytes)), -1);
bin = ResGetData(resPath, "bin0", &binLen);
TEST_EQ(binLen, (int32_t)sizeof(zeroBytes));
TEST_TRUE(bin != NULL && memcmp(bin, zeroBytes, sizeof(zeroBytes)) == 0);
bin = ResGetData(resPath, "blob", &binLen);
TEST_TRUE(bin != NULL && binLen == 7 && memcmp(bin, "BINDATA", 7) == 0);
TEST_PTR_EQ(ResGetData(resPath, "missing", &binLen), NULL);
TEST_EQ(binLen, 0);
TEST_PTR_EQ(ResGetData(NULL, "blob", &binLen), NULL);
// The same from BASIC through resource.bas
char *resBas = NULL;
int32_t resLen = 0;
resBas = (char *)platformReadFile(FRT_INCLUDE_DIR "/resource.bas", &resLen);
TEST_TRUE(resBas != NULL);
if (resBas) {
char mainSrc[FRT_APP_PATH_MAX * 2];
size_t srcLen;
char *src;
const char *frm = "Begin Form Form1\n Caption = \"Res\"\nEnd\n";
FrtAppT app;
snprintf(mainSrc, sizeof(mainSrc),
"DIM b AS STRING\n"
"PRINT ResAddData(\"%s\", \"bas0\", RES_TYPE_BINARY, \"x\" + CHR$(0) + \"y\")\n"
"b = ResGetData$(\"%s\", \"bas0\")\n"
"PRINT LEN(b); ASC(MID$(b, 2, 1)); MID$(b, 3, 1); LEN(ResGetData$(\"%s\", \"nope\")); RES_NAME_ICON; RES_NAME_MAX\n",
resPath, resPath, resPath);
srcLen = strlen(resBas) + strlen(mainSrc) + 2;
src = (char *)malloc(srcLen);
TEST_TRUE(src != NULL);
if (src) {
snprintf(src, srcLen, "%s\n%s", resBas, mainSrc);
basNativeHostSetLive(true);
if (expectBuild(&app, src, &frm, 1)) {
frtStart(&app, NULL);
TEST_STR_EQ(frtOut(&app), "-1 \n3 0 y0 icon3232 \n");
frtDestroy(&app);
}
basNativeHostSetLive(false);
free(src);
}
free(resBas);
}
TEST_EQ(ResRemove(resPath, "blob"), -1);
TEST_EQ(ResExtract(resPath, "greet", "/no/dir/x.out"), 0);
// basFormRtTestReset closes every open resource handle.
TEST_EQ(ResOpen(resPath), 2);
basFormRtTestReset();
TEST_EQ(ResCount(2), 0);
// Fill every handle slot from a clean table; the ninth open fails.
int32_t handles[RES_HANDLE_PROBE];
int32_t got = 0;
while (got < RES_HANDLE_PROBE) {
handles[got] = ResOpen(resPath);
if (handles[got] == 0) {
break;
}
got++;
}
TEST_EQ(got, RES_HANDLE_PROBE - 1);
TEST_EQ(ResOpen(resPath), 0);
for (int32_t i = 0; i < got; i++) {
ResClose(handles[i]);
}
unlink(resPath);
unlink(srcPath);
unlink(outPath);
tShutdown();
}
static void caseRoundTrip(void) {
tCase(".frm round trip for every widget interface");
int32_t ifaceCount = wgtIfaceCount();
int32_t tested = 0;
for (int32_t i = 0; i < ifaceCount; i++) {
const char *wgtName = NULL;
const WgtIfaceT *iface = wgtIfaceAt(i, &wgtName);
if (!iface || !iface->basName || strcasecmp(iface->basName, "TabPage") == 0) {
continue;
}
printf(" round trip: %s\n", iface->basName);
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
bool keepsText = frtWidgetKeepsText(wgtName);
char *frm = (char *)calloc(1, FRM_TEXT_MAX);
char *back = (char *)calloc(1, FRM_TEXT_MAX);
int32_t pos = 0;
pos += snprintf(frm + pos, FRM_TEXT_MAX - pos, "%s%s", RT_FORM_HEADER, RT_FORM_MENUS);
pos += snprintf(frm + pos, FRM_TEXT_MAX - pos, " Begin %s C1\n", iface->basName);
if (keepsText) {
pos += snprintf(frm + pos, FRM_TEXT_MAX - pos, " Caption = \"Hello %s\"\n", iface->basName);
}
for (int32_t p = 0; p < iface->propCount; p++) {
const WgtPropDescT *pd = &iface->props[p];
char val[128];
if (!pd->getFn || !pd->setFn) {
continue;
}
const char *v = roundTripValue(iface->basName, pd, val, sizeof(val));
if (pd->type == WGT_IFACE_STRING) {
pos += snprintf(frm + pos, FRM_TEXT_MAX - pos, " %s = \"%s\"\n", pd->name, v);
} else {
pos += snprintf(frm + pos, FRM_TEXT_MAX - pos, " %s = %s\n", pd->name, v);
}
}
// Common writable set (skipping names the interface shadows).
static const char *const common[] = {
"Weight = 2",
"MaxWidth = 150",
"MaxHeight = 90",
"Visible = True",
"Enabled = True",
"ReadOnly = True",
"BackColor = 255",
"ForeColor = 65280",
"ToolTipText = \"Tip\"",
"HelpTopic = \"topic1\"",
"ContextMenu = \"mnuPop\"",
"DataSource = \"Dat1\"",
"DataField = \"fld\"",
};
for (int32_t c = 0; c < DVX_ARRAY_LEN(common); c++) {
char key[32];
sscanf(common[c], "%31s", key);
if (wgtIfaceFindProp(iface, key)) {
continue;
}
pos += snprintf(frm + pos, FRM_TEXT_MAX - pos, " %s\n", common[c]);
}
if (strcasecmp(iface->basName, "TabStrip") == 0) {
pos += snprintf(frm + pos, FRM_TEXT_MAX - pos,
" Begin TabPage P1\n"
" Caption = \"Page\"\n"
" Weight = 0\n"
" MaxWidth = 0\n"
" MaxHeight = 0\n"
" Visible = True\n"
" Enabled = True\n"
" ReadOnly = False\n"
" BackColor = 0\n"
" ForeColor = 0\n"
" ToolTipText = \"\"\n"
" HelpTopic = \"\"\n"
" ContextMenu = \"\"\n"
" DataSource = \"\"\n"
" DataField = \"\"\n"
" End\n");
}
pos += snprintf(frm + pos, FRM_TEXT_MAX - pos, " End\nEnd\n");
FrtAppT app;
if (expectBuild(&app, "", (const char *const *)&frm, 1)) {
frtStart(&app, NULL);
BasFormT *form = frtForm(&app, "Form1");
if (!form || app.rt->terminated) {
printf(" %s: load failed (%s)\n", iface->basName, app.vm->errorMsg);
TEST_TRUE(form && !app.rt->terminated);
} else {
frtSerializeForm(form, back, FRM_TEXT_MAX);
// The serializer writes no menus; splice the expected
// text without the menu block.
char *expect = (char *)calloc(1, FRM_TEXT_MAX);
char *ctrls = strstr(frm, RT_FORM_MENUS) + strlen(RT_FORM_MENUS);
snprintf(expect, FRM_TEXT_MAX, "%s%s", RT_FORM_HEADER, ctrls);
if (strcmp(back, expect) != 0) {
printf(" %s round trip differs\n--- expected ---\n%s--- actual ---\n%s", iface->basName, expect, back);
}
TEST_TRUE(strcmp(back, expect) == 0);
tested++;
free(expect);
}
frtDestroy(&app);
}
free(frm);
free(back);
tShutdown();
}
printf(" round-tripped %d widget interfaces\n", (int)tested);
TEST_TRUE(tested >= 29);
}
static void caseRunSimple(void) {
tCase("basFormRtRunSimple: slices, event loop, error dialog");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
basFormRtRunSimple(NULL);
const char *frm =
"Begin Form Form1\n"
" Caption = \"Run\"\n"
" Begin CommandButton Quit\n"
" Caption = \"Quit\"\n"
" End\n"
"End\n"
"\n"
"Sub Quit_Click\n"
" Unload Me\n"
"End Sub\n";
const char *bas =
"DIM i AS LONG\n"
"DIM n AS LONG\n"
"FOR i = 1 TO 30000\n"
" n = n + 1\n"
"NEXT i\n"
"PRINT \"main\"; n\n";
FrtAppT app;
if (!expectBuild(&app, bas, &frm, 1)) {
tShutdown();
return;
}
basFormRtLoadAllForms(app.rt, "Form1");
tPump(1);
BasFormT *form = frtForm(&app, "Form1");
BasControlT *quit = frtCtrl(form, "Quit");
int32_t sx = 0;
int32_t sy = 0;
tWidgetCenter(quit->widget, &sx, &sy);
hostMousePush(sx, sy, 0);
hostMousePush(sx, sy, MOUSE_LEFT);
hostMousePush(sx, sy, 0);
basFormRtRunSimple(app.rt);
outContains(&app, "main30000");
TEST_EQ((int32_t)arrlen(app.rt->forms), 0);
frtDestroy(&app);
// A VM-internal runtime error surfaces the generic error box (the
// harness dismisses it) and stops the run.
const char *basErr = "DIM a AS INTEGER\nDIM b AS INTEGER\nb = 0\na = 1 \\ b\nPRINT \"unreached\"\n";
if (!expectBuild(&app, basErr, &frm, 1)) {
tShutdown();
return;
}
basFormRtLoadAllForms(app.rt, "Form1");
tPump(1);
int32_t dismissedBefore = app.dialogsDismissed;
form = frtForm(&app, "Form1");
quit = frtCtrl(form, "Quit");
tWidgetCenter(quit->widget, &sx, &sy);
hostMousePush(sx, sy, 0);
hostMousePush(sx, sy, MOUSE_LEFT);
hostMousePush(sx, sy, 0);
basFormRtRunSimple(app.rt);
TEST_TRUE(app.dialogsDismissed > dismissedBefore);
TEST_TRUE(strstr(frtOut(&app), "unreached") == NULL);
frtDestroy(&app);
tShutdown();
}
static void caseRuntimeError(void) {
tCase("runtime error routes to the error dialog and halts");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm =
"Begin Form Form1\n"
" Caption = \"Err\"\n"
" Begin CommandButton Cmd1\n"
" Caption = \"Go\"\n"
" End\n"
"End\n"
"\n"
"Sub Form1_Test\n"
" Print \"before\"\n"
" Cmd1.NoSuchProperty = 1\n"
" Print \"after\"\n"
"End Sub\n"
"Sub Form1_Bogus\n"
" Cmd1.Bogus\n"
"End Sub\n";
FrtAppT app;
DialogCtxT dlg;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
memset(&dlg, 0, sizeof(dlg));
snprintf(dlg.button, sizeof(dlg.button), "OK");
frtStart(&app, NULL);
tDialogScript(dialogClick, &dlg);
frtFire(&app, "Form1", "Test");
tDialogScript(NULL, NULL);
TEST_TRUE(app.vm->ended);
TEST_TRUE(app.rt->terminated);
TEST_EQ(dlg.seen >= 1, true);
TEST_STR_EQ(dlg.title, "BASIC Runtime Error");
TEST_STR_EQ(frtOut(&app), "before\n");
TEST_TRUE(strstr(basVmGetError(app.vm), "Property not found on control") != NULL);
TEST_TRUE(strstr(basVmGetError(app.vm), "NoSuchProperty") != NULL);
TEST_PTR_EQ(tCtx()->modalWindow, NULL);
// Follow-on errors are swallowed while terminated: no second dialog.
dlg.seen = 0;
basFormRtRuntimeError(app.rt, "again", "x");
TEST_EQ(dlg.seen, 0);
// A host that suppresses the dialog still halts and records the text.
frtDestroy(&app);
tPump(1);
if (expectBuild(&app, "", &frm, 1)) {
frtStart(&app, NULL);
app.rt->suppressErrorDialog = true;
dlg.seen = 0;
tDialogScript(dialogClick, &dlg);
frtFire(&app, "Form1", "Bogus");
tDialogScript(NULL, NULL);
TEST_TRUE(app.vm->ended);
TEST_TRUE(app.rt->terminated);
TEST_EQ(dlg.seen, 0);
TEST_TRUE(strstr(basVmGetError(app.vm), "Method not found on control") != NULL);
frtDestroy(&app);
}
tShutdown();
}
// The Screen object's BitsPerPixel, DebugLayout, MousePointer and Arrange
// (VB's arrangements by what they look like, and DVX's grid), and the
// errors for bad values.
static void caseScreenMembers(void) {
tCase("Screen.BitsPerPixel / DebugLayout / MousePointer / Arrange");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm1 =
"Begin Form Form1\n"
" Caption = \"One\"\n"
" Width = 200\n"
" Height = 150\n"
"End\n"
"\n"
"Sub Form1_Read\n"
" Print Screen.BitsPerPixel; Screen.DebugLayout; Screen.MousePointer\n"
" Screen.DebugLayout = True\n"
" Screen.MousePointer = vbHourglass\n"
" Print Screen.DebugLayout; Screen.MousePointer = vbHourglass\n"
"End Sub\n"
"Sub Form1_Restore\n"
" Screen.DebugLayout = False\n"
" Screen.MousePointer = vbDefault\n"
" Print Screen.DebugLayout; Screen.MousePointer\n"
"End Sub\n"
"Sub Form1_Busy\n"
" Screen.MousePointer = vbHourglass\n"
"End Sub\n"
"Sub Form1_Cascade\n"
" Screen.Arrange vbCascade\n"
"End Sub\n"
"Sub Form1_TileH\n"
" Screen.Arrange vbTileHorizontal\n"
"End Sub\n"
"Sub Form1_TileV\n"
" Screen.Arrange vbTileVertical\n"
"End Sub\n"
"Sub Form1_Grid\n"
" Screen.Arrange vbTileGrid\n"
"End Sub\n"
"Sub Form1_BadArrange\n"
" Screen.Arrange 3\n"
"End Sub\n"
"Sub Form1_BadPointer\n"
" Screen.MousePointer = 3\n"
"End Sub\n"
"Sub Form1_BadMethod\n"
" Screen.Refresh\n"
"End Sub\n"
"Sub Form1_BadProp\n"
" Screen.BitsPerPixel = 8\n"
"End Sub\n";
const char *frm2 =
"Begin Form Form2\n"
" Caption = \"Two\"\n"
" Width = 200\n"
" Height = 150\n"
"End\n";
const char *frms[2] = { frm1, frm2 };
const char *bad[] = { "BadArrange", "BadPointer", "BadMethod", "BadProp" };
FrtAppT app;
if (!expectBuild(&app, "Form2.Show\n", frms, 2)) {
tShutdown();
return;
}
frtStart(&app, "Form1");
WindowT *w1 = frtForm(&app, "Form1")->window;
WindowT *w2 = frtForm(&app, "Form2")->window;
TEST_TRUE(w1->visible && w2->visible);
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form1", "Read"));
TEST_STR_EQ(frtOut(&app), "32 False 0 \nTrue True \n");
TEST_TRUE(wgtGetDebugLayout());
TEST_TRUE(tCtx()->busy);
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form1", "Restore"));
TEST_STR_EQ(frtOut(&app), "False 0 \n");
TEST_TRUE(!wgtGetDebugLayout());
TEST_TRUE(!tCtx()->busy);
// vbTileVertical: side by side, full height
TEST_TRUE(frtFire(&app, "Form1", "TileV"));
TEST_EQ(w1->y, 0);
TEST_EQ(w2->y, 0);
TEST_TRUE(w1->x != w2->x);
TEST_EQ(w1->h, SCREEN_H);
// vbTileHorizontal: stacked, full width
TEST_TRUE(frtFire(&app, "Form1", "TileH"));
TEST_EQ(w1->x, 0);
TEST_EQ(w2->x, 0);
TEST_TRUE(w1->y != w2->y);
TEST_EQ(w1->w, SCREEN_W);
// vbCascade: each window down and to the right of the one before
TEST_TRUE(frtFire(&app, "Form1", "Cascade"));
TEST_TRUE(w1->x != w2->x && w1->y != w2->y);
// vbTileGrid: no window overlaps another
TEST_TRUE(frtFire(&app, "Form1", "Grid"));
TEST_TRUE(w1->x + w1->w <= w2->x || w2->x + w2->w <= w1->x || w1->y + w1->h <= w2->y || w2->y + w2->h <= w1->y);
TEST_TRUE(!app.rt->terminated);
// A busy pointer the program leaves on ends with it
TEST_TRUE(frtFire(&app, "Form1", "Busy"));
TEST_TRUE(tCtx()->busy);
frtDestroy(&app);
TEST_TRUE(!tCtx()->busy);
for (int32_t i = 0; i < (int32_t)DVX_ARRAY_LEN(bad); i++) {
if (!expectBuild(&app, "", frms, 2)) {
break;
}
frtStart(&app, "Form1");
frtFire(&app, "Form1", bad[i]);
if (!app.rt->terminated) {
printf(" Screen error case %s did not stop the program\n", bad[i]);
}
TEST_TRUE(app.rt->terminated);
frtDestroy(&app);
}
tShutdown();
}
// The Screen object: the desktop's size in pixels.
static void caseScreenObject(void) {
tCase("Screen.Width / Screen.Height, read-only");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm =
"Begin Form Form1\n"
" Caption = \"Screen\"\n"
"End\n"
"\n"
"Sub Form1_Test\n"
" Print Screen.Width; Screen.Height\n"
"End Sub\n"
"Sub Form1_Bad\n"
" Screen.Width = 5\n"
"End Sub\n";
FrtAppT app;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form1", "Test"));
TEST_STR_EQ(frtOut(&app), "800 600 \n");
TEST_TRUE(frtFire(&app, "Form1", "Bad"));
TEST_TRUE(app.rt->terminated);
frtDestroy(&app);
tShutdown();
}
// A ScrollPane fires Change when the user moves it (here: the Down key),
// not when the program sets ScrollTop; the window-scrollbar route of the
// C demo (a large PictureBox in a NoBorder ScrollPane).
static void caseScrollPaneChange(void) {
tCase("ScrollPane Change when its position changes");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm =
"Begin Form Form1\n"
" Caption = \"Scroll\"\n"
" Width = 200\n"
" Height = 150\n"
" Begin ScrollPane Sp\n"
" NoBorder = True\n"
" Begin PictureBox Big\n"
" MinWidth = 600\n"
" MinHeight = 900\n"
" End\n"
" End\n"
"End\n"
"Sub Sp_Change ()\n"
" Print \"CHANGE\"; Sp.ScrollTop; Sp.ScrollLeft\n"
"End Sub\n"
"Sub Form1_T ()\n"
" Sp.ScrollTop = 40\n"
" Print \"SET\"; Sp.ScrollTop\n"
"End Sub\n";
FrtAppT app;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
BasFormT *form = frtForm(&app, "Form1");
BasControlT *sp = form ? frtCtrl(form, "Sp") : NULL;
TEST_TRUE(sp != NULL);
if (sp) {
WidgetT *w = sp->widget;
dvxUpdate(tCtx());
wclsOnKey(w, KEY_DOWN, 0);
TEST_STR_EQ(frtOut(&app), "CHANGE16 0 \n");
frtOutClear(&app);
// At the top already: no change, no event
wclsOnKey(w, KEY_HOME, 0);
wclsOnKey(w, KEY_HOME, 0);
TEST_STR_EQ(frtOut(&app), "CHANGE0 0 \n");
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form1", "T"));
TEST_STR_EQ(frtOut(&app), "SET40 \n");
}
frtDestroy(&app);
tShutdown();
}
static void caseSerialLoopback(void) {
tCase("Comm/Ser through the stub serial library");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const FrtStubApiT *api = frtStubsOpen();
if (!api) {
TEST_TRUE(api != NULL);
tShutdown();
return;
}
basFormRtTestReset();
const char *frm =
"Begin Form Form1\n"
" Caption = \"Ser\"\n"
" Begin Terminal Term1\n"
" End\n"
" Begin Terminal Term2\n"
" End\n"
"End\n";
FrtAppT app;
if (!expectBuild(&app, "", &frm, 1)) {
basFormRtTestReset();
frtStubsClose();
tShutdown();
return;
}
frtStart(&app, NULL);
// Raw serial: open, attach, write, loop bytes back, poll via the
// stub idle registry, close.
TEST_EQ(SerOpen(1, 9600, 8, "N", 1, 0), -1);
TEST_TRUE(api->serIsOpen(0));
SerAttach(1, "Term1");
TEST_TRUE(api->idleCount() >= 1);
TEST_EQ(serWriteText(1, "hi"), -1);
int32_t txLen = 0;
const uint8_t *tx = api->serTx(0, &txLen);
TEST_TRUE(txLen == 2 && memcmp(tx, "hi", 2) == 0);
TEST_EQ(serWriteText(1, ""), -1);
api->serPush(0, "echo", 4);
TEST_EQ(SerAvailable(1), 4);
api->idleRun();
tPump(1);
TEST_EQ(SerAvailable(1), 0);
api->serPush(0, "rd", 2);
TEST_STR_EQ(serReadText(1), "rd");
SerFlush(1);
TEST_EQ(SerGetBase(1), SER_STUB_BASE);
TEST_EQ(SerGetIrq(1), SER_STUB_IRQ);
TEST_EQ(SerGetUart(1), SER_STUB_UART);
SerSetBase(1, 0x2F8);
TEST_EQ(SerGetBase(1), 0x2F8);
SerSetIrq(1, 3);
TEST_EQ(SerGetIrq(1), 3);
// Modem lines: DTR/RTS up after the open, settable; CTS/DSR up and no
// carrier on the stub modem; BASIC True is -1.
TEST_EQ(SerGetDtr(1), -1);
TEST_EQ(SerGetRts(1), -1);
TEST_EQ(SerGetCts(1), -1);
TEST_EQ(SerGetDsr(1), -1);
TEST_EQ(SerGetDcd(1), 0);
SerSetDtr(1, 0);
SerSetRts(1, 0);
TEST_EQ(SerGetDtr(1), 0);
TEST_EQ(SerGetRts(1), 0);
SerSetDtr(1, -1);
TEST_EQ(SerGetDtr(1), -1);
TEST_EQ(SerGetCts(4), 0);
SerSetRts(4, -1);
SerAttach(9, "Term1");
SerAttach(1, "NoSuchTerm");
// Keystrokes into a serial-attached terminal go out through the port.
BasFormT *serForm = frtForm(&app, "Form1");
BasControlT *term1 = frtCtrl(serForm, "Term1");
callIntM(&app, term1, "SetFocus", NULL, 0);
tPump(1);
tType("s");
tPump(1);
tx = api->serTx(0, &txLen);
TEST_TRUE(txLen >= 1 && tx[txLen - 1] == 's');
// Re-attaching the port to another terminal unbinds the first, and
// closing an attached port detaches on the way out.
SerDetach(1);
SerAttach(1, "Term1");
SerAttach(1, "Term2");
SerClose(1);
api->serFail(true, false);
TEST_EQ(SerOpen(2, 9600, 8, "N", 1, 0), 0);
api->serFail(false, false);
// Comm attach over a serial-bound terminal drops the serial binding.
TEST_EQ(SerOpen(1, 9600, 8, "N", 1, 0), -1);
SerAttach(1, "Term1");
// secLink: open a handle, attach the terminal on a channel, send
// (the stub loops the payload back), receive from the ring buffer.
int32_t h = CommOpen(1, 9600, 8, "N", 1, 0);
TEST_EQ(h, 1);
CommAttach(h, "Term1", 2, 1);
CommAttach(h, "Term2", 2, 1);
CommAttach(h, "Term1", 2, 1);
CommAttach(h, "Term1", SECLINK_NUM_CHANNELS, 0);
api->idleRun();
TEST_EQ(commSendText(h, "ping", 2, 1), -1);
int32_t sentLen = 0;
uint8_t sentChannel = 0;
bool sentEnc = false;
const uint8_t *sent = api->commSent(&sentLen, &sentChannel, &sentEnc);
TEST_TRUE(sentLen == 4 && memcmp(sent, "ping", 4) == 0);
TEST_EQ(sentChannel, 2);
TEST_TRUE(sentEnc);
TEST_STR_EQ(commRecvText(h, 2), "ping");
TEST_EQ(CommRecvEncrypted(h, 2), -1);
TEST_STR_EQ(commRecvText(h, 2), "");
// Data that arrived in the clear is reported as such to BASIC
TEST_EQ(commSendText(h, "clr", 4, 0), -1);
TEST_STR_EQ(commRecvText(h, 4), "clr");
TEST_EQ(CommRecvEncrypted(h, 4), 0);
TEST_EQ(CommRecvEncrypted(h, SECLINK_NUM_CHANNELS), 0);
TEST_STR_EQ(commRecvText(h, -1), "");
api->commInject("inj", 3, 5);
TEST_STR_EQ(commRecvText(h, 5), "inj");
TEST_EQ(commSendText(h, "", 0, 0), -1);
TEST_EQ(commSendText(h, "x", SECLINK_NUM_CHANNELS, 0), 0);
TEST_EQ(CommPending(h), 0);
TEST_EQ(CommPoll(h), 0);
TEST_EQ(CommIsReady(h), -1);
// Passphrase combinations: none/none and match succeed; a mismatch
// or a one-sided passphrase fails the handshake.
TEST_EQ(CommHandshake(h, NULL), -1);
TEST_EQ(CommHandshake(h, ""), -1);
TEST_EQ(CommHandshake(h, "secret"), 0);
api->commPeerPass("secret");
TEST_EQ(CommHandshake(h, "secret"), -1);
TEST_EQ(CommHandshake(h, "other"), 0);
TEST_EQ(CommHandshake(h, ""), 0);
api->commPeerPass("");
api->commHandshakeRc(1);
TEST_EQ(CommHandshake(h, NULL), 0);
api->commHandshakeRc(0);
TEST_EQ(CommHandshake(9, NULL), 0);
// Plaintext channel opt-in reaches the link.
TEST_EQ(CommSetPlain(h, 3, -1), -1);
TEST_TRUE(api->commPlain(3));
TEST_EQ(CommSetPlain(h, 3, 0), -1);
TEST_TRUE(!api->commPlain(3));
TEST_EQ(CommSetPlain(h, SECLINK_NUM_CHANNELS, -1), 0);
TEST_EQ(CommSetPlain(9, 3, -1), 0);
// Keystrokes routed out through the attached terminal.
BasFormT *form = frtForm(&app, "Form1");
BasControlT *term = frtCtrl(form, "Term1");
callIntM(&app, term, "SetFocus", NULL, 0);
tPump(1);
tType("k");
tPump(1);
sent = api->commSent(&sentLen, &sentChannel, &sentEnc);
TEST_TRUE(sentLen == 1 && sent[0] == 'k');
TEST_EQ(sentChannel, 2);
// Removing a comm-attached terminal control detaches its binding.
basFormRtRemoveCtrl(app.rt, serForm, "Term2");
tPump(1);
CommDetach(h);
CommClose(h);
TEST_EQ(CommIsReady(h), 0);
// Failure injection and slot-hole reuse.
api->commFail(true, false);
TEST_EQ(CommOpen(1, 9600, 8, "N", 1, 0), 0);
api->commFail(false, false);
h = CommOpen(1, 9600, 8, NULL, 1, 0);
TEST_EQ(h, 1);
api->commFail(false, true);
TEST_EQ(commSendText(h, "y", 0, 0), 0);
api->commFail(false, false);
CommClose(h);
// Shutdown with a live connection and an attached port closes both,
// and also closes a port that was opened but never attached.
TEST_EQ(CommOpen(1, 9600, 8, "N", 1, 0), 1);
CommAttach(1, "Term1", 0, 0);
SerAttach(1, "Term1");
TEST_EQ(SerOpen(3, 9600, 8, "N", 1, 0), -1);
TEST_TRUE(api->serIsOpen(2));
basFormRtSerialShutdown();
TEST_TRUE(!api->serIsOpen(0));
TEST_TRUE(!api->serIsOpen(2));
frtDestroy(&app);
basFormRtTestReset();
frtStubsClose();
tShutdown();
}
static void caseSerialUnresolved(void) {
tCase("Comm/Ser attach and detach with the serial API unresolved");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm =
"Begin Form Form1\n"
" Caption = \"Ser\"\n"
" Begin Terminal Term1\n"
" End\n"
"End\n";
FrtAppT app;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
BasFormT *form = frtForm(&app, "Form1");
BasControlT *term = frtCtrl(form, "Term1");
TEST_TRUE(term != NULL);
TEST_EQ(SerOpen(1, 9600, 8, "N", 1, 0), 0);
SerAttach(1, "Term1");
SerAttach(9, "Term1");
SerAttach(1, "NoSuchTerm");
TEST_EQ(serWriteText(1, "hello"), 0);
TEST_STR_EQ(serReadText(1), "");
TEST_EQ(SerAvailable(1), 0);
SerDetach(1);
SerDetach(0);
SerClose(1);
TEST_EQ(CommOpen(1, 9600, 8, "N", 1, 0), 0);
CommAttach(1, "Term1", 0, 0);
CommAttach(0, "Term1", 0, 0);
TEST_EQ(commSendText(1, "hello", 0, 0), 0);
CommDetach(1);
CommClose(1);
CommClose(0);
basFormRtSerialShutdown();
TEST_TRUE(!app.rt->terminated);
tPump(1);
frtDestroy(&app);
tShutdown();
}
static void caseSetEvent(void) {
tCase("SetEvent retargets a control's event");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm =
"Begin Form Form1\n"
" Caption = \"SE\"\n"
" Begin CommandButton Cmd1\n"
" Caption = \"Go\"\n"
" End\n"
"End\n"
"\n"
"Sub Cmd1_Click\n"
" Print \"default\"\n"
"End Sub\n"
"Sub AltClick\n"
" Print \"alt\"\n"
"End Sub\n"
"Sub AltClick2\n"
" Print \"alt2\"\n"
"End Sub\n"
"Sub DynClick\n"
" Print \"dyn \"; Cmd2.Caption\n"
"End Sub\n"
"Sub Form1_Load\n"
" Dim c As Long\n"
" Set c = CreateControl(Me, \"CommandButton\", \"Cmd2\")\n"
" Cmd2.Caption = \"Made\"\n"
" SetEvent c, \"Click\", \"DynClick\"\n"
"End Sub\n";
FrtAppT app;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
BasFormT *form = frtForm(&app, "Form1");
BasControlT *cmd = frtCtrl(form, "Cmd1");
BasControlT *cmd2 = frtCtrl(form, "Cmd2");
int32_t sx = 0;
int32_t sy = 0;
TEST_EQ(app.mainResult, BAS_VM_HALTED);
TEST_TRUE(cmd && cmd2);
if (!(cmd && cmd2)) {
frtDestroy(&app);
tShutdown();
return;
}
tPump(1);
tWidgetCenter(cmd->widget, &sx, &sy);
tClick(sx, sy);
TEST_STR_EQ(frtOut(&app), "default\n");
// Retarget, retarget again (update in place), then to a missing SUB
// (consumes the event: nothing fires, no fallback).
frtOutClear(&app);
basFormRtSetEvent(app.rt, cmd, "Click", "AltClick");
tClick(sx, sy);
TEST_STR_EQ(frtOut(&app), "alt\n");
frtOutClear(&app);
basFormRtSetEvent(app.rt, cmd, "Click", "AltClick2");
TEST_EQ(cmd->eventOverrideCount, 1);
tClick(sx, sy);
TEST_STR_EQ(frtOut(&app), "alt2\n");
frtOutClear(&app);
basFormRtSetEvent(app.rt, cmd, "Click", "Missing");
tClick(sx, sy);
TEST_STR_EQ(frtOut(&app), "");
// Dynamically created control wired from BASIC.
frtOutClear(&app);
tWidgetCenter(cmd2->widget, &sx, &sy);
tClick(sx, sy);
TEST_STR_EQ(frtOut(&app), "dyn Made\n");
frtDestroy(&app);
tShutdown();
}
// SizeChars / SizePercent (layout.bas): the size properties keep the
// tagged size for the layout and read back the pixels it stands for.
static void caseSizeUnits(void) {
tCase("SizeChars and SizePercent sizes");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm =
"Begin Form Form1\n"
" Caption = \"Sizes\"\n"
" Begin TextBox Txt\n"
" End\n"
"End\n"
"DECLARE LIBRARY \"basrt\"\n"
" DECLARE FUNCTION SizeChars(BYVAL n AS LONG) AS LONG\n"
" DECLARE FUNCTION SizePercent(BYVAL n AS LONG) AS LONG\n"
"END DECLARE\n"
"Sub Form1_T ()\n"
" Txt.MinWidth = SizeChars(10)\n"
" Txt.MaxWidth = SizePercent(150)\n"
" Print Txt.MinWidth\n"
"End Sub\n"
"Sub Form1_U ()\n"
" Txt.MinWidth = 33\n"
" Txt.MaxWidth = 0\n"
" Print Txt.MinWidth; Txt.MaxWidth\n"
"End Sub\n";
FrtAppT app;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
// layout.bas is called for real
basNativeHostSetLive(true);
frtStart(&app, NULL);
TEST_TRUE(frtFire(&app, "Form1", "T"));
BasFormT *form = frtForm(&app, "Form1");
BasControlT *txt = form ? frtCtrl(form, "Txt") : NULL;
char want[FRT_OUT_MAX];
snprintf(want, sizeof(want), "%" PRId32 " \n", (int32_t)(SIZE_TEST_CHARS * tCtx()->font.charWidth));
TEST_STR_EQ(frtOut(&app), want);
TEST_TRUE(txt != NULL);
if (txt) {
TEST_EQ(txt->widget->minW, wgtChars(SIZE_TEST_CHARS));
TEST_EQ(txt->widget->maxW, wgtPercent(SIZE_PERCENT_MAX));
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form1", "U"));
TEST_STR_EQ(frtOut(&app), "33 0 \n");
TEST_EQ(txt->widget->minW, wgtPixels(33));
}
basNativeHostSetLive(false);
frtDestroy(&app);
tShutdown();
}
static void caseSqlWrappers(void) {
tCase("SQL* wrappers through fake callbacks and without any");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm = "Begin Form Form1\n Caption = \"Sql\"\nEnd\n";
FrtAppT app;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
// No callbacks installed: every wrapper takes its guard path.
TEST_EQ(SQLOpen("db"), 0);
TEST_EQ(SQLExec(1, "x"), 0);
TEST_STR_EQ(SQLError(1), "");
TEST_EQ(SQLQuery(1, "q"), 0);
TEST_EQ(SQLNext(1), 0);
TEST_EQ(SQLEof(1), -1);
TEST_EQ(SQLFieldCount(1), 0);
TEST_STR_EQ(SQLFieldName(1, 0), "");
TEST_STR_EQ(SQLFieldText(1, 0), "");
TEST_STR_EQ(SQLField(1, "n"), "");
TEST_EQ(SQLFieldInt(1, 0), 0);
TEST_TRUE(SQLFieldDbl(1, 0) == 0.0);
TEST_EQ(SQLAffected(1), 0);
SQLFreeResult(1);
SQLClose(1);
BasSqlCallbacksT tbl;
memset(&tbl, 0, sizeof(tbl));
tbl.sqlOpen = sqlFakeOpen;
tbl.sqlClose = sqlFakeClose;
tbl.sqlExec = sqlFakeExec;
tbl.sqlError = sqlFakeError;
tbl.sqlQuery = sqlFakeQuery;
tbl.sqlNext = sqlFakeNext;
tbl.sqlEof = sqlFakeEof;
tbl.sqlFieldCount = sqlFakeFieldCount;
tbl.sqlFieldName = sqlFakeFieldName;
tbl.sqlFieldText = sqlFakeFieldText;
tbl.sqlFieldByName = sqlFakeFieldByName;
tbl.sqlFieldInt = sqlFakeFieldInt;
tbl.sqlFieldDbl = sqlFakeFieldDbl;
tbl.sqlFreeResult = sqlFakeFree;
tbl.sqlAffectedRows = sqlFakeAffected;
basVmSetSqlCallbacks(app.vm, &tbl);
TEST_EQ(SQLOpen("db"), SQL_FAKE_DB);
TEST_EQ(SQLOpen(NULL), 0);
TEST_EQ(SQLExec(SQL_FAKE_DB, "create"), -1);
TEST_EQ(SQLExec(SQL_FAKE_DB, NULL), 0);
TEST_STR_EQ(SQLError(SQL_FAKE_DB), "fake error");
int32_t rs = SQLQuery(SQL_FAKE_DB, "select");
TEST_EQ(rs, SQL_FAKE_RS);
TEST_EQ(SQLEof(rs), 0);
TEST_EQ(SQLNext(rs), -1);
TEST_EQ(SQLNext(rs), -1);
TEST_EQ(SQLFieldCount(rs), 2);
TEST_STR_EQ(SQLFieldName(rs, 0), "id");
TEST_STR_EQ(SQLFieldName(rs, 1), "name");
TEST_STR_EQ(SQLFieldText(rs, 1), "r1c1");
TEST_STR_EQ(SQLField(rs, "name"), "r1c1");
TEST_STR_EQ(SQLField(rs, "zip"), "");
TEST_EQ(SQLFieldInt(rs, 1), 11);
TEST_TRUE(SQLFieldDbl(rs, 0) == 10.5);
TEST_EQ(SQLNext(rs), 0);
TEST_EQ(SQLEof(rs), -1);
SQLFreeResult(rs);
TEST_EQ(SQLAffected(SQL_FAKE_DB), 3);
SQLClose(SQL_FAKE_DB);
frtDestroy(&app);
tShutdown();
}
// A library's byte stream on a Terminal control (basFormRtTermBind, as
// the connection library's ConnAttach uses it): only a Terminal binds;
// what is typed or pasted reaches the stream; a new binding or the
// form's end tells the old one; Unbind and Forget end it quietly. The
// Terminal's Cols / Rows, SetColor, ResetColors, Copy and Paste.
static void caseTermBind(void) {
tCase("Terminal: library binding, size, colors, copy, paste");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm =
"Begin Form Form1\n"
" Caption = \"Term\"\n"
" Begin Terminal Term1\n"
" End\n"
" Begin Label Lbl1\n"
" Caption = \"x\"\n"
" End\n"
"End\n"
"\n"
"Sub Form1_Paste\n"
" Term1.Paste\n"
"End Sub\n"
"Sub Form1_Size\n"
" Term1.Cols = 100\n"
" Term1.Rows = 30\n"
" Print Term1.Cols; Term1.Rows\n"
"End Sub\n"
"Sub Form1_Colors\n"
" Term1.SetColor 1, RGB(1, 2, 3)\n"
" Term1.SetColor 99, RGB(1, 2, 3)\n"
" Term1.ResetColors\n"
" Print Term1.Copy()\n"
"End Sub\n";
FrtAppT app;
int32_t ctxA = 0;
int32_t ctxB = 0;
WidgetT *term;
int32_t w;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
sBindLen = 0;
sBindUnbound = 0;
term = frtCtrl(frtForm(&app, "Form1"), "Term1")->widget;
TEST_PTR_EQ(basFormRtTermBind("Lbl1", &ctxA, termBindWrite, termBindUnbound), NULL);
TEST_PTR_EQ(basFormRtTermBind("Nope", &ctxA, termBindWrite, termBindUnbound), NULL);
TEST_PTR_EQ(basFormRtTermBind("Term1", &ctxA, termBindWrite, termBindUnbound), term);
// Paste sends the clipboard (new lines as CR) to the stream
dvxClipboardCopy("a\nb", 3);
frtFire(&app, "Form1", "Paste");
TEST_EQ(sBindLen, 3);
TEST_TRUE(memcmp(sBindText, "a\rb", 3) == 0);
// Binding ctxA again is not an end; ctxB taking the control is
TEST_PTR_EQ(basFormRtTermBind("Term1", &ctxA, termBindWrite, termBindUnbound), term);
TEST_EQ(sBindUnbound, 0);
TEST_PTR_EQ(basFormRtTermBind("Term1", &ctxB, termBindWrite, termBindUnbound), term);
TEST_EQ(sBindUnbound, 1);
// Unbind and Forget end quietly; typing reaches nobody
basFormRtTermUnbind(&ctxB);
basFormRtTermForget(&ctxA);
sBindLen = 0;
frtFire(&app, "Form1", "Paste");
TEST_EQ(sBindLen, 0);
TEST_EQ(sBindUnbound, 1);
// Size and colors
w = term->calcMinW;
frtFire(&app, "Form1", "Size");
tPump(1);
TEST_STR_EQ(frtOut(&app), "100 30 \n");
TEST_TRUE(term->calcMinW > w);
frtOutClear(&app);
frtFire(&app, "Form1", "Colors");
TEST_STR_EQ(frtOut(&app), "False \n");
// The form's end ends a binding
TEST_PTR_EQ(basFormRtTermBind("Term1", &ctxA, termBindWrite, termBindUnbound), term);
frtDestroy(&app);
TEST_EQ(sBindUnbound, 2);
tShutdown();
}
// TextBox MaxLength (the text is cut; 0 = the default) and PasswordChar.
static void caseTextBoxProps(void) {
tCase("TextBox MaxLength and PasswordChar");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm =
"Begin Form Form1\n"
" Caption = \"Text\"\n"
" Begin TextBox Txt1\n"
" End\n"
"End\n"
"\n"
"Sub Form1_Max\n"
" Txt1.Text = \"abcdefgh\"\n"
" Txt1.MaxLength = 5\n"
" Print Txt1.Text; Txt1.MaxLength\n"
" Txt1.Text = \"123456789\"\n"
" Print Txt1.Text\n"
" Txt1.MaxLength = 0\n"
" Print Txt1.MaxLength\n"
"End Sub\n"
"Sub Form1_Pass\n"
" Txt1.PasswordChar = \"*\"\n"
" Print \"[\" & Txt1.PasswordChar & \"]\"\n"
" Txt1.PasswordChar = \"\"\n"
" Print \"[\" & Txt1.PasswordChar & \"]\"\n"
"End Sub\n";
FrtAppT app;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
frtFire(&app, "Form1", "Max");
TEST_STR_EQ(frtOut(&app), "abcde5 \n12345\n256 \n");
frtOutClear(&app);
frtFire(&app, "Form1", "Pass");
TEST_STR_EQ(frtOut(&app), "[*]\n[]\n");
frtDestroy(&app);
tShutdown();
}
static void caseTimers(void) {
tCase("Timer events on the fake clock");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm =
"Begin Form Form1\n"
" Caption = \"Tmr\"\n"
" Begin Timer Tmr1\n"
" Interval = 100\n"
" Enabled = True\n"
" End\n"
"End\n"
"\n"
"Dim Shared ticks As Integer\n"
"Sub Tmr1_Timer\n"
" ticks = ticks + 1\n"
" Print \"tick\"; ticks\n"
" If ticks = 3 Then Tmr1.Enabled = False\n"
"End Sub\n";
FrtAppT app;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
BasFormT *form = frtForm(&app, "Form1");
BasControlT *tmr = frtCtrl(form, "Tmr1");
TEST_TRUE(wgtTimerIsRunning(tmr->widget));
tPump(2);
TEST_STR_EQ(frtOut(&app), "");
for (int32_t i = 0; i < TIMER_TICKS + 2; i++) {
tAdvanceClock(TIMER_INTERVAL_MS);
}
TEST_STR_EQ(frtOut(&app), "tick1 \ntick2 \ntick3 \n");
TEST_TRUE(!wgtTimerIsRunning(tmr->widget));
frtDestroy(&app);
tShutdown();
}
static void caseToolbarClearFromHandler(void) {
tCase("Toolbar.Clear from a toolbar button's own Click");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm =
"Begin Form Form1\n"
" Caption = \"Tb\"\n"
" Begin Toolbar Tb1\n"
" End\n"
"End\n"
"\n"
"Sub Form1_Load\n"
" Tb1.AddTextButton \"TbA\", \"A\"\n"
" Tb1.AddSeparator\n"
" Tb1.AddTextButton \"TbB\", \"B\"\n"
"End Sub\n"
"Sub TbA_Click\n"
" Tb1.Clear\n"
" Print \"cleared \"; Tb1.ButtonCount()\n"
"End Sub\n";
FrtAppT app;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
BasFormT *form = frtForm(&app, "Form1");
BasControlT *tb = frtCtrl(form, "Tb1");
BasControlT *tba = frtCtrl(form, "TbA");
int32_t sx = 0;
int32_t sy = 0;
TEST_TRUE(tb && tba);
TEST_EQ((int32_t)arrlen(form->controls), 4);
if (tb && tba) {
tWidgetCenter(tba->widget, &sx, &sy);
tClick(sx, sy);
tPump(2);
TEST_STR_EQ(frtOut(&app), "cleared 0 \n");
TEST_PTR_EQ(tb->widget->firstChild, NULL);
TEST_EQ((int32_t)arrlen(form->controls), 1);
TEST_EQ((int32_t)arrlen(app.rt->pendingCtrlFree), 0);
TEST_EQ(app.rt->eventDepth, 0);
}
frtDestroy(&app);
tShutdown();
}
// Two programs at once (each with its own runtime): menus and the close
// box of the first one's window reach the first program after the second
// was started.
static void caseTwoRuntimes(void) {
tCase("two BASIC programs at once: window events reach their own runtime");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm =
"Begin Form Form1\n"
" Caption = \"Twin\"\n"
" Begin Menu mnuFile\n"
" Caption = \"&File\"\n"
" Begin Menu mnuGo\n"
" Caption = \"&Go\"\n"
" End\n"
" End\n"
"End\n"
"\n"
"Sub mnuGo_Click\n"
" Print \"go\"\n"
"End Sub\n"
"Sub Form1_Unload\n"
" Print \"bye\"\n"
"End Sub\n";
FrtAppT first;
FrtAppT second;
if (!expectBuild(&first, "", &frm, 1)) {
tShutdown();
return;
}
frtStart(&first, NULL);
if (!expectBuild(&second, "", &frm, 1)) {
frtDestroy(&first);
tShutdown();
return;
}
frtStart(&second, NULL);
BasFormT *form1 = frtForm(&first, "Form1");
BasFormT *form2 = frtForm(&second, "Form1");
TEST_TRUE(form1 != NULL && form2 != NULL && form1 != form2);
if (form1 && form2) {
MenuT *file = form1->window->menuBar->menus[0];
frtOutClear(&first);
frtOutClear(&second);
form1->window->onMenu(form1->window, file->items[0].id);
form1->window->onClose(form1->window);
TEST_STR_EQ(frtOut(&first), "go\nbye\n");
TEST_STR_EQ(frtOut(&second), "");
TEST_PTR_EQ(frtForm(&first, "Form1"), NULL);
TEST_TRUE(frtForm(&second, "Form1") != NULL);
}
frtDestroy(&second);
frtDestroy(&first);
tShutdown();
}
static void caseUnloadDeferred(void) {
tCase("Unload Me inside a handler is deferred until it returns");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm =
"Begin Form Form1\n"
" Caption = \"Def\"\n"
" Begin CommandButton Cmd1\n"
" Caption = \"Bye\"\n"
" End\n"
"End\n"
"\n"
"Dim Shared n As Integer\n"
"Sub Cmd1_Click\n"
" n = 7\n"
" Unload Form1\n"
" Print \"after \"; n\n"
" Unload Form1\n"
"End Sub\n"
"Sub Form1_Unload\n"
" Print \"unload\"\n"
"End Sub\n";
FrtAppT app;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
BasFormT *form = frtForm(&app, "Form1");
BasControlT *cmd = frtCtrl(form, "Cmd1");
int32_t sx = 0;
int32_t sy = 0;
tWidgetCenter(cmd->widget, &sx, &sy);
tMouseMove(sx, sy);
tMouseDown(sx, sy, MOUSE_LEFT);
tMouseUp(sx, sy, MOUSE_LEFT);
TEST_STR_EQ(frtOut(&app), "unload\nafter 7 \n");
tPump(2);
TEST_PTR_EQ(frtForm(&app, "Form1"), NULL);
TEST_EQ((int32_t)arrlen(app.rt->pendingUnload), 0);
TEST_EQ((int32_t)arrlen(app.rt->forms), 0);
TEST_PTR_EQ(tFindWindow("Def"), NULL);
TEST_EQ(app.rt->eventDepth, 0);
frtDestroy(&app);
tShutdown();
}
static void caseValidateCancel(void) {
tCase("Validate cancel reaches the widget as a refused write");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm =
"Begin Form Form1\n"
" Caption = \"Val\"\n"
" Begin TextBox Txt1\n"
" End\n"
" Begin TextBox Txt\n"
" Index = 3\n"
" End\n"
"End\n"
"\n"
"Sub Txt1_Validate(Cancel As Integer)\n"
" If Txt1.Text = \"\" Then Cancel = 1\n"
" Print \"v1=\"; Cancel\n"
"End Sub\n"
"Sub Txt_Validate(Index As Integer, Cancel As Integer)\n"
" Cancel = Index\n"
" Print \"va=\"; Index; Cancel\n"
"End Sub\n";
FrtAppT app;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
BasFormT *form = frtForm(&app, "Form1");
BasControlT *txt = frtCtrl(form, "Txt1");
BasControlT *arr = frtCtrlIdx(form, "Txt", 3);
TEST_TRUE(txt && arr);
if (txt && arr) {
TEST_TRUE(!txt->widget->onValidate(txt->widget));
wgtSetText(txt->widget, "ok");
TEST_TRUE(txt->widget->onValidate(txt->widget));
TEST_TRUE(!arr->widget->onValidate(arr->widget));
TEST_STR_EQ(frtOut(&app), "v1=1 \nv1=0 \nva=3 3 \n");
}
frtDestroy(&app);
tShutdown();
}
// Visible = True on a form already shown modal keeps it modal (it used
// to go through a modeless Show and drop the modal chrome).
static void caseVisibleKeepsModal(void) {
tCase("Form.Visible = True on a modal form keeps it modal");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm =
"Begin Form Form1\n"
" Caption = \"Modal\"\n"
"End\n";
FrtAppT app;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
BasFormT *form = frtForm(&app, "Form1");
TEST_TRUE(form != NULL && form->window != NULL);
// Show vbModal runs until the form is hidden: the checks run in the
// dialog script, while the form is up.
if (form && form->window) {
sModalCheckApp = &app;
sModalChecks = 0;
tDialogScript(visibleKeepsModalCheck, form);
basFormRtShowForm(app.rt, form, true);
TEST_EQ(sModalChecks, 1);
TEST_PTR_EQ(app.rt->ctx->modalWindow, NULL);
sModalCheckApp = NULL;
frtDialogsDefault(&app);
}
frtDestroy(&app);
tShutdown();
}
// The widget properties a BASIC port of DVX Demo needs: ProgressBar and
// Splitter Vertical, ScrollPane Padding / Spacing / ScrollTop and the
// ScrollToTop method, ComboBox MaxLength, and Labels nested in a
// StatusBar (from the .frm and with CreateControl), at design time and
// from code.
static void caseWidgetParity(void) {
tCase("widget parity: Vertical, ScrollPane gaps and scroll, ComboBox MaxLength, StatusBar panes");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm =
"Begin Form Form1\n"
" Caption = \"Parity\"\n"
" Begin ProgressBar Pb1\n"
" Vertical = True\n"
" Value = 75\n"
" End\n"
" Begin Splitter Spl1\n"
" Vertical = False\n"
" Begin Label TopPane\n"
" Caption = \"Top\"\n"
" End\n"
" Begin Label BottomPane\n"
" Caption = \"Bottom\"\n"
" End\n"
" End\n"
" Begin ScrollPane Sp1\n"
" Padding = 4\n"
" Spacing = 3\n"
" Begin Label SpA\n"
" Caption = \"A\"\n"
" End\n"
" End\n"
" Begin ComboBox Cb1\n"
" MaxLength = 8\n"
" End\n"
" Begin StatusBar Sb1\n"
" Begin Label Pane1\n"
" Caption = \"Ready\"\n"
" End\n"
" End\n"
"End\n"
"\n"
"Sub Form1_Test\n"
" Print Pb1.Vertical; Spl1.Vertical; Sp1.Padding; Sp1.Spacing; Cb1.MaxLength\n"
" Pb1.Vertical = False\n"
" Spl1.Vertical = True\n"
" Sp1.Padding = 0\n"
" Cb1.Text = \"abcdefghij\"\n"
" Print Pb1.Vertical; Spl1.Vertical; Sp1.Padding; Cb1.Text\n"
" Cb1.MaxLength = 3\n"
" Print Cb1.MaxLength; Cb1.Text\n"
" Sp1.ScrollTop = 0\n"
" Sp1.ScrollToTop\n"
" Print Sp1.ScrollTop; Sp1.ScrollLeft\n"
" Dim p As Object\n"
" Set p = CreateControl(Me, \"Label\", \"Pane2\", Sb1)\n"
" p.Caption = \"Line 1\"\n"
"End Sub\n";
FrtAppT app;
if (!expectBuild(&app, "", &frm, 1)) {
tShutdown();
return;
}
frtStart(&app, NULL);
BasFormT *form = frtForm(&app, "Form1");
BasControlT *sb = form ? frtCtrl(form, "Sb1") : NULL;
BasControlT *pane1 = form ? frtCtrl(form, "Pane1") : NULL;
TEST_TRUE(form != NULL && sb != NULL && pane1 != NULL);
if (form && sb && pane1) {
TEST_PTR_EQ(pane1->widget->parent, sb->widget);
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form1", "Test"));
TEST_STR_EQ(frtOut(&app), "True False 4 3 8 \nFalse True 0 abcdefgh\n3 abc\n0 0 \n");
BasControlT *pane2 = frtCtrl(form, "Pane2");
TEST_TRUE(pane2 != NULL && pane2->widget->parent == sb->widget);
}
frtDestroy(&app);
tShutdown();
}
// Form.WindowState: from the .frm (applied at the first Show), read while
// hidden, set at run time (maximizing resizes, which fires Resize), set on
// a hidden form, and an invalid value.
static void caseWindowState(void) {
tCase("Form.WindowState: .frm, run time, hidden form, invalid value");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm1 =
"Begin Form Form1\n"
" Caption = \"One\"\n"
"End\n";
const char *frm2 =
"Begin Form Form2\n"
" Caption = \"Two\"\n"
" WindowState = 1\n"
"End\n"
"\n"
"Sub Form2_Resize\n"
" Print \"resize\"\n"
"End Sub\n"
"Sub Form2_Before\n"
" Print Form2.Visible; Form2.WindowState\n"
" Form2.Show\n"
" Print Form2.WindowState = vbMinimized\n"
"End Sub\n"
"Sub Form2_Max\n"
" Form2.WindowState = vbMaximized\n"
" Print Form2.WindowState\n"
"End Sub\n"
"Sub Form2_Normal\n"
" Form2.WindowState = vbNormal\n"
" Print Form2.WindowState\n"
"End Sub\n"
"Sub Form2_Hidden\n"
" Form2.Hide\n"
" Form2.WindowState = vbMaximized\n"
" Print Form2.WindowState\n"
"End Sub\n"
"Sub Form2_Again\n"
" Form2.Show\n"
"End Sub\n"
"Sub Form2_Bad\n"
" Form2.WindowState = 7\n"
"End Sub\n";
const char *frms[2] = { frm1, frm2 };
FrtAppT app;
if (!expectBuild(&app, "", frms, 2)) {
tShutdown();
return;
}
frtStart(&app, "Form1");
BasFormT *f2 = frtForm(&app, "Form2");
TEST_TRUE(f2 != NULL);
if (!f2) {
frtDestroy(&app);
tShutdown();
return;
}
WindowT *win = f2->window;
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form2", "Before"));
TEST_TRUE(win->visible && win->minimized);
outContains(&app, "False 1 \nTrue \n");
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form2", "Max"));
TEST_TRUE(!win->minimized && win->maximized);
outContains(&app, "resize\n");
outContains(&app, "2 \n");
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form2", "Normal"));
TEST_TRUE(!win->minimized && !win->maximized);
outContains(&app, "0 \n");
frtOutClear(&app);
TEST_TRUE(frtFire(&app, "Form2", "Hidden"));
TEST_STR_EQ(frtOut(&app), "2 \n");
TEST_TRUE(!win->visible && !win->maximized);
TEST_TRUE(frtFire(&app, "Form2", "Again"));
TEST_TRUE(win->visible && win->maximized);
TEST_TRUE(!app.rt->terminated);
frtFire(&app, "Form2", "Bad");
TEST_TRUE(app.rt->terminated);
frtDestroy(&app);
tShutdown();
}
static void caseWithEvents(void) {
tCase("WithEvents variables on forms: each form's handler runs with its own form variables");
tInit(SCREEN_W, SCREEN_H, SCREEN_BPP);
const char *frm1 =
"Begin Form Form1\n"
" Caption = \"One\"\n"
"End\n"
"\n"
"Dim WithEvents w As Ticker\n"
"Dim Shared tag As String\n"
"Sub Form1_Bind\n"
" tag = \"one\"\n"
" Set w = TheTicker()\n"
"End Sub\n"
"Sub Form1_Go\n"
" FireTicker\n"
"End Sub\n"
"Sub w_Tick(n As Integer)\n"
" Print tag; n\n"
" n = n + 1\n"
"End Sub\n";
const char *frm2 =
"Begin Form Form2\n"
" Caption = \"Two\"\n"
"End\n"
"\n"
"Dim WithEvents t2 As Ticker\n"
"Dim Shared tag As String\n"
"Sub Form2_Bind\n"
" tag = \"two\"\n"
" Set t2 = TheTicker()\n"
"End Sub\n"
"Sub t2_Tick(n As Integer)\n"
" Print tag; n\n"
" n = n + 1\n"
"End Sub\n";
const char *frms[2] = { frm1, frm2 };
const char *bas =
"Dim Shared gT As Ticker\n"
"Set gT = New Ticker\n"
"Load Form2\n"
"Function TheTicker() As Ticker\n"
" Set TheTicker = gT\n"
"End Function\n"
"Sub FireTicker\n"
" gT.Fire\n"
"End Sub\n"
"BEGINCLASS \"Ticker\"\n"
"Event Tick(n As Integer)\n"
"Public Sub Fire()\n"
" Dim k As Integer\n"
" k = 1\n"
" RaiseEvent Tick(k)\n"
" Print \"k=\"; k\n"
"End Sub\n"
"ENDCLASS\n";
FrtAppT app;
if (!expectBuild(&app, bas, frms, 2)) {
tShutdown();
return;
}
frtStart(&app, "Form1");
TEST_EQ(app.mainResult, BAS_VM_HALTED);
BasFormT *f1 = frtForm(&app, "Form1");
BasFormT *f2 = frtForm(&app, "Form2");
TEST_TRUE(f1 && f2);
if (f1 && f2) {
frtOutClear(&app);
basFormRtFireEvent(app.rt, f1, "Form1", "Bind");
basFormRtFireEvent(app.rt, f2, "Form2", "Bind");
basFormRtFireEvent(app.rt, f1, "Form1", "Go");
basFormRtUnloadForm(app.rt, f2);
basFormRtFireEvent(app.rt, f1, "Form1", "Go");
TEST_STR_EQ(frtOut(&app), "one1 \ntwo2 \nk=3 \none1 \nk=2 \n");
}
frtDestroy(&app);
tShutdown();
}
// Call a control method whose arguments are all integers.
// idx-th direct child widget of w, or NULL.
static WidgetT *childAt(WidgetT *w, int32_t idx) {
WidgetT *c = w ? w->firstChild : NULL;
while (c && idx > 0) {
c = c->nextSibling;
idx--;
}
return c;
}
// CommRecv's bytes as a C string (these tests send text).
static const char *commRecvText(int32_t handle, int32_t channel) {
static char text[FRT_OUT_MAX];
int32_t len = 0;
const uint8_t *bytes = CommRecv(handle, channel, &len);
len = DVX_MIN(len, (int32_t)sizeof(text) - 1);
memcpy(text, bytes, (size_t)len);
text[len] = '\0';
return text;
}
static int32_t commSendText(int32_t handle, const char *text, int32_t channel, int32_t encrypt) {
return CommSend(handle, (const uint8_t *)text, (int32_t)strlen(text), channel, encrypt);
}
static void dialogClick(AppContextT *ctx, WindowT *modal, void *userCtx) {
DialogCtxT *dlg = (DialogCtxT *)userCtx;
(void)ctx;
dlg->seen++;
snprintf(dlg->title, sizeof(dlg->title), "%s", modal->title);
if (!tDialogClickButton(modal, dlg->button)) {
tDialogClickButton(modal, "OK");
}
}
// Call ctrl.Drag action through the runtime's method dispatch.
static void dragCallMethod(FrtAppT *app, BasControlT *ctrl, int32_t action) {
int32_t vals[1] = { action };
BasValueT r = callIntM(app, ctrl, "Drag", vals, 1);
basValRelease(&r);
}
// caseDrawThemed Form1_HBar's pixels: a horizontal bar (the top row runs
// left button, trough, thumb, trough, right button; the glyphs point left
// and right) and DrawScrollArrow's button (raised 1px bevel on the
// scrollbar face, the arrow's tip pointing right).
static void drawThemedHBarCheck(WidgetT *pic) {
const ColorSchemeT *cs = &tCtx()->colors;
int32_t midY = FRT_HBAR_Y + SCROLLBAR_WIDTH / 2;
int32_t rightX = FRT_HBAR_END + 1 - SCROLLBAR_WIDTH;
int32_t leftTip = SCROLLBAR_WIDTH / 2 - SB_ARROW_ROWS / 2;
int32_t rightTip = rightX + SCROLLBAR_WIDTH / 2 + SB_ARROW_ROWS / 2;
int32_t buttonEnd = SCROLLBAR_WIDTH - 1;
int32_t arrowTipX = FRT_SARROW_X + SCROLLBAR_WIDTH / 2 + SB_ARROW_ROWS / 2;
int32_t arrowMidY = FRT_SARROW_Y + SCROLLBAR_WIDTH / 2;
TEST_EQ(wgtCanvasGetPixel(pic, 0, FRT_HBAR_Y), cs->windowHighlight);
TEST_EQ(wgtCanvasGetPixel(pic, SCROLLBAR_WIDTH, FRT_HBAR_Y), cs->windowShadow);
TEST_EQ(wgtCanvasGetPixel(pic, FRT_HBAR_THUMB_X - 1, FRT_HBAR_Y), cs->windowShadow);
TEST_EQ(wgtCanvasGetPixel(pic, FRT_HBAR_THUMB_X, FRT_HBAR_Y), cs->windowHighlight);
TEST_EQ(wgtCanvasGetPixel(pic, FRT_HBAR_THUMB_END, FRT_HBAR_Y), cs->windowHighlight);
TEST_EQ(wgtCanvasGetPixel(pic, FRT_HBAR_THUMB_END + 1, FRT_HBAR_Y), cs->windowShadow);
TEST_EQ(wgtCanvasGetPixel(pic, rightX - 1, FRT_HBAR_Y), cs->windowShadow);
TEST_EQ(wgtCanvasGetPixel(pic, rightX, FRT_HBAR_Y), cs->windowHighlight);
TEST_EQ(wgtCanvasGetPixel(pic, FRT_HBAR_END, FRT_HBAR_Y + buttonEnd), cs->windowShadow);
TEST_EQ(wgtCanvasGetPixel(pic, FRT_HBAR_TROUGH_X, midY), cs->scrollbarTrough);
TEST_EQ(wgtCanvasGetPixel(pic, FRT_HBAR_THUMB_X + SCROLLBAR_WIDTH / 2, midY), cs->scrollbarBg);
TEST_EQ(wgtCanvasGetPixel(pic, leftTip, midY), cs->scrollbarFg);
TEST_EQ(wgtCanvasGetPixel(pic, leftTip - 1, midY), cs->scrollbarBg);
TEST_EQ(wgtCanvasGetPixel(pic, leftTip, midY - 1), cs->scrollbarBg);
TEST_EQ(wgtCanvasGetPixel(pic, rightTip, midY), cs->scrollbarFg);
TEST_EQ(wgtCanvasGetPixel(pic, rightTip + 1, midY), cs->scrollbarBg);
TEST_EQ(wgtCanvasGetPixel(pic, rightTip, midY - 1), cs->scrollbarBg);
TEST_EQ(wgtCanvasGetPixel(pic, FRT_SARROW_X, FRT_SARROW_Y), cs->windowHighlight);
TEST_EQ(wgtCanvasGetPixel(pic, FRT_SARROW_X + buttonEnd, FRT_SARROW_Y + buttonEnd), cs->windowShadow);
TEST_EQ(wgtCanvasGetPixel(pic, FRT_SARROW_X + 1, FRT_SARROW_Y + 1), cs->scrollbarBg);
TEST_EQ(wgtCanvasGetPixel(pic, arrowTipX, arrowMidY), cs->scrollbarFg);
TEST_EQ(wgtCanvasGetPixel(pic, arrowTipX + 1, arrowMidY), cs->scrollbarBg);
TEST_EQ(wgtCanvasGetPixel(pic, arrowTipX, arrowMidY - 1), cs->scrollbarBg);
}
// A modal box (the runtime error box): counted, its title kept, OK.
static void errorDialogCheck(AppContextT *ctx, WindowT *modal, void *userCtx) {
ErrorDlgT *dlg = (ErrorDlgT *)userCtx;
(void)ctx;
dlg->seen++;
snprintf(dlg->title, sizeof(dlg->title), "%s", modal->title);
tDialogClickButton(modal, "OK");
}
static bool expectBuild(FrtAppT *app, const char *bas, const char *const *frms, int32_t frmCount) {
bool ok = frtBuild(app, bas, frms, frmCount);
if (!ok) {
printf(" compile error: %s\n", app->error);
}
TEST_TRUE(ok);
return ok;
}
// Modal driver: type the configured text and accept with OK, or cancel
// the dialog with Esc when no text is configured.
static void fileDialogType(AppContextT *ctx, WindowT *modal, void *userCtx) {
FileDlgCtxT *fd = (FileDlgCtxT *)userCtx;
(void)ctx;
if (fd->busy) {
return;
}
fd->busy = true;
fd->seen++;
if (fd->typeText) {
// The save dialog's name input is the second child of the button
// row above the buttons (after path input, list, filter).
// The save/open dialogs keep their name input as the second
// child of the row above the buttons; plain dialogs have none.
WidgetT *nameInput = childAt(childAt(modal->widgetRoot, 3), 1);
if (nameInput) {
int32_t sx = 0;
int32_t sy = 0;
tWidgetCenter(nameInput, &sx, &sy);
tClick(sx, sy);
}
tType(fd->typeText);
if (!tDialogClickButton(modal, "OK") && !tDialogClickButton(modal, "Save") && !tDialogClickButton(modal, "Open")) {
tKeyEsc();
}
} else {
tKeyEsc();
}
fd->busy = false;
}
// The first widget under root that takes the keyboard focus (a HelpPane
// link), or NULL.
static WidgetT *firstFocusable(WidgetT *root) {
if (!root) {
return NULL;
}
if (root->wclass && (root->wclass->flags & WCLASS_FOCUSABLE)) {
return root;
}
for (WidgetT *c = root->firstChild; c; c = c->nextSibling) {
WidgetT *hit = firstFocusable(c);
if (hit) {
return hit;
}
}
return NULL;
}
static bool frtDynCall(WidgetT *w, int32_t methodIdx, const WgtValueT *args, int32_t argc, WgtValueT *ret) {
static const char kinds[] = { [WGT_IFACE_STRING] = 'S', [WGT_IFACE_INT] = 'I', [WGT_IFACE_BOOL] = 'B', [WGT_IFACE_FLOAT] = 'F', [WGT_IFACE_ENUM] = 'E', [WGT_IFACE_NONE] = 'N', [WGT_IFACE_DOUBLE] = 'D' };
int32_t n = 0;
(void)w;
(void)methodIdx;
for (int32_t i = 0; i < argc && n < FRT_DYN_TEXT - 1; i++) {
sFrtDynArgTypes[n++] = (args[i].type < sizeof(kinds)) ? kinds[args[i].type] : '?';
}
sFrtDynArgTypes[n] = '\0';
*ret = wgtValueInt(argc);
return true;
}
static WidgetT *frtDynCreate(WidgetT *parent, const WgtIfaceT *iface) {
(void)iface;
return widgetAlloc(parent, sFrtDynType);
}
static bool frtDynGet(WidgetT *w, int32_t propIdx, WgtValueT *out) {
(void)w;
*out = (propIdx == 0) ? wgtValueStr(sFrtDynTitle) : wgtValueInt(FRT_DYN_LEVEL);
return true;
}
static bool frtDynSet(WidgetT *w, int32_t propIdx, const WgtValueT *value) {
(void)w;
(void)propIdx;
snprintf(sFrtDynTitle, sizeof(sFrtDynTitle), "%s", value->s);
return true;
}
// BINARY STRING arguments: both lengths, the bytes of the first (zeros
// included) and the length of the text argument between them.
int32_t frtExtBinSum(const uint8_t *d, int32_t len, const char *tag, const uint8_t *d2, int32_t len2) {
int32_t sum = 0;
(void)d2;
for (int32_t i = 0; i < len; i++) {
sum += d[i];
}
return len * FRT_EXT_LEN_WEIGHT + sum + (int32_t)strlen(tag) * FRT_EXT_TAG_WEIGHT + len2 * FRT_EXT_LEN2_WEIGHT;
}
double frtExtDbl(double d, float s) {
return d + (double)s;
}
int32_t frtExtFlag(int32_t a) {
return a != 0 ? -1 : 0;
}
int32_t frtExtInt(int32_t a) {
return a + 1;
}
int32_t frtExtLong(int32_t a, int32_t b) {
return a + b;
}
// Mixed classes: integer-class and floating-point arguments interleaved.
double frtExtMix(const char *s, double d, int32_t n, float f) {
return (double)strlen(s) + d + (double)n + (double)f;
}
// Seven integer arguments: the seventh goes on the host's stack.
int32_t frtExtSeven(int32_t a, int32_t b, int32_t c, int32_t d, int32_t e, int32_t f, int32_t g) {
return a + b + c + d + e + f + g * FRT_SEVENTH_WEIGHT;
}
const char *frtExtStr(const char *s) {
return s;
}
void frtExtSub(int32_t a) {
(void)a;
}
// A BINARY STRING result: every byte XORed with key (zero bytes survive
// both ways); FRT_EXT_BIN_NULL returns NULL, FRT_EXT_BIN_NOLEN leaves the
// length unset.
const uint8_t *frtExtXor(const uint8_t *data, int32_t len, int32_t key, int32_t *outLen) {
static uint8_t buf[FRT_EXT_BIN_MAX];
int32_t n = DVX_MIN(len, FRT_EXT_BIN_MAX);
if (key == FRT_EXT_BIN_NULL) {
*outLen = n;
return NULL;
}
for (int32_t i = 0; i < n; i++) {
buf[i] = (uint8_t)(data[i] ^ key);
}
if (key != FRT_EXT_BIN_NOLEN) {
*outLen = n;
}
return buf;
}
// sProbeMethods target: records its argument and returns a status.
static int32_t frtProbeRetIntStr(WidgetT *w, const char *text) {
(void)w;
snprintf(sProbeArg, sizeof(sProbeArg), "%s", text);
return FRT_PROBE_BIAS + (int32_t)strlen(text);
}
// caseNewArgs' message box: two sets of new arguments arrive while it is
// open (nothing may run yet), then OK.
static void newArgsDuringDialog(AppContextT *ctx, WindowT *modal, void *userCtx) {
NewArgsDlgT *dlg = (NewArgsDlgT *)userCtx;
(void)ctx;
dlg->seen++;
basFormRtNewArgs(dlg->app->rt, "a.hlp first");
basFormRtNewArgs(dlg->app->rt, "b.hlp second");
dlg->firedDuring = strchr(frtOut(dlg->app), '[') != NULL;
tDialogClickButton(modal, "OK");
}
static void outContains(const FrtAppT *app, const char *needle) {
bool found = strstr(frtOut(app), needle) != NULL;
if (!found) {
printf(" PRINT output lacks [%s]; got:\n%s", needle, frtOut(app));
}
TEST_TRUE(found);
}
// Value written to the round-trip form for one interface property.
// Defaults by type; a few properties need a value the widget will keep
// with no items, rows or image data behind it.
static void parseOnCtrlBegin(void *userData, const char *typeName, const char *name) {
ParseRecT *rec = (ParseRecT *)userData;
(void)name;
rec->ctrls++;
snprintf(rec->lastType, sizeof(rec->lastType), "%s", typeName);
}
static void parseOnCtrlEnd(void *userData) {
ParseRecT *rec = (ParseRecT *)userData;
rec->ctrlEnds++;
}
static void parseOnCtrlProp(void *userData, const char *key, const char *value) {
ParseRecT *rec = (ParseRecT *)userData;
rec->ctrlProps++;
snprintf(rec->lastKey, sizeof(rec->lastKey), "%s", key);
snprintf(rec->lastVal, sizeof(rec->lastVal), "%s", value);
}
static bool parseOnFormBegin(void *userData, const char *name) {
ParseRecT *rec = (ParseRecT *)userData;
(void)name;
if (rec->failFormBegin) {
return false;
}
rec->forms++;
return true;
}
static void parseOnFormEnd(void *userData, const char *rest, int32_t restLen) {
ParseRecT *rec = (ParseRecT *)userData;
int32_t n = restLen;
if (n > (int32_t)sizeof(rec->tail) - 1) {
n = (int32_t)sizeof(rec->tail) - 1;
}
memcpy(rec->tail, rest, n);
rec->tail[n] = '\0';
}
static void parseOnFormProp(void *userData, const char *key, const char *value) {
ParseRecT *rec = (ParseRecT *)userData;
(void)key;
(void)value;
rec->formProps++;
}
static void parseOnMenuBegin(void *userData, const char *name, int32_t level) {
ParseRecT *rec = (ParseRecT *)userData;
(void)name;
rec->menus++;
rec->lastMenuLevel = level;
}
static void parseOnMenuEnd(void *userData) {
ParseRecT *rec = (ParseRecT *)userData;
rec->menuEnds++;
}
static void parseOnMenuProp(void *userData, const char *key, const char *value) {
ParseRecT *rec = (ParseRecT *)userData;
(void)key;
(void)value;
rec->menuProps++;
}
static const char *roundTripValue(const char *basName, const WgtPropDescT *p, char *buf, int32_t bufSize) {
(void)basName;
// No row: a Data control without a database has none
if (strcasecmp(p->name, "ListIndex") == 0 || strcasecmp(p->name, "SelectedRow") == 0 || strcasecmp(p->name, "AbsolutePosition") == 0) {
return "-1";
}
// A single page: index 0 is the only active one.
if (strcasecmp(p->name, "TabIndex") == 0 || strcasecmp(p->name, "Decimals") == 0) {
return "0";
}
// Below the minimum pane width the splitter clamps.
if (strcasecmp(p->name, "Position") == 0) {
return "100";
}
// An empty ScrollPane has nothing to scroll: the layout clamps the
// position to 0.
if (strcasecmp(p->name, "ScrollLeft") == 0 || strcasecmp(p->name, "ScrollTop") == 0) {
return "0";
}
// The spinner keeps separate integer and real values, so switching
// RealMode after Value would read back the other one.
if (strcasecmp(p->name, "RealMode") == 0) {
return "False";
}
if (strcasecmp(p->name, "Picture") == 0) {
snprintf(buf, bufSize, "%s/icon.bmp", FRT_FIXTURE_DIR);
return buf;
}
if (strcasecmp(p->name, "Enabled") == 0) {
return "False";
}
// Room for the caption, which a smaller TextBox would cut; a password
// box keeps one character.
if (strcasecmp(p->name, "MaxLength") == 0) {
return "40";
}
if (strcasecmp(p->name, "PasswordChar") == 0) {
return "*";
}
// The selection is run-time state: an empty one at the start, and a
// plain box (a Mask would reshape the caption)
if (strcasecmp(p->name, "SelStart") == 0 || strcasecmp(p->name, "SelLength") == 0) {
return "0";
}
if (strcasecmp(p->name, "SelText") == 0 || strcasecmp(p->name, "Mask") == 0) {
return "";
}
switch (p->type) {
case WGT_IFACE_STRING:
return "Sample";
case WGT_IFACE_INT:
return "3";
case WGT_IFACE_BOOL:
return "True";
case WGT_IFACE_ENUM: {
int32_t last = 0;
while (p->enumNames && p->enumNames[last + 1]) {
last++;
}
return p->enumNames ? p->enumNames[last] : "0";
}
default:
return "1";
}
}
// Set a string property from a C literal, releasing the temporary.
// SerRead's bytes as a C string (these tests send text).
static const char *serReadText(int32_t com) {
static char text[FRT_OUT_MAX];
int32_t len = 0;
const uint8_t *bytes = SerRead(com, &len);
len = DVX_MIN(len, (int32_t)sizeof(text) - 1);
memcpy(text, bytes, (size_t)len);
text[len] = '\0';
return text;
}
static int32_t serWriteText(int32_t com, const char *text) {
return SerWrite(com, (const uint8_t *)text, (int32_t)strlen(text));
}
static void setStrProp(FrtAppT *app, BasControlT *ctrl, const char *propName, const char *text) {
BasValueT v = basValStringFromC(text);
basFormRtSetProp(app->rt, ctrl, propName, v);
basValRelease(&v);
}
static int32_t sSqlRow = -1;
static int32_t sqlFakeAffected(int32_t db) {
(void)db;
return 3;
}
static void sqlFakeClose(int32_t db) {
(void)db;
}
static bool sqlFakeEof(int32_t rs) {
(void)rs;
return sSqlRow >= SQL_FAKE_ROWS;
}
static const char *sqlFakeError(int32_t db) {
(void)db;
return "fake error";
}
static bool sqlFakeExec(int32_t db, const char *sql) {
(void)db;
return sql != NULL;
}
static const char *sqlFakeFieldByName(int32_t rs, const char *name) {
if (strcmp(name, "id") == 0) {
return sqlFakeFieldText(rs, 0);
}
if (strcmp(name, "name") == 0) {
return sqlFakeFieldText(rs, 1);
}
return NULL;
}
static int32_t sqlFakeFieldCount(int32_t rs) {
(void)rs;
return 2;
}
static double sqlFakeFieldDbl(int32_t rs, int32_t col) {
return (double)sqlFakeFieldInt(rs, col) + 0.5;
}
static int32_t sqlFakeFieldInt(int32_t rs, int32_t col) {
(void)rs;
return sSqlRow * 10 + col;
}
static const char *sqlFakeFieldName(int32_t rs, int32_t col) {
(void)rs;
return col == 0 ? "id" : "name";
}
static const char *sqlFakeFieldText(int32_t rs, int32_t col) {
static char buf[16];
(void)rs;
snprintf(buf, sizeof(buf), "r%dc%d", (int32_t)sSqlRow, (int32_t)col);
return buf;
}
static void sqlFakeFree(int32_t rs) {
(void)rs;
}
static bool sqlFakeNext(int32_t rs) {
(void)rs;
sSqlRow++;
return sSqlRow < SQL_FAKE_ROWS;
}
static int32_t sqlFakeOpen(const char *path) {
return path ? SQL_FAKE_DB : 0;
}
static int32_t sqlFakeQuery(int32_t db, const char *sql) {
(void)db;
(void)sql;
sSqlRow = -1;
return SQL_FAKE_RS;
}
// The dialog script of caseCreateFormDynamic: the form shown modal holds
// the input gate; unloading it ends the Show.
static void termBindUnbound(void *ctx) {
(void)ctx;
sBindUnbound++;
}
// The bound stream's writer: keeps what it is sent.
static int32_t termBindWrite(void *ctx, const uint8_t *data, int32_t len) {
(void)ctx;
for (int32_t i = 0; i < len && sBindLen < FRT_BIND_MAX; i++) {
sBindText[sBindLen++] = (char)data[i];
}
return len;
}
static void unloadModalCheck(AppContextT *ctx, WindowT *modal, void *userCtx) {
BasFormT *form = (BasFormT *)userCtx;
sModalChecks++;
TEST_PTR_EQ(modal, form->window);
TEST_PTR_EQ(ctx->modalWindow, form->window);
basFormRtUnloadForm(sModalCheckApp->rt, form);
}
// The dialog script of caseVisibleKeepsModal: with the form shown modal,
// Visible = True keeps it modal; then it is hidden, which ends the Show.
static void visibleKeepsModalCheck(AppContextT *ctx, WindowT *modal, void *userCtx) {
BasFormT *form = (BasFormT *)userCtx;
sModalChecks++;
TEST_PTR_EQ(modal, form->window);
TEST_TRUE(form->window->modal);
basFormRtSetProp(sModalCheckApp->rt, form, "Visible", basValBool(true));
TEST_TRUE(form->window->modal);
TEST_PTR_EQ(ctx->modalWindow, form->window);
basFormRtHideForm(sModalCheckApp->rt, form);
}
// Write text to path (created or truncated).
static bool writeText(const char *path, const char *text) {
FILE *f = fopen(path, "wb");
if (!f) {
return false;
}
size_t len = strlen(text);
bool written = fwrite(text, 1, len, f) == len;
return (fclose(f) == 0) && written;
}
int main(void) {
setvbuf(stdout, NULL, _IOLBF, 0);
tSuiteBegin("formrt");
tProcessInit(DVXTEST_WIDGET_DIR);
caseRoundTrip();
caseBuildProject();
caseAppNotepad();
caseAppNotepadCloseRequest();
caseAppIconEd();
caseAppBasDemo();
caseAppCommandLine();
caseMenus();
caseEvents();
caseToolbarClearFromHandler();
caseRemoveContainerFromHandler();
caseVisibleKeepsModal();
caseLoadForm2();
caseSetEvent();
caseQueryUnloadCancel();
caseValidateCancel();
casePopupMenu();
casePropTables();
caseCommonMethods();
caseFormShowHide();
caseUnloadDeferred();
caseFormVars();
caseFormInstances();
caseWithEvents();
caseControlArrays();
caseMsgBox();
caseNewArgs();
caseObjectRefs();
caseTimers();
caseSerialUnresolved();
caseRuntimeError();
caseMethodSignatures();
caseMethodRetIntStr();
casePropEdges();
caseCreateFormDynamic();
caseDataBinding();
caseDialogWrappers();
caseClipboard();
caseGapClosure();
caseDragDrop();
caseLoadPicture();
caseDrawMethods();
caseDrawFocusRect();
caseSizeUnits();
caseScrollPaneChange();
caseDrawPaint();
caseDrawScale();
caseEventLoopExits();
caseExternCalls();
caseExternMarshal();
caseExternLive();
caseFrameMissed();
caseProgramScreen();
caseProgramScreenModes();
caseRefValidation();
caseFrmLoadEdges();
caseFrmParserUnit();
caseHelpHooks();
caseHelpPane();
caseHelpTopic();
casePendingUnloadDrain();
casePictureLoadSave();
caseResources();
caseRunSimple();
caseSerialLoopback();
frtLibBasCases();
frtFrmModelCases();
caseSqlWrappers();
caseBoxLayoutProps();
caseDefaultCancelButtons();
caseHandlerContext();
caseHandlerError();
caseListTreeMethods();
caseDesignerLive();
caseDesignerRegistry();
caseEditorMembers();
caseParDsgnFixture();
caseMenuShortcuts();
caseMenuCaption();
caseModalShow();
caseScreenObject();
caseScreenMembers();
caseFormWindowMembers();
caseMenuBarRuntime();
caseDrawThemed();
caseControlMembers2();
caseWindowState();
caseMenuRuntime();
caseProgramIcon();
caseTermBind();
caseTextBoxProps();
caseWidgetParity();
caseTwoRuntimes();
caseResetCycles();
caseCustomEvents();
caseDynamicControl();
frtUserCtlCases();
frtUcDesignCases();
return tSuiteEnd();
}
Reference in a new issue View git blame Copy permalink