[Patch, Fortran] PR 42418: PROCEDURE: Rejects interface which is both specific and generic procedure

[Patch, Fortran] PR 42418: PROCEDURE: Rejects interface which is both specific and generic procedure

[Janus Weil]

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

Hi all,

here is a patch which does several things:

1) It fixes the original problem in the PR (cf. comments 0 and 6) by
adding code which checks if a generic interface has a specific
procedure of the same name (see resolve_procedure_interface).

2) It fixes other problems found along the way (cf. comment 7), which
are all due to the fact that the checks for interface declarations in
PROCEDURE statements came too early (checks for generics, statement
functions and intrinsics are moved from "match_procedure_interface" to
"resolve_procedure_interface"). For the intrinsics we do the same
trick as for PR51081, by setting the flavor at parsing stage and later
setting the INTRINSIC attribute at resolution stage.

3) It does minor cleanup related to "gfc_is_intrinsic", by moving some
checks into the routine, which were typically done before calling the
routine in a several places. (This is also related to the recent patch
for PR51081.) Note that 'use_assoc' is not sufficient to identify a
routine as non-intrinsic (apparently this was wrongly assumed in some
cases).

The patch was regtested successfully on x86_64-unknown-linux-gnu. Ok for trunk?

Cheers,
Janus


2012-07-31  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/42418
	* decl.c (match_procedure_interface): Move some checks to
	'resolve_procedure_interface'. Set flavor if appropriate.
	* expr.c (gfc_check_pointer_assign): Cleanup of 'gfc_is_intrinsic'.
	* intrinsic.c (gfc_is_intrinsic): Additional checks for attributes which
	identify a procedure as being non-intrinsic.
	* resolve.c (resolve_procedure_interface): Checks moved here from
	'match_procedure_interface'. Minor cleanup.
	(resolve_formal_arglist,resolve_symbol): Cleanup of
	'resolve_procedure_interface'
	(resolve_actual_arglist,is_external_proc): Cleanup of
	'gfc_is_intrinsic'.

2012-07-31  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/42418
	* gfortran.dg/proc_decl_29.f90: New.

