home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The World of Computer Software
/
World_Of_Computer_Software-02-385-Vol-1of3.iso
/
e
/
errins.zip
/
ERRDEMO.PRG
next >
Wrap
Text File
|
1992-04-01
|
9KB
|
530 lines
/***
*
* ErrDemo.prg
* Demonstration of the Error Inspector, a diagnostic error handler
* for Clipper 5.0, version 5.01.
*
* Copyright (c) 1992 Nantucket Corp. All rights reserved
*
* Compile with /m /n /w
*
*/
#include "Box.ch"
#include "Inkey.ch"
MEMVAR cMacroExp
FIELD Key
// manifest constant used to control whether or not a message is
// displayed when a BREAK is issued. Helpful for differentiating
// BREAKs from default recovery.
//
#define MESSAGE_ON_BREAK .F.
#define ERR_DESCRIPTION 1
#define ERR_BLOCK 2
#define FILL_PATTERN CHR( 176 )
// number of sample records to create
//
#define SAMPLE_RECS 5
// center row and column pseudo functions
//
#define CROW() INT( MAXROW() / 2 )
#define CCOL() INT( MAXCOL() / 2 )
/***
*
* MakeError()
*
* Generate an error to test the Error Inspector.
*
*/
PROCEDURE MakeError()
LOCAL aError := { ;
{ "No Variable", {|| NoVariable() } }, ;
{ "Open Error", {|| OpenError() } }, ;
{ "Type Mismatch", {|| MisMatch() } }, ;
{ "Complexity", {|| Complexity() } }, ;
{ "String Overflow", {|| Overflow() } }, ;
{ "Bound Violation", {|| BoundViolation() } }, ;
{ "No Exported Method", {|| NoExpMethod() } }, ;
{ "Data Width Error", {|| DataWidth() } }, ;
{ "Data Type Error", {|| DataType() } }, ;
{ "File Corruption", {|| Corruption() } }, ;
{ "No Alias", {|| NoAlias() } }, ;
{ "Undefined Function", {|| UndefFunction() } } ;
}
LOCAL nErrPtr
LOCAL nChoice := 0
// calculate dimensions of menu
//
LOCAL nWidth := MaxPromptLen( aError )
LOCAL nHeight := LEN( aError )
LOCAL nTop := CROW() - ( ( nHeight + 1 ) / 2 )
LOCAL nLeft := CCOL() - ( ( nWidth + 3 ) / 2 )
LOCAL nBottom := nTop + ( nHeight + 1 )
LOCAL nRight := nLeft + ( nWidth + 3 )
SET EXCLUSIVE ON
CreateFiles()
@ 0, 0, MAXROW(), MAXCOL() BOX REPLICATE( FILL_PATTERN, 9 )
@ nTop, nLeft, nBottom, nRight BOX B_SINGLE + SPACE( 1 )
@ nTop, nLeft + 1 SAY " Error du jour "
nChoice := 1
DO WHILE ! EMPTY( nChoice )
// Add prompts from the error menu array
//
FOR nErrPtr := 1 TO LEN( aError )
@ nTop + nErrPtr, nLeft + 2 PROMPT aError[ nErrPtr, ERR_DESCRIPTION ]
NEXT nErrPtr
MENU TO nChoice
IF ! EMPTY( nChoice )
Are( aError[ nChoice, ERR_BLOCK ] )
ENDIF
ENDDO
KillFiles()
@ MAXROW() + 1, 0
RETURN
/***
*
* Are( <bBadBlock> )
*
* Just building a respectable callstack; we just pass the code block
* along.
*
*/
STATIC PROCEDURE Are( bBadBlock )
You( bBadBlock )
RETURN
/***
*
* You( <bBadBlock> )
*
* Still building the callstack; we just pass the code block along.
*
*/
STATIC PROCEDURE You( bBadBlock )
Reading( bBadBlock )
RETURN
/***
*
* Reading( <bBadBlock> )
*
* Still going...
*
*/
STATIC PROCEDURE Reading( bBadBlock )
This( bBadBlock )
RETURN
/***
*
* This( <bBadBlock> )
*
* Still going...
*
*/
STATIC PROCEDURE This( bBadBlock )
Upside( bBadBlock )
RETURN
/***
*
* Upside( <bBadBlock> )
*
* Still going...
*
*/
STATIC PROCEDURE Upside( bBadBlock )
Down( bBadBlock )
RETURN
/***
*
* Down( <bBadBlock> )
*
* Create a local recovery context to cushion the fall and launch
* the error.
*
*/
STATIC PROCEDURE Down( bBadBlock )
LOCAL oErrObject
LOCAL cMessage := ""
BEGIN SEQUENCE
EVAL( bBadBlock )
RECOVER USING oErrObject
UNLOCK
IF MESSAGE_ON_BREAK
cMessage := "Recovering from : " + oErrObject:description
// place message at center of screen
//
ErrMsg( cMessage, CROW() - 2, CCOL() - ( LEN( cMessage ) / 2 ) )
ENDIF
END SEQUENCE
RETURN
/***
*
* NoVariable()
*
* Generate a "No Variable" error.
*
*/
STATIC PROCEDURE NoVariable
MEMVAR xUnknown
LOCAL xResult
xResult := xUnknown / 5
RETURN
/***
*
* OpenError()
*
* Generate an "Open Error".
*
*/
STATIC PROCEDURE OpenError
LOCAL cFileName := "_@@@@@@.$$$"
USE (cFileName) NEW
RETURN
/***
*
* MisMatch()
*
* Generate a "Type Mismatch" error.
*
*/
STATIC PROCEDURE MisMatch
LOCAL nValue := 1
LOCAL cValue := "Mistake"
LOCAL xResult
xResult := nValue * cValue
RETURN
/***
*
* Complexity()
*
* Feed the macro processor something substantial to chew on.
*
*/
STATIC PROCEDURE Complexity
LOCAL xResult
PRIVATE cMacroExp := ".T." + REPLICATE( " .AND. .T.", 200 )
xResult := &( cMacroExp )
RETURN
/***
*
* Overflow()
*
* Generate a "String Overflow" error.
*
*/
STATIC PROCEDURE Overflow
LOCAL cLong := SPACE( 32000 )
LOCAL cRealLong := SPACE( 64000 )
cLong += cRealLong
RETURN
/***
*
* BoundViolation()
*
* Generate a "Bound Violation" error.
*
*/
STATIC PROCEDURE BoundViolation
LOCAL aArray
// One more element than is possible in a single dimension...
aArray := ARRAY( 4097 )
RETURN
/***
*
* NoExpMethod()
*
* Generate a "No Exported Method" error.
*
*/
STATIC PROCEDURE NoExpMethod
LOCAL cDecoyObject := "Not an Object"
cDecoyObject:interrogate()
RETURN
/***
*
* Corruption()
*
* Generate a "Corruption Detected" error.
*
*/
STATIC PROCEDURE Corruption
LOCAL cFileName := "ERRDEMO.EXE"
USE (cFileName) EXCLUSIVE NEW
RETURN
/***
*
* DataWidth()
*
* Generate a "Data Width" error.
*
*/
STATIC PROCEDURE DataWidth
LOCAL nKey := 99999999999.99
XSample->Key := nKey
RETURN
/***
*
* DataType()
*
* Generate a "Data Type" error.
*
*/
STATIC PROCEDURE DataType
LOCAL cKey := ""
RLOCK()
XSample->Key := cKey
RETURN
/***
*
* UndefFunction()
*
* Generate an "Undefined Function" error.
*
*/
STATIC PROCEDURE UndefFunction
LOCAL xResult
PRIVATE cMacroExp := "SONICYOUTH()"
xResult := &( cMacroExp )
RETURN
/***
*
* NoAlias()
*
* Generate an "No Alias" error.
*
*/
STATIC PROCEDURE NoAlias
LOCAL xResult
PRIVATE cMacroExp := "Mystery"
xResult := &( cMacroExp )->Key
RETURN
/***
*
* CreateFiles()
*
* Create sample tables, populate with data.
*
*
*/
STATIC PROCEDURE CreateFiles()
LOCAL bPrevError := ERRORBLOCK( {|oErr| BREAK( oErr ) } )
LOCAL nRecPtr
LOCAL oLocErr
BEGIN SEQUENCE
BuildTables()
USE Damage ALIAS Damage NEW READONLY
SET INDEX TO Damage
USE XSample ALIAS XSample NEW
SET INDEX TO XSample
SET FILTER TO XSample->Key > 3
SET RELATION TO XSample->Key INTO Damage
RECOVER USING oLocErr
// if we end up here, we run the demo with no sample tables
//
CLOSE DATABASES
END SEQUENCE
ERRORBLOCK( bPrevError )
RETURN
/***
*
* BuildTables()
*
* Create sample tables for the Error Inspector demo.
*
*/
STATIC PROCEDURE BuildTables()
// names of the tables to create
//
LOCAL aTables := { "DAMAGE", "XSAMPLE" }
// array to store all structure definitions
//
LOCAL aStructs := {}
// structure of the Damage table
//
LOCAL aDamage := { ;
{ "KEY", "N", 6, 0 }, ;
{ "REGION", "N", 6, 0 }, ;
{ "ZONE", "C", 4, 0 }, ;
{ "DATE", "D", 8, 0 }, ;
{ "DESC", "C", 20, 0 }, ;
{ "DAMAGE", "N", 14, 2 } ;
}
// structure of the XSample table
//
LOCAL aXSample := { ;
{ "KEY", "N", 10, 0 }, ;
{ "INT", "N", 10, 0 }, ;
{ "SIGNED", "N", 11, 0 }, ;
{ "FLOAT", "N", 18, 6 }, ;
{ "DOUBLE", "N", 18, 6 }, ;
{ "DECIM", "N", 14, 2 }, ;
{ "DATE", "D", 8, 0 }, ;
{ "CODE", "C", 10, 0 }, ;
{ "NAME", "C", 20, 0 }, ;
{ "ADDRESS", "C", 80, 0 } ;
}
// Table pointer, used to index the structure and table name arrays
//
LOCAL nTablePtr
LOCAL nRecPtr
// place all structure definitions into an array. This enables
// us to generalize the table creation process.
//
AADD( aStructs, aDamage )
AADD( aStructs, aXSample )
// create all tables in a single pass through the array
//
FOR nTablePtr := 1 TO LEN( aTables )
DBCREATE( aTables[ nTablePtr ], aStructs[ nTablePtr ] )
USE ( aTables[ nTablePtr] ) ALIAS ( aTables[ nTablePtr ] ) NEW
// add a few dummy records
//
FOR nRecPtr := 1 TO SAMPLE_RECS
APPEND BLANK
( aTables[ nTablePtr ] )->Key := nRecPtr
NEXT nRecPtr
INDEX ON Key TO ( aTables[ nTablePtr ] )
USE
NEXT nTablePtr
RETURN
/***
*
* KillFiles()
*
* Delete the sample tables from disk if present.
*
*
*/
STATIC PROCEDURE KillFiles()
CLOSE DATABASES
FERASE( "Damage.dbf" )
FERASE( "Damage.ntx" )
FERASE( "XSample.dbf" )
FERASE( "XSample.ntx" )
RETURN
/***
*
* MaxPromptLen( <aArray> ) --> nLength
*
* Determine the maximum length of a prompt in a two-dimensional array.
*
*/
STATIC FUNCTION MaxPromptLen( aArray )
LOCAL nLength := 0
AEVAL( aArray, {|aElement| nLength := ;
MAX( LEN( aElement[ ERR_DESCRIPTION ] ), nLength ) } )
RETURN ( nLength )