aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran/iresolve.cc
diff options
context:
space:
mode:
authorAndre Vehreschild <vehre@gcc.gnu.org>2025-04-07 15:12:09 +0200
committerAndre Vehreschild <vehre@gcc.gnu.org>2025-04-22 13:17:51 +0200
commit621fe931be1e0220854e4d3c49cf2ce05cf735f7 (patch)
treed72b6cd568469e2847ee3deb045039a181f50e86 /gcc/fortran/iresolve.cc
parent8f4ee36bd5248cd244f65282167e3a13a3c98bc2 (diff)
downloadgcc-621fe931be1e0220854e4d3c49cf2ce05cf735f7.zip
gcc-621fe931be1e0220854e4d3c49cf2ce05cf735f7.tar.gz
gcc-621fe931be1e0220854e4d3c49cf2ce05cf735f7.tar.bz2
Fortran: Update get_team, team_number and image_status to F2018 [PR88154, PR88960, PR97210, PR103001]
Add functions get_team() and team_number() to comply with F2018 standard. Update image_status() to comply with F2018 standard. PR fortran/88154 PR fortran/88960 PR fortran/97210 PR fortran/103001 gcc/fortran/ChangeLog: * check.cc (team_type_check): Check a type for being team_type from the iso_fortran_env module. (gfc_check_image_status): Use team_type check. (gfc_check_get_team): Check for level argument. (gfc_check_team_number): Use team_type check. * expr.cc (gfc_check_assign): Add treatment for returning team_type in caf-single mode. * gfortran.texi: Add/Update documentation for get_team and team_number API functions. * intrinsic.cc (add_functions): Update get_team signature. * intrinsic.h (gfc_resolve_get_team): Add prototype. * intrinsic.texi: Add/Update documentation for get_team and team_number Fortran functions. * iresolve.cc (gfc_resolve_get_team): Resolve return type to be of type team_type. * iso-fortran-env.def: Update STAT_LOCK constants. They have nothing to do with files. Add level constants for get_team. * libgfortran.h: Add level and unlock_stat constants. * simplify.cc (gfc_simplify_get_team): Simply to correct return type team_type. * trans-decl.cc (gfc_build_builtin_function_decls): Update get_team and image_status API prototypes to correct signatures. * trans-intrinsic.cc (conv_intrinsic_image_status): Translate second parameter correctly. (conv_intrinsic_team_number): Translate optional single team argument correctly. (gfc_conv_intrinsic_function): Add translation of get_team. libgfortran/ChangeLog: * caf/libcaf.h: Add constants for get_team's level argument and update stat values for failed images. (_gfortran_caf_team_number): Add prototype. (_gfortran_caf_get_team): Same. * caf/single.c (_gfortran_caf_team_number): Get the given team's team number. (_gfortran_caf_get_team): Get the current team or the team given by level when the argument is present. gcc/testsuite/ChangeLog: * gfortran.dg/coarray/image_status_1.f08: Correct check for team_type. * gfortran.dg/pr102458.f90: Adapt to multiple errors. * gfortran.dg/coarray/get_team_1.f90: New test. * gfortran.dg/team_get_1.f90: New test. * gfortran.dg/team_number_1.f90: Correct Fortran syntax.
Diffstat (limited to 'gcc/fortran/iresolve.cc')
-rw-r--r--gcc/fortran/iresolve.cc22
1 files changed, 17 insertions, 5 deletions
diff --git a/gcc/fortran/iresolve.cc b/gcc/fortran/iresolve.cc
index 858ffb1..567bf52 100644
--- a/gcc/fortran/iresolve.cc
+++ b/gcc/fortran/iresolve.cc
@@ -3209,11 +3209,21 @@ gfc_resolve_get_team (gfc_expr *f, gfc_expr *level ATTRIBUTE_UNUSED)
{
static char get_team[] = "_gfortran_caf_get_team";
f->rank = 0;
- f->ts.type = BT_INTEGER;
- f->ts.kind = gfc_default_integer_kind;
+ f->ts.type = BT_DERIVED;
+ gfc_find_symbol ("team_type", gfc_current_ns, 1, &f->ts.u.derived);
+ if (!f->ts.u.derived
+ || f->ts.u.derived->from_intmod != INTMOD_ISO_FORTRAN_ENV)
+ {
+ gfc_error (
+ "GET_TEAM at %L needs USE of the intrinsic module ISO_FORTRAN_ENV "
+ "to define its result type TEAM_TYPE",
+ &f->where);
+ f->ts.type = BT_UNKNOWN;
+ }
f->value.function.name = get_team;
-}
+ /* No requirements to resolve for level argument now. */
+}
/* Resolve image_index (...). */
@@ -3248,15 +3258,17 @@ gfc_resolve_stopped_images (gfc_expr *f, gfc_expr *team ATTRIBUTE_UNUSED,
/* Resolve team_number (team). */
void
-gfc_resolve_team_number (gfc_expr *f, gfc_expr *team ATTRIBUTE_UNUSED)
+gfc_resolve_team_number (gfc_expr *f, gfc_expr *team)
{
static char team_number[] = "_gfortran_caf_team_number";
f->rank = 0;
f->ts.type = BT_INTEGER;
f->ts.kind = gfc_default_integer_kind;
f->value.function.name = team_number;
-}
+ if (team)
+ gfc_resolve_expr (team);
+}
void
gfc_resolve_this_image (gfc_expr *f, gfc_expr *array, gfc_expr *dim,