Re: Assert in RPG/ILE

[Rich Duzenbury <rduz-midrange@xxxxxxxxxxxxxxxxxxx>]

Scott,

It's pretty slick - as usual for your stuff.

I *really* want the statement number and assertion message right away, 
though, without having to resort to the low-level help or the joblog.  The 
status data structure holds this info, but the trick is that it's not 
available until *after* the exception message has already been sent.  I 
found that I could capture it via a *PSSR, as follows.

The DSPLY is a bit of a kludge, as it won't work very well with a batch 
job, perhaps it would be better to send an *INFO message to *EXT, but I 
haven't tried it yet

It sure would be nice if we could force the update of the status data 
structure at any time, similar to how we can for file information data 
structures via the POST opcode.  Perhaps there is a mechanism that I am 
unaware of.

Assert((ptr <> NULL) or (post_sds()):'Hey, not null, dummy');

Thank you for your help on this.

Regards,
Rich

H DFTACTGRP(*NO) OPTION(*SRCSTMT)

D Assert          PR
D   peAssertion                  1N   const
D   peMsgTxt                  1024A   const varying options(*nopass)

D Escape          PR
D   peStackCnt                  10I 0 value
D   peMsgTxt                  1024A   const varying

D ptr             s               *   inz(*null)

D sds            sds                  qualified
D procedure                     10
D sts_code                       5s 0
D sts_code_prv                   5s 0
D line_no                        8
D routine                        8
D parm_count                     3s 0
D msgid                          7
D                                4
D work_area                     30
D pgm_lib                       10
D msg_dta                       80
D excpid                         4
D filename                      10
D                                6
D jobdate                        8
D compl_time                     6
D compl_levl                     4
D srcfile                       10
D srclib                        10
D srcmbr                        10
D                               76
D srcid_1                        5i 0
D srcid_2                        5i 0
D userid                        10

 /free
   //Assert(%parms>0: 'You must pass at least one parm!');
     Assert((ptr <> *NULL));

    *inlr = *on;  // (otherwise this wont compile)
 /end-free

C     *pssr         begsr
 /free
       dsply (sds.procedure + ' ' +
              sds.routine + ' ' +
              sds.line_no);
 /end-free
C                   endsr
 *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 *  Assert():  Assert that a condition must be true.
 *
 *        peAssertion = condition to assert.
 *           peMsgTxt = (optional) text of message to send
 *
 *  Program will crash with a CPF9897 if assertion is not true.
 *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
P Assert          B                   export
D Assert          PI
D   peAssertion                  1N   const
D   peMsgTxt                  1024A   const varying options(*nopass)

D   peErrTxt      s             52A
 /free
   if not peAssertion;
      if %parms>=2;
         peErrTxt = peMsgTxt;
         dsply  peErrTxt;
         Escape(2: peMsgTxt);
      else;
         peErrTxt = 'Assertion Failed.';
         dsply  peErrTxt;
         Escape(2: peErrTxt);
      endif;
   endif;
 /end-free
P                 E

  *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  * Escape():  Send an escape message to a given call-stack entry
  *
  *       peMsgTxt = human-readable text to send
  *     peStackCnt = call-stack entry to send message to
  *
  * This procedure does not return.
  *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 P Escape          B                   export
 D Escape          PI
 D   peStackCnt                  10I 0 value
 D   peMsgTxt                  1024A   const varying

 D QMHSNDPM        PR                  ExtPgm('QMHSNDPM')
 D   MessageID                    7A   Const
 D   QualMsgF                    20A   Const
 D   MsgData                   1024A   Const
 D   MsgDtaLen                   10I 0 Const
 D   MsgType                     10A   Const
 D   CallStkEnt                  10A   Const
 D   CallStkCnt                  10I 0 Const
 D   MessageKey                   4A
 D   ErrorCode                    8A

 D dsEC            DS
 D  dsECBytesP             1      4I 0 inz(0)
 D  dsECBytesA             5      8I 0 inz(0)

 D wwMsgKey        S              4A


  /free

     QMHSNDPM('CPF9897': 'QCPFMSG   *LIBL': peMsgTxt: %len(peMsgTxt):
             '*ESCAPE':'*': peStackCnt: wwMsgKey: dsEC);

 /end-free
P                 E