Re: [PATCH] pkl: fix `flush'

[Jose E. Marchesi]

Hi Mohammad.

OK for master and maint/poke-3.
Thanks!

> 2023-06-26  Mohammad-Reza Nabipoor  <mnabipoor@gnu.org>
>
>       * libpoke/ios-dev-stream.c (ios_dev_stream_flush): Fix flushing logic
>       for `<stdout>' and `<stderr>'.
>       * libpoke/pvm.jitter (flush): Push `PVM_NULL' when there's no error.
>       * testsuite/poke.pkl/flush-2.pk: New test.
>       * testsuite/poke.pkl/flush-3.pk: Likewise.
>       * testsuite/poke.pkl/flush-4.pk: Likewise.
>       * testsuite/poke.pkl/flush-5.pk: Likewise.
>       * testsuite/Makefile.am (EXTRA_DIST): Update.
> ---
>  ChangeLog                     | 11 +++++++++++
>  libpoke/ios-dev-stream.c      |  7 ++-----
>  libpoke/pvm.jitter            |  2 ++
>  testsuite/Makefile.am         |  4 ++++
>  testsuite/poke.pkl/flush-2.pk |  6 ++++++
>  testsuite/poke.pkl/flush-3.pk |  6 ++++++
>  testsuite/poke.pkl/flush-4.pk |  6 ++++++
>  testsuite/poke.pkl/flush-5.pk |  6 ++++++
>  8 files changed, 43 insertions(+), 5 deletions(-)
>  create mode 100644 testsuite/poke.pkl/flush-2.pk
>  create mode 100644 testsuite/poke.pkl/flush-3.pk
>  create mode 100644 testsuite/poke.pkl/flush-4.pk
>  create mode 100644 testsuite/poke.pkl/flush-5.pk
>
> diff --git a/ChangeLog b/ChangeLog
> index d6870084..fb0c251a 100644
> --- a/ChangeLog
> +++ b/ChangeLog
> @@ -1,3 +1,14 @@
> +2023-06-26  Mohammad-Reza Nabipoor  <mnabipoor@gnu.org>
> +
> +     * libpoke/ios-dev-stream.c (ios_dev_stream_flush): Fix flushing logic
> +     for `<stdout>' and `<stderr>'.
> +     * libpoke/pvm.jitter (flush): Push `PVM_NULL' when there's no error.
> +     * testsuite/poke.pkl/flush-2.pk: New test.
> +     * testsuite/poke.pkl/flush-3.pk: Likewise.
> +     * testsuite/poke.pkl/flush-4.pk: Likewise.
> +     * testsuite/poke.pkl/flush-5.pk: Likewise.
> +     * testsuite/Makefile.am (EXTRA_DIST): Update.
> +
>  2023-06-23  Jose E. Marchesi  <jemarch@gnu.org>
>  
>       * libpoke/pkl-gen.pks (struct_constructor): Re-raise an E_conv
> diff --git a/libpoke/ios-dev-stream.c b/libpoke/ios-dev-stream.c
> index 573d6124..20bef44e 100644
> --- a/libpoke/ios-dev-stream.c
> +++ b/libpoke/ios-dev-stream.c
> @@ -255,11 +255,8 @@ ios_dev_stream_flush (void *iod, ios_dev_off offset)
>        && offset > ios_buffer_get_begin_offset (sio->buffer)
>        && offset <= ios_buffer_get_end_offset (sio->buffer))
>      return ios_buffer_forget_till (sio->buffer, offset);
> -  else
> -    {
> -      assert (sio->flags & IOS_F_WRITE);
> -      fflush (sio->file);
> -    }
> +  else if (sio->flags & IOS_F_WRITE)
> +    fflush (sio->file);
>    return IOS_OK;
>  }
>  
> diff --git a/libpoke/pvm.jitter b/libpoke/pvm.jitter
> index 299f1b59..8d44872f 100644
> --- a/libpoke/pvm.jitter
> +++ b/libpoke/pvm.jitter
> @@ -1587,6 +1587,8 @@ instruction flush ()
>        JITTER_TOP_STACK () = PVM_MAKE_DFL_EXCEPTION (PVM_E_NO_IOS);
>      else if (ios_flush (io, offset) != IOS_OK)
>        JITTER_TOP_STACK () = PVM_MAKE_DFL_EXCEPTION (PVM_E_IO);
> +    else
> +      JITTER_TOP_STACK () = PVM_NULL;
>    end
>  end
>  
> diff --git a/testsuite/Makefile.am b/testsuite/Makefile.am
> index acb0220b..f1eaf6ab 100644
> --- a/testsuite/Makefile.am
> +++ b/testsuite/Makefile.am
> @@ -1392,6 +1392,10 @@ EXTRA_DIST = \
>    poke.pkl/field-init-diag-6.pk \
>    poke.pkl/field-init-diag-7.pk \
>    poke.pkl/flush-1.pk \
> +  poke.pkl/flush-2.pk \
> +  poke.pkl/flush-3.pk \
> +  poke.pkl/flush-4.pk \
> +  poke.pkl/flush-5.pk \
>    poke.pkl/for-1.pk \
>    poke.pkl/for-2.pk \
>    poke.pkl/for-3.pk \
> diff --git a/testsuite/poke.pkl/flush-2.pk b/testsuite/poke.pkl/flush-2.pk
> new file mode 100644
> index 00000000..1bfdf6d0
> --- /dev/null
> +++ b/testsuite/poke.pkl/flush-2.pk
> @@ -0,0 +1,6 @@
> +/* { dg-do run } */
> +
> +var stdout = open ("<stdout>");
> +
> +flush (stdout, 0#B);
> +close (stdout);
> diff --git a/testsuite/poke.pkl/flush-3.pk b/testsuite/poke.pkl/flush-3.pk
> new file mode 100644
> index 00000000..28c9fffc
> --- /dev/null
> +++ b/testsuite/poke.pkl/flush-3.pk
> @@ -0,0 +1,6 @@
> +/* { dg-do run } */
> +
> +var stdin = open ("<stdin>");
> +
> +flush (stdin, 0#B);
> +close (stdin);
> diff --git a/testsuite/poke.pkl/flush-4.pk b/testsuite/poke.pkl/flush-4.pk
> new file mode 100644
> index 00000000..e2c6dd8f
> --- /dev/null
> +++ b/testsuite/poke.pkl/flush-4.pk
> @@ -0,0 +1,6 @@
> +/* { dg-do run } */
> +
> +var stderr = open ("<stderr>");
> +
> +flush (stderr, 0#B);
> +close (stderr);
> diff --git a/testsuite/poke.pkl/flush-5.pk b/testsuite/poke.pkl/flush-5.pk
> new file mode 100644
> index 00000000..e2b63615
> --- /dev/null
> +++ b/testsuite/poke.pkl/flush-5.pk
> @@ -0,0 +1,6 @@
> +/* { dg-do run } */
> +
> +var mem = open ("*mem*");
> +
> +flush (mem, 0#B);
> +close (mem);