[-- Attachment #2: pr42418_v4.diff --]
[-- Type: application/octet-stream, Size: 8193 bytes --]

Index: gcc/fortran/intrinsic.c
===================================================================
--- gcc/fortran/intrinsic.c	(revision 189984)
+++ gcc/fortran/intrinsic.c	(working copy)
@@ -902,9 +902,9 @@ gfc_intrinsic_actual_ok (const char *name, const b
 }
 
 
-/* Given a symbol, find out if it is (and is to be treated) an intrinsic.  If
-   it's name refers to an intrinsic but this intrinsic is not included in the
-   selected standard, this returns FALSE and sets the symbol's external
+/* Given a symbol, find out if it is (and is to be treated as) an intrinsic.
+   If its name refers to an intrinsic, but this intrinsic is not included in
+   the selected standard, this returns FALSE and sets the symbol's external
    attribute.  */
 
 bool
@@ -913,10 +913,13 @@ gfc_is_intrinsic (gfc_symbol* sym, int subroutine_
   gfc_intrinsic_sym* isym;
   const char* symstd;
 
-  /* If INTRINSIC/EXTERNAL state is already known, return.  */
+  /* If INTRINSIC attribute is already known, return.  */
   if (sym->attr.intrinsic)
     return true;
-  if (sym->attr.external)
+
+  /* Check for attributes which prevent the symbol from being INTRINSIC.  */
+  if (sym->attr.external || sym->attr.contained
+      || sym->attr.if_source == IFSRC_IFBODY)
     return false;
 
   if (subroutine_flag)
Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c	(revision 189984)
+++ gcc/fortran/decl.c	(working copy)
@@ -4792,41 +4792,20 @@ match_procedure_interface (gfc_symbol **proc_if)
   gfc_current_ns = old_ns;
   *proc_if = st->n.sym;
 
-  /* Various interface checks.  */
   if (*proc_if)
     {
       (*proc_if)->refs++;
       /* Resolve interface if possible. That way, attr.procedure is only set
 	 if it is declared by a later procedure-declaration-stmt, which is
-	 invalid per C1212.  */
+	 invalid per F08:C1216 (cf. resolve_procedure_interface).  */
       while ((*proc_if)->ts.interface)
 	*proc_if = (*proc_if)->ts.interface;
 
-      if ((*proc_if)->generic)
-	{
-	  gfc_error ("Interface '%s' at %C may not be generic",
-		     (*proc_if)->name);
-	  return MATCH_ERROR;
-	}
-      if ((*proc_if)->attr.proc == PROC_ST_FUNCTION)
-	{
-	  gfc_error ("Interface '%s' at %C may not be a statement function",
-		     (*proc_if)->name);
-	  return MATCH_ERROR;
-	}
-      /* Handle intrinsic procedures.  */
-      if (!((*proc_if)->attr.external || (*proc_if)->attr.use_assoc
-	    || (*proc_if)->attr.if_source == IFSRC_IFBODY)
-	  && (gfc_is_intrinsic ((*proc_if), 0, gfc_current_locus)
-	      || gfc_is_intrinsic ((*proc_if), 1, gfc_current_locus)))
-	(*proc_if)->attr.intrinsic = 1;
-      if ((*proc_if)->attr.intrinsic
-	  && !gfc_intrinsic_actual_ok ((*proc_if)->name, 0))
-	{
-	  gfc_error ("Intrinsic procedure '%s' not allowed "
-		    "in PROCEDURE statement at %C", (*proc_if)->name);
-	  return MATCH_ERROR;
-	}
+      if ((*proc_if)->attr.flavor == FL_UNKNOWN
+	  && (*proc_if)->ts.type == BT_UNKNOWN
+	  && gfc_add_flavor (&(*proc_if)->attr, FL_PROCEDURE,
+			      (*proc_if)->name, NULL) == FAILURE)
+	return MATCH_ERROR;
     }
 
 got_ts:
Index: gcc/fortran/expr.c
===================================================================
--- gcc/fortran/expr.c	(revision 189985)
+++ gcc/fortran/expr.c	(working copy)
@@ -3426,8 +3426,6 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_ex
       	  /* Check for intrinsics.  */
 	  gfc_symbol *sym = rvalue->symtree->n.sym;
 	  if (!sym->attr.intrinsic
-	      && !(sym->attr.contained || sym->attr.use_assoc
-		   || sym->attr.external || sym->attr.if_source == IFSRC_IFBODY)
 	      && (gfc_is_intrinsic (sym, 0, sym->declared_at)
 		  || gfc_is_intrinsic (sym, 1, sym->declared_at)))
 	    {
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 189985)
+++ gcc/fortran/resolve.c	(working copy)
@@ -146,24 +146,58 @@ static void resolve_symbol (gfc_symbol *sym);
 static gfc_try
 resolve_procedure_interface (gfc_symbol *sym)
 {
-  if (sym->ts.interface == sym)
+  gfc_symbol *ifc = sym->ts.interface;
+
+  if (!ifc)
+    return SUCCESS;
+
+  /* Several checks for F08:C1216.  */
+  if (ifc == sym)
     {
       gfc_error ("PROCEDURE '%s' at %L may not be used as its own interface",
 		 sym->name, &sym->declared_at);
       return FAILURE;
     }
-  if (sym->ts.interface->attr.procedure)
+  if (ifc->attr.procedure)
     {
       gfc_error ("Interface '%s', used by procedure '%s' at %L, is declared "
-		 "in a later PROCEDURE statement", sym->ts.interface->name,
+		 "in a later PROCEDURE statement", ifc->name,
 		 sym->name, &sym->declared_at);
       return FAILURE;
     }
+  if (ifc->generic)
+    {
+      /* For generic interfaces, check if there is
+	 a specific procedure with the same name.  */
+      gfc_interface *gen = ifc->generic;
+      while (gen && strcmp (gen->sym->name, ifc->name) != 0)
+	gen = gen->next;
+      if (!gen)
+	{
+	  gfc_error ("Interface '%s' at %L may not be generic",
+		     ifc->name, &sym->declared_at);
+	  return FAILURE;
+	}
+    }
+  if (ifc->attr.proc == PROC_ST_FUNCTION)
+    {
+      gfc_error ("Interface '%s' at %L may not be a statement function",
+		 ifc->name, &sym->declared_at);
+      return FAILURE;
+    }
+  if (gfc_is_intrinsic (ifc, 0, ifc->declared_at)
+      || gfc_is_intrinsic (ifc, 1, ifc->declared_at))
+    ifc->attr.intrinsic = 1;
+  if (ifc->attr.intrinsic && !gfc_intrinsic_actual_ok (ifc->name, 0))
+    {
+      gfc_error ("Intrinsic procedure '%s' not allowed in "
+		 "PROCEDURE statement at %L", ifc->name, &sym->declared_at);
+      return FAILURE;
+    }
 
   /* Get the attributes from the interface (now resolved).  */
-  if (sym->ts.interface->attr.if_source || sym->ts.interface->attr.intrinsic)
+  if (ifc->attr.if_source || ifc->attr.intrinsic)
     {
-      gfc_symbol *ifc = sym->ts.interface;
       resolve_symbol (ifc);
 
       if (ifc->attr.intrinsic)
@@ -212,10 +246,10 @@ resolve_procedure_interface (gfc_symbol *sym)
 	    return FAILURE;
 	}
     }
-  else if (sym->ts.interface->name[0] != '\0')
+  else if (ifc->name[0] != '\0')
     {
       gfc_error ("Interface '%s' of procedure '%s' at %L must be explicit",
-		 sym->ts.interface->name, sym->name, &sym->declared_at);
+		 ifc->name, sym->name, &sym->declared_at);
       return FAILURE;
     }
 
@@ -273,9 +307,9 @@ resolve_formal_arglist (gfc_symbol *proc)
 		       &proc->declared_at);
 	  continue;
 	}
