OCamlPro / gnucobol

A clone of the sourceforge GnuCOBOL compiler from COBOL to C.
https://get-superbol.com
GNU Lesser General Public License v3.0
16 stars 21 forks source link

Allow OPEN EXTEND/I-O to create file if missing #98

Closed ddeclerck closed 1 year ago

ddeclerck commented 1 year ago

This PR adds a -fio-extend-create flag that, when set, allows OPEN EXTEND and OPEN I-O to go on and create the file instead of failing.

codecov-commenter commented 1 year ago

Codecov Report

Merging #98 (fe2b31c) into gcos4gnucobol-3.x (7ba3fb5) will decrease coverage by 0.01%. The diff coverage is 42.85%.

:exclamation: Your organization is not using the GitHub App Integration. As a result you may experience degraded service beginning May 15th. Please install the Github App Integration for your organization. Read more.

@@                  Coverage Diff                  @@
##           gcos4gnucobol-3.x      #98      +/-   ##
=====================================================
- Coverage              65.11%   65.11%   -0.01%     
=====================================================
  Files                     31       31              
  Lines                  58307    58317      +10     
  Branches               15349    15357       +8     
=====================================================
+ Hits                   37969    37973       +4     
- Misses                 14412    14417       +5     
- Partials                5926     5927       +1     
Impacted Files Coverage Δ
libcob/fileio.c 57.57% <33.33%> (-0.07%) :arrow_down:
cobc/codegen.c 74.85% <100.00%> (+<0.01%) :arrow_up:
cobc/flag.def 100.00% <100.00%> (ø)

:mega: We’re building smart automated test selection to slash your CI/CD build times. Learn more

GitMensch commented 1 year ago

How is the effect different to -foptional-file? Note: if that does not have a testcase yet, then it would be nice if you could directly commit your new testcase using -foptional-file.

ddeclerck commented 1 year ago

How is the effect different to -foptional-file? Note: if that does not have a testcase yet, then it would be nice if you could directly commit your new testcase using -foptional-file.

-foptional-file has an "all or nothing" approach, but our customer needs more granularity ; in particular, this should only apply to OPEN EXTEND and OPEN I-O, while not affecting OPEN INPUT statements.

GitMensch commented 1 year ago

So OPEN INPUT of not existing file should not return a 05 status, right?

ddeclerck commented 1 year ago

Yeah, the need here is that OPEN INPUT should behave as usual (in particular, fail with code 35 if file is missing and not optional), while OPEN I-O and OPEN EXTEND should more or less act like OPEN OUTPUT with respect to missing non-optional files.

GitMensch commented 1 year ago

I'm still not sure:

Is this for a single customer only?

GCOS docs:

The OPTIONAL phrase applies only to files opened in the input, I-O, or extend mode. Its specification is required for files that are not necessarily present each time the program is executed.

and

Table 12-2. Opening Available and Unavailable Files

FILE IS AVAILABLE FILE IS UNAVAILABLE
INPUT Normal OPEN OPEN is unsuccessful
---------------- -------------------- ----------------------
INPUT Normal OPEN Normal OPEN;
(optional file) The first READ causes
the AT END condition
or the INVALID KEY
condition.
---------------- -------------------- ----------------------
I-O Normal OPEN OPEN is unsuccessful
---------------- -------------------- ----------------------
I-O Normal OPEN The OPEN causes the
(optional file) file to be created.
---------------- -------------------- ----------------------
OUTPUT Contents are deleted The OPEN causes the
then normal OPEN file to be created
---------------- -------------------- ----------------------
EXTEND Normal OPEN OPEN is unsuccessful
---------------- -------------------- ----------------------
EXTEND Normal OPEN The OPEN causes the
(optional file) file to be created.
GitMensch commented 1 year ago

Note: for customer scenario, which seems to be the case, you have everything you need:

-fcallfh=ocamlproextfh and linking a matching entry point (can also be a COBOL module), which would always just call EXTFH (and may also set the OPTIONAL attribute before) and on the way back check for file status "05" and either replace it by zero or, if the open mode was INPUT close the file via EXTFH and return file status 35.

Until I see a possible general use case I'd say "tackle this via EXTFH" and close this issue.

