[Bug fortran/90166] Compiler Fails at Assembler

[sgk at troutmask dot apl.washington.edu]

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

--- Comment #3 from Steve Kargl <sgk at troutmask dot apl.washington.edu> ---
On Fri, Apr 19, 2019 at 12:01:55AM +0000, sgk at troutmask dot
apl.washington.edu wrote:
> https://gcc.gnu.org/bugzilla/show_bug.cgi?id=90166
> 
> --- Comment #2 from Steve Kargl <sgk at troutmask dot apl.washington.edu> ---
> On Thu, Apr 18, 2019 at 11:55:51PM +0000, sgk at troutmask dot
> apl.washington.edu wrote:
> > https://gcc.gnu.org/bugzilla/show_bug.cgi?id=90166
> > 
> > --- Comment #1 from Steve Kargl <sgk at troutmask dot apl.washington.edu> 
> > ---
> > ndex: decl.c
> > ===================================================================
> > --- decl.c      (revision 270181)
> > +++ decl.c      (working copy)
> > @@ -7598,6 +7598,13 @@ gfc_match_subroutine (void)
> >    if (m != MATCH_YES)
> >      return m;
> > 
> > +  if (current_attr.module_procedure == 1
> > +      && gfc_current_state () != COMP_MODULE)
> 
> This isn't quite right.  A module subroutine can appear in
> an interface statement.
> 

This survives regression testing, but boy is it ugly.

Index: decl.c
===================================================================
--- decl.c      (revision 270181)
+++ decl.c      (working copy)
@@ -6103,6 +6103,19 @@ gfc_match_prefix (gfc_typespec *ts)
          if (!gfc_notify_std (GFC_STD_F2008, "MODULE prefix at %C"))
            goto error;

+         if (gfc_current_state () != COMP_MODULE
+             && gfc_current_state () != COMP_SUBMODULE 
+             && gfc_current_state () != COMP_INTERFACE
+             && gfc_current_state () != COMP_CONTAINS
+             && !(gfc_state_stack->state == COMP_FUNCTION
+                  && (gfc_state_stack->previous->state == COMP_INTERFACE
+                       || gfc_state_stack->previous->state == COMP_CONTAINS)))
+           {
+             gfc_error ("MODULE prefix at %C found outside of a module, "
+                        "submodule, or INTERFACE");
+             goto error;
+           }
+
          current_attr.module_procedure = 1;
          found_prefix = true;
        }