# This file is a Tcl script to test menus in Tk. It is
# organized in the standard fashion for Tcl tests. This
# file tests the Macintosh-specific features of the menu
# system.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
namespace import ::tcltest::*
eval tcltest::configure $argv
tcltest::loadTestedCommands
test unixMenu-1.1 {TkpNewMenu - normal menu} -constraints unix -setup {
destroy .m1
} -body {
list [menu .m1] [destroy .m1]
} -returnCodes ok -result {.m1 {}}
test unixMenu-1.2 {TkpNewMenu - help menu} -constraints unix -setup {
destroy .m1
} -body {
menu .m1 -tearoff 0
. configure -menu .m1
.m1 add cascade -label Help -menu .m1.help
list [menu .m1.help] [. configure -menu ""] [destroy .m1]
} -returnCodes ok -result {.m1.help {} {}}
test unixMenu-2.1 {TkpDestroyMenu - nothing to do} -constraints unix -body {}
test unixMenu-3.1 {TkpDestroymenuEntry - nothing to do} -constraints unix -body {}
test unixMenu-4.1 {TkpConfigureMenuEntry - non-cascade entry} -constraints {
unix
} -setup {
destroy .m1
} -body {
menu .m1 -tearoff 0
.m1 add command -label test
list [.m1 entryconfigure test -label foo] [destroy .m1]
} -returnCodes ok -result {{} {}}
test unixMenu-4.2 {TkpConfigureMenuEntry - cascade entry} -constraints {
unix
} -setup {
destroy .m1
} -body {
menu .m1 -tearoff 0
.m1 add cascade -menu .m2 -label test
menu .m1.foo -tearoff 0
list [.m1 entryconfigure test -menu .m1.foo] [destroy .m1]
} -returnCodes ok -result {{} {}}
test unixMenu-5.1 {TkpMenuNewEntry - nothing to do} -constraints unix -body {}
test unixMenu-6.1 {TkpSetWindowMenuBar - null menu} -constraints unix -setup {
destroy .m1
} -body {
menu .m1
.m1 add cascade -label foo
. configure -menu .m1
list [. configure -menu ""] [destroy .m1]
} -returnCodes ok -result {{} {}}
test unixMenu-6.2 {TkpSetWindowMenuBar - menu} -constraints unix -setup {
destroy .m1
} -body {
menu .m1
.m1 add cascade -label foo
list [. configure -menu .m1] [. configure -menu ""] [destroy .m1]
} -returnCodes ok -result {{} {} {}}
test unixMenu-7.1 {TkpSetMainMenubar - nothing to do} -constraints unix -body {}
test unixMenu-8.1 {GetMenuIndicatorGeometry - indicator off} -constraints {
unix
} -setup {
destroy .m1
} -body {
menu .m1
.m1 add checkbutton -label foo -indicatoron 0
tk::TearOffMenu .m1 40 40
destroy .m1
} -returnCodes ok
test unixMenu-8.2 {GetMenuIndicatorGeometry - not checkbutton or radio} -constraints {
unix
} -setup {
destroy .m1
} -body {
menu .m1
.m1 add command -label foo
tk::TearOffMenu .m1 40 40
destroy .m1
} -returnCodes ok
test unixMenu-8.3 {GetMenuIndicatorGeometry - checkbutton image} -constraints {
unix testImageType
} -setup {
destroy .m1
catch {image delete image1}
} -body {
menu .m1
image create test image1
.m1 add checkbutton -image image1 -label foo
.m1 invoke foo
tk::TearOffMenu .m1 40 40
destroy .m1
} -cleanup {
image delete image1
} -returnCodes ok
test unixMenu-8.4 {GetMenuIndicatorGeometry - checkbutton bitmap} -constraints {
unix
} -setup {
destroy .m1
} -body {
menu .m1
.m1 add checkbutton -bitmap questhead -label foo
.m1 invoke foo
tk::TearOffMenu .m1 40 40
destroy .m1
} -returnCodes ok
test unixMenu-8.5 {GetMenuIndicatorGeometry - checkbutton} -constraints {
unix
} -setup {
destroy .m1
} -body {
menu .m1
.m1 add checkbutton -label foo
.m1 invoke foo
tk::TearOffMenu .m1 40 40
destroy .m1
} -returnCodes ok
test unixMenu-8.6 {GetMenuIndicatorGeometry - radiobutton image} -constraints {
unix testImageType
} -setup {
destroy .m1
catch {image delete image1}
} -body {
menu .m1
image create test image1
.m1 add radiobutton -image image1 -label foo
.m1 invoke foo
tk::TearOffMenu .m1 40 40
destroy .m1
image delete image1
} -returnCodes ok
test unixMenu-8.7 {GetMenuIndicatorGeometry - radiobutton bitmap} -constraints {
unix
} -setup {
destroy .m1
} -body {
menu .m1
.m1 add radiobutton -bitmap questhead -label foo
.m1 invoke foo
tk::TearOffMenu .m1 40 40
destroy .m1
} -returnCodes ok
test unixMenu-8.8 {GetMenuIndicatorGeometry - radiobutton} -constraints {
unix
} -setup {
destroy .m1
} -body {
menu .m1
.m1 add radiobutton -label foo
.m1 invoke foo
tk::TearOffMenu .m1 40 40
destroy .m1
} -returnCodes ok
test unixMenu-8.9 {GetMenuIndicatorGeometry - hideMargin} -constraints {
unix
} -setup {
destroy .m1
} -body {
menu .m1
.m1 add radiobutton -label foo -hidemargin 1
.m1 invoke foo
tk::TearOffMenu .m1 40 40
destroy .m1
} -returnCodes ok
test unixMenu-9.1 {GetMenuAccelGeometry - cascade entry} -constraints {
unix
} -setup {
destroy .m1
} -body {
menu .m1
.m1 add cascade -label foo
tk::TearOffMenu .m1 40 40
destroy .m1
} -returnCodes ok
test unixMenu-9.2 {GetMenuAccelGeometry - non-null label} -constraints {
unix
} -setup {
destroy .m1
} -body {
menu .m1
.m1 add command -label foo -accel "Ctrl+S"
tk::TearOffMenu .m1 40 40
destroy .m1
} -returnCodes ok
test unixMenu-9.3 {GetMenuAccelGeometry - null label} -constraints unix -setup {
destroy .m1
} -body {
menu .m1
.m1 add command -label foo
tk::TearOffMenu .m1 40 40
destroy .m1
} -returnCodes ok
test unixMenu-10.1 {DrawMenuEntryBackground - active menubar} -constraints {
unix
} -setup {
destroy .m1
} -body {
menu .m1
.m1 add cascade -label foo
. configure -menu .m1
.m1 activate 1
list [update] [. configure -menu ""] [destroy .m1]
} -returnCodes ok -result {{} {} {}}
test unixMenu-10.2 {DrawMenuEntryBackground - active} -constraints unix -setup {
destroy .m1
} -body {
menu .m1
.m1 add command -label foo
set tearoff [tk::TearOffMenu .m1 40 40]
$tearoff activate 0
list [update] [destroy .m1]
} -returnCodes ok -result {{} {}}
test unixMenu-10.3 {DrawMenuEntryBackground - non-active} -constraints {
unix
} -setup {
destroy .m1
} -body {
menu .m1
.m1 add command -label foo
set tearoff [tk::TearOffMenu .m1 40 40]
list [update] [destroy .m1]
} -returnCodes ok -result {{} {}}
test unixMenu-11.1 {DrawMenuEntryAccelerator - menubar} -constraints {
unix
} -setup {
destroy .m1
} -body {
menu .m1
.m1 add command -label foo -accel "Ctrl+U"
. configure -menu .m1
list [update] [. configure -menu ""] [destroy .m1]
} -result {{} {} {}}
# drawArrow parameter is never false under Unix
test unixMenu-11.2 {DrawMenuEntryAccelerator - cascade entry} -constraints {
unix
} -setup {
destroy .m1
} -body {
menu .m1
.m1 add cascade -label foo
set tearoff [tk::TearOffMenu .m1 40 40]
list [update] [destroy .m1]
} -result {{} {}}
test unixMenu-11.3 {DrawMenuEntryAccelerator - normal entry} -constraints {
unix
} -setup {
destroy .m1
} -body {
menu .m1
.m1 add command -label foo -accel "Ctrl+U"
set tearoff [tk::TearOffMenu .m1 40 40]
list [update] [destroy .m1]
} -result {{} {}}
test unixMenu-11.4 {DrawMenuEntryAccelerator - null entry} -constraints {
unix
} -setup {
destroy .m1
} -body {
menu .m1
.m1 add command -label foo
set tearoff [tk::TearOffMenu .m1 40 40]
list [update] [destroy .m1]
} -result {{} {}}
test unixMenu-12.1 {DrawMenuEntryIndicator - non-check or radio} -constraints {
unix
} -setup {
destroy .m1
} -body {
menu .m1
.m1 add command -label foo
set tearoff [tk::TearOffMenu .m1 40 40]
list [update] [destroy .m1]
} -result {{} {}}
test unixMenu-12.2 {DrawMenuEntryIndicator - checkbutton - indicator off} -constraints {
unix
} -setup {
destroy .m1
} -body {
menu .m1
.m1 add checkbutton -label foo -indicatoron 0
set tearoff [tk::TearOffMenu .m1 40 40]
list [update] [destroy .m1]
} -result {{} {}}
test unixMenu-12.3 {DrawMenuEntryIndicator - checkbutton - not selected} -constraints {
unix
} -setup {
destroy .m1
} -body {
menu .m1
.m1 add checkbutton -label foo
set tearoff [tk::TearOffMenu .m1 40 40]
list [update] [destroy .m1]
} -result {{} {}}
test unixMenu-12.4 {DrawMenuEntryIndicator - checkbutton - selected} -constraints {
unix
} -setup {
destroy .m1
} -body {
menu .m1
.m1 add checkbutton -label foo
.m1 invoke 1
set tearoff [tk::TearOffMenu .m1 40 40]
list [update] [destroy .m1]
} -result {{} {}}
test unixMenu-12.5 {DrawMenuEntryIndicator - radiobutton - indicator off} -constraints {
unix
} -setup {
destroy .m1
} -body {
menu .m1
.m1 add radiobutton -label foo -indicatoron 0
set tearoff [tk::TearOffMenu .m1 40 40]
list [update] [destroy .m1]
} -result {{} {}}
test unixMenu-12.6 {DrawMenuEntryIndicator - radiobutton - not selected} -constraints {
unix
} -setup {
destroy .m1
} -body {
menu .m1
.m1 add radiobutton -label foo
set tearoff [tk::TearOffMenu .m1 40 40]
list [update] [destroy .m1]
} -result {{} {}}
test unixMenu-12.7 {DrawMenuEntryIndicator - radiobutton - selected} -constraints {
unix
} -setup {
destroy .m1
} -body {
menu .m1
.m1 add radiobutton -label foo
.m1 invoke 1
set tearoff [tk::TearOffMenu .m1 40 40]
list [update] [destroy .m1]
} -result {{} {}}
test unixMenu-13.1 {DrawMenuSeparator - menubar case} -constraints unix -setup {
destroy .m1
} -body {
menu .m1
.m1 add separator
. configure -menu .m1
list [update] [. configure -menu ""] [destroy .m1]
} -result {{} {} {}}
test unixMenu-13.2 {DrawMenuSepartor - normal menu} -constraints unix -setup {
destroy .m1
} -body {
menu .m1
.m1 add separator
set tearoff [tk::TearOffMenu .m1 40 40]
list [update] [destroy .m1]
} -result {{} {}}
test unixMenu-14.1 {DrawMenuEntryLabel} -constraints unix -setup {
destroy .m1
} -body {
menu .m1
.m1 add command -label foo
set tearoff [tk::TearOffMenu .m1 40 40]
list [update] [destroy .m1]
} -result {{} {}}
test unixMenu-15.1 {DrawMenuUnderline - menubar} -constraints unix -setup {
destroy .m1
} -body {
menu .m1
.m1 add command -label foo -underline 0
. configure -menu .m1
list [update] [. configure -menu ""] [destroy .m1]
} -result {{} {} {}}
test unixMenu-15.2 {DrawMenuUnderline - no menubar} -constraints unix -setup {
destroy .m1
} -body {
menu .m1
.m1 add command -label foo -underline 0
set tearoff [tk::TearOffMenu .m1 40 40]
list [update] [destroy .m1]
} -result {{} {}}
test unixMenu-16.1 {TkpPostMenu} -constraints unix -setup {
destroy .m1
} -body {
menu .m1
.m1 add command -label foo
tk::TearOffMenu .m1 40 40
destroy .m1
} -returnCodes ok
test unixMenu-17.1 {GetMenuSeparatorGeometry} -constraints unix -setup {
destroy .m1
} -body {
menu .m1
.m1 add separator
tk::TearOffMenu .m1 40 40
destroy .m1
} -returnCodes ok
test unixMenu-18.1 {GetTearoffEntryGeometry} -constraints {
unix nonUnixUserInteraction
} -setup {
destroy .mb
} -body {
menubutton .mb -text "test" -menu .mb.m
menu .mb.m
.mb.m add command -label test
pack .mb
raise .
list [tk::MbPost .mb] [tk::MenuUnpost .mb.m] [destroy .mb]
} -result {{} {} {}}
# Don't know how to reproduce the case where the tkwin has been deleted.
test unixMenu-19.1 {TkpComputeMenubarGeometry - zero entries} -constraints {
unix
} -setup {
destroy .m1
} -body {
menu .m1
. configure -menu .m1
list [update] [. configure -menu ""] [destroy .m1]
} -result {{} {} {}}
# Don't know how to generate one width windows
test unixMenu-19.2 {TkpComputeMenubarGeometry - one entry} -constraints {
unix
} -setup {
destroy .m1
} -body {
menu .m1
.m1 add cascade -label File
. configure -menu .m1
list [update] [. configure -menu ""] [destroy .m1]
} -result {{} {} {}}
test unixMenu-19.3 {TkpComputeMenubarGeometry - entry with different font} -constraints {
unix
} -setup {
destroy .m1
} -body {
menu .m1 -font "Courier 24"
.m1 add cascade -label File -font "Helvetica 18"
. configure -menu .m1
list [update] [. configure -menu ""] [destroy .m1]
} -result {{} {} {}}
test unixMenu-19.4 {TkpComputeMenubarGeometry - separator} -constraints {
unix
} -setup {
destroy .m1
} -body {
menu .m1
.m1 add separator
. configure -menu .m1
list [update] [. configure -menu ""] [destroy .m1]
} -result {{} {} {}}
test unixMenu-19.5 {TkpComputeMenubarGeometry - First entry} -constraints {
unix
} -setup {
destroy .m1
} -body {
menu .m1 -tearoff 0
.m1 add cascade -label File
. configure -menu .m1
list [update] [. configure -menu ""] [destroy .m1]
} -result {{} {} {}}
test unixMenu-19.6 {TkpComputeMenubarGeometry - First entry too wide} -constraints {
unix
} -setup {
destroy .m1
} -body {
menu .m1 -tearoff 0
.m1 add cascade -label File -font "Times 72"
. configure -menu .m1
wm geometry . 10x10
list [update] [. configure -menu ""] [destroy .m1]
} -result {{} {} {}}
test unixMenu-19.7 {TkpComputeMenubarGeometry - two entries fit} -constraints {
unix
} -setup {
destroy .m1
} -body {
menu .m1 -tearoff 0
.m1 add cascade -label File
.m1 add cascade -label Edit
. configure -menu .m1
wm geometry . 200x200
list [update] [. configure -menu ""] [destroy .m1]
} -result {{} {} {}}
test unixMenu-19.8 {TkpComputeMenubarGeometry - two entries; 2nd don't fit} -constraints {
unix
} -setup {
destroy .m1
} -body {
menu .m1 -tearoff 0
.m1 add cascade -label File
.m1 add cascade -label Edit -font "Times 72"
. configure -menu .m1
wm geometry . 100x100
list [update] [. configure -menu ""] [destroy .m1]
} -result {{} {} {}}
test unixMenu-19.9 {TkpComputeMenubarGeometry - two entries; 1st dont fit} -constraints {
unix
} -setup {
destroy .m1
} -body {
menu .m1 -tearoff 0
.m1 add cascade -label File -font "Times 72"
.m1 add cascade -label Edit
. configure -menu .m1
wm geometry . 100x100
list [update] [. configure -menu ""] [destroy .m1]
} -result {{} {} {}}
test unixMenu-19.10 {TkpComputeMenubarGeometry - two entries; neither fit} -constraints {
unix
} -setup {
destroy .m1
} -body {
menu .m1 -tearoff 0 -font "Times 72"
.m1 add cascade -label File
.m1 add cascade -label Edit
. configure -menu .m1
wm geometry . 10x10
list [update] [. configure -men
* Purpose: Private non-prototype header.
*
* Modifications:
*
*-------------------------------------------------------------------------
*/
#ifndef _H5FLprivate_H
#define _H5FLprivate_H
/* Public headers needed by this file */
#ifdef LATER
#include "H5FLpublic.h" /*API prototypes */
#endif /* LATER */
/* Private headers needed by this file */
/*
* Private datatypes.
*/
/* Data structure to store each block in free list */
typedef struct H5FL_reg_node_t {
struct H5FL_reg_node_t *next; /* Pointer to next block in free list */
} H5FL_reg_node_t;
/* Data structure for free list of blocks */
typedef struct H5FL_reg_head_t {
unsigned init; /* Whether the free list has been initialized */
unsigned allocated; /* Number of blocks allocated */
unsigned onlist; /* Number of blocks on free list */
size_t list_mem; /* Amount of memory on free list */
const char *name; /* Name of the type */
size_t size; /* Size of the blocks in the list */
H5FL_reg_node_t *list; /* List of free blocks */
} H5FL_reg_head_t;
/*
* Macros for defining & using free lists for a type
*/
/* Declare a free list to manage objects of type 't' */
#define H5FL_DEFINE(t) H5FL_reg_head_t t##_free_list={0,0,0,0,#t,sizeof(t),NULL}
/* Reference a free list for type 't' defined in another file */
#define H5FL_EXTERN(t) extern H5FL_reg_head_t t##_free_list
/* Declare a static free list to manage objects of type 't' */
#define H5FL_DEFINE_STATIC(t) static H5FL_DEFINE(t)
/* Allocate an object of type 't' */
#define H5FL_ALLOC(t,clr) H5FL_reg_alloc(&(t##_free_list),clr)
/* Free an object of type 't' */
#define H5FL_FREE(t,obj) H5FL_reg_free(&(t##_free_list),obj)
/* Re-allocating an object of type 't' is not defined, because these free-lists
* only support fixed sized types, like structs, etc..
*/
/* Data structure to store information about each block allocated */
typedef union H5FL_blk_list_t {
size_t size; /* Size of the page */
union H5FL_blk_list_t *next; /* Pointer to next block in free list */
double unused1; /* Unused normally, just here for aligment */
haddr_t unused2; /* Unused normally, just here for aligment */
} H5FL_blk_list_t;
/* Data structure for priority queue node of block free lists */
typedef struct H5FL_blk_node_t {
size_t size; /* Size of the blocks in the list */
H5FL_blk_list_t *list; /* List of free blocks */
struct H5FL_blk_node_t *next; /* Pointer to next free list in queue */
struct H5FL_blk_node_t *prev; /* Pointer to previous free list in queue */
} H5FL_blk_node_t;
/* Data structure for priority queue of native block free lists */
typedef struct H5FL_blk_head_t {
unsigned init; /* Whether the free list has been initialized */
unsigned allocated; /* Number of blocks allocated */
unsigned onlist; /* Number of blocks on free list */
size_t list_mem; /* Amount of memory in block on free list */
const char *name; /* Name of the type */
H5FL_blk_node_t *head; /* Pointer to first free list in queue */
} H5FL_blk_head_t;
/*
* Macros for defining & using priority queues
*/
/* Declare a free list to manage objects of type 't' */
#define H5FL_BLK_DEFINE(t) H5FL_blk_head_t t##_pq={0,0,0,0,#t,NULL}
/* Reference a free list for type 't' defined in another file */
#define H5FL_BLK_EXTERN(t) extern H5FL_blk_head_t t##_pq
/* Declare a static free list to manage objects of type 't' */
#define H5FL_BLK_DEFINE_STATIC(t) static H5FL_BLK_DEFINE(t)
/* Allocate an block of type 't' */
#define H5FL_BLK_ALLOC(t,size,clr) H5FL_blk_alloc(&(t##_pq),size,clr)
/* Free a block of type 't' */
#define H5FL_BLK_FREE(t,blk) H5FL_blk_free(&(t##_pq),blk)
/* Re-allocate a block of type 't' */
#define H5FL_BLK_REALLOC(t,blk,new_size) H5FL_blk_realloc(&(t##_pq),blk,new_size)
/* Data structure to store each array in free list */
typedef union H5FL_arr_node_t {
union H5FL_arr_node_t *next; /* Pointer to next block in free list */
size_t nelem; /* Number of elements in this array */
double unused1; /* Unused normally, just here for aligment */
haddr_t unused2; /* Unused normally, just here for aligment */
} H5FL_arr_node_t;
/* Data structure for free list of array blocks */
typedef struct H5FL_arr_head_t {
unsigned init; /* Whether the free list has been initialized */
unsigned allocated; /* Number of blocks allocated */
unsigned *onlist; /* Number of blocks on free list */
size_t list_mem; /* Amount of memory in block on free list */
const char *name; /* Name of the type */
int maxelem; /* Maximum number of elements in an array */
size_t size; /* Size of the array elements in the list */
union {
H5FL_arr_node_t **list_arr; /* Array of lists of free blocks */
H5FL_blk_head_t queue; /* Priority queue of array blocks */
}u;
} H5FL_arr_head_t;
/*
* Macros for defining & using free lists for an array of a type
*/
/* Declare a free list to manage arrays of type 't' */
#define H5FL_ARR_DEFINE(t,m) H5FL_arr_head_t t##_arr_free_list={0,0,NULL,0,#t"_arr",m+1,sizeof(t),{NULL}}
/* Reference a free list for arrays of type 't' defined in another file */
#define H5FL_ARR_EXTERN(t) extern H5FL_arr_head_t t##_arr_free_list
/* Declare a static free list to manage arrays of type 't' */
#define H5FL_ARR_DEFINE_STATIC(t,m) static H5FL_ARR_DEFINE(t,m)
/* Allocate an array of type 't' */
#define H5FL_ARR_ALLOC(t,elem,clr) H5FL_arr_alloc(&(t##_arr_free_list),elem,clr)
/* Free an array of type 't' */
#define H5FL_ARR_FREE(t,obj) H5FL_arr_free(&(t##_arr_free_list),obj)
/* Re-allocate an array of type 't' */
#define H5FL_ARR_REALLOC(t,obj,new_elem) H5FL_arr_realloc(&(t##_arr_free_list),obj,new_elem)
/*
* Library prototypes.
*/
__DLL__ void * H5FL_blk_alloc(H5FL_blk_head_t *head, size_t size, unsigned clear);
__DLL__ void * H5FL_blk_free(H5FL_blk_head_t *head, void *block);
__DLL__ void * H5FL_blk_realloc(H5FL_blk_head_t *head, void *block, size_t new_size);
__DLL__ void * H5FL_reg_alloc(H5FL_reg_head_t *head, unsigned clear);
__DLL__ void * H5FL_reg_free(H5FL_reg_head_t *head, void *obj);
__DLL__ void * H5FL_arr_alloc(H5FL_arr_head_t *head, size_t elem, unsigned clear);
__DLL__ void * H5FL_arr_free(H5FL_arr_head_t *head, void *obj);
__DLL__ void * H5FL_arr_realloc(H5FL_arr_head_t *head, void *obj, size_t new_elem);
__DLL__ herr_t H5FL_garbage_coll(void);
__DLL__ herr_t H5FL_set_free_list_limits(int reg_global_lim, int reg_list_lim,
int arr_global_lim, int arr_list_lim, int blk_global_lim, int blk_list_lim);
__DLL__ int H5FL_term_interface(void);
#endif