[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

@@ -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,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,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_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) {