[gfortran] Fix PR15481 and related bugs

[gfortran] Fix PR15481 and related bugs

[Tobias Schlüter]

[-- Attachment #1: Type: text/plain, Size: 1382 bytes --]


This was surprisingly easily, after I had looked at what's really
happening. We avoid emitting the spurious symbol in gfc_match_rvalue by
explicitly checking if we're matching a function call where the first
argument is a keyword argument, and skip the array detection if that's
the case. With this fix in place, I could turn on the issuing of errors
in resolve_symbol when implicitly typing variables and remove several
workarounds. The diff to primary.c looks bigger than it is because of
the changed identation.

Compiled and tested on i686-pc-linux, with no failures besides the
intrinsic_nearest issue discussed before. I will add compile testcases
from the PRs to the testsuite, and once we have a fully functional dg
testsuite I will also add a testcase (or if I find more, several
testcases) which now give the correct errors.

- Tobi

2004-07-09  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>

	PR fortran/15481
	PR fortran/13372
	PR fortran/13575
	PR fortran/15978
	* module.c (write_symbol, write_symtree): Remove workaround.
	* primary.c (match_actual_arglist): Enhance comment.
	(gfc_match_rvalue): Handle function call with first argument
	a keyword argument correctly.
	* resolve.c (resolve_symbol): Change call to
	gfc_set_default_type to issue error if no implicit type
	can be found.
	* trans-decl.c (gfc_create_module_variable): Remove workaround.

[-- Attachment #2: 15481patch --]
[-- Type: text/plain, Size: 6909 bytes --]

Index: module.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/module.c,v
retrieving revision 1.8
diff -c -3 -p -r1.8 module.c
*** module.c	29 Jun 2004 18:56:47 -0000	1.8
--- module.c	9 Jul 2004 14:23:15 -0000
*************** write_symbol (int n, gfc_symbol * sym)
*** 3189,3201 ****
    if (sym->attr.flavor == FL_UNKNOWN || sym->attr.flavor == FL_LABEL)
      gfc_internal_error ("write_symbol(): bad module symbol '%s'", sym->name);
  
- 
-   if (sym->attr.flavor == FL_VARIABLE && sym->ts.type == BT_UNKNOWN)
-     /* TODO: this is a workaround for some of the problems in PR15481,
-        and fixes the dependent bug PR13372. In an ideal frontend, this
-        should never happen.  */
-     return;
- 
    mio_integer (&n);
    mio_internal_string (sym->name);
  
--- 3189,3194 ----
*************** write_symtree (gfc_symtree * st)
*** 3319,3330 ****
  	  && !sym->attr.subroutine && !sym->attr.function))
      return;
  
-   if (sym->attr.flavor == FL_VARIABLE && sym->ts.type == BT_UNKNOWN)
-     /* TODO: this is a workaround for some of the problems in PR15481,
-        and fixes the dependent bug PR13372. In an ideal frontend, this
-        should never happen.  */
-     return;
- 
    if (check_unique_name (st->name))
      return;
  
--- 3312,3317 ----
Index: primary.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/primary.c,v
retrieving revision 1.6
diff -c -3 -p -r1.6 primary.c
*** primary.c	27 May 2004 12:35:12 -0000	1.6
--- primary.c	9 Jul 2004 14:23:18 -0000
*************** cleanup:
*** 1400,1406 ****
     the opening parenthesis to the closing parenthesis.  The argument
     list is assumed to allow keyword arguments because we don't know if
     the symbol associated with the procedure has an implicit interface
!    or not.  We make sure keywords are unique.  */
  
  match
  gfc_match_actual_arglist (int sub_flag, gfc_actual_arglist ** argp)
--- 1400,1407 ----
     the opening parenthesis to the closing parenthesis.  The argument
     list is assumed to allow keyword arguments because we don't know if
     the symbol associated with the procedure has an implicit interface
!    or not.  We make sure keywords are unique. If SUB_FLAG is set,
!    we're matching the argument list of a subroutine.  */
  
  match
  gfc_match_actual_arglist (int sub_flag, gfc_actual_arglist ** argp)
*************** match
*** 1839,1851 ****
  gfc_match_rvalue (gfc_expr ** result)
  {
    gfc_actual_arglist *actual_arglist;
!   char name[GFC_MAX_SYMBOL_LEN + 1];
    gfc_state_data *st;
    gfc_symbol *sym;
    gfc_symtree *symtree;
!   locus where;
    gfc_expr *e;
!   match m;
    int i;
  
    m = gfc_match_name (name);
--- 1840,1852 ----
  gfc_match_rvalue (gfc_expr ** result)
  {
    gfc_actual_arglist *actual_arglist;
!   char name[GFC_MAX_SYMBOL_LEN + 1], argname[GFC_MAX_SYMBOL_LEN + 1];
    gfc_state_data *st;
    gfc_symbol *sym;
    gfc_symtree *symtree;
!   locus where, old_loc;
    gfc_expr *e;
!   match m, m2;
    int i;
  
    m = gfc_match_name (name);
*************** gfc_match_rvalue (gfc_expr ** result)
*** 2044,2078 ****
  	  break;
  	}
  
!       /* See if this could possibly be a substring reference of a name
!          that we're not sure is a variable yet.  */
  
        e = gfc_get_expr ();
        e->symtree = symtree;
  
!       if ((sym->ts.type == BT_UNKNOWN || sym->ts.type == BT_CHARACTER)
! 	  && match_substring (sym->ts.cl, 0, &e->ref) == MATCH_YES)
  	{
  
! 	  e->expr_type = EXPR_VARIABLE;
! 
! 	  if (sym->attr.flavor != FL_VARIABLE
! 	      && gfc_add_flavor (&sym->attr, FL_VARIABLE, NULL) == FAILURE)
  	    {
- 	      m = MATCH_ERROR;
- 	      break;
- 	    }
  
! 	  if (sym->ts.type == BT_UNKNOWN
! 	      && gfc_set_default_type (sym, 1, NULL) == FAILURE)
! 	    {
! 	      m = MATCH_ERROR;
  	      break;
  	    }
- 
- 	  e->ts = sym->ts;
- 	  m = MATCH_YES;
- 	  break;
  	}
  
        /* Give up, assume we have a function.  */
--- 2045,2090 ----
  	  break;
  	}
  
