[open-cobol-list] Bug Fix

[Robert Sherry]

 

   Approximately, one week ago, I reported a bug dealing with the keyword EXTERNAL and files. I have tracked the bug down to the routine output_file_definition. Here is a version of this routine, with the bug fixed. The needed changes are protected with #if _ATT_. If nobody objects, I am going to make the changes into the official source tree.

 

static void

output_file_definition (struct cb_file *f)

{

  int nkeys = 1;

#if _ATT_ == 1

  char *name = 0;

  int field_size;

#endif

 

  /* output RELATIVE/RECORD KEY's */

  if (f->organization == COB_ORG_RELATIVE

      || f->organization == COB_ORG_INDEXED)

    {

      struct cb_alt_key *l;

      output ("  static cob_file_key %s%s[] = {\n", CB_PREFIX_KEYS, f->cname);

      output ("  {");

      output_param (f->key, -1);

      output (", 0},\n");

      for (l = f->alt_key_list; l; l = l->next)

    {

      nkeys++;

      output ("  {");

      output_param (l->key, -1);

      output (", %d},\n", l->duplicates);

    }

      output ("};\n");

    }

 

  /* output the file descriptor */

  output ("  static cob_file %s%s = {", CB_PREFIX_FILE, f->cname);

  /* organization, access_mode, open_mode, flag_optional */

  output ("%d, %d, 0, %d, ", f->organization, f->access_mode, f->optional);

  /* file_status */

if (f->file_status)

#if _ATT_ == 1

    {

       cb_tree tree_node = f->file_status;

       struct cb_reference *r = CB_REFERENCE (tree_node);

       struct cb_field *f = CB_FIELD (r->value);

       if ( f->flag_external == 0 )

          output_data ( tree_node );

       else {

          name = f->name;

          field_size = f->size;

          output( "NULL " );

       }

    }

#else

    output_data (f->file_status);

#endif

  else

    output ("0");

  output (", ");

  /* assign */

  output_param (f->assign, -1);

  output (", ");

  /* record */

  output_param (CB_TREE (f->record), -1);

  output (", ");

  /* record_size */

  output_param (f->record_depending, -1);

  output (", ");

  /* record_min, record_max */

  output ("%d, %d, ", f->record_min, f->record_max);

  /* nkeys, keys */

  if (f->organization == COB_ORG_RELATIVE

      || f->organization == COB_ORG_INDEXED)

    output ("%d, %s%s, ", nkeys, CB_PREFIX_KEYS, f->cname);

  else

    output ("0, 0, ");

  /* file */

    output ("0, ");

 /* LINAGE */

  if ( f->linage ) {

    output_param (f->linage, -1);

    output (", ");

    output_param (f->linage_ctr, -1);

    output (", ");

    if ( f->latfoot ) {

        output_param (f->latfoot, -1);

    } else {

        output ("NULL");

    }

    output (", ");

    if ( f->lattop ) {

        output_param (f->lattop, -1);

    } else {

        output ("NULL");

    }

    output (", ");

    if ( f->lattop ) {

        output_param (f->latbot, -1);

    } else {

        output ("NULL");

    }

    output (", ");

  } else {

    output ("NULL, NULL, NULL, NULL, NULL, ");

  }

  /* LINAGE  Current values */

  output ("0, 0, 0, 0, ");

  /* flags */

  output ("0, 0, 0, 0, 0, ");

  /* has file status flag */

  if (f->file_status)

    output ("1, ");

  else

    output ("0, ");

  /* LS close needs NL / Linage needs top */

  output ("0, 0};\n\n");

#if _ATT_ == 1

   if ( name != 0 ) {

      output (" %s%s.file_status = cob_external_addr( \"%s\", %d );",

                    CB_PREFIX_FILE, f->cname, name, field_size );

   }

#endif

}

 

Robert Sherry