PR libfortran/95195 - improve runtime error for namelist i/o to unformatted file
authorHarald Anlauf <anlauf@gmx.de>
Tue, 26 May 2020 19:21:19 +0000 (21:21 +0200)
committerHarald Anlauf <anlauf@gmx.de>
Tue, 26 May 2020 19:33:46 +0000 (21:33 +0200)
Namelist input/output to unformatted files is prohibited.
Generate useful runtime errors instead instead of misleading ones.

2020-05-26  Harald Anlauf  <anlauf@gmx.de>

libgfortran/
PR fortran/95195
* io/transfer.c (finalize_transfer): Generate runtime error for
namelist input/output to unformatted file.

gcc/testsuite/
PR fortran/95195
* gfortran.dg/namelist_97.f90: New test.

gcc/testsuite/gfortran.dg/namelist_97.f90 [new file with mode: 0644]
libgfortran/io/transfer.c

diff --git a/gcc/testsuite/gfortran.dg/namelist_97.f90 b/gcc/testsuite/gfortran.dg/namelist_97.f90
new file mode 100644 (file)
index 0000000..4907e46
--- /dev/null
@@ -0,0 +1,14 @@
+! { dg-do run }
+! { dg-output "At line 12 .*" }
+! { dg-shouldfail "Fortran runtime error: Namelist formatting .* FORM='UNFORMATTED'" }
+!
+! PR95195 - improve runtime error when writing a namelist to an unformatted file
+
+program test
+  character(len=11) :: my_form = 'unformatted'
+  integer           :: i = 1, j = 2, k = 3
+  namelist /nml1/ i, j, k
+  open  (unit=10, file='test.dat', form=my_form)
+  write (unit=10, nml=nml1)
+  close (unit=10, status='delete')
+end program test
index b8db47dbff9dbe03fbd990424a0134c98521c2c0..d071c1ce915cc7222f66a70e80848b6671c1c5b7 100644 (file)
@@ -4123,6 +4123,14 @@ finalize_transfer (st_parameter_dt *dtp)
   if ((dtp->u.p.ionml != NULL)
       && (cf & IOPARM_DT_HAS_NAMELIST_NAME) != 0)
     {
+       if (dtp->u.p.current_unit->flags.form == FORM_UNFORMATTED)
+        {
+          generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT,
+                          "Namelist formatting for unit connected "
+                          "with FORM='UNFORMATTED");
+          return;
+        }
+
        dtp->u.p.namelist_mode = 1;
        if ((cf & IOPARM_DT_NAMELIST_READ_MODE) != 0)
         namelist_read (dtp);