re PR fortran/49638 ([OOP] length parameter is ignored when overriding type bound...

2011-08-20  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/49638
	* dependency.c (gfc_dep_compare_expr): Add new result value "-3".
	(gfc_check_element_vs_section,gfc_check_element_vs_element): Handle
	result value "-3".
        * frontend-passes.c (optimize_comparison): Ditto.
	* interface.c (gfc_check_typebound_override): Ditto.

2011-08-20  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/49638
	* gfortran.dg/typebound_override_1.f90: Modified.

From-SVN: r177932

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index a361d530081af32319e2090b67fb5f9dfe1b98c6..2e2a714dd2530bed1541fd122f2fe938b2e56503 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+2011-08-20  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/49638
+       * dependency.c (gfc_dep_compare_expr): Add new result value "-3".
+       (gfc_check_element_vs_section,gfc_check_element_vs_element): Handle
+       result value "-3".
+        * frontend-passes.c (optimize_comparison): Ditto.
+       * interface.c (gfc_check_typebound_override): Ditto.
+
 2011-08-19  Mikael Morin  <mikael.morin@sfr.fr>
 
        PR fortran/50129

diff --git a/gcc/fortran/dependency.c b/gcc/fortran/dependency.c
index 5238c861381952ee6ffe985f2f21f3b05680791f..c43af00c727ff88e49c8c292fe30d6ac2bd605aa 100644 (file)
--- a/gcc/fortran/dependency.c
+++ b/gcc/fortran/dependency.c
@@ -230,8 +230,12 @@ gfc_dep_compare_functions (gfc_expr *e1, gfc_expr *e2, bool impure_ok)
        return -2;      
 }
 
-/* Compare two values.  Returns 0 if e1 == e2, -1 if e1 < e2, +1 if e1 > e2,
-   and -2 if the relationship could not be determined.  */
+/* Compare two expressions.  Return values:
+   * +1 if e1 > e2
+   * 0 if e1 == e2
+   * -1 if e1 < e2
+   * -2 if the relationship could not be determined
+   * -3 if e1 /= e2, but we cannot tell which one is larger.  */
 
 int
 gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
@@ -304,9 +308,9 @@ gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
          r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2);
          if (l == 0 && r == 0)
            return 0;
-         if (l == 0 && r != -2)
+         if (l == 0 && r > -2)
            return r;
-         if (l != -2 && r == 0)
+         if (l > -2 && r == 0)
            return l;
          if (l == 1 && r == 1)
            return 1;
@@ -317,9 +321,9 @@ gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
          r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op1);
          if (l == 0 && r == 0)
            return 0;
-         if (l == 0 && r != -2)
+         if (l == 0 && r > -2)
            return r;
-         if (l != -2 && r == 0)
+         if (l > -2 && r == 0)
            return l;
          if (l == 1 && r == 1)
            return 1;
@@ -354,9 +358,9 @@ gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
          r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2);
          if (l == 0 && r == 0)
            return 0;
-         if (l != -2 && r == 0)
+         if (l > -2 && r == 0)
            return l;
-         if (l == 0 && r != -2)
+         if (l == 0 && r > -2)
            return -r;
          if (l == 1 && r == -1)
            return 1;
@@ -375,8 +379,8 @@ gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
       l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1);
       r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2);
 
-      if (l == -2)
-       return -2;
+      if (l <= -2)
+       return l;
 
       if (l == 0)
        {
@@ -387,7 +391,7 @@ gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
          if (e1_left->expr_type == EXPR_CONSTANT
              && e2_left->expr_type == EXPR_CONSTANT
              && e1_left->value.character.length
-               != e2_left->value.character.length)
+                != e2_left->value.character.length)
            return -2;
          else
            return r;
@@ -411,7 +415,7 @@ gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
     }
 
   if (e1->expr_type != e2->expr_type)
-    return -2;
+    return -3;
 
   switch (e1->expr_type)
     {
@@ -434,7 +438,7 @@ gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
       if (are_identical_variables (e1, e2))
        return 0;
       else
-       return -2;
+       return -3;
 
     case EXPR_OP:
       /* Intrinsic operators are the same if their operands are the same.  */
@@ -1406,7 +1410,7 @@ gfc_check_element_vs_section( gfc_ref *lref, gfc_ref *rref, int n)
       if (!start || !end)
        return GFC_DEP_OVERLAP;
       s = gfc_dep_compare_expr (start, end);
-      if (s == -2)
+      if (s <= -2)
        return GFC_DEP_OVERLAP;
       /* Assume positive stride.  */
       if (s == -1)
@@ -1553,7 +1557,7 @@ gfc_check_element_vs_element (gfc_ref *lref, gfc_ref *rref, int n)
   if (contains_forall_index_p (r_start) || contains_forall_index_p (l_start))
     return GFC_DEP_OVERLAP;
 
-  if (i != -2)
+  if (i > -2)
     return GFC_DEP_NODEP;
   return GFC_DEP_EQUAL;
 }

diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c
index 8ab46f6e457bc104c0b554b8b386cdbd8f1d99d0..8f2b1d1350d88617b9b30cb87f84a66d92bc0de8 100644 (file)
--- a/gcc/fortran/frontend-passes.c
+++ b/gcc/fortran/frontend-passes.c
@@ -682,7 +682,7 @@ optimize_comparison (gfc_expr *e, gfc_intrinsic_op op)
          && op1->ts.type != BT_COMPLEX && op2->ts.type != BT_COMPLEX))
     {
       eq = gfc_dep_compare_expr (op1, op2);
-      if (eq == -2)
+      if (eq <= -2)
        {
          /* Replace A // B < A // C with B < C, and A // B < C // B
             with A < C.  */

diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 0ea244de32a9676f449d2dca5b6aa4640bd685c7..c6626972bb7422a8ae8d1561fc6b058f46d9cca4 100644 (file)
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -3574,7 +3574,8 @@ gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old)
          switch (compval)
          {
            case -1:
-           case 1:
+           case  1:
+           case -3:
              gfc_error ("Character length mismatch between '%s' at '%L' and "
                         "overridden FUNCTION", proc->name, &where);
              return FAILURE;

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 459eea5518a6d9fc4894b66578dcb751e125647e..d54fd2bd9bb8f00306feb5a083a5aa582b5e1ed2 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2011-08-20  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/49638
+       * gfortran.dg/typebound_override_1.f90: Modified.
+
 2011-08-20  Jakub Jelinek  <jakub@redhat.com>
 
        PR tree-optimization/48739

diff --git a/gcc/testsuite/gfortran.dg/typebound_override_1.f90 b/gcc/testsuite/gfortran.dg/typebound_override_1.f90
index 37939d9a17ccfce68ec00968a7167f07af2244ae..c2b71933ac0b882afe76a1c6062b018850cb57fe 100644 (file)
--- a/gcc/testsuite/gfortran.dg/typebound_override_1.f90
+++ b/gcc/testsuite/gfortran.dg/typebound_override_1.f90
@@ -23,7 +23,7 @@ module m
      procedure, nopass :: b => b2  ! { dg-error "should have matching result types and ranks" }
      procedure, nopass :: c => c2  ! { dg-warning "Possible character length mismatch" }
      procedure, nopass :: d => d2  ! valid, check for commutativity (+,*)
-     procedure, nopass :: e => e2  ! { dg-warning "Possible character length mismatch" }
+     procedure, nopass :: e => e2  ! { dg-error "Character length mismatch" }
   end type
 
 contains