From ef78bc3c0b9d23b3decd8b6439c99a025ebc8f28 Mon Sep 17 00:00:00 2001 From: Andre Vehreschild Date: Sun, 5 Mar 2017 12:35:47 +0100 Subject: check.c (positive_check): Add new function checking constant for being greater then zero. gcc/fortran/ChangeLog: 2017-03-05 Andre Vehreschild Alessandro Fanfarillo * check.c (positive_check): Add new function checking constant for being greater then zero. (gfc_check_image_status): Add checking of image_status arguments. (gfc_check_failed_or_stopped_images): Same but for failed_- and stopped_images function. * dump-parse-tree.c (show_code_node): Added output of FAIL IMAGE. * gfortran.h (enum gfc_statement): Added FAIL_IMAGE_ST. (enum gfc_isym_id): Added new intrinsic symbols. (enum gfc_exec_op): Added EXEC_FAIL_IMAGE. * gfortran.texi: Added description for the new API functions. Updated coverage of gfortran of TS18508. * intrinsic.c (add_functions): Added symbols to resolve new intrinsic functions. * intrinsic.h: Added prototypes. * iresolve.c (gfc_resolve_failed_images): Resolve the failed_images intrinsic. (gfc_resolve_image_status): Same for image_status. (gfc_resolve_stopped_images): Same for stopped_images. * libgfortran.h: Added prototypes. * match.c (gfc_match_if): Added matching of FAIL IMAGE statement. (gfc_match_fail_image): Match a FAIL IMAGE statement. * match.h: Added prototype. * parse.c (decode_statement): Added matching for FAIL IMAGE. (next_statement): Same. (gfc_ascii_statement): Same. * resolve.c: Same. * simplify.c (gfc_simplify_failed_or_stopped_images): For COARRAY= single a constant result can be returne.d (gfc_simplify_image_status): For COARRAY=single the result is constant. * st.c (gfc_free_statement): Added FAIL_IMAGE handling. * trans-decl.c (gfc_build_builtin_function_decls): Added decls of the new intrinsics. * trans-expr.c (gfc_conv_procedure_call): This is first time all arguments of a function are optional, which is now handled here correctly. * trans-intrinsic.c (conv_intrinsic_image_status): Translate image_status. (gfc_conv_intrinsic_function): Add support for image_status. (gfc_is_intrinsic_libcall): Add support for the remaining new intrinsics. * trans-stmt.c (gfc_trans_fail_image): Trans a fail image. * trans-stmt.h: Add the prototype for the above. * trans.c (trans_code): Dispatch for fail_image. * trans.h: Add the trees for the new intrinsics. libgfortran/ChangeLog: 2017-03-05 Andre Vehreschild Alessandro Fanfarillo * caf/libcaf.h: Added prototypes and stat codes for failed and stopped images. * caf/single.c (void _gfortran_caf_fail_image): Add the routine. (int _gfortran_caf_image_status): Same. (_gfortran_caf_failed_images): Same. (_gfortran_caf_stopped_images): Same. gcc/testsuite/ChangeLog: 2017-03-05 Andre Vehreschild Alessandro Fanfarillo * gfortran.dg/coarray/fail_image_1.f08: New test. * gfortran.dg/coarray/fail_image_2.f08: New test. * gfortran.dg/coarray/failed_images_1.f08: New test. * gfortran.dg/coarray/failed_images_2.f08: New test. * gfortran.dg/coarray/image_status_1.f08: New test. * gfortran.dg/coarray/image_status_2.f08: New test. * gfortran.dg/coarray/stopped_images_1.f08: New test. * gfortran.dg/coarray/stopped_images_2.f08: New test. * gfortran.dg/coarray_fail_st.f90: New test. * gfortran.dg/coarray_failed_images_1.f08: New test. * gfortran.dg/coarray_image_status_1.f08: New test. * gfortran.dg/coarray_stopped_images_1.f08: New test. From-SVN: r245900 --- gcc/fortran/check.c | 77 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 77 insertions(+) (limited to 'gcc/fortran/check.c') diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index c22bfa9..45bc68e 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -295,6 +295,29 @@ nonnegative_check (const char *arg, gfc_expr *expr) } +/* If expr is a constant, then check to ensure that it is greater than zero. */ + +static bool +positive_check (int n, gfc_expr *expr) +{ + int i; + + if (expr->expr_type == EXPR_CONSTANT) + { + gfc_extract_int (expr, &i); + if (i <= 0) + { + gfc_error ("%qs argument of %qs intrinsic at %L must be positive", + gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic, + &expr->where); + return false; + } + } + + return true; +} + + /* If expr2 is constant, then check that the value is less than (less than or equal to, if 'or_equal' is true) bit_size(expr1). */ @@ -1138,6 +1161,60 @@ gfc_check_atomic_ref (gfc_expr *value, gfc_expr *atom, gfc_expr *stat) bool +gfc_check_image_status (gfc_expr *image, gfc_expr *team) +{ + /* IMAGE has to be a positive, scalar integer. */ + if (!type_check (image, 0, BT_INTEGER) || !scalar_check (image, 0) + || !positive_check (0, image)) + return false; + + if (team) + { + gfc_error ("%qs argument of %qs intrinsic at %L not yet supported", + gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic, + &team->where); + return false; + } + return true; +} + + +bool +gfc_check_failed_or_stopped_images (gfc_expr *team, gfc_expr *kind) +{ + if (team) + { + gfc_error ("%qs argument of %qs intrinsic at %L not yet supported", + gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic, + &team->where); + return false; + } + + if (kind) + { + int k; + + if (!type_check (kind, 1, BT_INTEGER) || !scalar_check (kind, 1) + || !positive_check (1, kind)) + return false; + + /* Get the kind, reporting error on non-constant or overflow. */ + gfc_current_locus = kind->where; + if (gfc_extract_int (kind, &k, 1)) + return false; + if (gfc_validate_kind (BT_INTEGER, k, true) == -1) + { + gfc_error ("%qs argument of %qs intrinsic at %L shall specify a " + "valid integer kind", gfc_current_intrinsic_arg[1]->name, + gfc_current_intrinsic, &kind->where); + return false; + } + } + return true; +} + + +bool gfc_check_atomic_cas (gfc_expr *atom, gfc_expr *old, gfc_expr *compare, gfc_expr *new_val, gfc_expr *stat) { -- cgit v1.1