Fix a min-max bug

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)

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)

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)

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

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

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

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

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
+

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

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
+

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) {