[flang-commits] [flang] 9bb18a9 - [flang] Add semantics test for image_status and add a check
Katherine Rasmussen via flang-commits
flang-commits at lists.llvm.org
Mon Jul 11 10:55:05 PDT 2022
Author: Katherine Rasmussen
Date: 2022-07-11T10:54:12-07:00
New Revision: 9bb18a983f2f41dc0f933f1263678e66ee912fa8
URL: https://github.com/llvm/llvm-project/commit/9bb18a983f2f41dc0f933f1263678e66ee912fa8
DIFF: https://github.com/llvm/llvm-project/commit/9bb18a983f2f41dc0f933f1263678e66ee912fa8.diff
LOG: [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
Added:
flang/test/Semantics/image_status.f90
flang/test/Semantics/ishftc.f90
Modified:
flang/lib/Evaluate/intrinsics.cpp
Removed:
################################################################################
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index ff31aae6fdd4..70b87baf6114 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -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 =
diff --git a/flang/test/Semantics/image_status.f90 b/flang/test/Semantics/image_status.f90
new file mode 100644
index 000000000000..229b7c9b7de7
--- /dev/null
+++ b/flang/test/Semantics/image_status.f90
@@ -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
diff --git a/flang/test/Semantics/ishftc.f90 b/flang/test/Semantics/ishftc.f90
new file mode 100644
index 000000000000..3e0ebe5a41d0
--- /dev/null
+++ b/flang/test/Semantics/ishftc.f90
@@ -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
More information about the flang-commits
mailing list