OSDN Git Service

PR fortran/21177
authorfxcoudert <fxcoudert@138bc75d-0d04-0410-961f-82ee72b054a4>
Wed, 27 Apr 2005 15:37:53 +0000 (15:37 +0000)
committerfxcoudert <fxcoudert@138bc75d-0d04-0410-961f-82ee72b054a4>
Wed, 27 Apr 2005 15:37:53 +0000 (15:37 +0000)
* interface.c (compare_parameter): Ignore type for EXPR_NULL
only if type is BT_UNKNOWN.

* gfortran.dg/pr21177.f90: New test

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@98837 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/fortran/ChangeLog
gcc/fortran/interface.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/pr21177.f90 [new file with mode: 0644]

index bf87e6a..822dcd0 100644 (file)
@@ -1,3 +1,9 @@
+2005-04-27  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+       PR fortran/21177
+       * interface.c (compare_parameter): Ignore type for EXPR_NULL
+       only if type is BT_UNKNOWN.
+
 2005-04-25  Paul Brook  <paul@codesourcery.com>
        Steven G. Kargl  <kargls@comcast.net>
 
index 6cb8fc6..5b848bc 100644 (file)
@@ -1096,7 +1096,7 @@ compare_parameter (gfc_symbol * formal, gfc_expr * actual,
       return compare_interfaces (formal, actual->symtree->n.sym, 0);
     }
 
-  if (actual->expr_type != EXPR_NULL
+  if ((actual->expr_type != EXPR_NULL || actual->ts.type != BT_UNKNOWN)
       && !gfc_compare_types (&formal->ts, &actual->ts))
     return 0;
 
index 78ac81a..e76ab25 100644 (file)
@@ -1,3 +1,8 @@
+2005-04-27  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+       PR fortran/21177
+       * gfortran.dg/pr21177.f90: New test.
+
 2005-04-27  Zdenek Dvorak  <dvorakz@suse.cz>
 
        PR tree-optimization/21171
 
 2004-04-27  Paolo Bonzini  <bonzini@gnu.org>
 
-        * gcc.dg/tree-ssa/gen-vect-11.c, gcc.dg/tree-ssa/gen-vect-11a.c,
-        gcc.dg/tree-ssa/gen-vect-11b.c, gcc.dg/tree-ssa/gen-vect-11c.c,
-        gcc.dg/tree-ssa/gen-vect-2.c, gcc.dg/tree-ssa/gen-vect-25.c,
-        gcc.dg/tree-ssa/gen-vect-26.c, gcc.dg/tree-ssa/gen-vect-28.c,
-        gcc.dg/tree-ssa/gen-vect-32.c: New.
-        * gcc.dg/vect/vect-82.c, gcc.dg/vect/vect-83.c: Fix dg-final.
-        * gcc.dg/vect/vect-82_64.c, gcc.dg/vect/vect-83_64.c: Remove xfail,
-        don't run on PPC32.
-        
+       * gcc.dg/tree-ssa/gen-vect-11.c, gcc.dg/tree-ssa/gen-vect-11a.c,
+       gcc.dg/tree-ssa/gen-vect-11b.c, gcc.dg/tree-ssa/gen-vect-11c.c,
+       gcc.dg/tree-ssa/gen-vect-2.c, gcc.dg/tree-ssa/gen-vect-25.c,
+       gcc.dg/tree-ssa/gen-vect-26.c, gcc.dg/tree-ssa/gen-vect-28.c,
+       gcc.dg/tree-ssa/gen-vect-32.c: New.
+       * gcc.dg/vect/vect-82.c, gcc.dg/vect/vect-83.c: Fix dg-final.
+       * gcc.dg/vect/vect-82_64.c, gcc.dg/vect/vect-83_64.c: Remove xfail,
+       don't run on PPC32.
+
 2005-04-27  Joseph S. Myers  <joseph@codesourcery.com>
 
        PR c/21213
diff --git a/gcc/testsuite/gfortran.dg/pr21177.f90 b/gcc/testsuite/gfortran.dg/pr21177.f90
new file mode 100644 (file)
index 0000000..8ce0180
--- /dev/null
@@ -0,0 +1,53 @@
+! { dg-do run }
+! PR fortran/21177
+module mymod
+  interface tt
+    module procedure tt_i, tt_r, tt_l, tt_c4, tt_c8
+  end interface tt
+contains
+  function tt_l(x) result(y)
+    integer :: y
+    logical, pointer :: x
+    y = 0
+  end function
+  function tt_i(x) result(y)
+    integer :: y
+    integer, pointer :: x
+    y = 1
+  end function
+  function tt_r(x) result(y)
+    integer :: y
+    real, pointer :: x
+    y = 2
+  end function
+  function tt_c4(x) result(y)
+    integer :: y
+    complex(4), pointer :: x
+    y = 3
+  end function
+  function tt_c8(x) result(y)
+    integer :: y
+    complex(8), pointer :: x
+    y = 4
+  end function
+end module mymod
+
+program test
+  use mymod
+  logical, pointer :: l
+  integer, pointer :: i
+  real, pointer :: r
+  complex(4), pointer :: c4
+  complex(8), pointer :: c8
+  
+  if (tt(l) /= 0) call abort()
+  if (tt(i) /= 1) call abort()
+  if (tt(r) /= 2) call abort()
+  if (tt(c4) /= 3) call abort()
+  if (tt(c8) /= 4) call abort()
+  if (tt(null(l)) /= 0) call abort()
+  if (tt(null(i)) /= 1) call abort()
+  if (tt(null(r)) /= 2) call abort()
+  if (tt(null(c4)) /= 3) call abort()
+  if (tt(null(c8)) /= 4) call abort()
+end program test