[Patch, fortran] PR37274 - [Regression] error: type name is ambiguous and PR36374 - nested module inclusion fails

["Paul Richard Thomas" <paul dot richard dot thomas at gmail dot com>]

Salvatore,

Thanks for these two reports.  It turned out that the problems are
sufficiently related that your surmise that they are the same is
justified.

In both cases, read_module is detecting ambiguity incorrectly:
(i) In PR37274 it is the type of a function argument that is not made
public in the containing module that appears to be ambiguous with the
same derived type form its original module; and
(ii) In PR36374 it is generic interface procedures from different
modules that are incorrectly identified to be ambiguous.

The solution is not to depend merely on the symbols being different
for ambiguity but to check, in addition, for these two cases.  Since
there might be other, similar problems lurking in the background, I
have introduced a static function to do the test.

This patch has yet to be regtested but deals correctly with the other
module tests in the testsuite.

After regtesting, OK for trunk and 4.3?

Paul

Attachment: Change.Logs
Description: Binary data

Index: gcc/fortran/module.c
===================================================================
--- gcc/fortran/module.c	(revision 139704)
+++ gcc/fortran/module.c	(working copy)
@@ -1939,6 +1939,7 @@
     minit ("LOGICAL", BT_LOGICAL),
     minit ("CHARACTER", BT_CHARACTER),
     minit ("DERIVED", BT_DERIVED),
+    minit ("CLASS", BT_CLASS),
     minit ("PROCEDURE", BT_PROCEDURE),
     minit ("UNKNOWN", BT_UNKNOWN),
     minit ("VOID", BT_VOID),
@@ -1993,7 +1994,7 @@
 
   ts->type = MIO_NAME (bt) (ts->type, bt_types);
 
-  if (ts->type != BT_DERIVED)
+  if (ts->type != BT_DERIVED && ts->type != BT_CLASS)
     mio_integer (&ts->kind);
   else
     mio_symbol_ref (&ts->derived);
@@ -3812,6 +3813,32 @@
 }
 
 
+/* It is not quite enough to check for ambiguity by the loaded symbol
+   and the new symbol not being identical.  */
+static bool
+check_for_ambiguous (gfc_symbol *st_sym, gfc_symbol *rsym)
+{
+  if (st_sym == rsym)
+    return false;
+
+  /* Identical derived types are not ambiguous and will be rolled up
+     later.  */
+  if (st_sym->attr.flavor == FL_DERIVED
+	&& rsym->attr.flavor == FL_DERIVED
+	&& gfc_compare_derived_types (st_sym, rsym))
+    return false;
+
+  /* If the existing symbol is generic and from a different module,
+     there can be no ambiguity.  */
+  if (st_sym->attr.generic
+	&& st_sym->module
+	&& strcmp (st_sym->module, module_name))
+    return false;
+
+  return true;
+}
+
+
 /* Read a module file.  */
 
 static void
@@ -3953,7 +3980,7 @@
 	  if (st != NULL)
 	    {
 	      /* Check for ambiguous symbols.  */
-	      if (st->n.sym != info->u.rsym.sym)
+	      if (check_for_ambiguous (st->n.sym, info->u.rsym.sym))
 		st->ambiguous = 1;
 	      info->u.rsym.symtree = st;
 	    }
