MrDebug.ch
MrDebug header file
──────────────────────────────────────────────────────────────────────────────

/*
┌─────────────┬────────────────────────────────────────────────────────────┐
│ File Name│MrDebug.ch │
│ Description│A few useful things to aid debugging │
│ Date created│26-09-94 Date updated: 06-10-94 │
│ Time created│12:12:18pm Time updated: 10:29:24am │
│ Copyright│1994 by Dark Black Software Ltd. │
└─────────────┴────────────────────────────────────────────────────────────┛
*/

#ifndef __MRDEBUG_CH
#define __MRDEBUG_CH


/*
┌──────────────────────────────────┐
│ MrDebug Assertion Trace Facility │
├──────────────────────────────────┴────────────────────────────────────┐
│ If you want MrDebug's Assertion Trace facility to work, then just │
│ define the MRDEBUG constant when you compile 'clipper <x> /dMRDEBUG', │
│ and the trace commands (below) will show you when your assertions are │
│ failing. │
└───────────────────────────────────────────────────────────────────────┛
*/

#ifdef MRDEBUG

// Send custom message if condition is not met
#command TRACE <exp> MESSAGE <list,...> ;
=> IF !(<exp>) ;
; MrdTrace ("Trace:", <list>) ;
; ENDIF

// Send trace message if condition is not met
#command TRACE <exp> ;
=> IF !(<exp>) ;
; MrdTrace ("Trace:", <"exp">) ;
; ENDIF

// Send implicit trace message
#command TRACE [MESSAGE <list,...>] ;
=> MrdTrace ("Trace:", [<list>])

// Send custom message and stop program if condition is not met
#command ASSERT <exp> MESSAGE <list,...> ;
=> IF !(<exp>) ;
; MrdAssert ("Assert:", <list>) ;
; ENDIF

// Send assert message and stop program if condition is not met
#command ASSERT <exp> ;
=> IF !(<exp>) ;
; MrdAssert ("Assert:", <"exp">) ;
; ENDIF

// Send implicit assert message and stop program
#command ASSERT [MESSAGE <list,...>] ;
=> MrdAssert ("Assert:", [<list>])

// Check type of variables
#command ASSERT <var1> AS <type1:STRING,CHARACTER,NUMERIC,FLOAT,INTEGER,;
; INT,LOGICAL,DATE,BLOCK,CODEBLOCK,ARRAY,OBJECT,USUAL,ANY> ;
; [, <varN> AS <typeN:STRING,CHARACTER,NUMERIC,FLOAT,INTEGER,INT,;
; LOGICAL,DATE,BLOCK,CODEBLOCK,ARRAY,OBJECT,USUAL,ANY>] ;
=> MrdVarCheck(.F., {<var1>[, <varN>]}, ;
; {Upper(<"type1">)[, Upper(<"typeN">)]},, {<"var1">[, <"varN">]})

// Function parameter checking
#command FUNCTION <func>(<var1> <ref1:AS,ASREF> <type1:STRING,CHARACTER,;
; NUMERIC,FLOAT,INTEGER,INT,LOGICAL,DATE,BLOCK,CODEBLOCK,ARRAY, ;
; OBJECT,USUAL,ANY> [, <varN> <refN:AS,ASREF> ;
; <typeN:STRING,CHARACTER,NUMERIC,FLOAT,INTEGER,INT,LOGICAL,DATE,;
; BLOCK,CODEBLOCK,ARRAY,OBJECT,USUAL,ANY> ] ) ;
; [AS <typeX:STRING,CHARACTER,NUMERIC,FLOAT,INTEGER,INT,LOGICAL, ;
; DATE,BLOCK,CODEBLOCK,ARRAY,OBJECT,USUAL,ANY>] ;
; [ <idConvention:CLIPPER, STRICT, PASCAL, CALLBACK> ] ;
=> FUNCTION <func>(<var1>[, <varN>]) ;
; LOCAL xMrDebug := MrdVarCheck(.T., {<var1>[, <varN>]}, ;
; {Upper(<"type1">)[, Upper(<"typeN">)]}, ;
; {(Upper(<"ref1">) == "ASREF")[, (Upper(<"refN">) == "ASREF")]})

