Skip to content

Commit

Permalink
[flang1] Fix an MIN/MAX intrinsic bug
Browse files Browse the repository at this point in the history
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.
  • Loading branch information
liuyunlong16 committed Oct 19, 2023
1 parent 08b46d7 commit 178894a
Show file tree
Hide file tree
Showing 11 changed files with 297 additions and 0 deletions.
14 changes: 14 additions & 0 deletions test/f90_correct/inc/min_max_1.mk
Original file line number Diff line number Diff line change
@@ -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)
14 changes: 14 additions & 0 deletions test/f90_correct/inc/min_max_2.mk
Original file line number Diff line number Diff line change
@@ -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)
14 changes: 14 additions & 0 deletions test/f90_correct/inc/min_max_3.mk
Original file line number Diff line number Diff line change
@@ -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)
9 changes: 9 additions & 0 deletions test/f90_correct/lit/min_max_1.sh
Original file line number Diff line number Diff line change
@@ -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
9 changes: 9 additions & 0 deletions test/f90_correct/lit/min_max_2.sh
Original file line number Diff line number Diff line change
@@ -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
10 changes: 10 additions & 0 deletions test/f90_correct/lit/min_max_3.sh
Original file line number Diff line number Diff line change
@@ -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
76 changes: 76 additions & 0 deletions test/f90_correct/src/min_max_1.F90
Original file line number Diff line number Diff line change
@@ -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
20 changes: 20 additions & 0 deletions test/f90_correct/src/min_max_2.F90
Original file line number Diff line number Diff line change
@@ -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

45 changes: 45 additions & 0 deletions test/f90_correct/src/min_max_3.F90
Original file line number Diff line number Diff line change
@@ -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
19 changes: 19 additions & 0 deletions test/llvm_ir_correct/min_max_dtype_01.f90
Original file line number Diff line number Diff line change
@@ -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

67 changes: 67 additions & 0 deletions tools/flang1/flang1exe/semfunc.c
Original file line number Diff line number Diff line change
Expand Up @@ -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 */
Expand Down Expand Up @@ -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
Expand All @@ -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;
Expand Down Expand Up @@ -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) {
Expand Down

0 comments on commit 178894a

Please sign in to comment.