Skip to content

R
riscv-gcc-1
Commit c224550f by Steven G. Kargl Committed by Paul Brook
Options

resolve.c (compare_case): Cleanup. 

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
parent 08a0c536
Showing with 96 additions and 98 deletions
gcc/fortran/ChangeLog
2005-01-14 Steven G. Kargl <kargls@comcast.net> 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. * resolve.c (compare_case): Give arguments correct type.
2005-01-13 Kazu Hirata <kazu@cs.umass.edu> 2005-01-13 Kazu Hirata <kazu@cs.umass.edu>
......
gcc/fortran/resolve.c
...@@ -2493,85 +2493,52 @@ resolve_allocate_expr (gfc_expr * e) ...@@ -2493,85 +2493,52 @@ resolve_allocate_expr (gfc_expr * e)
/* Callback function for our mergesort variant. Determines interval /* Callback function for our mergesort variant. Determines interval
overlaps for CASEs. Return <0 if op1 < op2, 0 for overlap, >0 for 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 static int
compare_cases (const gfc_case * op1, const gfc_case * op2) 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. */ /* op2 = (:N), so overlap. */
return 0; retval = 0;
/* op2 = (M:) or (M:N), L < M */
else if (op2->high == NULL) /* op2 = (M:) */ if (op2->low != NULL
{ && gfc_compare_expr (op1->high, op2->low) < 0)
if (gfc_compare_expr (op1->high, op2->low) < 0) retval = -1;
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;
}
} }
else if (op1->high == NULL) /* op1 = (K:) */
else if (op1->high == NULL) /* op1 = (N:) */
{ {
if (op2->low == NULL) /* op2 = (:M) */ /* op2 = (M:), so overlap. */
{ retval = 0;
if (gfc_compare_expr (op1->low, op2->high) > 0) /* op2 = (:N) or (M:N), K > N */
return 1; /* N > M */ if (op2->high != NULL
else && gfc_compare_expr (op1->low, op2->high) > 0)
return 0; retval = 1;
}
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;
}
} }
else /* op1 = (K:L) */
else /* op1 = (N:P) */
{ {
if (op2->low == NULL) /* op2 = (:M) */ if (op2->low == NULL) /* op2 = (:N), K > N */
{ retval = (gfc_compare_expr (op1->low, op2->high) > 0) ? 1 : 0;
if (gfc_compare_expr (op1->low, op2->high) > 0) else if (op2->high == NULL) /* op2 = (M:), L < M */
return 1; /* N > M */ retval = (gfc_compare_expr (op1->high, op2->low) < 0) ? -1 : 0;
else else /* op2 = (M:N) */
return 0;
}
else if (op2->high == NULL) /* op2 = (M:) */
{ {
retval = 0;
/* L < M */
if (gfc_compare_expr (op1->high, op2->low) < 0) if (gfc_compare_expr (op1->high, op2->low) < 0)
return -1; /* P < M */ retval = -1;
else /* K > N */
return 0; else if (gfc_compare_expr (op1->low, op2->high) > 0)
} retval = 1;
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;
} }
} }
return retval;
} }
......
gcc/testsuite/ChangeLog
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> 2005-01-14 Jakub Jelinek <jakub@redhat.com>
PR middle-end/19084 PR middle-end/19084
......
gcc/testsuite/gfortran.dg/select_1.f90 0 → 100644
! { 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
gcc/testsuite/gfortran.dg/select_2.f90
! { dg-do run } ! { 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 integer i
do i = 1, 4 do i = 1, 4
select case(i) select case(i)
case (1) case (1)
if (i /= 1) call abort if (i /= 1) call abort
case (2:3) case (3:2)
if (i /= 2 .and. i /= 3) call abort call abort
case (4) case (4)
if (i /= 4) call abort if (i /= 4) call abort
case default case default
call abort if (i /= 2 .and. i /= 3) call abort
end select end select
end do end do
end program select_2 end program select_3
gcc/testsuite/gfortran.dg/select_3.f90
! [dg-do run } ! { dg-do run }
! Simple test program to see if gfortran eliminates the 'case (3:2)' ! Short test program with a CASE statement that uses a range.
! statement. This is an unreachable CASE because the range is empty.
! !
program select_3 program select_4
integer i integer i
do i = 1, 4 do i = 1, 34, 4
select case(i) select case(i)
case (1) case (:5)
if (i /= 1) call abort if (i /= 1 .and. i /= 5) call abort
case (3:2) case (13:21)
call abort if (i /= 13 .and. i /= 17 .and. i /= 21) call abort
case (4) case (29:)
if (i /= 4) call abort if (i /= 29 .and. i /= 33) call abort
case default case default
if (i /= 2 .and. i /= 3) call abort if (i /= 9 .and. i /= 25) call abort
end select end select
end do end do
end program select_3 end program select_4
gcc/testsuite/gfortran.dg/select_4.f90
! { dg-do run } ! { dg-do compile }
! Short test program with a CASE statement that uses a range. ! Check for overlapping case range diagnostics.
! !
program select_4 program select_5
integer i integer i
do i = 1, 40, 4 select case(i)
select case(i) case (20:30)
case (:5) case (25:) ! { dg-error "overlaps with CASE" "" }
if (i /= 1 .and. i /= 5) call abort end select
case (20:30) select case(i)
if (i /= 21 .and. i /= 25 .and. i /= 29) call abort case (30)
case (34:) case (25:) ! { dg-error "overlaps with CASE" "" }
if (i /= 37) call abort end select
end select select case(i)
end do case (20:30)
end program select_4 case (25) ! { dg-error "overlaps with CASE" "" }
end select
end program select_5
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment