resolve.c (compare_case): Cleanup.
authorSteven G. Kargl <kargls@comcast.net>
Fri, 14 Jan 2005 11:55:12 +0000 (11:55 +0000)
committerPaul Brook <pbrook@gcc.gnu.org>
Fri, 14 Jan 2005 11:55:12 +0000 (11:55 +0000)
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.

From-SVN: r93640

gcc/fortran/ChangeLog
gcc/fortran/resolve.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/select_1.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/select_2.f90
gcc/testsuite/gfortran.dg/select_3.f90
gcc/testsuite/gfortran.dg/select_4.f90

index 84eae3d5b13a1ef5b170e83c339a6c77012ca06d..ba5ae017361ee4df4c96a4420313bd2f19ace4e1 100644 (file)
@@ -1,3 +1,7 @@
+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.
index 70886772d9d19ad999af19b383f2f381e14a6550..4615df77e154a560a306beb636a4df47d73bc1d6 100644 (file)
@@ -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;
 }
 
 
index 2d14c7d4e8704980c1fb5756068b075fbd2e0c3a..f233054980fe113d5e74c1938607a4178ddbf5e1 100644 (file)
@@ -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
@@ -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
index 5859ee39bf3e1e466a89f0612536dd75d80d702e..6ece65840f03a06a64a87013890ea1e6ae587437 100644 (file)
@@ -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
index 022b6820e7e2baee97b0b19e1938bca87b752eca..d1f2d6904993de270d65ef75c61e4a9909a85ea7 100644 (file)
@@ -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
index 8c410fc3de6f8abd45637393f1d37b534af884bb..8fb661f7c22c1680800bcffa6b99abf0b54919ff 100644 (file)
@@ -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