aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorSteve Kargl <kargl@gcc.gnu.org>2021-10-30 18:22:19 +0200
committerHarald Anlauf <anlauf@gmx.de>2021-10-30 18:22:19 +0200
commitd18e4cc416b832fa98ca8af13b09cf7fe904ba8f (patch)
treef03973ea21e640b9e8fecc8764c57019d4bb1973 /gcc
parent70c947e4dfaa6d63b5efc0d8cd990726a9b6d8ba (diff)
downloadgcc-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.c4
-rw-r--r--gcc/testsuite/gfortran.dg/pr99853.f9029
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" }