-      else if (sym->attr.procedure && sym->ts.interface
-	       && sym->attr.if_source != IFSRC_DECL)
-	resolve_procedure_interface (sym);
+      else if (sym->attr.procedure && sym->attr.if_source != IFSRC_DECL
+	       && resolve_procedure_interface (sym) == FAILURE)
+	return;
 
       if (sym->attr.if_source != IFSRC_UNKNOWN)
 	resolve_formal_arglist (sym);
@@ -1672,10 +1706,7 @@ resolve_actual_arglist (gfc_actual_arglist *arg, p
 
 	  /* If a procedure is not already determined to be something else
 	     check if it is intrinsic.  */
-	  if (!sym->attr.intrinsic
-	      && !(sym->attr.external || sym->attr.use_assoc
-		   || sym->attr.if_source == IFSRC_IFBODY)
-	      && gfc_is_intrinsic (sym, sym->attr.subroutine, e->where))
+	  if (gfc_is_intrinsic (sym, sym->attr.subroutine, e->where))
 	    sym->attr.intrinsic = 1;
 
 	  if (sym->attr.proc == PROC_ST_FUNCTION)
@@ -2601,8 +2632,7 @@ static bool
 is_external_proc (gfc_symbol *sym)
 {
   if (!sym->attr.dummy && !sym->attr.contained
-	&& !(sym->attr.intrinsic
-	      || gfc_is_intrinsic (sym, sym->attr.subroutine, sym->declared_at))
+	&& !gfc_is_intrinsic (sym, sym->attr.subroutine, sym->declared_at)
 	&& sym->attr.proc != PROC_ST_FUNCTION
 	&& !sym->attr.proc_pointer
 	&& !sym->attr.use_assoc
@@ -12486,8 +12516,7 @@ resolve_symbol (gfc_symbol *sym)
   if (sym->attr.external && sym->ts.type != BT_UNKNOWN && !sym->attr.function)
     gfc_add_function (&sym->attr, sym->name, &sym->declared_at);
 
-  if (sym->attr.procedure && sym->ts.interface
-      && sym->attr.if_source != IFSRC_DECL
+  if (sym->attr.procedure && sym->attr.if_source != IFSRC_DECL
       && resolve_procedure_interface (sym) == FAILURE)
     return;
 

[-- Attachment #3: proc_decl_29.f90 --]
[-- Type: application/octet-stream, Size: 552 bytes --]

! { dg-do compile }
!
! PR 42418: PROCEDURE: Rejects interface which is both specific and generic procedure
!
! Contributed by Tobias Burnus <burnus@gcc.gnu.org>

  interface gen
    procedure gen
  end interface

  procedure(gen)  :: p1
  procedure(gen2) :: p2  ! { dg-error "may not be generic" }
  procedure(sf)   :: p3  ! { dg-error "may not be a statement function" }
  procedure(char) :: p4

  interface gen2
    procedure char
  end interface

  sf(x) = x**2

contains

  subroutine gen
  end subroutine

  subroutine char
  end subroutine

end

Re: [Patch, Fortran] PR 42418: PROCEDURE: Rejects interface which is both specific and generic procedure

[Tobias Burnus]

On 07/31/2012 11:50 AM, Janus Weil wrote:
> The patch was regtested successfully on x86_64-unknown-linux-gnu. Ok for trunk?

The patch looks  okay. I assume, the patch doesn't help to get PR 54035 
fixed,does it? (That PR is about TBP binding to the generic instead of 
the specific name.)

Tobias

> 2012-07-31  Janus Weil  <janus@gcc.gnu.org>
>
> 	PR fortran/42418
> 	* decl.c (match_procedure_interface): Move some checks to
> 	'resolve_procedure_interface'. Set flavor if appropriate.
> 	* expr.c (gfc_check_pointer_assign): Cleanup of 'gfc_is_intrinsic'.
> 	* intrinsic.c (gfc_is_intrinsic): Additional checks for attributes which
> 	identify a procedure as being non-intrinsic.
> 	* resolve.c (resolve_procedure_interface): Checks moved here from
> 	'match_procedure_interface'. Minor cleanup.
> 	(resolve_formal_arglist,resolve_symbol): Cleanup of
> 	'resolve_procedure_interface'
> 	(resolve_actual_arglist,is_external_proc): Cleanup of
> 	'gfc_is_intrinsic'.
>
> 2012-07-31  Janus Weil  <janus@gcc.gnu.org>
>
> 	PR fortran/42418
> 	* gfortran.dg/proc_decl_29.f90: New.

Re: [Patch, Fortran] PR 42418: PROCEDURE: Rejects interface which is both specific and generic procedure

[Janus Weil]

>> The patch was regtested successfully on x86_64-unknown-linux-gnu. Ok for
>> trunk?
>
>
> The patch looks  okay.

Thanks!

> I assume, the patch doesn't help to get PR 54035
> fixed,does it? (That PR is about TBP binding to the generic instead of the
> specific name.)

Not directly. Although - since they're not completely unrelated - one
might think about applying a similar strategy for that one. However, I
expect it will be a bit harder to fix. Maybe I'll have a look soon ...

In general I don't really like the sort of special-case treatment that
is needed, e.g. in this PR, to handle generics and specifics with the
same. In the long run, it might be worth to think about a separate
symtree for generics in each namespace. That would also help to
simplify the treatment of 'constructors' etc, but it's surely not a
quick'n'easy project (and I'm not sure if there are any pitfalls
lurking).

Cheers,
Janus



>> 2012-07-31  Janus Weil  <janus@gcc.gnu.org>
>>
>>         PR fortran/42418
>>         * decl.c (match_procedure_interface): Move some checks to
>>         'resolve_procedure_interface'. Set flavor if appropriate.
>>         * expr.c (gfc_check_pointer_assign): Cleanup of
>> 'gfc_is_intrinsic'.
>>         * intrinsic.c (gfc_is_intrinsic): Additional checks for attributes
>> which
>>         identify a procedure as being non-intrinsic.
>>         * resolve.c (resolve_procedure_interface): Checks moved here from
>>         'match_procedure_interface'. Minor cleanup.
>>         (resolve_formal_arglist,resolve_symbol): Cleanup of
>>         'resolve_procedure_interface'
>>         (resolve_actual_arglist,is_external_proc): Cleanup of
>>         'gfc_is_intrinsic'.
>>
>> 2012-07-31  Janus Weil  <janus@gcc.gnu.org>
>>
>>         PR fortran/42418
>>         * gfortran.dg/proc_decl_29.f90: New.
>
>

Re: [Patch, Fortran] PR 42418: PROCEDURE: Rejects interface which is both specific and generic procedure

[Janus Weil]

>>> The patch was regtested successfully on x86_64-unknown-linux-gnu. Ok for
>>> trunk?
>>
>>
>> The patch looks  okay.
>
> Thanks!

Committed as r190017.

Cheers,
Janus



>>> 2012-07-31  Janus Weil  <janus@gcc.gnu.org>
>>>
>>>         PR fortran/42418
>>>         * decl.c (match_procedure_interface): Move some checks to
>>>         'resolve_procedure_interface'. Set flavor if appropriate.
>>>         * expr.c (gfc_check_pointer_assign): Cleanup of
>>> 'gfc_is_intrinsic'.
>>>         * intrinsic.c (gfc_is_intrinsic): Additional checks for attributes
>>> which
>>>         identify a procedure as being non-intrinsic.
>>>         * resolve.c (resolve_procedure_interface): Checks moved here from
>>>         'match_procedure_interface'. Minor cleanup.
>>>         (resolve_formal_arglist,resolve_symbol): Cleanup of
>>>         'resolve_procedure_interface'
>>>         (resolve_actual_arglist,is_external_proc): Cleanup of
>>>         'gfc_is_intrinsic'.
>>>
>>> 2012-07-31  Janus Weil  <janus@gcc.gnu.org>
>>>
>>>         PR fortran/42418
>>>         * gfortran.dg/proc_decl_29.f90: New.
>>
>>