From 178894a09f6d9178fdfb3fdf10ffbbe0327e4bab Mon Sep 17 00:00:00 2001 From: Liuyunlong Date: Wed, 6 Sep 2023 10:02:43 +0800 Subject: [PATCH] [flang1] Fix an MIN/MAX intrinsic bug This patch solves two problems: 1.According to the fortran 2008 standard, add syntax check for MAX/MIN intrinsic, as follows: The arguments shall all be of the same type which shall be integer, real, or character and they shall all have the same kind type parameter. 2.The final type of argument with MIN/MAX intrinsic is determined by the type of highest precision atgument, not the first argument. --- test/f90_correct/inc/min_max_1.mk | 14 +++++ test/f90_correct/inc/min_max_2.mk | 14 +++++ test/f90_correct/inc/min_max_3.mk | 14 +++++ test/f90_correct/lit/min_max_1.sh | 9 +++ test/f90_correct/lit/min_max_2.sh | 9 +++ test/f90_correct/lit/min_max_3.sh | 10 +++ test/f90_correct/src/min_max_1.F90 | 76 +++++++++++++++++++++++ test/f90_correct/src/min_max_2.F90 | 20 ++++++ test/f90_correct/src/min_max_3.F90 | 45 ++++++++++++++ test/llvm_ir_correct/min_max_dtype_01.f90 | 19 ++++++ tools/flang1/flang1exe/semfunc.c | 67 ++++++++++++++++++++ 11 files changed, 297 insertions(+) create mode 100644 test/f90_correct/inc/min_max_1.mk create mode 100644 test/f90_correct/inc/min_max_2.mk create mode 100644 test/f90_correct/inc/min_max_3.mk create mode 100644 test/f90_correct/lit/min_max_1.sh create mode 100644 test/f90_correct/lit/min_max_2.sh create mode 100644 test/f90_correct/lit/min_max_3.sh create mode 100644 test/f90_correct/src/min_max_1.F90 create mode 100644 test/f90_correct/src/min_max_2.F90 create mode 100644 test/f90_correct/src/min_max_3.F90 create mode 100644 test/llvm_ir_correct/min_max_dtype_01.f90 diff --git a/test/f90_correct/inc/min_max_1.mk b/test/f90_correct/inc/min_max_1.mk new file mode 100644 index 00000000000..da16475f304 --- /dev/null +++ b/test/f90_correct/inc/min_max_1.mk @@ -0,0 +1,14 @@ +# Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +# See https://llvm.org/LICENSE.txt for license information. +# SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception + +build: $(SRC)/$(TEST).F90 + @echo ------------------------------------ building test $(TEST) + -$(FC) -c $(SRC)/$(TEST).F90 > $(TEST).rslt 2>&1 + +run: + @echo ------------------------------------ nothing to run for test $(TEST) + +verify: $(TEST).rslt + @echo ------------------------------------ verifying test $(TEST) + $(COMP_CHECK) $(SRC)/$(TEST).F90 $(TEST).rslt $(FC) diff --git a/test/f90_correct/inc/min_max_2.mk b/test/f90_correct/inc/min_max_2.mk new file mode 100644 index 00000000000..da16475f304 --- /dev/null +++ b/test/f90_correct/inc/min_max_2.mk @@ -0,0 +1,14 @@ +# Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +# See https://llvm.org/LICENSE.txt for license information. +# SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception + +build: $(SRC)/$(TEST).F90 + @echo ------------------------------------ building test $(TEST) + -$(FC) -c $(SRC)/$(TEST).F90 > $(TEST).rslt 2>&1 + +run: + @echo ------------------------------------ nothing to run for test $(TEST) + +verify: $(TEST).rslt + @echo ------------------------------------ verifying test $(TEST) + $(COMP_CHECK) $(SRC)/$(TEST).F90 $(TEST).rslt $(FC) diff --git a/test/f90_correct/inc/min_max_3.mk b/test/f90_correct/inc/min_max_3.mk new file mode 100644 index 00000000000..da16475f304 --- /dev/null +++ b/test/f90_correct/inc/min_max_3.mk @@ -0,0 +1,14 @@ +# Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +# See https://llvm.org/LICENSE.txt for license information. +# SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception + +build: $(SRC)/$(TEST).F90 + @echo ------------------------------------ building test $(TEST) + -$(FC) -c $(SRC)/$(TEST).F90 > $(TEST).rslt 2>&1 + +run: + @echo ------------------------------------ nothing to run for test $(TEST) + +verify: $(TEST).rslt + @echo ------------------------------------ verifying test $(TEST) + $(COMP_CHECK) $(SRC)/$(TEST).F90 $(TEST).rslt $(FC) diff --git a/test/f90_correct/lit/min_max_1.sh b/test/f90_correct/lit/min_max_1.sh new file mode 100644 index 00000000000..3880a96ea63 --- /dev/null +++ b/test/f90_correct/lit/min_max_1.sh @@ -0,0 +1,9 @@ +# +# Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +# See https://llvm.org/LICENSE.txt for license information. +# SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception + +# Shared lit script for each tests. Run bash commands that run tests with make. + +# RUN: KEEP_FILES=%keep FLAGS=%flags TEST_SRC=%s MAKE_FILE_DIR=%S/.. bash %S/runmake | tee %t +# RUN: cat %t | FileCheck %S/runmake diff --git a/test/f90_correct/lit/min_max_2.sh b/test/f90_correct/lit/min_max_2.sh new file mode 100644 index 00000000000..3880a96ea63 --- /dev/null +++ b/test/f90_correct/lit/min_max_2.sh @@ -0,0 +1,9 @@ +# +# Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +# See https://llvm.org/LICENSE.txt for license information. +# SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception + +# Shared lit script for each tests. Run bash commands that run tests with make. + +# RUN: KEEP_FILES=%keep FLAGS=%flags TEST_SRC=%s MAKE_FILE_DIR=%S/.. bash %S/runmake | tee %t +# RUN: cat %t | FileCheck %S/runmake diff --git a/test/f90_correct/lit/min_max_3.sh b/test/f90_correct/lit/min_max_3.sh new file mode 100644 index 00000000000..b10b9877bfc --- /dev/null +++ b/test/f90_correct/lit/min_max_3.sh @@ -0,0 +1,10 @@ +# +# Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +# See https://llvm.org/LICENSE.txt for license information. +# SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception + +# Shared lit script for each tests. Run bash commands that run tests with make. + +# REQUIRES: quadfp +# RUN: KEEP_FILES=%keep FLAGS=%flags TEST_SRC=%s MAKE_FILE_DIR=%S/.. bash %S/runmake | tee %t +# RUN: cat %t | FileCheck %S/runmake diff --git a/test/f90_correct/src/min_max_1.F90 b/test/f90_correct/src/min_max_1.F90 new file mode 100644 index 00000000000..4a17b120e49 --- /dev/null +++ b/test/f90_correct/src/min_max_1.F90 @@ -0,0 +1,76 @@ +! Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +! See https://llvm.org/LICENSE.txt for license information. +! SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception + +! Test that MIN/MAX intrinsic have not the same kind type parameter. + +program test + real(kind = 4) :: r4 = 1.0 + real(kind = 8) :: r8 = 1.0 + integer(kind = 1) :: i1 = 1 + integer(kind = 2) :: i2 = 1 + integer(kind = 4) :: i4 = 1 + integer(kind = 8) :: i8 = 1 + character(len = 1) :: c = "a" + real :: res + !{warning "PGF90-W-0093-Type conversion of expression performed"} + !{error "PGF90-S-0155-Arguments must have the same kind type parameter!"} + res = max(r4, i1) + !{warning "PGF90-W-0093-Type conversion of expression performed"} + !{error "PGF90-S-0155-Arguments must have the same kind type parameter!"} + res = min(r4, i1) + !{warning "PGF90-W-0093-Type conversion of expression performed"} + !{error "PGF90-S-0155-Arguments must have the same kind type parameter!"} + res = max(r4, i2) + !{warning "PGF90-W-0093-Type conversion of expression performed"} + !{error "PGF90-S-0155-Arguments must have the same kind type parameter!"} + res = min(r4, i2) + !{warning "PGF90-W-0093-Type conversion of expression performed"} + !{error "PGF90-S-0155-Arguments must have the same kind type parameter!"} + res = max(r4, i4) + !{warning "PGF90-W-0093-Type conversion of expression performed"} + !{error "PGF90-S-0155-Arguments must have the same kind type parameter!"} + res = min(r4, i4) + !{warning "PGF90-W-0093-Type conversion of expression performed"} + !{error "PGF90-S-0155-Arguments must have the same kind type parameter!"} + res = max(r4, i8) + !{warning "PGF90-W-0093-Type conversion of expression performed"} + !{error "PGF90-S-0155-Arguments must have the same kind type parameter!"} + res = min(r4, i8) + !{error "PGF90-S-0074-Illegal number or type of arguments to max"} + !{error "PGF90-S-0155-Arguments must have the same kind type parameter!"} + res = max(r4, c) + !{error "PGF90-S-0074-Illegal number or type of arguments to min"} + !{error "PGF90-S-0155-Arguments must have the same kind type parameter!"} + res = min(r4, c) + !{warning "PGF90-W-0093-Type conversion of expression performed"} + !{error "PGF90-S-0155-Arguments must have the same kind type parameter!"} + res = max(r8, i1) + !{warning "PGF90-W-0093-Type conversion of expression performed"} + !{error "PGF90-S-0155-Arguments must have the same kind type parameter!"} + res = min(r8, i1) + !{warning "PGF90-W-0093-Type conversion of expression performed"} + !{error "PGF90-S-0155-Arguments must have the same kind type parameter!"} + res = max(r8, i2) + !{warning "PGF90-W-0093-Type conversion of expression performed"} + !{error "PGF90-S-0155-Arguments must have the same kind type parameter!"} + res = min(r8, i2) + !{warning "PGF90-W-0093-Type conversion of expression performed"} + !{error "PGF90-S-0155-Arguments must have the same kind type parameter!"} + res = max(r8, i4) + !{warning "PGF90-W-0093-Type conversion of expression performed"} + !{error "PGF90-S-0155-Arguments must have the same kind type parameter!"} + res = min(r8, i4) + !{warning "PGF90-W-0093-Type conversion of expression performed"} + !{error "PGF90-S-0155-Arguments must have the same kind type parameter!"} + res = max(r8, i8) + !{warning "PGF90-W-0093-Type conversion of expression performed"} + !{error "PGF90-S-0155-Arguments must have the same kind type parameter!"} + res = min(r8, i8) + !{error "PGF90-S-0074-Illegal number or type of arguments to max"} + !{error "PGF90-S-0155-Arguments must have the same kind type parameter!"} + res = max(r8, c) + !{error "PGF90-S-0074-Illegal number or type of arguments to min"} + !{error "PGF90-S-0155-Arguments must have the same kind type parameter!"} + res = min(r8, c) +end diff --git a/test/f90_correct/src/min_max_2.F90 b/test/f90_correct/src/min_max_2.F90 new file mode 100644 index 00000000000..f919dfd1ad0 --- /dev/null +++ b/test/f90_correct/src/min_max_2.F90 @@ -0,0 +1,20 @@ +! Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +! See https://llvm.org/LICENSE.txt for license information. +! SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception + +! Test that MIN/MAX intrinsic have not INTEGER, REAL, or CHARACTER arguments. + +program test + complex(kind = 4) :: c1 = 1.0 + complex(kind = 4) :: c2 = 1.0 + logical :: l1 = .true. + logical :: l2 = .true. + real :: res + !{error "PGF90-S-0155-Arguments must be INTEGER, REAL, or CHARACTER!"} + !{error "PGF90-S-0155-Arguments must be INTEGER, REAL, or CHARACTER!"} + res = max(c1, c2) + !{error "PGF90-S-0155-Arguments must be INTEGER, REAL, or CHARACTER!"} + !{error "PGF90-S-0155-Arguments must be INTEGER, REAL, or CHARACTER!"} + res = min(l1, l2) +end + diff --git a/test/f90_correct/src/min_max_3.F90 b/test/f90_correct/src/min_max_3.F90 new file mode 100644 index 00000000000..cd8fdf5c9f4 --- /dev/null +++ b/test/f90_correct/src/min_max_3.F90 @@ -0,0 +1,45 @@ +! Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +! See https://llvm.org/LICENSE.txt for license information. +! SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception + +! Test that MIN/MAX intrinsic have not the same kind type parameter. + +program test + real(kind = 16) :: r16 = 1.0 + integer(kind = 1) :: i1 = 1 + integer(kind = 2) :: i2 = 1 + integer(kind = 4) :: i4 = 1 + integer(kind = 8) :: i8 = 1 + character(len = 1) :: c = "a" + real :: res + !{warning "PGF90-W-0093-Type conversion of expression performed"} + !{error "PGF90-S-0155-Arguments must have the same kind type parameter!"} + res = max(r16, i1) + !{warning "PGF90-W-0093-Type conversion of expression performed"} + !{error "PGF90-S-0155-Arguments must have the same kind type parameter!"} + res = min(r16, i1) + !{warning "PGF90-W-0093-Type conversion of expression performed"} + !{error "PGF90-S-0155-Arguments must have the same kind type parameter!"} + res = max(r16, i2) + !{warning "PGF90-W-0093-Type conversion of expression performed"} + !{error "PGF90-S-0155-Arguments must have the same kind type parameter!"} + res = min(r16, i2) + !{warning "PGF90-W-0093-Type conversion of expression performed"} + !{error "PGF90-S-0155-Arguments must have the same kind type parameter!"} + res = max(r16, i4) + !{warning "PGF90-W-0093-Type conversion of expression performed"} + !{error "PGF90-S-0155-Arguments must have the same kind type parameter!"} + res = min(r16, i4) + !{warning "PGF90-W-0093-Type conversion of expression performed"} + !{error "PGF90-S-0155-Arguments must have the same kind type parameter!"} + res = max(r16, i8) + !{warning "PGF90-W-0093-Type conversion of expression performed"} + !{error "PGF90-S-0155-Arguments must have the same kind type parameter!"} + res = min(r16, i8) + !{error "PGF90-S-0074-Illegal number or type of arguments to max"} + !{error "PGF90-S-0155-Arguments must have the same kind type parameter!"} + res = max(r16, c) + !{error "PGF90-S-0074-Illegal number or type of arguments to min"} + !{error "PGF90-S-0155-Arguments must have the same kind type parameter!"} + res = min(r16, c) +end diff --git a/test/llvm_ir_correct/min_max_dtype_01.f90 b/test/llvm_ir_correct/min_max_dtype_01.f90 new file mode 100644 index 00000000000..faf83f1a506 --- /dev/null +++ b/test/llvm_ir_correct/min_max_dtype_01.f90 @@ -0,0 +1,19 @@ +! +! Part of the LLVM Project, under the Apache License v2.0 with LLVM +! Exceptions. +! See https://llvm.org/LICENSE.txt for license information. +! SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +! +! Test that MIN/MAX intrinsic have different kind type. +! +! RUN: %flang -emit-llvm -S %s -o %t +! RUN: cat %t | FileCheck %s -check-prefix=CHECK-DTYPE + +! CHECK-DTYPE: fpext float {{%.*}} to double +program test + real(kind = 4) :: r4 = 2.0 + real(kind = 8) :: r8 = 1.0 + real(kind = 8) :: res + res = min(r4, r8) +end + diff --git a/tools/flang1/flang1exe/semfunc.c b/tools/flang1/flang1exe/semfunc.c index 1750ddfd0de..19ed9f479e6 100644 --- a/tools/flang1/flang1exe/semfunc.c +++ b/tools/flang1/flang1exe/semfunc.c @@ -33,6 +33,13 @@ #define ARGS_NUMBER 3 #define MIN_ARGS_NUMBER 0 +enum DT_GENERAL{ + DT_INT_GENERAL, + DT_REAL_GENERAL, + DT_CHAR_GENERAL, + DT_NONE_GENERAL +}; + static struct { int nent; /* number of arguments specified by user */ int nargt; /* number actually needed for AST creation */ @@ -4152,6 +4159,49 @@ cmp_mod_scope(SPTR sptr) return scope1 == scope2; } +/* + * The arguments shall all have the same type which shall be integer, real, + * or character and they shall all have the same kind type parameter. + */ +void +check_max_min_argument(int argdtype, int *dtype_new, int *dtype_last) { + switch (DTYG(argdtype)) { + case TY_BINT: + case TY_SINT: + case TY_INT: + case TY_INT8: + case TY_WORD: + case TY_DWORD: + *dtype_new = DT_INT_GENERAL; + break; + case TY_HALF: + case TY_REAL: + case TY_DBLE: + case TY_QUAD: + *dtype_new = DT_REAL_GENERAL; + break; + case TY_CHAR: + case TY_NCHAR: + *dtype_new = DT_CHAR_GENERAL; + break; + default: + *dtype_new = DT_NONE_GENERAL; + break; + } + if (*dtype_last == 0) + *dtype_last = *dtype_new; + + if (*dtype_new == DT_NONE_GENERAL) { + error(155, 3, gbl.lineno, + "Arguments must be INTEGER, REAL, or CHARACTER!", CNULL); + } else if (*dtype_new != *dtype_last) { + error(155, 3, gbl.lineno, + "Arguments must have the same kind type parameter!", CNULL); + } else { + *dtype_last = *dtype_new; + } +} + /** \brief Handle Generic and Intrinsic function calls. */ int @@ -4178,6 +4228,9 @@ ref_intrin(SST *stktop, ITEM *list) int tmp, tmp_ast; FtnRtlEnum rtlRtn; int intrin; /* one of the I_* constants */ + int dtype_new = 0; + int dtype_last = 0; + int maxtype = 0; dtyper = 0; dtype1 = 0; @@ -4264,11 +4317,25 @@ ref_intrin(SST *stktop, ITEM *list) } else if (argdtype == DT_WORD) { } } + + if (intrin == I_MAX || intrin == I_MIN) { + check_max_min_argument(argdtype, &dtype_new, &dtype_last); + } + if (!dtype1) { f_dt = dtype1 = argdtype; /* Save 1st arg's data type */ if (DTY(argdtype) == TY_ARRAY) break; } else { + if (intrin == I_MAX || intrin == I_MIN) { + int dtypecompare = DTYG(argdtype); + if (dtypecompare == TY_WORD) dtypecompare = TY_INT; + if (dtypecompare == TY_DWORD) dtypecompare = TY_INT8; + if (dtypecompare > maxtype) + maxtype = dtypecompare; + dtype1 = argdtype; + } + /* check rest of args to see if they might be array. */ /* assert. haven't seen an array argument yet. */ if (DTY(argdtype) == TY_ARRAY) {