// Function parameter checking
#command STATIC <type:FUNCTION,PROCEDURE> <func>(<var1> <ref1:AS,ASREF> ;
; <type1:STRING,CHARACTER,NUMERIC,FLOAT,INTEGER,INT,LOGICAL,DATE,;
; BLOCK,CODEBLOCK,ARRAY,OBJECT,USUAL,ANY> ;
; [, <varN> <refN:AS,ASREF> <typeN:STRING,CHARACTER,NUMERIC, ;
; FLOAT,INTEGER,INT,LOGICAL,DATE,BLOCK,CODEBLOCK,ARRAY,OBJECT, ;
; USUAL,ANY> ] ) [AS <typeX:STRING,CHARACTER,NUMERIC,FLOAT, ;
; INTEGER,INT,LOGICAL,DATE,BLOCK,CODEBLOCK,ARRAY,OBJECT,USUAL, ;
; ANY>] [ <idConvention:CLIPPER, STRICT, PASCAL, CALLBACK> ] ;
=> STATIC <type> <func>(<var1>[, <varN>]) ;
; LOCAL xMrDebug := MrdVarCheck(.T., {<var1>[, <varN>]}, ;
; {Upper(<"type1">)[, Upper(<"typeN">)]}, ;
; {(Upper(<"ref1">) == "ASREF")[, (Upper(<"refN">) == "ASREF")]})

// Function parameter checking
#command PROCEDURE <func>(<var1> <ref1:AS,ASREF> <type1:STRING, ;
; CHARACTER,NUMERIC,FLOAT,INTEGER,INT,LOGICAL,DATE,BLOCK, ;
; CODEBLOCK,ARRAY,OBJECT,USUAL,ANY> [, <varN> <refN:AS,ASREF> ;
; <typeN:STRING,CHARACTER,NUMERIC,FLOAT,INTEGER,INT,LOGICAL,DATE,;
; BLOCK,CODEBLOCK,ARRAY,OBJECT,USUAL,ANY> ] ) [AS <typeX:STRING, ;
; CHARACTER,NUMERIC,FLOAT,INTEGER,INT,LOGICAL,DATE,BLOCK, ;
; CODEBLOCK,ARRAY,OBJECT,USUAL,ANY>] [ <idConvention:CLIPPER, ;
; STRICT, PASCAL, CALLBACK> ] ;
=> PROCEDURE <func>(<var1>[, <varN>]) ;
; LOCAL xMrDebug := MrdVarCheck(.T., {<var1>[, <varN>]}, ;
; {Upper(<"type1">)[, Upper(<"typeN">)]}, ;
; {(Upper(<"ref1">) == "ASREF")[, (Upper(<"refN">) == "ASREF")]})

#command METHOD FUNCTION <func>(<var1> <ref1:AS,ASREF> <type1:STRING, ;
; CHARACTER,NUMERIC,FLOAT,INTEGER,INT,LOGICAL,DATE,BLOCK, ;
; CODEBLOCK,ARRAY,OBJECT,USUAL,ANY> [, <varN> <refN:AS,ASREF> ;
; <typeN:STRING,CHARACTER,NUMERIC,FLOAT,INTEGER,INT,LOGICAL,DATE,;
; BLOCK,CODEBLOCK,ARRAY,OBJECT,USUAL,ANY> ] ) [AS <typeX:STRING, ;
; CHARACTER,NUMERIC,FLOAT,INTEGER,INT,LOGICAL,DATE,BLOCK, ;
; CODEBLOCK,ARRAY,OBJECT,USUAL,ANY>] [ <idConvention:CLIPPER, ;
; STRICT, PASCAL, CALLBACK> ] ;
=> METHOD FUNCTION <func>(<var1>[, <varN>]) ;
; LOCAL xMrDebug := MrdVarCheck(.T., {<var1>[, <varN>]}, ;
; {Upper(<"type1">)[, Upper(<"typeN">)]}, ;
; {(Upper(<"ref1">) == "ASREF") [, (Upper(<"refN">) == "ASREF")]})

#command METHOD PROCEDURE <func>(<var1> <ref1:AS,ASREF> <type1:STRING, ;
; CHARACTER,NUMERIC,FLOAT,INTEGER,INT,LOGICAL,DATE,BLOCK, ;
; CODEBLOCK,ARRAY,OBJECT,USUAL,ANY> [, <varN> <refN:AS,ASREF> ;
; <typeN:STRING,CHARACTER,NUMERIC,FLOAT,INTEGER,INT,LOGICAL,DATE,;
; BLOCK,CODEBLOCK,ARRAY,OBJECT,USUAL,ANY> ] ) [AS <typeX:STRING, ;
; CHARACTER,NUMERIC,FLOAT,INTEGER,INT,LOGICAL,DATE,BLOCK, ;
; CODEBLOCK,ARRAY,OBJECT,USUAL,ANY>] [ <idConvention:CLIPPER, ;
; STRICT, PASCAL, CALLBACK> ] ;
=> METHOD FUNCTION <func>(<var1>[, <varN>]) ;
; LOCAL xMrDebug := MrdVarCheck(.T., {<var1>[, <varN>]}, ;
; {Upper(<"type1">)[, Upper(<"typeN">)]}, ;
; {(Upper(<"ref1">) == "ASREF") [, (Upper(<"refN">) == "ASREF")]})