!       /* See if this is a function reference with a keyword argument
! 	 as first argument. We do this because otherwise a spurious
! 	 symbol would end up in the symbol table.  */
! 
!       old_loc = gfc_current_locus;
!       m2 = gfc_match (" ( %n =", argname);
!       gfc_current_locus = old_loc;
  
        e = gfc_get_expr ();
        e->symtree = symtree;
  
!       if (m2 != MATCH_YES)
  	{
+ 	  /* See if this could possibly be a substring reference of a name
+ 	     that we're not sure is a variable yet.  */
  
! 	  if ((sym->ts.type == BT_UNKNOWN || sym->ts.type == BT_CHARACTER)
! 	      && match_substring (sym->ts.cl, 0, &e->ref) == MATCH_YES)
  	    {
  
! 	      e->expr_type = EXPR_VARIABLE;
! 
! 	      if (sym->attr.flavor != FL_VARIABLE
! 		  && gfc_add_flavor (&sym->attr, FL_VARIABLE, NULL) == FAILURE)
! 		{
! 		  m = MATCH_ERROR;
! 		  break;
! 		}
! 
! 	      if (sym->ts.type == BT_UNKNOWN
! 		  && gfc_set_default_type (sym, 1, NULL) == FAILURE)
! 		{
! 		  m = MATCH_ERROR;
! 		  break;
! 		}
! 
! 	      e->ts = sym->ts;
! 	      m = MATCH_YES;
  	      break;
  	    }
  	}
  
        /* Give up, assume we have a function.  */
Index: resolve.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/resolve.c,v
retrieving revision 1.8
diff -c -3 -p -r1.8 resolve.c
*** resolve.c	22 Jun 2004 00:43:52 -0000	1.8
--- resolve.c	9 Jul 2004 14:23:18 -0000
*************** resolve_symbol (gfc_symbol * sym)
*** 3714,3720 ****
    if (sym->ts.type == BT_UNKNOWN)
      {
        if (sym->attr.flavor == FL_VARIABLE || sym->attr.flavor == FL_PARAMETER)
! 	gfc_set_default_type (sym, 0, NULL);
  
        if (sym->attr.flavor == FL_PROCEDURE && sym->attr.function)
  	{
--- 3714,3720 ----
    if (sym->ts.type == BT_UNKNOWN)
      {
        if (sym->attr.flavor == FL_VARIABLE || sym->attr.flavor == FL_PARAMETER)
! 	gfc_set_default_type (sym, 1, NULL);
  
        if (sym->attr.flavor == FL_PROCEDURE && sym->attr.function)
  	{
Index: trans-decl.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-decl.c,v
retrieving revision 1.18
diff -c -3 -p -r1.18 trans-decl.c
*** trans-decl.c	4 Jul 2004 17:00:11 -0000	1.18
--- trans-decl.c	9 Jul 2004 14:23:19 -0000
*************** gfc_create_module_variable (gfc_symbol *
*** 1798,1809 ****
        && (sym->attr.flavor != FL_PARAMETER || sym->attr.dimension == 0))
      return;
  
-   if (sym->attr.flavor == FL_VARIABLE && sym->ts.type == BT_UNKNOWN)
-     /* TODO: This is a workaround for the issue outlined in PR 15481,
-        and it fixes the bug in PR13372. This should never happen in an
-        ideal frontend.  */
-     return;
- 
    /* Don't generate variables from other modules.  */
    if (sym->attr.use_assoc)
      return;
--- 1798,1803 ----

Re: [gfortran] Fix PR15481 and related bugs

[Paul Brook]

> 2004-07-09  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
>
> 	PR fortran/15481
> 	PR fortran/13372
> 	PR fortran/13575
> 	PR fortran/15978
> 	* module.c (write_symbol, write_symtree): Remove workaround.
> 	* primary.c (match_actual_arglist): Enhance comment.
> 	(gfc_match_rvalue): Handle function call with first argument
> 	a keyword argument correctly.
> 	* resolve.c (resolve_symbol): Change call to
> 	gfc_set_default_type to issue error if no implicit type
> 	can be found.
> 	* trans-decl.c (gfc_create_module_variable): Remove workaround.

Ok.

Paul