[Bug fortran/88269] ICE in gfc_format_decoder, at fortran/error.c:947

[kargl at gcc dot gnu.org]

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

kargl at gcc dot gnu.org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
           Priority|P3                          |P4
             Status|UNCONFIRMED                 |NEW
   Last reconfirmed|                            |2018-11-30
     Ever confirmed|0                           |1

--- Comment #1 from kargl at gcc dot gnu.org ---
(In reply to G. Steinmetz from comment #0)
> With invalid code, down to at least gcc-5 :
> 
> 
> $ cat z1.f90
> program p
>    write (end=1e1)
>    write (end=1d1)
>    write (end=1q1)
> end
> 
> 
> $ gfortran-9-20181125 -c z1.f90
> 0x619a5e gfc_format_decoder
>         ../../gcc/fortran/error.c:947
> 0x131c83e pp_format(pretty_printer*, text_info*)
>         ../../gcc/pretty-print.c:1390
> 0x13121e5 diagnostic_report_diagnostic(diagnostic_context*, diagnostic_info*)
>         ../../gcc/diagnostic.c:1015
> 0x6198fc gfc_error_opt
>         ../../gcc/fortran/error.c:1313
> 0x61aea0 gfc_error(char const*, ...)
>         ../../gcc/fortran/error.c:1342
> 0x63c9b2 check_io_constraints
>         ../../gcc/fortran/io.c:3755


Index: gcc/fortran/io.c
===================================================================
--- gcc/fortran/io.c    (revision 266386)
+++ gcc/fortran/io.c    (working copy)
@@ -3681,7 +3681,10 @@ check_io_constraints (io_kind k, gfc_dt *dt, gfc_code 
 #define io_constraint(condition,msg,arg)\
 if (condition) \
   {\
-    gfc_error(msg,arg);\
+    if ((arg)->lb != NULL) \
+      gfc_error(msg,arg);\
+    else \
+      gfc_error(msg,&gfc_current_locus);\
     m = MATCH_ERROR;\
   }

@@ -3741,11 +3744,14 @@ if (condition) \
   if (expr && expr->ts.type != BT_CHARACTER)
     {

-      io_constraint (gfc_pure (NULL) && (k == M_READ || k == M_WRITE),
-                    "IO UNIT in %s statement at %C must be "
+      if (gfc_pure (NULL) && (k == M_READ || k == M_WRITE))
+       {
+         gfc_error ("IO UNIT in %s statement at %C must be "
                     "an internal file in a PURE procedure",
                     io_kind_name (k));
-
+         return MATCH_ERROR;
+       }
+         
       if (k == M_READ || k == M_WRITE)
        gfc_unset_implicit_pure (NULL);
     }