GitMensch commented 1 year ago

Until we see a reason that this may be useful in general I'm closing it (we may reopen it later).

Note that also for a local patch I'd highly suggest to do it clean by putting that flag to the file not the program.

ddeclerck commented 1 year ago

Hi @GitMensch,

I've been experimenting a bit with EXTFH. I had some success, except I could not get it to create the file if missing, despite flipping the OPTIONAL flag.

Here is my minimal not working example :

COB_EXPIMP int myextfh(unsigned char *opcode, FCD3 *fcd) {
  fcd->otherFlags = fcd->otherFlags & ~OTH_NOT_OPTIONAL | OTH_OPTIONAL;
  int res = EXTFH(opcode, fcd);
  printf("Result: %c%c\n", fcd->fileStatus[0], fcd->fileStatus[1]);
  return res;
}

I always get code 35, while if I add "OPTIONAL" in my SELECT instruction, I get code 05.

Doing some tracing, I found that my OPEN EXTEND triggers a call to cob_extfh_open, which first calls find_fcd, and then calls my EXTFH handler through callfh, which just calls back the EXTFH3 function, which itself calls find_file. Now the problem is that find_fcd creates a cached cob_file object before I get a chance to set the OPTIONAL flag in my EXTFH handler, and the call to find_file just retrieve and use this cob_file object...

Is there a way I could bypass/update this cache from my EXTFH handler ?

GitMensch commented 1 year ago

find_fcd must set the (NOT) OPTIONAL flag in the resulting fcd. I guess that this is done correctly (you can either debug or do the call one time with, one time without the attribute, then print the flag in your EXTFH or have a look at it with a debugger).

Your myextfh is then called and can both read and adjust this flag (it would just always set the attribute). You then call the EXTFH function which only checks for the parameter, then calls EXTFH3 then calls find_file... and after reiterating what you've said I see the error: It does not copy over all necessary attributes.`

This is a bug in GnuCOBOL's EXTFH handling!

Can you please check a quick-fix? Before the cop_open() calls in fileio.c (EXTFH3): call copy_fcd_to_file (fcd, f, NULL); - that should be better. If that works you can ideally push this with a testcase upstream, otherwise I'd have to do that.

ddeclerck commented 1 year ago

Can you please check a quick-fix? Before the cop_open() calls in fileio.c (EXTFH3): call copy_fcd_to_file (fcd, f, NULL); - that should be better. If that works you can ideally push this with a testcase upstream, otherwise I'd have to do that.

Yup, that works (BTW: four occurrences of cop_open in EXTFH3, right ?).

I'll make a PR with the fix and a testcase so you can check (even if it's small).

GitMensch commented 1 year ago

Thank you, that helps a lot (yes, those 4 occurrences).

So I guess you can now also solve the customer issue with the -fcallfh option, right?

GitMensch commented 1 year ago

Note: to get it working also with released versions I'd change the approach:

ddeclerck commented 1 year ago

Thank you, that helps a lot (yes, those 4 occurrences).

So I guess you can now also solve the customer issue with the -fcallfh option, right?

That should solve it, yes.

ddeclerck commented 1 year ago

Note: to get it working also with released versions I'd change the approach:

  • send everything to EXTFH callback
  • if the result is status 35, then check for the open functions which should return zero, if it is, just send an OPEN OUTPUT, then a CLOSE, then the original open function

Actually, I did try that to circumvent the bug ;)

Just wondering if it's okay to make all these calls just to open a file...

GitMensch commented 1 year ago

Just wondering if it's okay to make all these calls just to open a file...

Those calls are quite cheap, compared to the actual file io on disk. If you want to you can do an easy check - just take a program with a bunch of io and compile it with -fcallfh=EXTFH and compare the performance results with/without that using perf stat yourprog youroptions - while the instruction count increases (a bit) the task time won't increase much.

ddeclerck commented 1 year ago

Uh-oh, it breaks a test : 919: INDEXED File READ/DELETE/READ.

Here is a partial diff between the expected and actual output :

$ diff -y testsuite.dir/0919/reference testsuite.dir/0919/prog.out 
Loading sample data file.                   Loading sample data file.
Sample data file load complete.                 Sample data file load complete.
List sample data file                       List sample data file
Key: ALP00000 is ALPHA ELECTRICAL CO. LTD. Disk=8417    .   Key: ALP00000 is ALPHA ELECTRICAL CO. LTD. Disk=8417    .
Key: BET00000 is BETA SHOE MFG. INC.       Disk=8470    .   Key: BET00000 is BETA SHOE MFG. INC.       Disk=8470    .
Key: DEL00000 is DELTA LUGGAGE REPAIRS     Disk=********.   Key: DEL00000 is DELTA LUGGAGE REPAIRS     Disk=********.
Key: EPS00000 is EPSILON EQUIPMENT SUPPLY  Disk=********.   Key: EPS00000 is EPSILON EQUIPMENT SUPPLY  Disk=********.
Key: FOR00000 is FORTUNE COOKIE COMPANY    Disk=8470    .   Key: FOR00000 is FORTUNE COOKIE COMPANY    Disk=8470    .
Key: GAM00000 is GAMMA X-RAY TECHNOLOGY    Disk=8417    .   Key: GAM00000 is GAMMA X-RAY TECHNOLOGY    Disk=8417    .
Key: GIB00000 is GIBRALTER LIFE INSURANCE  Disk=8417    .   Key: GIB00000 is GIBRALTER LIFE INSURANCE  Disk=8417    .
Key: H&J00000 is H & J PLUMBING SUPPLIES   Disk=********.   Key: H&J00000 is H & J PLUMBING SUPPLIES   Disk=********.
Key: INC00000 is INCREMENTAL BACKUP CORP.  Disk=8417    .   Key: INC00000 is INCREMENTAL BACKUP CORP.  Disk=8417    .
Key: JOH00000 is JOHNSON BOATING SUPPLIES  Disk=8417    .   Key: JOH00000 is JOHNSON BOATING SUPPLIES  Disk=8417    .
Key: KON00000 is KONFLAB PLASTIC PRODUCTS. Disk=8417    .   Key: KON00000 is KONFLAB PLASTIC PRODUCTS. Disk=8417    .
Key: LEW00000 is LEWISTON GRAPHICS LTD.    Disk=********.   Key: LEW00000 is LEWISTON GRAPHICS LTD.    Disk=********.
Key: MOR00000 is MORNINGSIDE CARPENTRY.    Disk=8470    .   Key: MOR00000 is MORNINGSIDE CARPENTRY.    Disk=8470    .
Key: NEW00000 is NEW WAVE SURF SHOPS INC.  Disk=********.   Key: NEW00000 is NEW WAVE SURF SHOPS INC.  Disk=********.
Key: OLD00000 is OLD TYME PIZZA MFG. CO.   Disk=8470    .   Key: OLD00000 is OLD TYME PIZZA MFG. CO.   Disk=8470    .
Key: PRE00000 is PRESTIGE OFFICE FURNITURE Disk=8470    .   Key: PRE00000 is PRESTIGE OFFICE FURNITURE Disk=8470    .
Hit End of File                         Hit End of File
List sample data file by Phone                  List sample data file by Phone
Ph=3131234432 Key: ALP00000 is ALPHA ELECTRICAL CO. LTD..     | Ph=ALP00000 A Key: ALP00000 is ALPHA ELECTRICAL CO. LTD..
Ph=3455445444 Key: INC00000 is INCREMENTAL BACKUP CORP. .     | Ph=BET00000 B Key: BET00000 is BETA SHOE MFG. INC.      .
Ph=4169898509 Key: BET00000 is BETA SHOE MFG. INC.      .     | Ph=DEL00000 D Key: DEL00000 is DELTA LUGGAGE REPAIRS    .
Ph=4169898509 Key: DEL00000 is DELTA LUGGAGE REPAIRS    .     | Ph=EPS00000 E Key: EPS00000 is EPSILON EQUIPMENT SUPPLY .
Ph=4169898509 Key: MOR00000 is MORNINGSIDE CARPENTRY.   .     | Ph=FOR00000 F Key: FOR00000 is FORTUNE COOKIE COMPANY   .
Ph=4169898509 Key: PRE00000 is PRESTIGE OFFICE FURNITURE.     | Ph=GAM00000 G Key: GAM00000 is GAMMA X-RAY TECHNOLOGY   .
Ph=5292398745 Key: EPS00000 is EPSILON EQUIPMENT SUPPLY .     | Ph=GIB00000 G Key: GIB00000 is GIBRALTER LIFE INSURANCE .
Ph=6456445643 Key: GIB00000 is GIBRALTER LIFE INSURANCE .     | Ph=H&J00000 H Key: H&J00000 is H & J PLUMBING SUPPLIES  .
Ph=6456445643 Key: JOH00000 is JOHNSON BOATING SUPPLIES .     | Ph=INC00000 I Key: INC00000 is INCREMENTAL BACKUP CORP. .
Ph=6546456333 Key: H&J00000 is H & J PLUMBING SUPPLIES  .     | Ph=JOH00000 J Key: JOH00000 is JOHNSON BOATING SUPPLIES .
Ph=6554456433 Key: LEW00000 is LEWISTON GRAPHICS LTD.   .     | Ph=KON00000 K Key: KON00000 is KONFLAB PLASTIC PRODUCTS..
Ph=7456434355 Key: KON00000 is KONFLAB PLASTIC PRODUCTS..     | Ph=LEW00000 L Key: LEW00000 is LEWISTON GRAPHICS LTD.   .
Ph=7534587453 Key: NEW00000 is NEW WAVE SURF SHOPS INC. .     | Ph=MOR00000 M Key: MOR00000 is MORNINGSIDE CARPENTRY.   .
Ph=8009329492 Key: FOR00000 is FORTUNE COOKIE COMPANY   .     | Ph=NEW00000 N Key: NEW00000 is NEW WAVE SURF SHOPS INC. .
Ph=8372487274 Key: GAM00000 is GAMMA X-RAY TECHNOLOGY   .     | Ph=OLD00000 O Key: OLD00000 is OLD TYME PIZZA MFG. CO.  .
Ph=8787458374 Key: OLD00000 is OLD TYME PIZZA MFG. CO.  .     | Ph=PRE00000 P Key: PRE00000 is PRESTIGE OFFICE FURNITURE.
Hit End of File                         Hit End of File
Test Read/Delete                        Test Read/Delete
 Delete: INC00000 random                     Delete: INC00000 random
 Delete: ALP00000 random                     Delete: ALP00000 random
   Read: BET00000 4169898509                      |    Read: BET00000 BET00000 B
 Delete: PRE00000 random                     Delete: PRE00000 random
