[Bug libfortran/88776] Namelist read from stdin: loss of data

[jvdelisle at gcc dot gnu.org]

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=88776

Jerry DeLisle <jvdelisle at gcc dot gnu.org> changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
                 CC|                            |jvdelisle at gcc dot gnu.org

--- Comment #4 from Jerry DeLisle <jvdelisle at gcc dot gnu.org> ---
(In reply to Harald Anlauf from comment #3)
> Created attachment 45407 [details]
> Self-contained testcase
> 
> I've been able to produce a self-contained testcase, which may aid
> debugging.
> 
> While reducing further, I got the impression that it is just a subtle
> whitespace issue.

I have looked a little closer at this. 

There are a few places where reading is handled differently if the unit is
stdin_unit. For example in list_read.c near line 3614 we have:

  while (!dtp->u.p.input_complete)
    {
      if (!nml_get_obj_data (dtp, &prev_nl, nml_err_msg, sizeof nml_err_msg))
        {
          printf ("ping: %d, %d\n", dtp->u.p.current_unit->unit_number,    
options.stdin_unit);
          if (dtp->u.p.current_unit->unit_number != options.stdin_unit)
            goto nml_err_ret;
          printf("pong\n");
          generate_error (&dtp->common, LIBERROR_READ_VALUE, nml_err_msg);
        }

Where I have instrumented this a little and running a slightly modified test
case, we take two different error paths. This results in:

$ ./a.out 
 Calling on unit 10:
ping: 10, 5
 Calling on unit 5:
ping: 5, 5
pong
 ichan not 2,unit=           5
STOP 3

goto nml_err_ret above is a more graceful return:

nml_err_ret:

  /* All namelist error calls return from here */
  free_saved (dtp);
  free_line (dtp);
  generate_error (&dtp->common, LIBERROR_READ_VALUE, nml_err_msg);
  return;

Putting a return after the error in the block at 3614 seems to fix it.

      if (!nml_get_obj_data (dtp, &prev_nl, nml_err_msg, sizeof nml_err_msg))
        {
          //printf ("ping: %d, %d\n", dtp->u.p.current_unit->unit_number,
options.stdin_unit);
          if (dtp->u.p.current_unit->unit_number != options.stdin_unit)
            goto nml_err_ret;
          //printf("pong\n");
          generate_error (&dtp->common, LIBERROR_READ_VALUE, nml_err_msg);
          return;
        }

With the printf's commented out:

$ ./a.out 
 Calling on unit 10:
 Calling on unit 5:

I have not regression tested this and will report back.