2005-01-14 Steven G. Kargl <kargls@comcast.net>

	* resolve.c (compare_case): Cleanup.
testsuite/
	* gfortran.dg/select_1.f90: New test.
	* gfortran.dg/select_2.f90: New test.
	* gfortran.dg/select_3.f90: New test.
	* gfortran.dg/select_4.f90: New test.

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 84eae3d..ba5ae01 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,9 @@
 2005-01-14  Steven G. Kargl  <kargls@comcast.net>
 
+       * resolve.c (compare_case): Cleanup.
+
+2005-01-14  Steven G. Kargl  <kargls@comcast.net>
+
        * resolve.c (compare_case): Give arguments correct type.
 
 2005-01-13  Kazu Hirata  <kazu@cs.umass.edu>

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 7088677..4615df7 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -2493,85 +2493,52 @@ resolve_allocate_expr (gfc_expr * e)
 
 /* Callback function for our mergesort variant.  Determines interval
    overlaps for CASEs. Return <0 if op1 < op2, 0 for overlap, >0 for
-   op1 > op2.  Assumes we're not dealing with the default case.  */
+   op1 > op2.  Assumes we're not dealing with the default case.  
+   We have op1 = (:L), (K:L) or (K:) and op2 = (:N), (M:N) or (M:).
+   There are nine situations to check.  */
 
 static int
 compare_cases (const gfc_case * op1, const gfc_case * op2)
 {
+  int retval;
 
-  if (op1->low == NULL) /* op1 = (:N) */
+  if (op1->low == NULL) /* op1 = (:L)  */
     {
-      if (op2->low == NULL) /* op2 = (:M), so overlap.  */
-        return 0;
-
-      else if (op2->high == NULL) /* op2 = (M:) */
-        {
-         if (gfc_compare_expr (op1->high, op2->low) < 0)
-           return -1;  /* N < M */
-         else
-           return 0;
-       }
-
-      else /* op2 = (L:M) */
-        {
-         if (gfc_compare_expr (op1->high, op2->low) < 0)
-           return -1; /* N < L */
-         else
-           return 0;
-       }
+      /* op2 = (:N), so overlap.  */
+      retval = 0;
+      /* op2 = (M:) or (M:N),  L < M  */
+      if (op2->low != NULL
+         && gfc_compare_expr (op1->high, op2->low) < 0)
+       retval = -1;
     }
-
-  else if (op1->high == NULL) /* op1 = (N:) */
+  else if (op1->high == NULL) /* op1 = (K:)  */
     {
-      if (op2->low == NULL) /* op2 = (:M)  */
-        {
-         if (gfc_compare_expr (op1->low, op2->high) > 0)
-           return 1; /* N > M */
-         else
-           return 0;
-       }
-
-      else if (op2->high == NULL) /* op2 = (M:), so overlap.  */
-        return 0;
-
-      else /* op2 = (L:M) */
-        {
-         if (gfc_compare_expr (op1->low, op2->high) > 0)
-           return 1; /* N > M */
-         else
-           return 0;
-       }
+      /* op2 = (M:), so overlap.  */
+      retval = 0;
+      /* op2 = (:N) or (M:N), K > N  */
+      if (op2->high != NULL
+         && gfc_compare_expr (op1->low, op2->high) > 0)
+       retval = 1;
     }
-
-  else /* op1 = (N:P) */
+  else /* op1 = (K:L)  */
     {
-      if (op2->low == NULL) /* op2 = (:M)  */
-        {
-         if (gfc_compare_expr (op1->low, op2->high) > 0)
-           return 1; /* N > M */
-         else
-           return 0;
-       }
-
-      else if (op2->high == NULL) /* op2 = (M:)  */
+      if (op2->low == NULL)       /* op2 = (:N), K > N  */
+       retval = (gfc_compare_expr (op1->low, op2->high) > 0) ? 1 : 0;
+      else if (op2->high == NULL) /* op2 = (M:), L < M  */
+       retval = (gfc_compare_expr (op1->high, op2->low) < 0) ? -1 : 0;
+      else                        /* op2 = (M:N)  */
         {
+         retval =  0;
+          /* L < M  */
          if (gfc_compare_expr (op1->high, op2->low) < 0)
-           return -1; /* P < M */
-         else
-           return 0;
-       }
-
-      else /* op2 = (L:M) */
-        {
-         if (gfc_compare_expr (op1->high, op2->low) < 0)
-           return -1; /* P < L */
-
-         if (gfc_compare_expr (op1->low, op2->high) > 0)
-           return 1; /* N > M */
-
-         return 0;
+           retval =  -1;
+          /* K > N  */
+         else if (gfc_compare_expr (op1->low, op2->high) > 0)
+           retval =  1;
        }
     }
+
+  return retval;
 }
 
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 2d14c7d..f233054 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+2005-01-14  Steven G. Kargl  <kargls@comcast.net>
+
+       * gfortran.dg/select_1.f90: New test.
+       * gfortran.dg/select_2.f90: New test.
+       * gfortran.dg/select_3.f90: New test.
+       * gfortran.dg/select_4.f90: New test.
+
 2005-01-14  Jakub Jelinek  <jakub@redhat.com>
 
        PR middle-end/19084