Expected 10 after delete PRE00000               Expected 10 after delete PRE00000
GitMensch commented 1 year ago

Looks like the key reference is overwritten, can you please check this?

GitMensch commented 1 year ago

In theory it could only be in this block;

        if (f->keys == NULL) {
            if (fcd->kdbPtr != NULL
             && LDCOMPX2(fcd->kdbPtr->nkeys) > 0) {
                /* Copy Key information from FCD to cob_file,
                   CHECKME: possibly only for ORG_DETERMINE + OP-DELETE-FILE ? */
                f->nkeys = LDCOMPX2(fcd->kdbPtr->nkeys);
                if (f->nkeys > MAX_FILE_KEYS) {
                    /* CHECKME - Should this result in any error handling? */
                    cob_runtime_warning (_("maximum keys (%d/%d) exceeded for file '%s'"),
                        (int)f->nkeys, MAX_FILE_KEYS, cob_get_filename_print (f->file, 0));
                    f->nkeys = MAX_FILE_KEYS;
                }
                f->keys = cob_cache_malloc (sizeof (cob_file_key) * f->nkeys);
                copy_keys_fcd_to_file (fcd, f, 0);
            } else {
                f->keys = cob_cache_malloc(sizeof (cob_file_key));
            }
        } else if (f->nkeys > 0
                && fcd->kdbPtr != NULL
                && LDCOMPX2(fcd->kdbPtr->nkeys) >= (int)f->nkeys) {
            copy_keys_fcd_to_file (fcd, f, 0);
        }

which would mean that either the code is bad or copy_file_to_fcd() missed to set an attribute in the fcd.