diff options
author | Steve Kargl <kargl@gcc.gnu.org> | 2021-10-30 18:22:19 +0200 |
---|---|---|
committer | Harald Anlauf <anlauf@gmx.de> | 2021-10-30 18:22:19 +0200 |
commit | d18e4cc416b832fa98ca8af13b09cf7fe904ba8f (patch) | |
tree | f03973ea21e640b9e8fecc8764c57019d4bb1973 /gcc | |
parent | 70c947e4dfaa6d63b5efc0d8cd990726a9b6d8ba (diff) | |
download | gcc-d18e4cc416b832fa98ca8af13b09cf7fe904ba8f.zip gcc-d18e4cc416b832fa98ca8af13b09cf7fe904ba8f.tar.gz gcc-d18e4cc416b832fa98ca8af13b09cf7fe904ba8f.tar.bz2 |
Fortran: generate regular error on invalid conversions of CASE expressions
gcc/fortran/ChangeLog:
PR fortran/99853
* resolve.c (resolve_select): Generate regular gfc_error on
invalid conversions instead of an gfc_internal_error.
gcc/testsuite/ChangeLog:
PR fortran/99853
* gfortran.dg/pr99853.f90: New test.
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/fortran/resolve.c | 4 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/pr99853.f90 | 29 |
2 files changed, 31 insertions, 2 deletions
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index af71b13..8da396b 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -8770,11 +8770,11 @@ resolve_select (gfc_code *code, bool select_type) if (cp->low != NULL && case_expr->ts.kind != gfc_kind_max(case_expr, cp->low)) - gfc_convert_type_warn (case_expr, &cp->low->ts, 2, 0); + gfc_convert_type_warn (case_expr, &cp->low->ts, 1, 0); if (cp->high != NULL && case_expr->ts.kind != gfc_kind_max(case_expr, cp->high)) - gfc_convert_type_warn (case_expr, &cp->high->ts, 2, 0); + gfc_convert_type_warn (case_expr, &cp->high->ts, 1, 0); } } } diff --git a/gcc/testsuite/gfortran.dg/pr99853.f90 b/gcc/testsuite/gfortran.dg/pr99853.f90 new file mode 100644 index 0000000..421a656 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr99853.f90 @@ -0,0 +1,29 @@ +! { dg-do compile } +! { dg-options "-std=f2018" } +! PR fortran/99853 + +subroutine s1 () + select case (.true.) ! { dg-error "Cannot convert" } + case (1_8) ! { dg-error "must be of type LOGICAL" } + end select +end + +subroutine s2 () + select case (.false._1) ! { dg-error "Cannot convert" } + case (2:3) ! { dg-error "must be of type LOGICAL" } + end select +end + +subroutine s3 () + select case (3_2) ! { dg-error "Cannot convert" } + case (.false.) ! { dg-error "must be of type INTEGER" } + end select +end + +subroutine s4 (i) + select case (i) ! { dg-error "Cannot convert" } + case (.true._8) ! { dg-error "must be of type INTEGER" } + end select +end + +! { dg-prune-output "Cannot convert" } |