diff options
author | Damian Rouson <damian@sourceryinstitute.org> | 2018-01-26 20:14:09 +0000 |
---|---|---|
committer | Alessandro Fanfarillo <afanfa@gcc.gnu.org> | 2018-01-26 13:14:09 -0700 |
commit | f8862a1b2afad9d107ad505de2bf554705ebdb38 (patch) | |
tree | 77fadaa9edcf35dc620e4fc70fd49c750295acd5 /gcc/fortran/check.c | |
parent | deece1aa0135de487e7846025efbc8f6cd79ffe2 (diff) | |
download | gcc-f8862a1b2afad9d107ad505de2bf554705ebdb38.zip gcc-f8862a1b2afad9d107ad505de2bf554705ebdb38.tar.gz gcc-f8862a1b2afad9d107ad505de2bf554705ebdb38.tar.bz2 |
Partial Failed Images patch
Co-Authored-By: Alessandro Fanfarillo <fanfarillo.gcc@gmail.com>
Co-Authored-By: Soren Rasmussen <s.c.rasmussen@gmail.com>
From-SVN: r257105
Diffstat (limited to 'gcc/fortran/check.c')
-rw-r--r-- | gcc/fortran/check.c | 45 |
1 files changed, 43 insertions, 2 deletions
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index f1c6695..dbb1aa0 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -1253,6 +1253,20 @@ gfc_check_failed_or_stopped_images (gfc_expr *team, gfc_expr *kind) bool +gfc_check_get_team (gfc_expr *level) +{ + if (level) + { + gfc_error ("%qs argument of %qs intrinsic at %L not yet supported", + gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic, + &level->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) { @@ -2264,7 +2278,7 @@ gfc_check_eoshift (gfc_expr *array, gfc_expr *shift, gfc_expr *boundary, return false; } } - + if (array->rank == 1 || boundary->rank == 0) { if (!scalar_check (boundary, 2)) @@ -2313,7 +2327,7 @@ gfc_check_eoshift (gfc_expr *array, gfc_expr *shift, gfc_expr *boundary, case BT_COMPLEX: case BT_CHARACTER: break; - + default: gfc_error ("Missing %qs argument to %qs intrinsic at %L for %qs " "of type %qs", gfc_current_intrinsic_arg[2]->name, @@ -5275,6 +5289,33 @@ gfc_check_num_images (gfc_expr *distance, gfc_expr *failed) bool +gfc_check_team_number (gfc_expr *team) +{ + if (flag_coarray == GFC_FCOARRAY_NONE) + { + gfc_fatal_error ("Coarrays disabled at %C, use %<-fcoarray=%> to enable"); + return false; + } + + if (team) + { + if (team->ts.type != BT_DERIVED + || team->ts.u.derived->from_intmod != INTMOD_ISO_FORTRAN_ENV + || team->ts.u.derived->intmod_sym_id != ISOFORTRAN_TEAM_TYPE) + { + gfc_error ("TEAM argument at %L to the intrinsic TEAM_NUMBER " + "shall be of type TEAM_TYPE", &team->where); + return false; + } + } + else + return true; + + return true; +} + + +bool gfc_check_this_image (gfc_expr *coarray, gfc_expr *dim, gfc_expr *distance) { if (flag_coarray == GFC_FCOARRAY_NONE) |