#313 SEARCH bug: WHEN gets a runtime check generated

[Simon Sobisch]

As the runtime will always run into the AT END clause (or leave the search) the WHEN should not include cob_check_subscript.

::cobol
       IDENTIFICATION DIVISION.
       PROGRAM-ID. SEARCHBUG.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
       78  screen-max         value 20.
       77  screen-akt         pic 9(02) comp-5.
      *
       01  screen-tab.
           03 screen-entry    occurs 0  to screen-max
                              depending on screen-akt
                              ascending key screen-name
                              indexed   by screen-idx.
             05 screen-name     pic x(02).
             05 screen-mode     pic 9 value 0.

       PROCEDURE DIVISION.

           SEARCH ALL screen-entry
              AT END
                 DISPLAY 'END'

               *> we currently have cob_check_subscript here:
              WHEN screen-name (screen-idx) = 'ABC'
                 DISPLAY 'FOUND'
           END-SEARCH.

The error is the generated check in this part

::c
      /* WHEN */
      if (((int)(ret = cob_cmp (
      (cob_check_subscript (b_10, 1, (*(cob_u8_ptr) (b_7)), "screen-name"),
      COB_SET_FLD(f0, 2, b_8 + 3 * (b_10 - 1), &a_1) ), (cob_field *)&c_2)) == 0))
      {

[Simon Sobisch]

Currently not reproducable (the WHEN in this minimal sample does not produce the subscript check), leaving as pending for further investigation.

[Ron Norman]

trunk had no test case like you are talking about so that is why nothing fails.
And it does not really fail it is just doing unneeded checking.
Is that the issue?

So I make up a new test case that does:

           SEARCH ALL DBX-RECORD-NAMES
           AT END
               DISPLAY 'B ' REC-NAME ' is invalid.'
           WHEN DBI-RECORD-NAME (REC-NAME-IDX)
              = DBX-RECORD-NAME (REC-NAME-DBX)
               DISPLAY 'B ' REC-NAME ' is code '
                         DBX-RECORD-CODE (REC-NAME-DBX) '.'.

The the WHEN becomes:

      /* WHEN */
      if (((int)(ret = memcmp (
      ((cob_check_subscript (b_35, 7, "DBX-RECORD-NAME", 0)),
      b_24 + 35 * (b_35 - 1)),
      ((cob_check_subscript (b_19, 7, "DBI-RECORD-NAME", 0)),
      b_8 + 35 * (b_19 - 1)), 30)) == 0))

So your idea is to not do checks on the array subscript when the verb was SEARCH ALL.
If it does not say ALL, then it should continue doing the subscript checks.
Do I have this right?

[Simon Sobisch]

Nearly correct.

Yes: nothing fails here anywhere, this is just a performance issue.

Yes: The last test case does not exist anywhere, it was just to highlight that (all) references to the INDEX of the table that is the target of the SEARCH should not be checked, but other subscripts should.

To give a very special case:

WHEN TAB-KEY (INDEX-VAR) = BACKUP (INDEX-VAR)

in this case the first should not be checked, but the second should.

This also applies to plain SEARCH, which likely should have a one-time subscript check before the generated loop, but not within.

Simon

[Simon Sobisch]

Reproduced with the internal testsuite, test "OCCURS INDEXED ASCENDING".
Both trunk (currently test 684) and 3.1 fail in doing the correct thing.

           SEARCH DBI-RECORD-NAMES
           AT END
               DISPLAY 'A ' REC-NAME ' is invalid.'
           WHEN REC-NAME = DBI-RECORD-NAME (REC-NAME-IDX)
               DISPLAY 'A ' REC-NAME ' is code '
                         DBI-RECORD-CODE (REC-NAME-IDX) '.'.

is generated as

  /* Line: 66        : Paragraph FINDIT                  : prog.cob */
  l_5:;
  module->module_stmt = 0x00100042;
  cob_trace_para (st_6);
  /* Line: 67        : SEARCH             : prog.cob */
  module->module_stmt = 0x00100043;
  cob_trace_stmt (st_7);
  cob_global_exception = -1;
  for (;;) {
    if (b_19 > 7)
    {
      /* Table end */
      /* Line: 69        : DISPLAY            : prog.cob */
      module->module_stmt = 0x00100045;
      cob_trace_stmt (st_8);
      cob_global_exception = -1;
      cob_display (0, 1, 3, &c_2, &f_23, &c_3);
      break;
    }

    /* Line: 70        : WHEN               : prog.cob */
    module->module_stmt = 0x00100046;
    cob_trace_stmt (st_9);

    if (((int)memcmp (b_23, 
    ((cob_check_subscript (b_19, 7, "DBI-RECORD-NAME", 0)), 
    b_8 + 35 * (b_19 - 1)), 30) == 0))
    {
      /* Line: 71        : DISPLAY            : prog.cob */
      module->module_stmt = 0x00100047;
      cob_trace_stmt (st_8);
      cob_global_exception = -1;
      cob_display (0, 1, 5, &c_2, &f_23, &c_4, 
      (cob_check_subscript (b_19, 7, "DBI-RECORD-CODE", 0),
      COB_SET_FLD(f0, 4, b_8 + 30 + 35 * (b_19 - 1), &a_3) ), &c_5);
      break;
    }

    b_19++;
    /* Iterate */
  }

Issue: Line: 70 : WHEN should not include a subscript check for the tables INDEX field (in this case b_19.

It still should the subscript for the DISPLAY (line 71) and it also should check it for a different index, for example with the code:

           SEARCH DBI-RECORD-NAMES
           AT END
               DISPLAY 'entry from different table not found.'
           WHEN DBX-RECORD-NAME (REC-NAME-DBX)
               = DBI-RECORD-NAME (REC-NAME-IDX)
              CONTINUE.

where REC-NAME-IDX should not be checked, but REC-NAME-IDX should.

Question @rjnorman74: Do you see an option to omit the subscript check here? Especially when the table is huge: a libcob function call with a check for every entry to be in range (which is not necessary here as the entry is only set be the generated code) is something that has measurable performance effect (the actual memcmp doing the WHEN is resolved to a cpu-optimized function).