// Private parameter checking
#command PARAMETERS <var1> <ref1:AS,ASREF> <type1:STRING,CHARACTER, ;
; NUMERIC,FLOAT,INTEGER,INT,LOGICAL,DATE,BLOCK,CODEBLOCK,ARRAY, ;
; OBJECT,USUAL,ANY> [, <varN> <refN:AS,ASREF> <typeN:STRING, ;
; CHARACTER,NUMERIC,FLOAT,INTEGER,INT,LOGICAL,DATE,BLOCK, ;
; CODEBLOCK,ARRAY,OBJECT,USUAL,ANY> ] ;
=> PARAMETERS <var1>[, <varN>] ;
; LOCAL xMrDebug := MrdVarCheck(.T., {m-><var1>[, m-><varN>]}, ;
; {Upper(<"type1">)[, Upper(<"typeN">)]}, ;
; {(Upper(<"ref1">) == "ASREF")[, (Upper(<"refN">) == "ASREF")]},;
; , .T.)

#command RETURN <x> AS <type:STRING,CHARACTER,NUMERIC,FLOAT,INTEGER,INT,;
; LOGICAL,DATE,BLOCK,CODEBLOCK,ARRAY,OBJECT,USUAL,ANY> ;
=> MrdVarCheck (, {<x>}, {Upper(<"type">)}, {.F.}) ;
; RETURN (<x>)

#else

#command TRACE [<exp>] [MESSAGE <list,...>] =>
#command ASSERT [<exp>] [MESSAGE <list,...>] =>

#command FUNCTION <func>(<var1> <ref1:AS,ASREF> <type1> [, <varN> ;
; <refN:AS,ASREF> <typeN> ] ) [AS <typeX>] ;
; [ <idConvention:CLIPPER, STRICT, PASCAL, CALLBACK> ] ;
=> FUNCTION <func>(<var1>[, <varN>])

#command PROCEDURE <func>(<var1> <ref1:AS,ASREF> <type1> ;
; [, <varN> <refN:AS,ASREF> <typeN> ] ) [AS <typeX>] ;
; [ <idConvention:CLIPPER, STRICT, PASCAL, CALLBACK> ] ;
=> PROCEDURE <func>(<var1>[, <varN>])

#command STATIC [<type:PROCEDURE,FUNCTION>] <func>(<var1> ;
; <ref1:AS,ASREF> <type1> [, <varN> <refN:AS,ASREF> <typeN> ] ) ;
; [AS <typeX>] [ <idConvention:CLIPPER, STRICT, PASCAL, ;
; CALLBACK> ] ;
=> STATIC <type> <func>(<var1>[, <varN>])

#command METHOD FUNCTION <func>(<var1> <ref1:AS,ASREF> <type1:STRING, ;
; CHARACTER,NUMERIC,FLOAT,INTEGER,INT,LOGICAL,DATE,BLOCK, ;
; CODEBLOCK,ARRAY,OBJECT,USUAL,ANY> [, <varN> <refN:AS,ASREF> ;
; <typeN:STRING,CHARACTER,NUMERIC,FLOAT,INTEGER,INT,LOGICAL,DATE,;
; BLOCK,CODEBLOCK,ARRAY,OBJECT,USUAL,ANY> ] ) [AS <typeX>] ;
; [ <idConvention:CLIPPER, STRICT, PASCAL, CALLBACK> ] ;
=> METHOD FUNCTION <func>(<var1>[, <varN>])

#command METHOD PROCEDURE <func>(<var1> <ref1:AS,ASREF> <type1:STRING, ;
; CHARACTER,NUMERIC,FLOAT,INTEGER,INT,LOGICAL,DATE,BLOCK, ;
; CODEBLOCK,ARRAY,OBJECT,USUAL,ANY> [, <varN> <refN:AS,ASREF> ;
; <typeN:STRING,CHARACTER,NUMERIC,FLOAT,INTEGER,INT,LOGICAL,DATE,;
; BLOCK,CODEBLOCK,ARRAY,OBJECT,USUAL,ANY> ] ) [AS <typeX>] ;
; [ <idConvention:CLIPPER, STRICT, PASCAL, CALLBACK> ] ;
=> METHOD FUNCTION <func>(<var1>[, <varN>])

#command PARAMETERS <var1> <ref1:AS,ASREF> <type1> [, <varN> ;
; <refN:AS,ASREF> <typeN> ] ;
=> PARAMETERS <var1>[, <varN>]

#command RETURN <x> AS <type:STRING,CHARACTER,NUMERIC,FLOAT,INTEGER,INT,;
; LOGICAL,DATE,BLOCK,CODEBLOCK,ARRAY,OBJECT,USUAL,ANY> ;
=> RETURN (<x>)

#endif

#translate EXPORT LOCAL =>

// If you like, you can use this syntax too, although nothing
#command LOCAL <var1> AS <type1>[, <varN> AS <typeN>] ;
=> LOCAL <var1>[, <varN>]

