This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.

Index Nav:	[Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav:	[Date Prev] [Date Next]	[Thread Prev] [Thread Next]
Other format:	[Raw text]

[Patch, fortran] PR24558, PR20877 and PR25047 - module function alternate entries.

From: Paul Thomas <paulthomas2 at wanadoo dot fr>
To: "'fortran at gcc dot gnu dot org'" <fortran at gcc dot gnu dot org>, patch <gcc-patches at gcc dot gnu dot org>
Date: Wed, 31 May 2006 12:12:32 +0200
Subject: [Patch, fortran] PR24558, PR20877 and PR25047 - module function alternate entries.

:ADDPATCH fortran:

This patch fixes PR24558 and, in so doing, PR20877 and PR25047. In all three, a prior reference to a module function alternate entry would produce the error: "insert_bbt(): Duplicate key found!" This occurs because decl.c(get_proc_name) attempts to create a symtree for the entry in the current namespace, when one has already been created as a result of the reference.

The fix proceeds by adding a new argument to get_proc_name, which signals that a module function entry is being processed. If this is true, the new symtree is created in the module namespace and gfc_add_procedure is called to add a module procedure.

Having cleared the duplicate key message a series of downstream steps are required to persuade module function entries to work: (i) In resolve.c(resolve_entries), the entry symbol needs to reference the master entry namespace, so that the fake result mechanism works. (ii) Trans-decl.c(gfc_create_module_variable) must return immediately on seeing an entry because the subsequent check that the symbol namespace is the module namespace fails. (iii) Finally, the condition for parent_flag, in trans-expr.c(gfc_conv_variable), must be corrected to deal with both parent_decl and the proc_name backend_decl both being NULL. This pushed gfc_get_fake_result_decl into segfaulting.

The first test case checks the functioning of module function entries and the second checks that the correct errors are generated by the incorrect code of PRs 20877 and 25047. PR20877 produces a slightly strange error message, which comes from check_conflict and is due to the order in which the PROCEDURE, ENTRY and RESULT attributes are encountered. Changing this causes all manner of regressions and, since the error message is correct and comprehensible, I have left well alone.

Regtested on FC5/Athlon1700. OK for trunk and 4.1?

Paul

2006-05-31 Paul Thomas <pault@gcc.gnu.org>

   PR fortran/24558
   PR fortran/20877
   PR fortran/25047
   * decl.c (get_proc_name): Add new argument to flag that a
   module function entry is being treated. If true, correct
   error condition, add symtree to module namespace and add
   a module procedure.
   (gfc_match_function_decl, gfc_match_entry,
   gfc_match_subroutine): Use the new argument in calls to
   get_proc_name.
   * resolve.c (resolve_entries): ENTRY symbol reference to
   to master entry namespace if a module function.
   * trans-decl.c (gfc_create_module_variable): Return if
   the symbol is an entry.
   * trans-exp.c (gfc_conv_variable): Check that parent_decl
   is not NULL.

2006-05-31 Paul Thomas <pault@gcc.gnu.org>

   PR fortran/24558
   * gfortran.dg/entry_6.f90: New test.

   PR fortran/20877
   PR fortran/25047
   * gfortran.dg/entry_7.f90: New test.

Index: gcc/fortran/decl.c
===================================================================
*** gcc/fortran/decl.c	(revision 114148)
--- gcc/fortran/decl.c	(working copy)
*************** end:
*** 596,608 ****
     parent, then the symbol is just created in the current unit.  */
  
  static int
! get_proc_name (const char *name, gfc_symbol ** result)
  {
    gfc_symtree *st;
    gfc_symbol *sym;
    int rc;
  
!   if (gfc_current_ns->parent == NULL)
      rc = gfc_get_symbol (name, NULL, result);
    else
      rc = gfc_get_symbol (name, gfc_current_ns->parent, result);
--- 596,609 ----
     parent, then the symbol is just created in the current unit.  */
  
  static int
! get_proc_name (const char *name, gfc_symbol ** result,
! 	       bool module_fcn_entry)
  {
    gfc_symtree *st;
    gfc_symbol *sym;
    int rc;
  
!   if (gfc_current_ns->parent == NULL || module_fcn_entry)
      rc = gfc_get_symbol (name, NULL, result);
    else
      rc = gfc_get_symbol (name, gfc_current_ns->parent, result);
*************** get_proc_name (const char *name, gfc_sym
*** 628,634 ****
        if (sym->ts.kind != 0
  	    && sym->attr.proc == 0
  	    && gfc_current_ns->parent != NULL
! 	    && sym->attr.access == 0)
  	gfc_error_now ("Procedure '%s' at %C has an explicit interface"
  		       " and must not have attributes declared at %L",
  		       name, &sym->declared_at);
--- 629,636 ----
        if (sym->ts.kind != 0
  	    && sym->attr.proc == 0
  	    && gfc_current_ns->parent != NULL
! 	    && sym->attr.access == 0
! 	    && !module_fcn_entry)
  	gfc_error_now ("Procedure '%s' at %C has an explicit interface"
  		       " and must not have attributes declared at %L",
  		       name, &sym->declared_at);
*************** get_proc_name (const char *name, gfc_sym
*** 637,654 ****
    if (gfc_current_ns->parent == NULL || *result == NULL)
      return rc;
  
!   st = gfc_new_symtree (&gfc_current_ns->sym_root, name);
  
    st->n.sym = sym;
    sym->refs++;
  
    /* See if the procedure should be a module procedure */
  
!   if (sym->ns->proc_name != NULL
!       && sym->ns->proc_name->attr.flavor == FL_MODULE
!       && sym->attr.proc != PROC_MODULE
!       && gfc_add_procedure (&sym->attr, PROC_MODULE,
! 			    sym->name, NULL) == FAILURE)
      rc = 2;
  
    return rc;
--- 639,661 ----
    if (gfc_current_ns->parent == NULL || *result == NULL)
      return rc;
  
!   /* Module function entries will already have a symtree in
!      the current namespace but will need one at module level.  */
!   if (module_fcn_entry)
!     st = gfc_new_symtree (&gfc_current_ns->parent->sym_root, name);
!   else
!     st = gfc_new_symtree (&gfc_current_ns->sym_root, name);
  
    st->n.sym = sym;
    sym->refs++;
  
    /* See if the procedure should be a module procedure */
  
!   if (((sym->ns->proc_name != NULL
! 	  && sym->ns->proc_name->attr.flavor == FL_MODULE
! 	  && sym->attr.proc != PROC_MODULE) || module_fcn_entry)
! 	&& gfc_add_procedure (&sym->attr, PROC_MODULE,
! 			      sym->name, NULL) == FAILURE)
      rc = 2;
  
    return rc;
*************** gfc_match_function_decl (void)
*** 2564,2570 ****
        return MATCH_NO;
      }
  
!   if (get_proc_name (name, &sym))
      return MATCH_ERROR;
    gfc_new_block = sym;
  
--- 2571,2577 ----
        return MATCH_NO;
      }
  
!   if (get_proc_name (name, &sym, false))
      return MATCH_ERROR;
    gfc_new_block = sym;
  
*************** gfc_match_entry (void)
*** 2667,2672 ****
--- 2674,2680 ----
    match m;
    gfc_entry_list *el;
    locus old_loc;
+   bool module_procedure;
  
    m = gfc_match_name (name);
    if (m != MATCH_YES)
*************** gfc_match_entry (void)
*** 2727,2742 ****
        return MATCH_ERROR;
      }
  
    if (gfc_current_ns->parent != NULL
        && gfc_current_ns->parent->proc_name
!       && gfc_current_ns->parent->proc_name->attr.flavor != FL_MODULE)
      {
        gfc_error("ENTRY statement at %C cannot appear in a "
  		"contained procedure");
        return MATCH_ERROR;
      }
  
!   if (get_proc_name (name, &entry))
      return MATCH_ERROR;
  
    proc = gfc_current_block ();
--- 2735,2760 ----
        return MATCH_ERROR;
      }
  
+   module_procedure = gfc_current_ns->parent != NULL
+       && gfc_current_ns->parent->proc_name
+       && gfc_current_ns->parent->proc_name->attr.flavor == FL_MODULE;
+ 
    if (gfc_current_ns->parent != NULL
        && gfc_current_ns->parent->proc_name
!       && !module_procedure)
      {
        gfc_error("ENTRY statement at %C cannot appear in a "
  		"contained procedure");
        return MATCH_ERROR;
      }
  
!   /* Module function entries need special care in get_proc_name
!      because previous references within the function will have
!      created symbols attached to the current namespace.  */
!   if (get_proc_name (name, &entry,
! 		     gfc_current_ns->parent != NULL
! 		     && module_procedure
! 		     && gfc_current_ns->proc_name->attr.function))
      return MATCH_ERROR;
  
    proc = gfc_current_block ();
*************** gfc_match_subroutine (void)
*** 2865,2871 ****
    if (m != MATCH_YES)
      return m;
  
!   if (get_proc_name (name, &sym))
      return MATCH_ERROR;
    gfc_new_block = sym;
  
--- 2883,2889 ----
    if (m != MATCH_YES)
      return m;
  
!   if (get_proc_name (name, &sym, false))
      return MATCH_ERROR;
    gfc_new_block = sym;
  
Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c	(revision 114148)
--- gcc/fortran/resolve.c	(working copy)
*************** resolve_entries (gfc_namespace * ns)
*** 379,384 ****
--- 379,391 ----
    ns->entries = el;
    ns->proc_name->attr.entry = 1;
  
+   /* If it is a module function, it needs to be in the right namespace
+      so that gfc_get_fake_result_decl can gather up the results.  */
+   if (ns->proc_name->attr.function
+ 	&& ns->parent
+ 	&& ns->parent->proc_name->attr.flavor == FL_MODULE)
+     el->sym->ns = ns;
+ 
    /* Add an entry statement for it.  */
    c = gfc_get_code ();
    c->op = EXEC_ENTRY;
Index: gcc/fortran/trans-decl.c
===================================================================
*** gcc/fortran/trans-decl.c	(revision 114148)
--- gcc/fortran/trans-decl.c	(working copy)
*************** gfc_create_module_variable (gfc_symbol *
*** 2656,2661 ****
--- 2656,2666 ----
  {
    tree decl;
  
+   /* Module functions with alternate entries are dealt with later and
+      would get caught by the next condition.  */
+   if (sym->attr.entry)
+     return;
+ 
    /* Only output symbols from this module.  */
    if (sym->ns != module_namespace)
      {
Index: gcc/fortran/trans-expr.c
===================================================================
*** gcc/fortran/trans-expr.c	(revision 114148)
--- gcc/fortran/trans-expr.c	(working copy)
*************** gfc_conv_variable (gfc_se * se, gfc_expr
*** 359,364 ****
--- 359,365 ----
  
        if ((se->expr == parent_decl && return_value)
  	   || (sym->ns && sym->ns->proc_name
+ 	       && parent_decl
  	       && sym->ns->proc_name->backend_decl == parent_decl
  	       && (alternate_entry || entry_master)))
  	parent_flag = 1;
Index: gcc/testsuite/gfortran.dg/entry_6.f90
===================================================================
*** gcc/testsuite/gfortran.dg/entry_6.f90	(revision 0)
--- gcc/testsuite/gfortran.dg/entry_6.f90	(revision 0)
***************
*** 0 ****
--- 1,56 ----
+ ! { dg-do run }
+ ! Tests the fix for PR24558, which reported that module
+ ! alternate function entries did not work.
+ !
+ ! Contributed by Erik Edelmann  <eedelman@gcc.gnu.org>
+ !
+ module foo
+ contains
+     function n1 (a)
+         integer :: n1, n2, a, b
+         integer, save :: c
+         c = a
+         n1 = c**3
+         return
+     entry n2 (b)
+         n2 = c * b
+         n2 = n2**2
+         return
+     end function n1
+     function z1 (u)
+         complex :: z1, z2, u, v
+         z1 = (1.0, 2.0) * u
+         return
+     entry z2 (v)
+         z2 = (3, 4) * v
+         return
+     end function z1
+     function n3 (d)
+         integer :: n3, d
+         n3 = n2(d) * n1(d) ! Check sibling references.
+         return
+     end function n3
+     function c1 (a)
+         character(4) :: c1, c2, a, b
+         c1 = a
+         if (a .eq. "abcd") c1 = "ABCD"
+         return
+     entry c2 (b)
+         c2 = b
+         if (b .eq. "wxyz") c2 = "WXYZ"
+         return
+     end function c1
+ end module foo
+     use foo
+     if (n1(9) .ne. 729) call abort ()
+     if (n2(2) .ne. 324) call abort ()
+     if (n3(19) .ne. 200564019) call abort ()
+     if (c1("lmno") .ne. "lmno") call abort ()
+     if (c1("abcd") .ne. "ABCD") call abort ()
+     if (c2("lmno") .ne. "lmno") call abort ()
+     if (c2("wxyz") .ne. "WXYZ") call abort ()
+     if (z1((3,4)) .ne. (-5, 10)) call abort ()
+     if (z2((5,6)) .ne. (-9, 38)) call abort ()
+  end
+ 
+ ! { dg-final { cleanup-modules "foo" } }
Index: gcc/testsuite/gfortran.dg/entry_7.f90
===================================================================
*** gcc/testsuite/gfortran.dg/entry_7.f90	(revision 0)
--- gcc/testsuite/gfortran.dg/entry_7.f90	(revision 0)
***************
*** 0 ****
--- 1,25 ----
+ ! { dg-do compile }
+ ! Check that PR20877 and PR25047 are fixed by the patch for
+ ! PR24558. Both modules would emit the error:
+ ! insert_bbt(): Duplicate key found!
+ ! because of the prior references to a module function entry.
+ !
+ ! Contributed by Joost VandeVondele  <jv244@cam.ac.uk>
+ !
+ MODULE TT
+ CONTAINS
+   FUNCTION K(I) RESULT(J)
+     ENTRY J() ! { dg-error "conflicts with PROCEDURE attribute" }
+   END FUNCTION K
+ 
+   integer function foo ()
+     character*4 bar ! { dg-error "type CHARACTER" }
+     foo = 21
+     return
+   entry bar ()
+     bar = "abcd"
+   end function
+ END MODULE TT
+ 
+ 
+ ! { dg-final { cleanup-modules "TT" } }

2006-05-31  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/24558
	PR fortran/20877
	PR fortran/25047
	* decl.c (get_proc_name): Add new argument to flag that a
	module function entry is being treated. If true, correct
	error condition, add symtree to module namespace and add
	a module procedure.
	(gfc_match_function_decl, gfc_match_entry,
	gfc_match_subroutine): Use the new argument in calls to
	get_proc_name.
	* resolve.c (resolve_entries): ENTRY symbol reference to
	to master entry namespace if a module function.
	* trans-decl.c (gfc_create_module_variable): Return if
	the symbol is an entry.
	* trans-exp.c (gfc_conv_variable): Check that parent_decl
	is not NULL.

2006-05-31 Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/24558
	* gfortran.dg/entry_6.f90: New test.

	PR fortran/20877
	PR fortran/25047
	* gfortran.dg/entry_7.f90: New test.

Index Nav:	[Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav:	[Date Prev] [Date Next]	[Thread Prev] [Thread Next]