diff --git a/gcc/testsuite/gfortran.dg/select_1.f90 b/gcc/testsuite/gfortran.dg/select_1.f90
new file mode 100644 (file)
index 0000000..4d9d597
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/select_1.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+!  Simple test for SELECT CASE
+!
+program select_2
+  integer i
+  do i = 1, 5
+     select case(i)
+     case (1)
+       if (i /= 1) call abort
+     case (2:3)
+       if (i /= 2 .and. i /= 3) call abort
+     case (4)
+       if (i /= 4) call abort
+     case default
+       if (i /= 5) call abort
+     end select
+  end do
+end program select_2

diff --git a/gcc/testsuite/gfortran.dg/select_2.f90 b/gcc/testsuite/gfortran.dg/select_2.f90
index 5859ee3..6ece658 100644 (file)
--- a/gcc/testsuite/gfortran.dg/select_2.f90
+++ b/gcc/testsuite/gfortran.dg/select_2.f90
@@ -1,18 +1,19 @@
 ! { dg-do run }
-!  Simple test for SELECT CASE
+!  Simple test program to see if gfortran eliminates the 'case (3:2)'
+!  statement.  This is an unreachable CASE because the range is empty.
 !
-program select_2
+program select_3
   integer i
   do i = 1, 4
      select case(i)
      case (1)
        if (i /= 1) call abort
-     case (2:3)
-       if (i /= 2 .and. i /= 3) call abort
+     case (3:2)
+       call abort
      case (4)
        if (i /= 4) call abort
      case default
-       call abort
+       if (i /= 2 .and. i /= 3) call abort
      end select
   end do
-end program select_2
+end program select_3

diff --git a/gcc/testsuite/gfortran.dg/select_3.f90 b/gcc/testsuite/gfortran.dg/select_3.f90
index 022b682..d1f2d69 100644 (file)
--- a/gcc/testsuite/gfortran.dg/select_3.f90
+++ b/gcc/testsuite/gfortran.dg/select_3.f90
@@ -1,19 +1,18 @@
-! [dg-do run }
-!  Simple test program to see if gfortran eliminates the 'case (3:2)'
-!  statement.  This is an unreachable CASE because the range is empty.
+! { dg-do run }
+!  Short test program with a CASE statement that uses a range.
 !
-program select_3
+program select_4
   integer i
-  do i = 1, 4
+  do i = 1, 34, 4
      select case(i)
-     case (1)
-       if (i /= 1) call abort
-     case (3:2)
-       call abort
-     case (4)
-       if (i /= 4) call abort
+     case (:5)
+       if (i /= 1 .and. i /= 5) call abort
+     case (13:21)
+       if (i /= 13 .and. i /= 17 .and. i /= 21) call abort
+     case (29:)
+       if (i /= 29 .and. i /= 33) call abort
      case default
-       if (i /= 2 .and. i /= 3) call abort
+       if (i /= 9 .and. i /= 25) call abort
      end select
   end do
-end program select_3
+end program select_4

diff --git a/gcc/testsuite/gfortran.dg/select_4.f90 b/gcc/testsuite/gfortran.dg/select_4.f90
index 8c410fc..8fb661f 100644 (file)
--- a/gcc/testsuite/gfortran.dg/select_4.f90
+++ b/gcc/testsuite/gfortran.dg/select_4.f90
@@ -1,16 +1,18 @@
-! { dg-do run }
-!  Short test program with a CASE statement that uses a range.
+! { dg-do compile }
+! Check for overlapping case range diagnostics.
 !
-program select_4
+program select_5
   integer i
-  do i = 1, 40, 4
-     select case(i)
-     case (:5)
-       if (i /= 1 .and. i /= 5) call abort
-     case (20:30)
-       if (i /= 21 .and. i /= 25 .and. i /= 29) call abort
-     case (34:)
-       if (i /= 37) call abort
-     end select
-  end do
-end program select_4
+  select case(i)
+  case (20:30)
+  case (25:) ! { dg-error "overlaps with CASE" "" }
+  end select
+  select case(i)
+  case (30)
+  case (25:) ! { dg-error "overlaps with CASE" "" }
+  end select
+  select case(i)
+  case (20:30)
+  case (25) ! { dg-error "overlaps with CASE" "" }
+  end select
+end program select_5