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] Fixes for entity ambiguity and interfaces (PR29975, PR30068)


:ADDPATCH fortran:

Attached you find the great patch by Paul. It fixes a great bunch of
ambiguity problems.
(I try to show what the patch does, however, I don't use always the
proper language of the Fortran standard. Have a look for more details at
comp.lang.fortran [link below] and the PR reports, which contain
quotations of the standard.)

a) Allowing to add non-ambiguous procedure to a generic interface

This was before rejected by gfortran if it happened in a different scope
(e.g. a different module).
This has been revealed by CP2k (PR29975) and the fix is simply to change
in symbol.c:
  if (st->ambiguous)
into
  if (st->ambiguous && !st->n.sym->attr.generic)
(cf. "C1209 (R1206)" in the Fortran 2003 standard.)


b) Importing of symbols which are indeed ambigious, but not actually "used"

According to the Fortran standard, one may "USE" modules which contain
ambiguous interfaces/variables/procedures etc., as long as they are not
"referred to". Whether the rules are stricter for generic interfaces or
not, is a matter of debate, namely: Is the following valid or not:

  use mod1 ! contains generic interface, which is ambiguous with
  use mod2 ! the generic interface in mod2

Depending how one reads the standard, this is valid (Richard Main) or
not (Malcolm Cohen); g95, sunf95 and (soon) NAG f95 reject this, ifort
and (currently) NAG f95 accept this without any warning.
See:
http://groups.google.com/group/comp.lang.fortran/browse_thread/thread/44aa13e0102ec83d/
With this patch, gfortran accepts the import, but gives the warning:

   Warning: 'generic' at (1) has ambiguous interfaces

Using ",only : ..." ifort gives for generic interfaces a warning as does
gfortran (with the patch).


If the ambiguous entity is actually used, e.g. "call ambigious()", then
an error is issued as before.


There is another example (see second example in comp.lang.fortran),
where ifort gives a warning, sunf95 and (current) NAG f95 accept it; 
g95 and (soon) NAG f95 will reject it  (error). With the patch gfortran
accepts it, but issues a warning:

  Warning: Ambiguous interfaces 'modproc' and 'modproc' in generic
interface 'generic' at (1)


c) The Fortran 2003 standard contains in section C.11.2 two examples,
BAD8 and BAD9,
of which at least BAD9 was not correctly detected as invalid (PR 30068).
With the patch, gfortran now issues the error:

Error: Ambiguous interfaces 's8b' and 's8a' in generic interface 'bad8'
at (1)


d) Unrelated to ambiguous entities, but also part of PR29975:
  IF (ANY(F(2:2) == Ops(5:6))) STOP
gave an ICE in simplify_const_ref. This is fixed (-> expr.f90,
find_array_section; gfortran.dg/array_initializer_2.f90)


I hope I haven't forgotten any PR in the list. This patch is Paul's
version (PR30068) except for a pair of quotes around one %s.


The patche has been regression-tested (and tested) by Paul and
me(x86_64-unknown-linux-gnu).


Tobias


Changelog:

fortran/
2006-12-08  Paul Thomas <pault@gcc.gnu.org>

    PR fortran/29975
    PR fortran/30068
    * interface.c (compare_type_rank_if): Reject invalid generic interfaces.
      (check_interface1): Give a warning for nonreferred to ambiguous
interfaces.
      (check_sym_interfaces): Check whether an ambiguous interface is
referred to.
      (check_uop_interface, gfc_check_interfaces): Update call to
check_interface1.
    * symbol.c (gfc_get_sym_tree, gfc_get_sym_tree): Allow adding
      unambiguous procedures to generic interfaces.
    * gfortran.h (symbol_attribute): Added use_only and
ambiguous_interfaces.
    * module.c (load_need): Set the use_only flag, if needed.
    * resolve.c (resolve_fl_procedure): Warn for nonreferred interfaces.
    * expr.c (find_array_section): Fix initializer array contructor.


testsuite/
2006-12-08  Paul Thomas <pault@gcc.gnu.org>

    PR fortran/29975
    PR fortran/30068
    * gfortran.dg/interface_4.f90: Test adding procedure to generic
interface.
    * gfortran.dg/interface_5.f90: Test warning for not-referenced-to