Index: gcc/testsuite/gfortran.dg/generic_17.f90
===================================================================
--- gcc/testsuite/gfortran.dg/generic_17.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/generic_17.f90	(revision 0)
@@ -0,0 +1,40 @@
+! { dg-do compile }
+! Test the patch for PR36374 in which the different
+! symbols for 'foobar' would be incorrectly flagged as
+! ambiguous in foo_mod.
+!
+! Contributed by Salvatore Filippone  <sfilippone@uniroma2.it>
+!
+module s_foo_mod
+  type s_foo_type
+    real(kind(1.e0)) :: v
+  end type s_foo_type
+  interface foobar
+    subroutine s_foobar(x)
+      import 
+      type(s_foo_type), intent (inout) :: x
+    end subroutine s_foobar
+  end interface
+end module s_foo_mod
+
+module d_foo_mod
+  type d_foo_type
+    real(kind(1.d0)) :: v
+  end type d_foo_type
+  interface foobar
+    subroutine d_foobar(x)
+      import  
+      type(d_foo_type), intent (inout) :: x
+    end subroutine d_foobar
+  end interface
+end module d_foo_mod
+
+module foo_mod
+  use s_foo_mod
+  use d_foo_mod
+end module foo_mod
+
+subroutine s_foobar(x)  
+  use foo_mod
+end subroutine s_foobar
+! { dg-final { cleanup-modules "s_foo_mod d_foo_mod foo_mod" } }
Index: gcc/testsuite/gfortran.dg/used_types_22.f90
===================================================================
--- gcc/testsuite/gfortran.dg/used_types_22.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/used_types_22.f90	(revision 0)
@@ -0,0 +1,294 @@
+! { dg-do compile }
+! Tests the fix for PR37274 a regression in which the derived type,
+! 'vector' of the function results contained in 'class_motion' is
+! private and is incorrectly detected to be ambiguous in 'smooth_mesh'.
+!
+! Contributed by Salvatore Filippone  <sfilippone@uniroma2.it>
+!
+module class_vector
+
+  implicit none
+
+  private ! Default
+  public :: vector                                  
+  public :: vector_ 
+
+  type vector
+     private
+     real(kind(1.d0)) :: x
+     real(kind(1.d0)) :: y
+     real(kind(1.d0)) :: z
+  end type vector
+
+contains
+  ! ----- Constructors -----
+
+  ! Public default constructor
+  elemental function vector_(x,y,z)
+    type(vector) :: vector_
+    real(kind(1.d0)), intent(in) :: x, y, z
+
+    vector_ = vector(x,y,z)
+
+  end function vector_
+
+end module class_vector
+
+module class_dimensions
+
+  implicit none
+
+  private ! Default
+  public :: dimensions
+
+  type dimensions
+     private
+     integer :: l
+     integer :: m
+     integer :: t
+     integer :: theta
+  end type dimensions
+
+
+end module class_dimensions
+
+module tools_math
+
+  implicit none
+
+
+  interface lin_interp
+     function lin_interp_s(f1,f2,fac)
+       real(kind(1.d0)) :: lin_interp_s
+       real(kind(1.d0)), intent(in) :: f1, f2
+       real(kind(1.d0)), intent(in) :: fac
+     end function lin_interp_s
+
+     function lin_interp_v(f1,f2,fac)
+       use class_vector
+       type(vector) :: lin_interp_v
+       type(vector),     intent(in) :: f1, f2
+       real(kind(1.d0)), intent(in) :: fac
+     end function lin_interp_v
+  end interface
+
+
+  interface pwl_deriv
+     subroutine pwl_deriv_x_s(dydx,x,y_data,x_data)
+       real(kind(1.d0)), intent(out) :: dydx
+       real(kind(1.d0)), intent(in) :: x
+       real(kind(1.d0)), intent(in) :: y_data(:)
+       real(kind(1.d0)), intent(in) :: x_data(:)
+     end subroutine pwl_deriv_x_s
+
+     subroutine pwl_deriv_x_v(dydx,x,y_data,x_data)
+       real(kind(1.d0)), intent(out) :: dydx(:)
+       real(kind(1.d0)), intent(in) :: x
+       real(kind(1.d0)), intent(in) :: y_data(:,:)
+       real(kind(1.d0)), intent(in) :: x_data(:)
+     end subroutine pwl_deriv_x_v
+
+     subroutine pwl_deriv_x_vec(dydx,x,y_data,x_data)
+       use class_vector
+       type(vector), intent(out) :: dydx
+       real(kind(1.d0)), intent(in) :: x
+       type(vector), intent(in) :: y_data(:)
+       real(kind(1.d0)), intent(in) :: x_data(:)
+     end subroutine pwl_deriv_x_vec
+  end interface
+
+end module tools_math
+
+module class_motion
+
+  use class_vector
+ 
+  implicit none
+  
+  private 
+  public :: motion 
+  public :: get_displacement, get_velocity
+
+  type motion
+     private
+     integer :: surface_motion
+     integer :: vertex_motion
+     !
+     integer :: iml
+     real(kind(1.d0)), allocatable :: law_x(:) 
+     type(vector), allocatable :: law_y(:)  
+  end type motion
+
+contains
+
+
+  function get_displacement(mot,x1,x2)
+    use tools_math
+
+    type(vector) :: get_displacement
+    type(motion), intent(in) :: mot
+    real(kind(1.d0)), intent(in) :: x1, x2
+    !
+    integer :: i1, i2, i3, i4
+    type(vector) :: p1, p2, v_A, v_B, v_C, v_D
+    type(vector) :: i_trap_1, i_trap_2, i_trap_3
+
+    get_displacement = vector_(0.d0,0.d0,0.d0)
+    
+  end function get_displacement
+
+
+  function get_velocity(mot,x)
+    use tools_math
+
+    type(vector) :: get_velocity
+    type(motion), intent(in) :: mot
+    real(kind(1.d0)), intent(in) :: x
+    !
+    type(vector) :: v
+    
+    get_velocity = vector_(0.d0,0.d0,0.d0)
+    
+  end function get_velocity
+  
+  
+
+end module class_motion
+
+module class_bc_math
+  
+  implicit none
+
+  private 
+  public :: bc_math                           
+
+  type bc_math
+     private
+     integer :: id
+     integer :: nbf
+     real(kind(1.d0)), allocatable :: a(:) 
+     real(kind(1.d0)), allocatable :: b(:) 
+     real(kind(1.d0)), allocatable :: c(:) 
+  end type bc_math
+
+  
+end module class_bc_math
+
+module class_bc
+
+  use class_bc_math
+  use class_motion
+
+  implicit none
+
+  private 
+  public :: bc_poly                          
+  public :: get_abc, &
+       &    get_displacement, get_velocity  
+
+  type bc_poly
+     private
+     integer :: id
+     type(motion) :: mot
+     type(bc_math), pointer :: math => null()
+  end type bc_poly
+
+
+  interface get_displacement
+     module procedure get_displacement, get_bc_motion_displacement
+  end interface
+
+  interface get_velocity
+     module procedure get_velocity, get_bc_motion_velocity
+  end interface
+
+  interface get_abc
+     module procedure get_abc_s, get_abc_v
+  end interface
+  
+contains
+
+
+  subroutine get_abc_s(bc,dim,id,a,b,c)
+    use class_dimensions
+    
+    type(bc_poly), intent(in) :: bc
+    type(dimensions), intent(in) :: dim
+    integer, intent(out) :: id
+    real(kind(1.d0)), intent(inout) :: a(:)
+    real(kind(1.d0)), intent(inout) :: b(:)
+    real(kind(1.d0)), intent(inout) :: c(:)
+    
+    
+  end subroutine get_abc_s
+
+
+  subroutine get_abc_v(bc,dim,id,a,b,c)
+    use class_dimensions
+    use class_vector
+
+    type(bc_poly), intent(in) :: bc
+    type(dimensions), intent(in) :: dim
+    integer, intent(out) :: id
+    real(kind(1.d0)), intent(inout) :: a(:)
+    real(kind(1.d0)), intent(inout) :: b(:)
+    type(vector),     intent(inout) :: c(:)
+
+    
+  end subroutine get_abc_v
+
+
+
+  function get_bc_motion_displacement(bc,x1,x2)result(res)
+    use class_vector
+    type(vector) :: res
+    type(bc_poly), intent(in) :: bc
+    real(kind(1.d0)), intent(in) :: x1, x2
+    
+    res = get_displacement(bc%mot,x1,x2)
+
+  end function get_bc_motion_displacement
+
+
+  function get_bc_motion_velocity(bc,x)result(res)
+    use class_vector
+    type(vector) :: res
+    type(bc_poly), intent(in) :: bc
+    real(kind(1.d0)), intent(in) :: x
+
+    res = get_velocity(bc%mot,x)
+
+  end function get_bc_motion_velocity
+
+
+end module class_bc
+
+module tools_mesh_basics
+  
+  implicit none
+  
+  interface
+     function geom_tet_center(v1,v2,v3,v4)
+       use class_vector
+       type(vector) :: geom_tet_center
+       type(vector), intent(in) :: v1, v2, v3, v4
+     end function geom_tet_center
+  end interface
+
+
+end module tools_mesh_basics
+
+
+subroutine smooth_mesh
+
+  use class_bc
+  use class_vector
+  use tools_mesh_basics
+
+  implicit none
+
+  type(vector) :: new_pos  ! the new vertex position, after smoothing
+
+end subroutine smooth_mesh
+! { dg-final { cleanup-modules "class_vector class_dimensions tools_math" } }
+! { dg-final { cleanup-modules "class_motion class_bc_math class_bc tools_mesh_basics" } }