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..c3789633476 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,52 @@ 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_last) +{ + int dtype_new = DT_NONE_GENERAL; + + 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 +4231,8 @@ ref_intrin(SST *stktop, ITEM *list) int tmp, tmp_ast; FtnRtlEnum rtlRtn; int intrin; /* one of the I_* constants */ + int dtype_last = 0; + int maxtype = 0; dtyper = 0; dtype1 = 0; @@ -4264,11 +4319,26 @@ ref_intrin(SST *stktop, ITEM *list) } else if (argdtype == DT_WORD) { } } + + if (intrin == I_MAX || intrin == I_MIN) { + check_max_min_argument(argdtype, &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) {