home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 17 / CD_ASCQ_17_101194.iso / vrac / chkarg.zip / CHECKARG.PRG < prev    next >
Text File  |  1994-05-24  |  16KB  |  443 lines
  1. // checkarg.prg
  2. // Copyright (C) 1994 All rights reserved. Paul Long
  3.  
  4. // With the UDCs in checkarg.ch, these functions automatically perform type
  5. // checking on the arguments passed in function and procedure calls based on
  6. // the modified Hungarian notation of the parameters.
  7. //
  8. // The CACkPm(), CABeg(), and CAEnd() functions are meant to be called by
  9. // the code generated by the UDCs in checkarg.ch, not called explicitly from
  10. // your code.  The accessor functions, CASkipAll(), CAChkReq(), CACheckExtra(),
  11. // CAOptChars(), and CAAnyChars(), are meant to be called explicitly by your
  12. // code to modify how or whether arguments are checked.
  13. //
  14. // Use the following commands to compile checkarg.prg and test.prg, link them
  15. // together with Blinker, and run the test program.  If you don't use Blinker,
  16. // use whatever syntax is appropriate for your linker.
  17. //    clipper checkarg /a/w/n
  18. //    clipper test /dDEBUG
  19. //    blinker fi test,checkarg
  20. //    test
  21. // The test program should display this error message:
  22. //  ┌────────────────────────────────────────────┐
  23. //  │C is an invalid type for parameter nHowMuch │
  24. //  │    of module DoIt, called from TEST/5.     │
  25. //  │                                            │
  26. //  │  Quit    Skip    Skip Module    SkipAll    │
  27. //  └────────────────────────────────────────────┘
  28.                                                     
  29.  
  30. // Type and modifier characters.
  31. #define SCALAR    "bcdlmno"   // Must agree with valtype() scalars.
  32. #define ARRAY     "a"         // Doesn't have to agree w/ valtype(), but should.
  33.                               //    Could have synonyms, e.g., "am" for
  34.                               //    "array" and "matrix."
  35. #define ANY       "x"         // Can be anything that doesn't conflict.
  36.                               //    Could have synonyms, e.g., "xi" for
  37.                               //    "x" and "indifferent."
  38. #define OPTIONAL  "u"         // Can be anything that doesn't conflict.
  39.                               //    Could have synonyms, e.g., "ue" for
  40.                               //    "nil" and "elective."
  41.  
  42. // For Class(y), use methodname: otherwise, procname.
  43. #define MODNAME   procname
  44.  
  45. // Module status regarding checking its parameters.
  46. #define CA_PROCESS         0  // Process this module, including name checking.
  47. #define CA_SKIP            1  // Do not process this module at all.
  48. #define CA_NAMES_CHECKED   2  // Process this module without name checking
  49.                               //    since already done.
  50.  
  51. // Strict checking, i.e., required vs optional?  If CASTRICT is defined on the
  52. // compilation command line, have the default be to perform strict checking.
  53. // This means to only allow arguments with the "optional" modifier character
  54. // in their names to be missing from the call--if the "optional" character is
  55. // missing from the name, the argument is required.  The normal default behavior
  56. // is to ignore whether a paremeter name has the "optional" modifier character--
  57. // all arguments are optional.
  58. #ifdef CASTRICT
  59. #undef CASTRICT
  60. #define CASTRICT  .t.
  61. #else
  62. #define CASTRICT  .f.
  63. #endif
  64.  
  65. // Check for extra arguments?  If CANUMBER is defined on the compilation
  66. // command line, have the default be to make sure that a module is not
  67. // called with extra arguments.  The normal default behavior is to not care
  68. // whether extra arguments are present.
  69. #ifdef CANUMBER
  70. #undef CANUMBER
  71. #define CANUMBER  .t.
  72. #else
  73. #define CANUMBER  .f.
  74. #endif
  75.  
  76.  
  77. // Variables that define how arguments are checked.
  78. static lStrict := CASTRICT    // Strict checking, i.e., required vs optional?
  79. static lExtra := CANUMBER     // Check for extra arguments?
  80. static lSkipAll := .f.        // Skip all checking?
  81. static cOpt := OPTIONAL       // Character(s) that indicate argument is
  82.                               //    optional.
  83. static cAny := ANY            // Character(s) that indicate don't care what
  84.                               //    type an argument is.
  85. static bModName := ;          // Block that returns name of module.
  86.       {|nAct| MODNAME(nAct)}
  87.  
  88. // Variables that are only used while processing a module's parameters.
  89. static nModStatus             // Status held here for current module.
  90. static nModParms              // Number of current module's parameters
  91.                               //    calculated here.
  92.  
  93.  
  94. ///////////////////////////////////////////////////////////////////////////
  95. // This function is called by the UDCs in the user code to initialize
  96. // variables in preparation for checking a module's parameters.
  97. function CABeg(nuStatus)
  98.  
  99. nModParms := 0
  100.  
  101. nModStatus := if(nuStatus == nil, CA_PROCESS, nuStatus)
  102.  
  103. return nil
  104.  
  105.  
  106. ///////////////////////////////////////////////////////////////////////////
  107. // This function is called by the UDCs in the user code to wrap up argument
  108. // checking for a module.  It updates the module's argument-checking status
  109. // and, if supposed to, displays an error messages if too many arguments were
  110. // passed to this module.
  111. function CAEnd(nArgs, nStatus)
  112.  
  113. if !lSkipAll .and. nModStatus != CA_SKIP .and. lExtra .and. nArgs > nModParms
  114.    BadNo(nArgs - nModParms, 1)
  115. endif
  116.  
  117. nStatus := if(nModStatus == CA_PROCESS, CA_NAMES_CHECKED, nModStatus)
  118.  
  119. return nil
  120.  
  121.  
  122. ///////////////////////////////////////////////////////////////////////////
  123. // This function is called by the UDCs in the user code for each parameter.
  124. // It extracts the type and modifier characters out of the parameter name,
  125. // makes sure that the name is properly formed, and sets up the call to
  126. // ChkType(), where the actual type checking is done.
  127. function CACkPm(cParm, xParm)
  128.  
  129. local cNext, cType
  130.  
  131. // Supposed to be checking arguments in general and this module's parameters
  132. // in particular?
  133. if !lSkipAll .and. nModStatus != CA_SKIP
  134.  
  135.    // Used later in CAEnd() to check whether too many arguments were passed.
  136.    ++nModParms
  137.  
  138.    // Get the type character from parameter name.
  139.    cType := left(cParm, 1)
  140.  
  141.    do case
  142.    // Does it indicate that the argument should be an array?
  143.    case cType $ ARRAY
  144.  
  145.       // Get the subtype character from the parameter name.
  146.       cNext := substr(cParm, 2, 1)
  147.  
  148.       // If the "optional" modifier character is present, call ChkType()
  149.       // without a subtype and indicating that this is not a required argument.
  150.       if cNext $ cOpt
  151.          ChkType(cType, "", cParm, xParm, .f., 1)
  152.       else
  153.  
  154.          // If base name immediately follows type character or the modifier
  155.          // character indicates that this is an array of any type, call
  156.          // ChkType() without a subtype and indicating that this is a required
  157.          // argument.
  158.          if isupper(cNext) .or. cNext $ cAny
  159.             ChkType(cType, "", cParm, xParm, .t., 1)
  160.  
  161.          // If modifier character indicates that this is an array of a
  162.          // particular type, call ChkType() with the subtype and indicating
  163.          // that this is a required argument.
  164.          elseif cNext $ SCALAR + ARRAY
  165.             ChkType(cType, cNext, cParm, xParm, .t., 1)
  166.  
  167.          else
  168.             BadName(cParm, 1)
  169.  
  170.          endif
  171.       endif
  172.  
  173.    // Does it indicate that the argument should be one of the other types?
  174.    case cType $ SCALAR + cAny
  175.  
  176.       // If the "optional" modifier character is present, call ChkType()
  177.       // indicating that this is not a required argument.
  178.       cNext := substr(cParm, 2, 1)
  179.       if cNext $ cOpt
  180.          ChkType(cType, "", cParm, xParm, .f., 1)
  181.       else
  182.  
  183.          // If base name immediately follows type character, call ChkType()
  184.          // indicating that this is a required argument.
  185.          if isupper(cNext)
  186.             ChkType(cType, "", cParm, xParm, .t., 1)
  187.  
  188.          else
  189.             BadName(cParm, 1)
  190.  
  191.          endif
  192.       endif
  193.  
  194.    otherwise
  195.       // Doesn't have a valid type character in the parameter name.
  196.       BadName(cParm, 1)
  197.  
  198.    endcase
  199.  
  200. endif
  201.  
  202. return nil
  203.  
  204.  
  205. ///////////////////////////////////////////////////////////////////////////
  206. // This function checks whether the parameter named in cParm and whos
  207. // value is in xParm is of one of the types indicated in cType.  If cType
  208. // indicates an array type, the subtype in cSubType is also checked against
  209. // the type of the first element of the array.  If an argument is missing
  210. // (valtype() is "U") and lRequired is true, an error message is displayed.
  211. // nAct is the activation level of the module whos arguments are being checked.
  212. static function ChkType(cType, cSubType, cParm, xParm, lRequired, nAct)
  213.  
  214. local cValType := valtype(xParm)
  215.  
  216. // Increment activation level in order to take the calling of this function
  217. // into consideration.
  218. ++nAct
  219.  
  220. // If not supposed to enforce the required-vs-optional check, ignore the
  221. // setting of lRequired and make all arguments optional.
  222. if !lStrict
  223.    lRequired := .f.
  224. endif
  225.  
  226. // Supposed to be an array?
  227. if cType $ ARRAY
  228.    if cValType == "A"
  229.       // Print error message if the first element is not the expected type.
  230.       if len(xParm) > 0 .and. ;
  231.             !empty(cSubType) .and. valtype(xParm[1]) != upper(cSubType)
  232.          BadType(cValType + valtype(xParm[1]), cParm, nAct)
  233.       endif
  234.    else
  235.       // This is not an array, but was supposed to be.  Print error message
  236.       // if the argument is present or is required but not present.
  237.       if cValType != "U" .or. lRequired
  238.          BadType(cValType, cParm, nAct)
  239.       endif
  240.    endif
  241.  
  242. // Can be any type?
  243. elseif cType $ cAny
  244.    // Don't perform normal type checking.  Just print error message if the
  245.    // argument is required but not present.
  246.    if lRequired .and. cValType == "U"
  247.       BadType(cValType, cParm, nAct)
  248.    endif
  249.  
  250. else
  251.    // Print error message if argument is not of the expected scalar type or
  252.    // argument is required but not present.
  253.    if upper(cType) != cValType .and. (cValType != "U" .or. lRequired)
  254.       BadType(cValType, cParm, nAct)
  255.    endif
  256.  
  257. endif
  258.  
  259. return nil
  260.  
  261.  
  262. ///////////////////////////////////////////////////////////////////////////
  263. // This function displays an error message indicating that an argument is
  264. // not of the expected type.
  265. static function BadType(cValType, cParm, nAct)
  266.  
  267. // Increment activation level in order to take the calling of this function
  268. // into consideration.
  269. ++nAct
  270.  
  271. BadSomething(cValType + " is an invalid type for parameter " + cParm + ;
  272.       ";of module", nAct)
  273.  
  274. return nil
  275.  
  276.  
  277. ///////////////////////////////////////////////////////////////////////////
  278. // This function displays an error message indicating that a parameter
  279. // name doesn't follow the naming standards.
  280. static function BadName(cParm, nAct)
  281.  
  282. // Only report naming error the first time that a module is checked.
  283. if nModStatus != CA_NAMES_CHECKED
  284.    // Increment activation level in order to take the calling of this function
  285.    // into consideration.
  286.    ++nAct
  287.    BadSomething(cParm + " is an invalid parameter name" + ;
  288.          ";in module", nAct)
  289. endif
  290.  
  291. return nil
  292.  
  293.  
  294. ///////////////////////////////////////////////////////////////////////////
  295. // This function displays an error message indicating that too many arguments
  296. // were passed to the module being checked.
  297. static function BadNo(nExtra, nAct)
  298.  
  299. // Increment activation level in order to take the calling of this function
  300. // into consideration.
  301. ++nAct
  302.  
  303. BadSomething(ltrim(str(nExtra)) + " extra argument(s) passed" + ;
  304.       ";to module", nAct)
  305.  
  306. return nil
  307.  
  308.  
  309. ///////////////////////////////////////////////////////////////////////////
  310. // This is the common error-handler function.  It calls alert() to display
  311. // the error.  Depending on which key the user presses from within alert(),
  312. // one of the following occurs:
  313. //    the quit command is executed,
  314. //    nothing is done (this error is skipped),
  315. //    this module is marked so that no further checking will occur on it, or
  316. //    no further checking will be performed on any module.
  317. static function BadSomething(cText, nAct)
  318.  
  319. local nChoice
  320.  
  321. // Increment activation level in order to take the calling of this function
  322. // into consideration.
  323. ++nAct
  324.  
  325. nChoice := alert(cText + " " + eval(bModName, nAct + 1) + ;
  326.       ", called from " + CodeLoc(nAct + 1) + ".", ;
  327.       {"Quit", "Skip", "Skip Module", "Skip All"})
  328.  
  329. if nChoice == 1
  330.    quit
  331. elseif nChoice == 3
  332.    nModStatus := CA_SKIP
  333. elseif nChoice == 4
  334.    lSkipAll := .t.
  335. endif
  336.  
  337. return nil
  338.  
  339.  
  340. ///////////////////////////////////////////////////////////////////////////
  341. // This function returns a string that indicates from where in the code the
  342. // checked module was called.  The module name comes from evaluating the
  343. // block in bModName.
  344. static function CodeLoc(nAct)
  345. ++nAct
  346. return eval(bModName, nAct + 1) + "/" + ltrim(str(procline(nAct)))
  347.  
  348.  
  349. ///////////////////////////////////////////////////////////////////////////
  350. // Accessor functions...
  351. ///////////////////////////////////////////////////////////////////////////
  352.  
  353. ///////////////////////////////////////////////////////////////////////////
  354. // This function returns and optionally sets whether to skip type checking.
  355. function CASkipAll(luSkipAll)
  356.  
  357. local lPrevSkipAll := lSkipAll
  358.  
  359. if valtype(luSkipAll) == "L"
  360.    lSkipAll := luSkipAll
  361. endif
  362.  
  363. return lPrevSkipAll
  364.  
  365.  
  366. ///////////////////////////////////////////////////////////////////////////
  367. // This function returns and optionally sets whether to distinguish between
  368. // optional and required arguments.  This has to do with the character that
  369. // indicates whether an argument is optional.
  370. function CACheckReq(luStrict)
  371.  
  372. local lPrevStrict := lStrict
  373.  
  374. if valtype(luStrict) == "L"
  375.    lStrict := luStrict
  376. endif
  377.  
  378. return lPrevStrict
  379.  
  380.  
  381. ///////////////////////////////////////////////////////////////////////////
  382. // This function returns and optionally sets whether to check for extra
  383. // arguments in a call to this function.
  384. function CACheckExtra(luExtra)
  385.  
  386. local lPrevExtra := lExtra
  387.  
  388. if valtype(luExtra) == "L"
  389.    lExtra := luExtra
  390. endif
  391.  
  392. return lPrevExtra
  393.  
  394.  
  395. ///////////////////////////////////////////////////////////////////////////
  396. // This function returns and optionally sets what character or characters to
  397. // use to indicate that an argument is optional.  The actual check is turned
  398. // on and off with the CACheckReq() function.  If more than one character is
  399. // specified, each character can be used individually to indicate an
  400. // optional argument--they are synonyms.  For example, "ue" means that
  401. // either "u" or "e" indicates an optional argument, not "ue" together.
  402. function CAOptChars(cuOpt)
  403.  
  404. local cPrevOpt := cOpt
  405.  
  406. if valtype(cuOpt) == "C"
  407.    cOpt := cuOpt
  408. endif
  409.  
  410. return cPrevOpt
  411.  
  412.  
  413. ///////////////////////////////////////////////////////////////////////////
  414. // This function returns and optionally sets what character or characters to
  415. // use to indicate "any type"--no type checking.  Like the CAOptChars()
  416. // function, if more than one character is specified, each character can be
  417. // used individually to indicate "any type."
  418. function CAAnyChars(cuAny)
  419.  
  420. local cPrevAny := cAny
  421.  
  422. if valtype(cuAny) == "C"
  423.    cAny := cuAny
  424. endif
  425.  
  426. return cPrevAny
  427.  
  428.  
  429. ///////////////////////////////////////////////////////////////////////////
  430. // This function returns and optionally sets a block that accepts an activation
  431. // level and returns the corresponding module name.  This is provided so that
  432. // the Class(y) methodname() function can be used in place of procname(), as in
  433. // {|nAct| methodname(nAct)}.
  434. function CAModName(buModName)
  435.  
  436. local bPrevModName := bModName
  437.  
  438. if valtype(buModName) == "B"
  439.    bModName := buModName
  440. endif
  441.  
  442. return bPrevModName
  443.