mirror of
https://github.com/intel/llvm.git
synced 2026-01-26 12:26:52 +08:00
[flang] Add semantics test for image_status and add a check
Add a semantics test for the intrinsic function image_status. Add a check and restriction on the image argument in image_status, ensuring that it is a positive value. Add same check on the size argument of the intrinsic ishftc. Add another check on the shift argument of ishftc, ensuring that it is less than or equal to the size argument. Add a short semantics test checking these restrictions in ishftc function calls. Reviewed By: klausler Differential Revision: https://reviews.llvm.org/D128009
This commit is contained in:
Katherine Rasmussen
@@ -10,6 +10,7 @@
|
||||
#include "flang/Common/Fortran.h"
|
||||
#include "flang/Common/enum-set.h"
|
||||
#include "flang/Common/idioms.h"
|
||||
#include "flang/Evaluate/check-expression.h"
|
||||
#include "flang/Evaluate/common.h"
|
||||
#include "flang/Evaluate/expression.h"
|
||||
#include "flang/Evaluate/fold.h"
|
||||
@@ -20,6 +21,7 @@
|
||||
#include "flang/Semantics/tools.h"
|
||||
#include "llvm/Support/raw_ostream.h"
|
||||
#include <algorithm>
|
||||
#include <cmath>
|
||||
#include <map>
|
||||
#include <string>
|
||||
#include <utility>
|
||||
@@ -2322,6 +2324,45 @@ static bool CheckAssociated(SpecificCall &call, FoldingContext &context) {
|
||||
return ok;
|
||||
}
|
||||
|
||||
static bool CheckForNonPositiveValues(FoldingContext &context,
|
||||
const ActualArgument &arg, const std::string &procName,
|
||||
const std::string &argName) {
|
||||
bool ok{true};
|
||||
if (arg.Rank() > 0) {
|
||||
if (const Expr<SomeType> *expr{arg.UnwrapExpr()}) {
|
||||
if (const auto *intExpr{std::get_if<Expr<SomeInteger>>(&expr->u)}) {
|
||||
std::visit(
|
||||
[&](const auto &kindExpr) {
|
||||
using IntType = typename std::decay_t<decltype(kindExpr)>::Result;
|
||||
if (const auto *constArray{
|
||||
UnwrapConstantValue<IntType>(kindExpr)}) {
|
||||
for (std::size_t j{0}; j < constArray->size(); ++j) {
|
||||
auto arrayExpr{constArray->values().at(j)};
|
||||
if (arrayExpr.IsNegative() || arrayExpr.IsZero()) {
|
||||
ok = false;
|
||||
context.messages().Say(arg.sourceLocation(),
|
||||
"'%s=' argument for intrinsic '%s' must contain all positive values"_err_en_US,
|
||||
argName, procName);
|
||||
}
|
||||
}
|
||||
}
|
||||
},
|
||||
intExpr->u);
|
||||
}
|
||||
}
|
||||
} else {
|
||||
if (auto val{ToInt64(arg.UnwrapExpr())}) {
|
||||
if (*val <= 0) {
|
||||
ok = false;
|
||||
context.messages().Say(arg.sourceLocation(),
|
||||
"'%s=' argument for intrinsic '%s' must be a positive value, but is %jd"_err_en_US,
|
||||
argName, procName, static_cast<std::intmax_t>(*val));
|
||||
}
|
||||
}
|
||||
}
|
||||
return ok;
|
||||
}
|
||||
|
||||
// Applies any semantic checks peculiar to an intrinsic.
|
||||
static bool ApplySpecificChecks(SpecificCall &call, FoldingContext &context) {
|
||||
bool ok{true};
|
||||
@@ -2340,6 +2381,28 @@ static bool ApplySpecificChecks(SpecificCall &call, FoldingContext &context) {
|
||||
}
|
||||
} else if (name == "associated") {
|
||||
return CheckAssociated(call, context);
|
||||
} else if (name == "image_status") {
|
||||
if (const auto &arg{call.arguments[0]}) {
|
||||
ok = CheckForNonPositiveValues(context, *arg, name, "image");
|
||||
}
|
||||
} else if (name == "ishftc") {
|
||||
if (const auto &sizeArg{call.arguments[2]}) {
|
||||
ok = CheckForNonPositiveValues(context, *sizeArg, name, "size");
|
||||
if (ok) {
|
||||
if (auto sizeVal{ToInt64(sizeArg->UnwrapExpr())}) {
|
||||
if (const auto &shiftArg{call.arguments[1]}) {
|
||||
if (auto shiftVal{ToInt64(shiftArg->UnwrapExpr())}) {
|
||||
if (std::abs(*shiftVal) > *sizeVal) {
|
||||
ok = false;
|
||||
context.messages().Say(shiftArg->sourceLocation(),
|
||||
"The absolute value of the 'shift=' argument for intrinsic '%s' must be less than or equal to the 'size=' argument"_err_en_US,
|
||||
name);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
} else if (name == "loc") {
|
||||
const auto &arg{call.arguments[0]};
|
||||
ok =
|
||||
|
||||
114
flang/test/Semantics/image_status.f90
Normal file
114
flang/test/Semantics/image_status.f90
Normal file
@@ -0,0 +1,114 @@
|
||||
! RUN: %python %S/test_errors.py %s %flang_fc1
|
||||
! Check for semantic errors in image_status(), as defined in
|
||||
! section 16.9.98 of the Fortran 2018 standard
|
||||
|
||||
program test_image_status
|
||||
use iso_fortran_env, only : team_type, stat_failed_image, stat_stopped_image
|
||||
implicit none
|
||||
|
||||
type(team_type) home, league(2)
|
||||
integer n, image_num, array(5), coindexed[*], non_array_result, array_2d(10, 10), not_team_type
|
||||
integer, parameter :: array_with_negative(2) = [-2, 1]
|
||||
integer, parameter :: array_with_zero(2) = [1, 0]
|
||||
integer, parameter :: constant_integer = 2, constant_negative = -4, constant_zero = 0
|
||||
integer, allocatable :: result_array(:), result_array_2d(:,:), wrong_rank_result(:)
|
||||
logical wrong_arg_type_logical
|
||||
real wrong_arg_type_real
|
||||
character wrong_result_type
|
||||
|
||||
!___ standard-conforming statements ___
|
||||
n = image_status(1)
|
||||
n = image_status(constant_integer)
|
||||
n = image_status(image_num)
|
||||
n = image_status(array(1))
|
||||
n = image_status(coindexed[1])
|
||||
n = image_status(image=1)
|
||||
result_array = image_status(array)
|
||||
result_array_2d = image_status(array_2d)
|
||||
|
||||
n = image_status(2, home)
|
||||
n = image_status(2, league(1))
|
||||
n = image_status(image=2, team=home)
|
||||
n = image_status(team=home, image=2)
|
||||
|
||||
if (image_status(1) .eq. stat_failed_image .or. image_status(1) .eq. stat_stopped_image) then
|
||||
error stop
|
||||
else if (image_status(1) .eq. 0) then
|
||||
continue
|
||||
end if
|
||||
|
||||
!___ non-conforming statements ___
|
||||
|
||||
!ERROR: 'image=' argument for intrinsic 'image_status' must be a positive value, but is -1
|
||||
n = image_status(-1)
|
||||
|
||||
!ERROR: 'image=' argument for intrinsic 'image_status' must be a positive value, but is 0
|
||||
n = image_status(0)
|
||||
|
||||
!ERROR: 'image=' argument for intrinsic 'image_status' must be a positive value, but is -4
|
||||
n = image_status(constant_negative)
|
||||
|
||||
!ERROR: 'image=' argument for intrinsic 'image_status' must be a positive value, but is 0
|
||||
n = image_status(constant_zero)
|
||||
|
||||
!ERROR: 'team=' argument has unacceptable rank 1
|
||||
n = image_status(1, team=league)
|
||||
|
||||
!ERROR: Actual argument for 'image=' has bad type 'REAL(4)'
|
||||
n = image_status(3.4)
|
||||
|
||||
!ERROR: Actual argument for 'image=' has bad type 'LOGICAL(4)'
|
||||
n = image_status(wrong_arg_type_logical)
|
||||
|
||||
!ERROR: Actual argument for 'image=' has bad type 'REAL(4)'
|
||||
n = image_status(wrong_arg_type_real)
|
||||
|
||||
!ERROR: Actual argument for 'team=' has bad type 'INTEGER(4)'
|
||||
n = image_status(1, not_team_type)
|
||||
|
||||
!ERROR: Actual argument for 'team=' has bad type 'INTEGER(4)'
|
||||
n = image_status(1, 1)
|
||||
|
||||
!ERROR: Actual argument for 'image=' has bad type 'REAL(4)'
|
||||
n = image_status(image=3.4)
|
||||
|
||||
!ERROR: Actual argument for 'team=' has bad type 'INTEGER(4)'
|
||||
n = image_status(1, team=1)
|
||||
|
||||
!ERROR: too many actual arguments for intrinsic 'image_status'
|
||||
n = image_status(1, home, 2)
|
||||
|
||||
!ERROR: repeated keyword argument to intrinsic 'image_status'
|
||||
n = image_status(image=1, image=2)
|
||||
|
||||
!ERROR: repeated keyword argument to intrinsic 'image_status'
|
||||
n = image_status(image=1, team=home, team=league(1))
|
||||
|
||||
!ERROR: unknown keyword argument to intrinsic 'image_status'
|
||||
n = image_status(images=1)
|
||||
|
||||
!ERROR: unknown keyword argument to intrinsic 'image_status'
|
||||
n = image_status(1, my_team=home)
|
||||
|
||||
!ERROR: 'image=' argument for intrinsic 'image_status' must contain all positive values
|
||||
result_array = image_status(image=array_with_negative)
|
||||
|
||||
!ERROR: 'image=' argument for intrinsic 'image_status' must contain all positive values
|
||||
result_array = image_status(image=[-2, 1])
|
||||
|
||||
!ERROR: 'image=' argument for intrinsic 'image_status' must contain all positive values
|
||||
result_array = image_status(image=array_with_zero)
|
||||
|
||||
!ERROR: 'image=' argument for intrinsic 'image_status' must contain all positive values
|
||||
result_array = image_status(image=[1, 0])
|
||||
|
||||
!ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches scalar INTEGER(4) and rank 1 array of INTEGER(4)
|
||||
non_array_result = image_status(image=array)
|
||||
|
||||
!ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches rank 1 array of INTEGER(4) and rank 2 array of INTEGER(4)
|
||||
wrong_rank_result = image_status(array_2d)
|
||||
|
||||
!ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types CHARACTER(KIND=1) and INTEGER(4)
|
||||
wrong_result_type = image_status(1)
|
||||
|
||||
end program test_image_status
|
||||
48
flang/test/Semantics/ishftc.f90
Normal file
48
flang/test/Semantics/ishftc.f90
Normal file
@@ -0,0 +1,48 @@
|
||||
! RUN: %python %S/test_errors.py %s %flang_fc1
|
||||
! Check for semantic errors in ishftc() function calls
|
||||
|
||||
program test_ishftc
|
||||
use iso_fortran_env, only: int8, int16, int32, int64
|
||||
implicit none
|
||||
|
||||
integer :: n
|
||||
integer, allocatable :: array_result(:)
|
||||
integer, parameter :: const_arr1(2) = [-3,3]
|
||||
integer, parameter :: const_arr2(2) = [3,0]
|
||||
integer(kind=8), parameter :: const_arr3(2) = [0,4]
|
||||
integer(kind=int8), parameter :: const_arr4(2) = [0,4]
|
||||
integer(kind=int16), parameter :: const_arr5(2) = [0,4]
|
||||
integer(kind=int32), parameter :: const_arr6(2) = [0,4]
|
||||
integer(kind=int64), parameter :: const_arr7(2) = [0,4]
|
||||
|
||||
n = ishftc(3, 2, 3)
|
||||
array_result = ishftc([3,3], [2,2], [3,3])
|
||||
|
||||
!ERROR: 'size=' argument for intrinsic 'ishftc' must be a positive value, but is -3
|
||||
n = ishftc(3, 2, -3)
|
||||
!ERROR: 'size=' argument for intrinsic 'ishftc' must be a positive value, but is 0
|
||||
n = ishftc(3, 2, 0)
|
||||
!ERROR: The absolute value of the 'shift=' argument for intrinsic 'ishftc' must be less than or equal to the 'size=' argument
|
||||
n = ishftc(3, 2, 1)
|
||||
!ERROR: The absolute value of the 'shift=' argument for intrinsic 'ishftc' must be less than or equal to the 'size=' argument
|
||||
n = ishftc(3, -2, 1)
|
||||
!ERROR: 'size=' argument for intrinsic 'ishftc' must contain all positive values
|
||||
array_result = ishftc([3,3], [2,2], [-3,3])
|
||||
!ERROR: 'size=' argument for intrinsic 'ishftc' must contain all positive values
|
||||
array_result = ishftc([3,3], [2,2], [-3,-3])
|
||||
!ERROR: 'size=' argument for intrinsic 'ishftc' must contain all positive values
|
||||
array_result = ishftc([3,3], [-2,-2], const_arr1)
|
||||
!ERROR: 'size=' argument for intrinsic 'ishftc' must contain all positive values
|
||||
array_result = ishftc([3,3], [-2,-2], const_arr2)
|
||||
!ERROR: 'size=' argument for intrinsic 'ishftc' must contain all positive values
|
||||
array_result = ishftc([3,3], [-2,-2], const_arr3)
|
||||
!ERROR: 'size=' argument for intrinsic 'ishftc' must contain all positive values
|
||||
array_result = ishftc([3,3], [-2,-2], const_arr4)
|
||||
!ERROR: 'size=' argument for intrinsic 'ishftc' must contain all positive values
|
||||
array_result = ishftc([3,3], [-2,-2], const_arr5)
|
||||
!ERROR: 'size=' argument for intrinsic 'ishftc' must contain all positive values
|
||||
array_result = ishftc([3,3], [-2,-2], const_arr6)
|
||||
!ERROR: 'size=' argument for intrinsic 'ishftc' must contain all positive values
|
||||
array_result = ishftc([3,3], [-2,-2], const_arr7)
|
||||
|
||||
end program test_ishftc
|
||||
Reference in New Issue
Block a user