ambiguous interfaces.
    * gfortran.dg/interface_6.f90: Test invalid, ambiguous interface.
    * gfortran.dg/interface_7.f90: Test invalid, ambiguous interface.
    * gfortran.dg/interface_8.f90: Test warning for not-referenced-to
ambiguous interfaces.
    * gfortran.dg/interface_1.f90: Change dg-error into a dg-warning.
    * gfortran.dg/array_initializer_2.f90: Add initializer array
constructor test.
Index: gcc/fortran/interface.c
===================================================================
*** gcc/fortran/interface.c	(revision 119554)
--- gcc/fortran/interface.c	(working copy)
*************** compare_type_rank_if (gfc_symbol * s1, g
*** 462,468 ****
    if (s1->attr.function && compare_type_rank (s1, s2) == 0)
      return 0;
  
!   return compare_interfaces (s1, s2, 0);	/* Recurse! */
  }
  
  
--- 462,468 ----
    if (s1->attr.function && compare_type_rank (s1, s2) == 0)
      return 0;
  
!   return 1;	/* Do not recurse, although it works fine! */
  }
  
  
*************** check_interface0 (gfc_interface * p, con
*** 965,971 ****
  
  static int
  check_interface1 (gfc_interface * p, gfc_interface * q0,
! 		  int generic_flag, const char *interface_name)
  {
    gfc_interface * q;
    for (; p; p = p->next)
--- 965,972 ----
  
  static int
  check_interface1 (gfc_interface * p, gfc_interface * q0,
! 		  int generic_flag, const char *interface_name,
! 		  int referenced)
  {
    gfc_interface * q;
    for (; p; p = p->next)
*************** check_interface1 (gfc_interface * p, gfc
*** 979,990 ****
  
  	if (compare_interfaces (p->sym, q->sym, generic_flag))
  	  {
! 	    gfc_error ("Ambiguous interfaces '%s' and '%s' in %s at %L",
! 		       p->sym->name, q->sym->name, interface_name, &p->where);
  	    return 1;
  	  }
        }
- 
    return 0;
  }
  
--- 980,999 ----
  
  	if (compare_interfaces (p->sym, q->sym, generic_flag))
  	  {
! 	    if (referenced)
! 	      {
! 		gfc_error ("Ambiguous interfaces '%s' and '%s' in %s at %L",
! 			   p->sym->name, q->sym->name, interface_name,
! 			   &p->where);
! 	      }
! 
! 	    if (!p->sym->attr.use_assoc && q->sym->attr.use_assoc)
! 	      gfc_warning ("Ambiguous interfaces '%s' and '%s' in %s at %L",
! 			   p->sym->name, q->sym->name, interface_name,
! 			   &p->where);
  	    return 1;
  	  }
        }
    return 0;
  }
  
*************** check_sym_interfaces (gfc_symbol * sym)
*** 1011,1018 ****
        s2 = sym;
        while (s2 != NULL)
  	{
! 	  if (check_interface1 (sym->generic, s2->generic, 1, interface_name))
! 	    return;
  
  	  if (s2->ns->parent == NULL)
  	    break;
--- 1020,1033 ----
        s2 = sym;
        while (s2 != NULL)
  	{
! 	  bool i;
! 	  i = sym->attr.referenced || (s2 == sym && !sym->attr.use_assoc);
! 	  if (check_interface1 (sym->generic, s2->generic, 1,
! 			        interface_name, i))
! 	    {
! 	      sym->attr.ambiguous_interfaces = 1;
! 	      return;
! 	    }
  
  	  if (s2->ns->parent == NULL)
  	    break;
*************** check_uop_interfaces (gfc_user_op * uop)
*** 1040,1046 ****
        if (uop2 == NULL)
  	continue;
  
!       check_interface1 (uop->operator, uop2->operator, 0, interface_name);
      }
  }
  
--- 1055,1062 ----
        if (uop2 == NULL)
  	continue;
  
!       check_interface1 (uop->operator, uop2->operator, 0,
! 			interface_name, 1);
      }
  }
  
