// 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 #include #include #include #include #include #include #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 " 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(); }