#command STATIC <var1> AS <type1>[, <varN> AS <typeN>] ;
=> STATIC <var1>[, <varN>]

#command RETURN NIL AS <type:USUAL,ANY> ;
=> RETURN (NIL)

#command RETURN NIL AS <type:STRING,CHARACTER,NUMERIC,FLOAT,INTEGER,INT, ;
; LOGICAL,DATE,BLOCK,CODEBLOCK,ARRAY,OBJECT> ;
=> RETURN (NIL) ;
; #error Return value is not <type>

#command RETURN (<x>) AS <type> ;
=> RETURN <x> AS <type>

/*
┌────────────────────────────────┐
│ IF..ENDIF --> DO CASE..ENDCASE │
├────────────────────────────────┴──────────────────────┐
│ These commands map IF statements onto CASE statements │
├───────────────────────────────────────────────────────┴────────────┐
│ The behaviour is the same, but you can trace each branch of a case │
│ statement, and error line numbers are correct │
├────────────────────────────────────────────────────────────────────┤
│ Be aware that if you mess up your code construct, then you will │
│ get a CASE related error and NOT an IF related error │
├────────────────────────────────────────────────────────────────────┤
│ Oh, and you may find them faster too... │
└────────────────────────────────────────────────────────────────────┛
*/

#translate IF(<stuff>,<result1>,<result2>) ;
=> IIF(<stuff>, <result1>, <result2>)

#command IF <stuff> ;
=> DO CASE; CASE <stuff>

#command ELSEIF <stuff> ;
=> CASE <stuff>

#command ELSE ;
=> OTHERWISE

#command ENDIF ;
=> ENDCASE


/*
┌────────────────────────────────────────────────────────────────┐
│ MrDump - Constant Definitions │
└────────────────────────────────────────────────────────────────┛
*/

#define MRDUMP_APPEND 1
#define MRDUMP_ERROR 2
#define MRDUMP_STACK 4
#define MRDUMP_VARIABLES 8
#define MRDUMP_IN_SCOPE 16
#define MRDUMP_WORKAREAS 32
#define MRDUMP_SCREEN 64
#define MRDUMP_MEMORY 128 /* Only applicable with MrDebug */
#define MRDUMP_SOURCE 256 /* Only applicable with MrDebug */


/*
┌─────────────────────────────────────────────────────────────────────────┐
│ The following portion has been donated by Dave Pearson with thanks from │
│ Dark Black Software Limited │
└─────────────────────────────────────────────────────────────────────────┛
*/



/*
╒═════════╤═════════════════════════════════════════════╕
│File Name│ MrDebug.Ch │
│ Author│ David A Pearson │
│ Notes│ Constants and commands for use with MrDebug.│
╘═════════╧═════════════════════════════════════════════╛
*/


// Parameters for the AltD() function.

#define MRD_ALTD_DISABLE 0
#define MRD_ALTD_ENABLE 1
#define MRD_ANIMATE 2
#define MRD_NO_ANIMATE 3
#define MRD_START_SPEED 4
#define MRD_STOP_SPEED 5
#define MRD_VIEW_WORKAREA 6
#define MRD_START_PROFILE 7
#define MRD_STOP_PROFILE 8
#define MRD_CRASH_LOG 9
#define MRD_REFRESH 10

// And, because it can be done, some commands. ;-)

#xcommand MRD ANIMATE ON => AltD( MRD_ANIMATE )
#xcommand MRD ANIMATE OFF => AltD( MRD_NO_ANIMATE )
#xcommand MRD SPEED MODE ON => AltD( MRD_START_SPEED )
#xcommand MRD SPEED MODE OFF => AltD( MRD_STOP_SPEED )
#xcommand MRD VIEW WORKAREAS => AltD( MRD_VIEW_WORKAREA )
#xcommand MRD PROFILE ON => AltD( MRD_START_PROFILE )
#xcommand MRD PROFILE OFF => AltD( MRD_STOP_PROFILE )
#xcommand MRD REFRESH => AltD( MRD_REFRESH )

// And, a translate function to tell you if MrDebug is linked
// in or not.

#xtranslate IsMrDebug() => If( AltD( 42 ) == NIL, .F., .T. )

// Now, one for your ErrorSys. It's a command to make a call to
// MrdSaveErr() and save your error object only if MrDebug is
// linked into your application. This means that your general
// error system in your super cool library can talk to MrDebug
// if it's there, and that the linker won't moan that it can't
// find MrdSaveErr when it ain't there.
//
// The only downside to this solution is that we need to do a
// macro compile, but, what the hell eh, it's worth it if it's
// for MrDebug! ;-)

#xcommand MRD SAVE ERROR <oError> ;
=> ;
If IsMrDebug() ;;
eval( &( "{|o| MrdSaveErr( o ) }" ), <oError> );;
EndIf

#endif