*************** gfc_check_interfaces (gfc_namespace * ns
*** 1082,1088 ****
  
        for (ns2 = ns->parent; ns2; ns2 = ns2->parent)
  	if (check_interface1 (ns->operator[i], ns2->operator[i], 0,
! 			      interface_name))
  	  break;
      }
  
--- 1098,1104 ----
  
        for (ns2 = ns->parent; ns2; ns2 = ns2->parent)
  	if (check_interface1 (ns->operator[i], ns2->operator[i], 0,
! 			      interface_name, 1))
  	  break;
      }
  
Index: gcc/fortran/symbol.c
===================================================================
*** gcc/fortran/symbol.c	(revision 119554)
--- gcc/fortran/symbol.c	(working copy)
*************** gfc_find_sym_tree (const char *name, gfc
*** 2036,2042 ****
        if (st != NULL)
  	{
  	  *result = st;
! 	  if (st->ambiguous)
  	    {
  	      ambiguous_symbol (name, st);
  	      return 1;
--- 2036,2044 ----
        if (st != NULL)
  	{
  	  *result = st;
! 	  /* Ambiguous generic interfaces are permitted, as long
! 	     as the specific interfaces are different.  */
! 	  if (st->ambiguous && !st->n.sym->attr.generic)
  	    {
  	      ambiguous_symbol (name, st);
  	      return 1;
*************** gfc_get_sym_tree (const char *name, gfc_
*** 2137,2144 ****
      }
    else
      {
!       /* Make sure the existing symbol is OK.  */
!       if (st->ambiguous)
  	{
  	  ambiguous_symbol (name, st);
  	  return 1;
--- 2139,2148 ----
      }
    else
      {
!       /* Make sure the existing symbol is OK.  Ambiguous
! 	 generic interfaces are permitted, as long as the
! 	 specific interfaces are different.  */
!       if (st->ambiguous && !st->n.sym->attr.generic)
  	{
  	  ambiguous_symbol (name, st);
  	  return 1;
Index: gcc/fortran/gfortran.h
===================================================================
*** gcc/fortran/gfortran.h	(revision 119554)
--- gcc/fortran/gfortran.h	(working copy)
*************** typedef struct
*** 483,489 ****
      dummy:1, result:1, assign:1, threadprivate:1;
  
    unsigned data:1,		/* Symbol is named in a DATA statement.  */
!     use_assoc:1;		/* Symbol has been use-associated.  */
  
    unsigned in_namelist:1, in_common:1, in_equivalence:1;
    unsigned function:1, subroutine:1, generic:1;
--- 483,490 ----
      dummy:1, result:1, assign:1, threadprivate:1;
  
    unsigned data:1,		/* Symbol is named in a DATA statement.  */
!     use_assoc:1,		/* Symbol has been use-associated.  */
!     use_only:1;			/* Symbol has been use-associated, with ONLY.  */
  
    unsigned in_namelist:1, in_common:1, in_equivalence:1;
    unsigned function:1, subroutine:1, generic:1;
*************** typedef struct
*** 518,523 ****
--- 519,527 ----
       modification of type or type parameters is permitted.  */
    unsigned referenced:1;
  
+   /* Set if the symbol has ambiguous interfaces.  */
+   unsigned ambiguous_interfaces:1;
+ 
    /* Set if the is the symbol for the main program.  This is the least
       cumbersome way to communicate this function property without
       strcmp'ing with __MAIN everywhere.  */
Index: gcc/fortran/expr.c
===================================================================
*** gcc/fortran/expr.c	(revision 119554)
--- gcc/fortran/expr.c	(working copy)
*************** find_array_section (gfc_expr *expr, gfc_
*** 1189,1195 ****
        for (d = 0; d < rank; d++)
  	{
  	  mpz_set (tmp_mpz, ctr[d]);
! 	  mpz_sub_ui (tmp_mpz, tmp_mpz, one);
  	  mpz_mul (tmp_mpz, tmp_mpz, delta[d]);
  	  mpz_add (ptr, ptr, tmp_mpz);
  
--- 1189,1196 ----
        for (d = 0; d < rank; d++)
  	{
  	  mpz_set (tmp_mpz, ctr[d]);
! 	  mpz_sub (tmp_mpz, tmp_mpz,
! 		   ref->u.ar.as->lower[d]->value.integer);
  	  mpz_mul (tmp_mpz, tmp_mpz, delta[d]);
  	  mpz_add (ptr, ptr, tmp_mpz);
  
Index: gcc/fortran/module.c
===================================================================
*** gcc/fortran/module.c	(revision 119554)
--- gcc/fortran/module.c	(working copy)
*************** load_needed (pointer_info * p)
*** 3212,3217 ****
--- 3212,3219 ----
  
    mio_symbol (sym);
    sym->attr.use_assoc = 1;
+   if (only_flag)
+     sym->attr.use_only = 1;
  
    return 1;
  }
Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c	(revision 119554)
--- gcc/fortran/resolve.c	(working copy)
*************** resolve_fl_procedure (gfc_symbol *sym, i
*** 5525,5530 ****
--- 5525,5534 ----
    gfc_formal_arglist *arg;
    gfc_symtree *st;
  
+   if (sym->attr.ambiguous_interfaces && !sym->attr.referenced)
+     gfc_warning ("Although not referenced, '%s' at %L has ambiguous "
+ 		 "interfaces", sym->name, &sym->declared_at);
+ 
    if (sym->attr.function
  	&& resolve_fl_var_and_proc (sym, mp_flag) == FAILURE)
      return FAILURE;
Index: gcc/testsuite/gfortran.dg/interface_4.f90
===================================================================
*** gcc/testsuite/gfortran.dg/interface_4.f90	(revision 0)
--- gcc/testsuite/gfortran.dg/interface_4.f90	(revision 0)
***************
*** 0 ****
--- 1,46 ----
+ ! { dg-do run }
+ ! Tests the fix for the interface bit of PR29975, in which the
+ ! interfaces bl_copy were rejected as ambiguous, even though
+ ! they import different specific interfaces.
+ !
+ ! Contributed by Joost VandeVondele <jv244@cam.ac.uk> and
+ ! simplified by Tobias Burnus <burnus@gcc.gnu.org>
+ !
+ SUBROUTINE RECOPY(N, c)
+   real, INTENT(IN) :: N
+   character(6) :: c
+   c = "recopy"
+ END SUBROUTINE RECOPY
+ 
+ MODULE f77_blas_extra
+ PUBLIC :: BL_COPY
+ INTERFACE BL_COPY
+   MODULE PROCEDURE SDCOPY
+ END INTERFACE BL_COPY
+ CONTAINS
+    SUBROUTINE SDCOPY(N, c)
+     INTEGER, INTENT(IN) :: N
+     character(6) :: c
+     c = "sdcopy"
+    END SUBROUTINE SDCOPY
+ END MODULE f77_blas_extra
+ 
+ MODULE f77_blas_generic
+ INTERFACE BL_COPY
+    SUBROUTINE RECOPY(N, c)
+     real, INTENT(IN) :: N
+     character(6) :: c
+    END SUBROUTINE RECOPY
+ END INTERFACE BL_COPY
+ END MODULE f77_blas_generic
+ 
+ program main
+   USE f77_blas_extra
+   USE f77_blas_generic
+   character(6) :: chr
+   call bl_copy(1, chr)
+   if (chr /= "sdcopy") call abort ()
+   call bl_copy(1.0, chr)
+   if (chr /= "recopy") call abort ()  
+ end program main
+ ! { dg-final { cleanup-modules "f77_blas_generic f77_blas_extra" } }
Index: gcc/testsuite/gfortran.dg/interface_5.f90
===================================================================
*** gcc/testsuite/gfortran.dg/interface_5.f90	(revision 0)
--- gcc/testsuite/gfortran.dg/interface_5.f90	(revision 0)
***************
*** 0 ****
--- 1,56 ----
+ ! { dg-do compile }
+ ! Tests the fix for the interface bit of PR29975, in which the
+ ! interfaces bl_copy were rejected as ambiguous, even though
+ ! they import different specific interfaces.  In this testcase,
+ ! it is verified that ambiguous specific interfaces are caught.
+ !
+ ! Contributed by Joost VandeVondele <jv244@cam.ac.uk> and
+ ! simplified by Tobias Burnus <burnus@gcc.gnu.org>
+ !
+ SUBROUTINE RECOPY(N, c)
+   real, INTENT(IN) :: N
+   character(6) :: c
+   print *, n
+   c = "recopy"
+ END SUBROUTINE RECOPY
+ 
+ MODULE f77_blas_extra
+ PUBLIC :: BL_COPY
+ INTERFACE BL_COPY
+   MODULE PROCEDURE SDCOPY
+ END INTERFACE BL_COPY
+ CONTAINS
+    SUBROUTINE SDCOPY(N, c)
+     REAL, INTENT(IN) :: N
+     character(6) :: c
+     print *, n
+     c = "sdcopy"
+    END SUBROUTINE SDCOPY
+ END MODULE f77_blas_extra
+ 
+ MODULE f77_blas_generic
+ INTERFACE BL_COPY
+    SUBROUTINE RECOPY(N, c)
+     real, INTENT(IN) :: N
+     character(6) :: c
+    END SUBROUTINE RECOPY
+ END INTERFACE BL_COPY
+ END MODULE f77_blas_generic
+ 
+ subroutine i_am_ok
+   USE f77_blas_extra ! { dg-warning "ambiguous interfaces" }
+   USE f77_blas_generic
+   character(6) :: chr
+   chr = ""
+   if (chr /= "recopy") call abort ()  
+ end subroutine i_am_ok
+ 
+ program main
+   USE f77_blas_extra ! { dg-error "Ambiguous interfaces" }
+   USE f77_blas_generic
+   character(6) :: chr
+   chr = ""
+   call bl_copy(1.0, chr)
+   if (chr /= "recopy") call abort ()  
+ end program main
+ ! { dg-final { cleanup-modules "f77_blas_generic f77_blas_extra" } }
Index: gcc/testsuite/gfortran.dg/interface_6.f90
===================================================================
*** gcc/testsuite/gfortran.dg/interface_6.f90	(revision 0)
--- gcc/testsuite/gfortran.dg/interface_6.f90	(revision 0)
***************
*** 0 ****
--- 1,24 ----
+ ! { dg-do compile }
+ ! One of the tests of the patch for PR30068.
+ ! Taken from the fortran standard.
+ !
+ ! The standard specifies that the optional arguments should be
+ ! ignored in the counting of like type/kind, so the specific
+ ! procedures below are invalid, even though actually unambiguous.
+ !
+ INTERFACE BAD8
+   SUBROUTINE S8A(X,Y,Z)
+     REAL,OPTIONAL :: X
+     INTEGER :: Y
+     REAL :: Z
+   END SUBROUTINE S8A
+   SUBROUTINE S8B(X,Z,Y)
+     INTEGER,OPTIONAL :: X
+     INTEGER :: Z
+     REAL :: Y
+   END SUBROUTINE S8B ! { dg-error "Ambiguous interfaces" }
+ END INTERFACE BAD8
+ real :: a, b
+ integer :: i, j
+ call bad8(x,i,b)
+ end
Index: gcc/testsuite/gfortran.dg/generic_7.f90
===================================================================
*** gcc/testsuite/gfortran.dg/generic_7.f90	(revision 119554)
--- gcc/testsuite/gfortran.dg/generic_7.f90	(working copy)
*************** CONTAINS
*** 24,27 ****
--- 24,28 ----
      WRITE(*,*) x, y
    END SUBROUTINE
  END MODULE
+ 
  ! { dg-final { cleanup-modules "global" } }
Index: gcc/testsuite/gfortran.dg/interface_7.f90
===================================================================
*** gcc/testsuite/gfortran.dg/interface_7.f90	(revision 0)
--- gcc/testsuite/gfortran.dg/interface_7.f90	(revision 0)
***************
*** 0 ****
--- 1,32 ----
+ ! { dg-do compile }
+ ! One of the tests of the patch for PR30068.
+ ! Taken from the fortran standard.
+ !
+ ! The interface is invalid although it is unambiguous because the
+ ! standard explicitly does not require recursion into the formal
+ ! arguments of procedures that themselves are interface arguments.
+ !
+ module x
+   INTERFACE BAD9
+     SUBROUTINE S9A(X)
+       REAL :: X
+     END SUBROUTINE S9A
+     SUBROUTINE S9B(X)
+       INTERFACE
+         FUNCTION X(A)
+           REAL :: X,A
+         END FUNCTION X
+       END INTERFACE
+     END SUBROUTINE S9B
+     SUBROUTINE S9C(X)
+       INTERFACE
+         FUNCTION X(A)
+           REAL :: X
+           INTEGER :: A
+         END FUNCTION X
+       END INTERFACE
+     END SUBROUTINE S9C  ! { dg-error "Ambiguous interfaces" }
+   END INTERFACE BAD9
+ end module x
+ 
+ ! { dg-final { cleanup-modules "x" } }
Index: gcc/testsuite/gfortran.dg/interface_8.f90
===================================================================
*** gcc/testsuite/gfortran.dg/interface_8.f90	(revision 0)
--- gcc/testsuite/gfortran.dg/interface_8.f90	(revision 0)
***************
*** 0 ****
--- 1,30 ----
+ ! { dg-do compile }
+ ! One of the tests of the patch for PR30068.
+ ! Taken from the fortran standard.
+ !
+ ! Although the generic procedure is not referenced and it would
+ ! normally be permissible for it to be ambiguous, the USE, ONLY
+ ! statement is effectively a reference and is invalid.
+ !
+ module mod1
+    interface generic
+       subroutine foo(a)
+          real :: a
+       end subroutine
+    end interface generic
+ end module  mod1
+ 
+ module mod2
+    interface generic
+       subroutine bar(a)
+          real :: a
+       end subroutine
+    end interface generic
+ end module  mod2
+ 
+ program main
+   use mod1, only: generic   ! { dg-warning "has ambiguous interfaces" }
+   use mod2
+ end program main
+ 
+ ! { dg-final { cleanup-modules "mod1 mod2" } }
Index: gcc/testsuite/gfortran.dg/array_initializer_2.f90
===================================================================
*** gcc/testsuite/gfortran.dg/array_initializer_2.f90	(revision 119554)
--- gcc/testsuite/gfortran.dg/array_initializer_2.f90	(working copy)
***************
*** 2,7 ****
--- 2,11 ----
  ! Tests the fix for PR28496 in which initializer array constructors with
  ! a missing initial array index would cause an ICE.
  !
+ ! Test for the fix of the initializer array constructor part of PR29975
+ ! was added later.  Here, the indexing would get in a mess if the array
+ ! specification had a lower bound other than unity.
+ !
  ! Contributed by Paul Thomas  <pault@gcc.gnu.org>
  ! Based on original test case from Samir Nordin  <snordin_ng@yahoo.fr> 
  !
***************
*** 11,17 ****
--- 15,31 ----
    integer, dimension(2,3), parameter :: d=reshape ((/c(3:2:-1,:)/),(/2,3/))
    integer, dimension(3,3), parameter :: e=reshape ((/a(:),a(:)+3,a(:)+6/),(/3,3/))
    integer, dimension(2,3), parameter :: f=reshape ((/c(2:1:-1,:)/),(/2,3/))
+   CHARACTER (LEN=1), DIMENSION(3:7),  PARAMETER :: g =  &
+     (/ '+', '-', '*', '/', '^' /)
+   CHARACTER (LEN=3) :: h = "A+C"
+ !
+ ! PR28496
+ !
    if (any (b .ne. (/1,2,3/))) call abort ()
    if (any (reshape(d,(/6/)) .ne. (/3, 2, 6, 5, 9, 8/))) call abort () 
    if (any (reshape(f,(/6/)) .ne. (/2, 1, 5, 4, 8, 7/))) call abort () 
+ !
+ ! PR29975
+ !
+   IF (all(h(2:2) /= g(3:4))) call abort ()
  end
Index: gcc/testsuite/gfortran.dg/interface_1.f90
===================================================================
*** gcc/testsuite/gfortran.dg/interface_1.f90	(revision 119554)
--- gcc/testsuite/gfortran.dg/interface_1.f90	(working copy)
*************** module z
*** 27,33 ****
    use y
  
    interface ambiguous
!     module procedure f    ! { dg-error "in generic interface" "" }
    end interface
  
    contains
--- 27,33 ----
    use y
  
    interface ambiguous
!     module procedure f    ! { dg-warning "in generic interface" "" }
    end interface
  
    contains

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