This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Patch, Fortran] Add support for TS18508's CO_SUM/MAX/MIN (part 1/2)
- From: Tobias Burnus <burnus at net-b dot de>
- To: gcc-patches <gcc-patches at gcc dot gnu dot org>, gfortran <fortran at gcc dot gnu dot org>
- Date: Sat, 03 May 2014 19:05:43 +0200
- Subject: [Patch, Fortran] Add support for TS18508's CO_SUM/MAX/MIN (part 1/2)
- Authentication-results: sourceware.org; auth=none
Dear all,
this patch adds support for the most important of TS18508's collective
intrinsics, namely co_sum (for int, real, cmplx) and co_min/co_max (int,
real, char). The feature is described at
ftp://ftp.nag.co.uk/sc22wg5/N2001-N2050/N2007.pdf ; N2007 has an
optional "result=" argument, however, as the next argument is the
optional result_image=, it becomes ambiguous for integer arguments.
Thus, TS18508 will presumably not have the "result=" image â and I also
left it out in the attached patch. See also
ftp://ftp.nag.co.uk/sc22wg5/N2001-N2050/N2013.txt â I will update the
implementation, in case TS18508 will still change in this regard (which
is unlikely).
The patch handles -fcoarray=single and -fcoarray=lib on the compiler
side, and there is a stub implementation for libcaf_single. The code
should work for all valid programs, however, I intent to make it
possible to also allow for optimized vector subscript access. You also
ready find some traces of it in libcaf.h
Build and regtested on x86-64-gnu-linux.
OK for the trunk?
Tobias
gcc/fortran/
2014-05-03 Tobias Burnus <burnus@net-b.de>
* check.c (check_co_minmaxsum, gfc_check_co_minmax,
gfc_check_co_sum): New.
* error.c (gfc_notify_std): Update -std=f2008ts.
* gfortran.h (gfc_isym_id): Add GFC_ISYM_CO_MAX,
GFC_ISYM_CO_MIN, GFC_ISYM_CO_SUM.
* intrinsic.h (gfc_check_co_minmax,
gfc_check_co_sum): Declare.
* intrinsic.c (add_subroutines): Add co_min, co_max
and co_sum.
(gfc_check_intrinsic_standard): Update text for
-std=f2008ts.
* intrinsic.texi (CO_MIN, CO_MAX, CO_SUM): Document
them.
* invoke.texi (-std=f2008ts): Update wording.
* trans.h (gfor_fndecl_co_max,
gfor_fndecl_co_min, gfor_fndecl_co_sum): Define.
* trans-decl.c (gfor_fndecl_co_max,
gfor_fndecl_co_min, gfor_fndecl_co_sum): Define.
(gfc_build_builtin_function_decls): Assign to it.
* trans-intrinsic.c (conv_co_minmaxsum): New.
(gfc_conv_intrinsic_subroutine): Call it.
libgfortran/
2014-05-03 Tobias Burnus <burnus@net-b.de>
* caf/libcaf.h (caf_vector_t, _gfortran_caf_co_sum,
_gfortran_caf_co_min, _gfortran_caf_co_max): Declare
* caf/single.c
gcc/testsuite/
2014-05-03 Tobias Burnus <burnus@net-b.de>
* gfortran.dg/coarray_collectives_1.f90: New.
* gfortran.dg/coarray_collectives_2.f90: New.
* gfortran.dg/coarray_collectives_3.f90: New.
* gfortran.dg/coarray_collectives_4.f90: New.
* gfortran.dg/coarray_collectives_5.f90: New.
* gfortran.dg/coarray_collectives_6.f90: New.
* gfortran.dg/coarray/collectives_1.f90: New.
* gfortran.dg/assumed_rank_5.f90: Update dg-error.
* gfortran.dg/assumed_type_4.f90: Update dg-error.
* gfortran.dg/bind_c_array_params.f03: Update dg-error.
* gfortran.dg/bind_c_usage_28.f90: Update dg-error.
* gfortran.dg/c_funloc_tests_5.f03: Update dg-error.
* gfortran.dg/c_funloc_tests_6.f90: Update dg-error.
* gfortran.dg/c_loc_tests_11.f03: Update dg-error.
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index b83d9da..90ba0c9 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -1290,6 +1290,91 @@ gfc_check_cmplx (gfc_expr *x, gfc_expr *y, gfc_expr *kind)
}
+static bool
+check_co_minmaxsum (gfc_expr *a, gfc_expr *result_image, gfc_expr *stat,
+ gfc_expr *errmsg)
+{
+ if (!variable_check (a, 0, false))
+ return false;
+
+ if (result_image != NULL)
+ {
+ if (!type_check (result_image, 1, BT_INTEGER))
+ return false;
+ if (!scalar_check (result_image, 1))
+ return false;
+ }
+
+ if (stat != NULL)
+ {
+ if (!type_check (stat, 2, BT_INTEGER))
+ return false;
+ if (!scalar_check (stat, 2))
+ return false;
+ if (!variable_check (stat, 2, false))
+ return false;
+ if (stat->ts.kind != 4)
+ {
+ gfc_error ("The stat= argument at %L must be a kind=4 integer "
+ "variable", &stat->where);
+ return false;
+ }
+ }
+
+ if (errmsg != NULL)
+ {
+ if (!type_check (errmsg, 3, BT_CHARACTER))
+ return false;
+ if (!scalar_check (errmsg, 3))
+ return false;
+ if (!variable_check (errmsg, 3, false))
+ return false;
+ if (errmsg->ts.kind != 1)
+ {
+ gfc_error ("The errmsg= argument at %L must be a default-kind "
+ "character variable", &errmsg->where);
+ return false;
+ }
+ }
+
+ if (gfc_option.coarray == GFC_FCOARRAY_NONE)
+ {
+ gfc_fatal_error ("Coarrays disabled at %L, use -fcoarray= to enable",
+ &a->where);
+ return false;
+ }
+
+ return true;
+}
+
+
+bool
+gfc_check_co_minmax (gfc_expr *a, gfc_expr *result_image, gfc_expr *stat,
+ gfc_expr *errmsg)
+{
+ if (a->ts.type != BT_INTEGER && a->ts.type != BT_REAL
+ && a->ts.type != BT_CHARACTER)
+ {
+ gfc_error ("'%s' argument of '%s' intrinsic at %L shall be of type "
+ "integer, real or character",
+ gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic,
+ &a->where);
+ return false;
+ }
+ return check_co_minmaxsum (a, result_image, stat, errmsg);
+}
+
+
+bool
+gfc_check_co_sum (gfc_expr *a, gfc_expr *result_image, gfc_expr *stat,
+ gfc_expr *errmsg)
+{
+ if (!numeric_check (a, 0))
+ return false;
+ return check_co_minmaxsum (a, result_image, stat, errmsg);
+}
+
+
bool
gfc_check_complex (gfc_expr *x, gfc_expr *y)
{
diff --git a/gcc/fortran/error.c b/gcc/fortran/error.c
index e843fa5..6ae44e8 100644
--- a/gcc/fortran/error.c
+++ b/gcc/fortran/error.c
@@ -878,7 +878,7 @@ gfc_notify_std (int std, const char *gmsgid, ...)
switch (std)
{
case GFC_STD_F2008_TS:
- msg2 = "TS 29113:";
+ msg2 = "TS 29113/TS 18508:";
break;
case GFC_STD_F2008_OBS:
msg2 = _("Fortran 2008 obsolescent feature:");
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 0707b58..63be8af 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -323,6 +323,9 @@ enum gfc_isym_id
GFC_ISYM_CHDIR,
GFC_ISYM_CHMOD,
GFC_ISYM_CMPLX,
+ GFC_ISYM_CO_MAX,
+ GFC_ISYM_CO_MIN,
+ GFC_ISYM_CO_SUM,
GFC_ISYM_COMMAND_ARGUMENT_COUNT,
GFC_ISYM_COMPILER_OPTIONS,
GFC_ISYM_COMPILER_VERSION,
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 19d4620..852ae92 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -3004,7 +3004,7 @@ add_subroutines (void)
{
/* Argument names as in the standard (to be used as argument keywords). */
const char
- *h = "harvest", *dt = "date", *vl = "values", *pt = "put",
+ *a = "a", *h = "harvest", *dt = "date", *vl = "values", *pt = "put",
*c = "count", *tm = "time", *tp = "topos", *gt = "get",
*t = "to", *zn = "zone", *fp = "frompos", *cm = "count_max",
*f = "from", *sz = "size", *ln = "len", *cr = "count_rate",
@@ -3013,7 +3013,8 @@ add_subroutines (void)
*trim_name = "trim_name", *ut = "unit", *han = "handler",
*sec = "seconds", *res = "result", *of = "offset", *md = "mode",
*whence = "whence", *pos = "pos", *ptr = "ptr", *p1 = "path1",
- *p2 = "path2", *msk = "mask", *old = "old";
+ *p2 = "path2", *msk = "mask", *old = "old", *result_image = "result_image",
+ *stat = "stat", *errmsg = "errmsg";
int di, dr, dc, dl, ii;
@@ -3209,6 +3210,31 @@ add_subroutines (void)
"fptr", BT_UNKNOWN, 0, REQUIRED, INTENT_OUT);
make_from_module();
+ /* Coarray collectives. */
+ add_sym_4s ("co_max", GFC_ISYM_CO_MAX, CLASS_IMPURE,
+ BT_UNKNOWN, 0, GFC_STD_F2008_TS,
+ gfc_check_co_minmax, NULL, NULL,
+ a, BT_REAL, dr, REQUIRED, INTENT_INOUT,
+ result_image, BT_INTEGER, di, OPTIONAL, INTENT_IN,
+ stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
+ errmsg, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT);
+
+ add_sym_4s ("co_min", GFC_ISYM_CO_MIN, CLASS_IMPURE,
+ BT_UNKNOWN, 0, GFC_STD_F2008_TS,
+ gfc_check_co_minmax, NULL, NULL,
+ a, BT_REAL, dr, REQUIRED, INTENT_INOUT,
+ result_image, BT_INTEGER, di, OPTIONAL, INTENT_IN,
+ stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
+ errmsg, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT);
+
+ add_sym_4s ("co_sum", GFC_ISYM_CO_SUM, CLASS_IMPURE,
+ BT_UNKNOWN, 0, GFC_STD_F2008_TS,
+ gfc_check_co_sum, NULL, NULL,
+ a, BT_REAL, dr, REQUIRED, INTENT_INOUT,
+ result_image, BT_INTEGER, di, OPTIONAL, INTENT_IN,
+ stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
+ errmsg, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT);
+
/* More G77 compatibility garbage. */
add_sym_3s ("alarm", GFC_ISYM_ALARM, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
gfc_check_alarm_sub, NULL, gfc_resolve_alarm_sub,
@@ -4160,7 +4186,7 @@ gfc_check_intrinsic_standard (const gfc_intrinsic_sym* isym,
break;
case GFC_STD_F2008_TS:
- symstd_msg = "new in TS 29113";
+ symstd_msg = "new in TS 29113/TS 18508";
break;
case GFC_STD_GNU:
diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h
index d7f7954..162fa71 100644
--- a/gcc/fortran/intrinsic.h
+++ b/gcc/fortran/intrinsic.h
@@ -49,6 +49,8 @@ bool gfc_check_chdir (gfc_expr *);
bool gfc_check_chmod (gfc_expr *, gfc_expr *);
bool gfc_check_cmplx (gfc_expr *, gfc_expr *, gfc_expr *);
bool gfc_check_complex (gfc_expr *, gfc_expr *);
+bool gfc_check_co_minmax (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
+bool gfc_check_co_sum (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
bool gfc_check_count (gfc_expr *, gfc_expr *, gfc_expr *);
bool gfc_check_cshift (gfc_expr *, gfc_expr *, gfc_expr *);
bool gfc_check_ctime (gfc_expr *);
diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi
index 926ffe9..b091ee4 100644
--- a/gcc/fortran/intrinsic.texi
+++ b/gcc/fortran/intrinsic.texi
@@ -86,6 +86,9 @@ Some basic guidelines for editing this document:
* @code{CHDIR}: CHDIR, Change working directory
* @code{CHMOD}: CHMOD, Change access permissions of files
* @code{CMPLX}: CMPLX, Complex conversion function
+* @code{CO_MAX}: CO_MAX, Maximal value on the current set of images
+* @code{CO_MIN}: CO_MIN, Minimal value on the current set of images
+* @code{CO_SUM}: CO_SUM, Sum of values on the current set of images
* @code{COMMAND_ARGUMENT_COUNT}: COMMAND_ARGUMENT_COUNT, Get number of command line arguments
* @code{COMPILER_OPTIONS}: COMPILER_OPTIONS, Options passed to the compiler
* @code{COMPILER_VERSION}: COMPILER_VERSION, Compiler version string
@@ -2811,6 +2814,168 @@ end program test_cmplx
+@node CO_MAX
+@section @code{CO_MAX} --- Maximal value on the current set of images
+@fnindex CO_MAX
+@cindex Collectives, maximal value
+
+@table @asis
+@item @emph{Description}:
+@code{CO_MAX} determines element-wise the maximal value of @var{A} on all
+images of the current team. If @var{RESULT_IMAGE} is present, the maximum
+values are returned on in @var{A} on the specified image only and the value
+of @var{A} on the other images become undefined. If @var{RESULT_IMAGE} is
+not present, the value is returned on all images. If the execution was
+successful and @var{STAT} is present, it is assigned the value zero. If the
+execution failed, @var{STAT} gets assigned a nonzero value and, if present,
+@var{ERRMSG} gets assigned a value describing the occurred error.
+
+@item @emph{Standard}:
+Technical Specification (TS) 18508 or later
+
+@item @emph{Class}:
+Collective subroutine
+
+@item @emph{Syntax}:
+@code{CALL CO_MAX(A [, RESULT_IMAGE, STAT, ERRMSG])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{A} @tab shall be an integer, real or character variable,
+which has the same type and type parameters on all images of the team.
+@item @var{RESULT_IMAGE} @tab (optional) a scalar integer expression; if
+present, it shall have the same the same value on all images and refer to an
+image of the current team.
+@item @var{STAT} @tab (optional) a scalar integer variable
+@item @var{ERRMSG} @tab (optional) a scalar character variable
+@end multitable
+
+@item @emph{Example}:
+@smallexample
+program test
+ integer :: val
+ val = this_image ()
+ call co_max (val, result_image=1)
+ if (this_image() == 1) then
+ write(*,*) "Maximal value", val ! prints num_images()
+ end if
+end program test
+@end smallexample
+
+@item @emph{See also}:
+@ref{CO_MIN}, @ref{CO_SUM}
+@end table
+
+
+
+@node CO_MIN
+@section @code{CO_MIN} --- Minimal value on the current set of images
+@fnindex CO_MIN
+@cindex Collectives, minimal value
+
+@table @asis
+@item @emph{Description}:
+@code{CO_MIN} determines element-wise the minimal value of @var{A} on all
+images of the current team. If @var{RESULT_IMAGE} is present, the minimal
+values are returned on in @var{A} on the specified image only and the value
+of @var{A} on the other images become undefined. If @var{RESULT_IMAGE} is
+not present, the value is returned on all images. If the execution was
+successful and @var{STAT} is present, it is assigned the value zero. If the
+execution failed, @var{STAT} gets assigned a nonzero value and, if present,
+@var{ERRMSG} gets assigned a value describing the occurred error.
+
+@item @emph{Standard}:
+Technical Specification (TS) 18508 or later
+
+@item @emph{Class}:
+Collective subroutine
+
+@item @emph{Syntax}:
+@code{CALL CO_MIN(A [, RESULT_IMAGE, STAT, ERRMSG])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{A} @tab shall be an integer, real or character variable,
+which has the same type and type parameters on all images of the team.
+@item @var{RESULT_IMAGE} @tab (optional) a scalar integer expression; if
+present, it shall have the same the same value on all images and refer to an
+image of the current team.
+@item @var{STAT} @tab (optional) a scalar integer variable
+@item @var{ERRMSG} @tab (optional) a scalar character variable
+@end multitable
+
+@item @emph{Example}:
+@smallexample
+program test
+ integer :: val
+ val = this_image ()
+ call co_min (val, result_image=1)
+ if (this_image() == 1) then
+ write(*,*) "Minimal value", val ! prints 1
+ end if
+end program test
+@end smallexample
+
+@item @emph{See also}:
+@ref{CO_MAX}, @ref{CO_SUM}
+@end table
+
+
+
+@node CO_SUM
+@section @code{CO_SUM} --- Sum of values on the current set of images
+@fnindex CO_SUM
+@cindex Collectives, sum of values
+
+@table @asis
+@item @emph{Description}:
+@code{CO_SUM} sums up the values of each element of @var{A} on all
+images of the current team. If @var{RESULT_IMAGE} is present, the summed-up
+values are returned on in @var{A} on the specified image only and the value
+of @var{A} on the other images become undefined. If @var{RESULT_IMAGE} is
+not present, the value is returned on all images. If the execution was
+successful and @var{STAT} is present, it is assigned the value zero. If the
+execution failed, @var{STAT} gets assigned a nonzero value and, if present,
+@var{ERRMSG} gets assigned a value describing the occurred error.
+
+@item @emph{Standard}:
+Technical Specification (TS) 18508 or later
+
+@item @emph{Class}:
+Collective subroutine
+
+@item @emph{Syntax}:
+@code{CALL CO_MIN(A [, RESULT_IMAGE, STAT, ERRMSG])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{A} @tab shall be an integer, real or complex variable,
+which has the same type and type parameters on all images of the team.
+@item @var{RESULT_IMAGE} @tab (optional) a scalar integer expression; if
+present, it shall have the same the same value on all images and refer to an
+image of the current team.
+@item @var{STAT} @tab (optional) a scalar integer variable
+@item @var{ERRMSG} @tab (optional) a scalar character variable
+@end multitable
+
+@item @emph{Example}:
+@smallexample
+program test
+ integer :: val
+ val = this_image ()
+ call co_sum (val, result_image=1)
+ if (this_image() == 1) then
+ write(*,*) "The sum is ", val ! prints (n**2 + n)/2, with n = num_images()
+ end if
+end program test
+@end smallexample
+
+@item @emph{See also}:
+@ref{CO_MAX}, @ref{CO_MIN}
+@end table
+
+
+
@node COMMAND_ARGUMENT_COUNT
@section @code{COMMAND_ARGUMENT_COUNT} --- Get number of command line arguments
@fnindex COMMAND_ARGUMENT_COUNT
diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi
index b92abfc..4c7d4a3 100644
--- a/gcc/fortran/invoke.texi
+++ b/gcc/fortran/invoke.texi
@@ -402,7 +402,7 @@ language standard, and warnings are given for the Fortran 77 features
that are permitted but obsolescent in later standards. @samp{-std=f2008ts}
allows the Fortran 2008 standard including the additions of the
Technical Specification (TS) 29113 on Further Interoperability of Fortran
-with C.
+with C and TS 18508 on Additional Parallel Features in Fortran.
@end table
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index ee6c7e3..7dca22f 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -131,6 +131,9 @@ tree gfor_fndecl_caf_sync_all;
tree gfor_fndecl_caf_sync_images;
tree gfor_fndecl_caf_error_stop;
tree gfor_fndecl_caf_error_stop_str;
+tree gfor_fndecl_co_max;
+tree gfor_fndecl_co_min;
+tree gfor_fndecl_co_sum;
/* Math functions. Many other math functions are handled in
@@ -3280,12 +3283,12 @@ gfc_build_builtin_function_decls (void)
gfor_fndecl_caf_sync_all = gfc_build_library_function_decl_with_spec (
get_identifier (PREFIX("caf_sync_all")), ".WW", void_type_node,
- 3, pint_type, build_pointer_type (pchar_type_node), integer_type_node);
+ 3, pint_type, pchar_type_node, integer_type_node);
gfor_fndecl_caf_sync_images = gfc_build_library_function_decl_with_spec (
get_identifier (PREFIX("caf_sync_images")), ".RRWW", void_type_node,
5, integer_type_node, pint_type, pint_type,
- build_pointer_type (pchar_type_node), integer_type_node);
+ pchar_type_node, integer_type_node);
gfor_fndecl_caf_error_stop = gfc_build_library_function_decl (
get_identifier (PREFIX("caf_error_stop")),
@@ -3298,6 +3301,21 @@ gfc_build_builtin_function_decls (void)
void_type_node, 2, pchar_type_node, gfc_int4_type_node);
/* CAF's ERROR STOP doesn't return. */
TREE_THIS_VOLATILE (gfor_fndecl_caf_error_stop_str) = 1;
+
+ gfor_fndecl_co_max = gfc_build_library_function_decl_with_spec (
+ get_identifier (PREFIX("caf_co_max")), "WR.WW",
+ void_type_node, 7, pvoid_type_node, pvoid_type_node, integer_type_node,
+ pint_type, pchar_type_node, integer_type_node, integer_type_node);
+
+ gfor_fndecl_co_min = gfc_build_library_function_decl_with_spec (
+ get_identifier (PREFIX("caf_co_min")), "WR.WW",
+ void_type_node, 7, pvoid_type_node, pvoid_type_node, integer_type_node,
+ pint_type, pchar_type_node, integer_type_node, integer_type_node);
+
+ gfor_fndecl_co_sum = gfc_build_library_function_decl_with_spec (
+ get_identifier (PREFIX("caf_co_sum")), "WR.WW",
+ void_type_node, 6, pvoid_type_node, pvoid_type_node, integer_type_node,
+ pint_type, pchar_type_node, integer_type_node);
}
gfc_build_intrinsic_function_decls ();
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index e13c0de..758893e 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -7520,6 +7520,124 @@ gfc_walk_intrinsic_function (gfc_ss * ss, gfc_expr * expr,
static tree
+conv_co_minmaxsum (gfc_code *code)
+{
+ gfc_se argse;
+ stmtblock_t block, post_block;
+ tree fndecl, array, vec, strlen, image_index, stat, errmsg, errmsg_len;
+
+ gfc_start_block (&block);
+ gfc_init_block (&post_block);
+
+ /* stat. */
+ if (code->ext.actual->next->next->expr)
+ {
+ gfc_init_se (&argse, NULL);
+ gfc_conv_expr (&argse, code->ext.actual->next->next->expr);
+ gfc_add_block_to_block (&block, &argse.pre);
+ gfc_add_block_to_block (&post_block, &argse.post);
+ stat = argse.expr;
+ if (gfc_option.coarray != GFC_FCOARRAY_SINGLE)
+ stat = gfc_build_addr_expr (NULL_TREE, stat);
+ }
+ else if (gfc_option.coarray == GFC_FCOARRAY_SINGLE)
+ stat = NULL_TREE;
+ else
+ stat = null_pointer_node;
+
+ /* Early exit for GFC_FCOARRAY_SINGLE. */
+ if (gfc_option.coarray == GFC_FCOARRAY_SINGLE)
+ {
+ if (stat != NULL_TREE)
+ gfc_add_modify (&block, stat,
+ fold_convert (TREE_TYPE (stat), integer_zero_node));
+ return gfc_finish_block (&block);
+ }
+
+ /* Handle the array. */
+ gfc_init_se (&argse, NULL);
+ if (code->ext.actual->expr->rank == 0)
+ {
+ symbol_attribute attr;
+ gfc_clear_attr (&attr);
+ gfc_init_se (&argse, NULL);
+ gfc_conv_expr (&argse, code->ext.actual->expr);
+ gfc_add_block_to_block (&block, &argse.pre);
+ gfc_add_block_to_block (&post_block, &argse.post);
+ array = gfc_conv_scalar_to_descriptor (&argse, argse.expr, attr);
+ array = gfc_build_addr_expr (NULL_TREE, array);
+ }
+ else
+ {
+ argse.want_pointer = 1;
+ gfc_conv_expr_descriptor (&argse, code->ext.actual->expr);
+ array = argse.expr;
+ }
+ gfc_add_block_to_block (&block, &argse.pre);
+ gfc_add_block_to_block (&post_block, &argse.post);
+
+ if (code->ext.actual->expr->ts.type == BT_CHARACTER)
+ strlen = argse.string_length;
+ else
+ strlen = integer_zero_node;
+
+ vec = null_pointer_node;
+
+ /* image_index. */
+ if (code->ext.actual->next->expr)
+ {
+ gfc_init_se (&argse, NULL);
+ gfc_conv_expr (&argse, code->ext.actual->next->expr);
+ gfc_add_block_to_block (&block, &argse.pre);
+ gfc_add_block_to_block (&post_block, &argse.post);
+ image_index = fold_convert (integer_type_node, argse.expr);
+ }
+ else
+ image_index = integer_zero_node;
+
+ /* errmsg. */
+ if (code->ext.actual->next->next->next->expr)
+ {
+ gfc_init_se (&argse, NULL);
+ gfc_conv_expr (&argse, code->ext.actual->next->next->next->expr);
+ gfc_add_block_to_block (&block, &argse.pre);
+ gfc_add_block_to_block (&post_block, &argse.post);
+ errmsg = argse.expr;
+ errmsg_len = fold_convert (integer_type_node, argse.string_length);
+ }
+ else
+ {
+ errmsg = null_pointer_node;
+ errmsg_len = integer_zero_node;
+ }
+
+ /* Generate the function call. */
+ if (code->resolved_isym->id == GFC_ISYM_CO_MAX)
+ fndecl = gfor_fndecl_co_max;
+ else if (code->resolved_isym->id == GFC_ISYM_CO_MIN)
+ fndecl = gfor_fndecl_co_min;
+ else
+ {
+ gcc_assert (code->resolved_isym->id == GFC_ISYM_CO_SUM);
+ fndecl = gfor_fndecl_co_sum;
+ }
+
+ if (code->resolved_isym->id == GFC_ISYM_CO_SUM)
+ fndecl = build_call_expr_loc (input_location, fndecl, 6, array, vec,
+ image_index, stat, errmsg, errmsg_len);
+ else
+ fndecl = build_call_expr_loc (input_location, fndecl, 7, array, vec,
+ image_index, stat, errmsg, strlen,
+ errmsg_len);
+ gfc_add_expr_to_block (&block, fndecl);
+ gfc_add_block_to_block (&block, &post_block);
+
+ /* Add CALL to CO_SUM/MIN/MAX: array descriptor, vector descriptor, stat, errmsg, strlen, errmsglen */
+ return gfc_finish_block (&block);
+}
+
+
+static tree
conv_intrinsic_atomic_def (gfc_code *code)
{
gfc_se atom, value;
@@ -7814,6 +7932,11 @@ gfc_conv_intrinsic_subroutine (gfc_code *code)
res = conv_isocbinding_subroutine (code);
break;
+ case GFC_ISYM_CO_MIN:
+ case GFC_ISYM_CO_MAX:
+ case GFC_ISYM_CO_SUM:
+ res = conv_co_minmaxsum (code);
+ break;
default:
res = NULL_TREE;
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 13b0a00..baae780 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -709,6 +709,9 @@ extern GTY(()) tree gfor_fndecl_caf_sync_all;
extern GTY(()) tree gfor_fndecl_caf_sync_images;
extern GTY(()) tree gfor_fndecl_caf_error_stop;
extern GTY(()) tree gfor_fndecl_caf_error_stop_str;
+extern GTY(()) tree gfor_fndecl_co_max;
+extern GTY(()) tree gfor_fndecl_co_min;
+extern GTY(()) tree gfor_fndecl_co_sum;
/* Math functions. Many other math functions are handled in
diff --git a/gcc/testsuite/gfortran.dg/assumed_rank_5.f90 b/gcc/testsuite/gfortran.dg/assumed_rank_5.f90
index a794996..f3d633d 100644
--- a/gcc/testsuite/gfortran.dg/assumed_rank_5.f90
+++ b/gcc/testsuite/gfortran.dg/assumed_rank_5.f90
@@ -5,5 +5,5 @@
!
!
subroutine foo(x)
- integer :: x(..) ! { dg-error "TS 29113: Assumed-rank array" }
+ integer :: x(..) ! { dg-error "TS 29113/TS 18508: Assumed-rank array" }
end subroutine foo
diff --git a/gcc/testsuite/gfortran.dg/assumed_type_4.f90 b/gcc/testsuite/gfortran.dg/assumed_type_4.f90
index 1ea982e..e940c45 100644
--- a/gcc/testsuite/gfortran.dg/assumed_type_4.f90
+++ b/gcc/testsuite/gfortran.dg/assumed_type_4.f90
@@ -6,5 +6,5 @@
! Test TYPE(*)
subroutine one(a)
- type(*) :: a ! { dg-error "TS 29113: Assumed type" }
+ type(*) :: a ! { dg-error "TS 29113/TS 18508: Assumed type" }
end subroutine one
diff --git a/gcc/testsuite/gfortran.dg/bind_c_array_params.f03 b/gcc/testsuite/gfortran.dg/bind_c_array_params.f03
index 0e9903c..1604517 100644
--- a/gcc/testsuite/gfortran.dg/bind_c_array_params.f03
+++ b/gcc/testsuite/gfortran.dg/bind_c_array_params.f03
@@ -5,11 +5,11 @@ use, intrinsic :: iso_c_binding
implicit none
contains
- subroutine sub0(assumed_array) bind(c) ! { dg-error "TS 29113: Assumed-shape array 'assumed_array' at .1. as dummy argument to the BIND.C. procedure 'sub0'" }
+ subroutine sub0(assumed_array) bind(c) ! { dg-error "TS 29113/TS 18508: Assumed-shape array 'assumed_array' at .1. as dummy argument to the BIND.C. procedure 'sub0'" }
integer(c_int), dimension(:) :: assumed_array
end subroutine sub0
- subroutine sub1(deferred_array) bind(c) ! { dg-error "TS 29113: Variable 'deferred_array' at .1. with POINTER attribute in procedure 'sub1' with BIND.C." }
+ subroutine sub1(deferred_array) bind(c) ! { dg-error "TS 29113/TS 18508: Variable 'deferred_array' at .1. with POINTER attribute in procedure 'sub1' with BIND.C." }
integer(c_int), pointer :: deferred_array(:)
end subroutine sub1
end module bind_c_array_params
diff --git a/gcc/testsuite/gfortran.dg/bind_c_usage_28.f90 b/gcc/testsuite/gfortran.dg/bind_c_usage_28.f90
index ff03ef4..bb9b5e8 100644
--- a/gcc/testsuite/gfortran.dg/bind_c_usage_28.f90
+++ b/gcc/testsuite/gfortran.dg/bind_c_usage_28.f90
@@ -8,11 +8,11 @@ type, bind(C) :: cstruct
integer :: i
end type
interface
- subroutine psub(this) bind(c, name='Psub') ! { dg-error "TS 29113: Variable 'this' at .1. with POINTER attribute in procedure 'psub' with BIND.C." }
+ subroutine psub(this) bind(c, name='Psub') ! { dg-error "TS 29113/TS 18508: Variable 'this' at .1. with POINTER attribute in procedure 'psub' with BIND.C." }
import :: c_float, cstruct
real(c_float), pointer :: this(:)
end subroutine psub
- subroutine psub2(that) bind(c, name='Psub2') ! { dg-error "TS 29113: Variable 'that' at .1. with ALLOCATABLE attribute in procedure 'psub2' with BIND.C." }
+ subroutine psub2(that) bind(c, name='Psub2') ! { dg-error "TS 29113/TS 18508: Variable 'that' at .1. with ALLOCATABLE attribute in procedure 'psub2' with BIND.C." }
import :: c_float, cstruct
type(cstruct), allocatable :: that(:)
end subroutine psub2
diff --git a/gcc/testsuite/gfortran.dg/c_funloc_tests_5.f03 b/gcc/testsuite/gfortran.dg/c_funloc_tests_5.f03
index ae321a9..8c1843b 100644
--- a/gcc/testsuite/gfortran.dg/c_funloc_tests_5.f03
+++ b/gcc/testsuite/gfortran.dg/c_funloc_tests_5.f03
@@ -8,9 +8,9 @@ contains
subroutine sub0() bind(c)
type(c_funptr) :: my_c_funptr
- my_c_funptr = c_funloc(sub1) ! { dg-error "TS 29113: Noninteroperable procedure at .1. to C_FUNLOC" }
+ my_c_funptr = c_funloc(sub1) ! { dg-error "TS 29113/TS 18508: Noninteroperable procedure at .1. to C_FUNLOC" }
- my_c_funptr = c_funloc(func0) ! { dg-error "TS 29113: Noninteroperable procedure at .1. to C_FUNLOC" }
+ my_c_funptr = c_funloc(func0) ! { dg-error "TS 29113/TS 18508: Noninteroperable procedure at .1. to C_FUNLOC" }
end subroutine sub0
subroutine sub1()
diff --git a/gcc/testsuite/gfortran.dg/c_funloc_tests_6.f90 b/gcc/testsuite/gfortran.dg/c_funloc_tests_6.f90
index 1a7f036..d426e81 100644
--- a/gcc/testsuite/gfortran.dg/c_funloc_tests_6.f90
+++ b/gcc/testsuite/gfortran.dg/c_funloc_tests_6.f90
@@ -26,6 +26,6 @@ cfp = c_loc (int) ! { dg-error "Can't convert TYPE.c_ptr. to TYPE.c_funptr." }
call c_f_pointer (cfp, int) ! { dg-error "Argument CPTR at .1. to C_F_POINTER shall have the type TYPE.C_PTR." }
call c_f_procpointer (cp, fsub) ! { dg-error "Argument CPTR at .1. to C_F_PROCPOINTER shall have the type TYPE.C_FUNPTR." }
-cfp = c_funloc (noCsub) ! { dg-error "TS 29113: Noninteroperable procedure at .1. to C_FUNLOC" }
-call c_f_procpointer (cfp, fint) ! { dg-error "TS 29113: Noninteroperable procedure pointer at .1. to C_F_PROCPOINTER" }
+cfp = c_funloc (noCsub) ! { dg-error "TS 29113/TS 18508: Noninteroperable procedure at .1. to C_FUNLOC" }
+call c_f_procpointer (cfp, fint) ! { dg-error "TS 29113/TS 18508: Noninteroperable procedure pointer at .1. to C_F_PROCPOINTER" }
end
diff --git a/gcc/testsuite/gfortran.dg/c_loc_tests_11.f03 b/gcc/testsuite/gfortran.dg/c_loc_tests_11.f03
index c00e5ed..d009ce0 100644
--- a/gcc/testsuite/gfortran.dg/c_loc_tests_11.f03
+++ b/gcc/testsuite/gfortran.dg/c_loc_tests_11.f03
@@ -43,7 +43,7 @@ contains
integer(c_int), intent(in) :: handle
get_foo_address = c_loc(foo_pool(handle)%v)
- get_foo_address = c_loc(foo_pool2(handle)%v) ! { dg-error "TS 29113: Noninteroperable array at .1. as argument to C_LOC: Expression is a noninteroperable derived type" }
+ get_foo_address = c_loc(foo_pool2(handle)%v) ! { dg-error "TS 29113/TS 18508: Noninteroperable array at .1. as argument to C_LOC: Expression is a noninteroperable derived type" }
end function get_foo_address
diff --git a/gcc/testsuite/gfortran.dg/coarray/collectives_1.f90 b/gcc/testsuite/gfortran.dg/coarray/collectives_1.f90
new file mode 100644
index 0000000..1404938
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/collectives_1.f90
@@ -0,0 +1,44 @@
+! { dg-do run }
+!
+! CO_SUM/CO_MIN/CO_MAX
+!
+program test
+ implicit none
+ intrinsic co_max
+ intrinsic co_min
+ intrinsic co_sum
+ call test_min
+ call test_max
+ call test_sum
+contains
+ subroutine test_min
+ integer :: val
+ val = this_image ()
+ call co_max (val, result_image=1)
+ if (this_image() == 1) then
+ !write(*,*) "Maximal value", val
+ if (val /= num_images()) call abort()
+ end if
+ end subroutine test_min
+
+ subroutine test_max
+ integer :: val
+ val = this_image ()
+ call co_min (val, result_image=1)
+ if (this_image() == 1) then
+ !write(*,*) "Minimal value", val
+ if (val /= 1) call abort()
+ end if
+ end subroutine test_max
+
+ subroutine test_sum
+ integer :: val, n
+ val = this_image ()
+ call co_sum (val, result_image=1)
+ if (this_image() == 1) then
+ !write(*,*) "The sum is ", val
+ n = num_images()
+ if (val /= (n**2 + n)/2) call abort()
+ end if
+ end subroutine test_sum
+end program test
diff --git a/gcc/testsuite/gfortran.dg/coarray_collectives_1.f90 b/gcc/testsuite/gfortran.dg/coarray_collectives_1.f90
new file mode 100644
index 0000000..a09a81f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_collectives_1.f90
@@ -0,0 +1,38 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=single" }
+!
+!
+! CO_SUM/CO_MIN/CO_MAX
+!
+program test
+ implicit none
+ intrinsic co_max
+ intrinsic co_min
+ intrinsic co_sum
+ integer :: val, i
+ character(len=30) :: errmsg
+ integer(8) :: i8
+ character(len=19, kind=4) :: msg4
+
+ call co_sum("abc") ! { dg-error "must be a numeric type" }
+ call co_max(cmplx(1.0,0.0)) ! { dg-error "shall be of type integer, real or character" }
+ call co_min(cmplx(0.0,1.0)) ! { dg-error "shall be of type integer, real or character" }
+
+ call co_sum(1) ! { dg-error "must be a variable" }
+ call co_min("abc") ! { dg-error "must be a variable" }
+ call co_max(2.3) ! { dg-error "must be a variable" }
+
+ call co_sum(val, result_image=[1,2]) ! { dg-error "must be a scalar" }
+ call co_sum(val, result_image=1.0) ! { dg-error "must be INTEGER" }
+ call co_min(val, stat=[1,2]) ! { dg-error "must be a scalar" }
+ call co_min(val, stat=1.0) ! { dg-error "must be INTEGER" }
+ call co_min(val, stat=1) ! { dg-error "must be a variable" }
+ call co_min(val, stat=i, result_image=1) ! OK
+ call co_max(val, stat=i, errmsg=errmsg, result_image=1) ! OK
+ call co_max(val, stat=i, errmsg=[errmsg], result_image=1) ! { dg-error "must be a scalar" }
+ call co_max(val, stat=i, errmsg=5, result_image=1) ! { dg-error "must be CHARACTER" }
+ call co_sum(val, errmsg="abc") ! { dg-error "must be a variable" }
+
+ call co_sum(val, stat=i8) ! { dg-error "The stat= argument at .1. must be a kind=4 integer variable" }
+ call co_min(val, errmsg=msg4) ! { dg-error "The errmsg= argument at .1. must be a default-kind character variable" }
+end program test
diff --git a/gcc/testsuite/gfortran.dg/coarray_collectives_2.f90 b/gcc/testsuite/gfortran.dg/coarray_collectives_2.f90
new file mode 100644
index 0000000..7494d3d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_collectives_2.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=single -std=f2008" }
+!
+!
+! CO_SUM/CO_MIN/CO_MAX
+!
+program test
+ implicit none
+ intrinsic co_max ! { dg-error "is not available in the current standard settings but new in TS 29113/TS 18508." }
+ intrinsic co_min ! { dg-error "is not available in the current standard settings but new in TS 29113/TS 18508." }
+ intrinsic co_sum ! { dg-error "is not available in the current standard settings but new in TS 29113/TS 18508." }
+end program test
diff --git a/gcc/testsuite/gfortran.dg/coarray_collectives_3.f90 b/gcc/testsuite/gfortran.dg/coarray_collectives_3.f90
new file mode 100644
index 0000000..971ee6a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_collectives_3.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+!
+! CO_SUM/CO_MIN/CO_MAX
+!
+program test
+ implicit none
+ intrinsic co_max
+ integer :: val
+ call co_max(val) ! { dg-error "Coarrays disabled at .1., use -fcoarray= to enable" }
+end program test
diff --git a/gcc/testsuite/gfortran.dg/coarray_collectives_4.f90 b/gcc/testsuite/gfortran.dg/coarray_collectives_4.f90
new file mode 100644
index 0000000..8b3da94
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_collectives_4.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original -fcoarray=single" }
+!
+! CO_SUM/CO_MIN/CO_MAX
+!
+program test
+ implicit none
+ intrinsic co_max
+ integer :: stat1, stat2, stat3
+ real :: val
+ call co_max(val, stat=stat1)
+ call co_min(val, stat=stat2)
+ call co_sum(val, stat=stat3)
+end program test
+
+! { dg-final { scan-tree-dump-times "stat1 = 0;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "stat2 = 0;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "stat3 = 0;" 1 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
+
diff --git a/gcc/testsuite/gfortran.dg/coarray_collectives_5.f90 b/gcc/testsuite/gfortran.dg/coarray_collectives_5.f90
new file mode 100644
index 0000000..15894d2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_collectives_5.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original -fcoarray=lib" }
+!
+! CO_SUM/CO_MIN/CO_MAX
+!
+program test
+ implicit none
+ intrinsic co_max
+ integer :: stat1, stat2, stat3
+ real :: val
+ call co_max(val, stat=stat1)
+ call co_min(val, stat=stat2)
+ call co_sum(val, stat=stat3)
+end program test
+
+! { dg-final { scan-tree-dump-times "_gfortran_caf_co_max \\(&desc.., 0B, 0, &stat1, 0B, 0, 0\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_co_min \\(&desc.., 0B, 0, &stat2, 0B, 0, 0\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_co_sum \\(&desc.., 0B, 0, &stat3, 0B, 0\\);" 1 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/coarray_collectives_6.f90 b/gcc/testsuite/gfortran.dg/coarray_collectives_6.f90
new file mode 100644
index 0000000..630ce9d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_collectives_6.f90
@@ -0,0 +1,26 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original -fcoarray=lib" }
+!
+! CO_SUM/CO_MIN/CO_MAX
+!
+program test
+ implicit none
+ intrinsic co_max
+ integer :: stat1, stat2, stat3
+ character(len=6) :: errmesg1
+ character(len=7) :: errmesg2
+ character(len=8) :: errmesg3
+ real :: val1
+ complex, allocatable :: val2(:)
+ character(len=99) :: val3
+ integer :: res
+
+ call co_max(val1, stat=stat1, errmsg=errmesg1)
+ call co_sum(val2, result_image=4, stat=stat2, errmsg=errmesg2)
+ call co_min(val3, result_image=res,stat=stat3, errmsg=errmesg3)
+end program test
+
+! { dg-final { scan-tree-dump-times "_gfortran_caf_co_max \\(&desc.., 0B, 0, &stat1, errmesg1, 0, 6\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_co_sum \\(&val2, 0B, 4, &stat2, errmesg2, 7\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_co_min \\(&desc.., 0B, res, &stat3, errmesg3, 99, 8\\);" 1 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/libgfortran/caf/libcaf.h b/libgfortran/caf/libcaf.h
index 8b8fd3e..f60eebc 100644
--- a/libgfortran/caf/libcaf.h
+++ b/libgfortran/caf/libcaf.h
@@ -65,6 +65,17 @@ typedef struct caf_static_t {
}
caf_static_t;
+typedef struct caf_vector_t {
+ size_t nvec; /* size of the vector; 0 means dim triplet. */
+ union {
+ struct {
+ ptrdiff_t lower_bound, upper_bound, stride;
+ } triplet;
+ ptrdiff_t *vector;
+ } u;
+}
+caf_vector_t;
+
void _gfortran_caf_init (int *, char ***);
void _gfortran_caf_finalize (void);
@@ -92,4 +103,10 @@ void _gfortran_caf_error_stop_str (const char *, int32_t)
__attribute__ ((noreturn));
void _gfortran_caf_error_stop (int32_t) __attribute__ ((noreturn));
+void _gfortran_caf_co_sum (void *, caf_vector_t *, int, int *, char *, int);
+void _gfortran_caf_co_min (void *, caf_vector_t *, int, int *, char *, int,
+ int);
+void _gfortran_caf_co_max (void *, caf_vector_t *, int, int *, char *, int,
+ int);
+
#endif /* LIBCAF_H */
diff --git a/libgfortran/caf/single.c b/libgfortran/caf/single.c
index cf1ced8..b883327 100644
--- a/libgfortran/caf/single.c
+++ b/libgfortran/caf/single.c
@@ -202,3 +202,39 @@ _gfortran_caf_error_stop (int32_t error)
fprintf (stderr, "ERROR STOP %d\n", error);
exit (error);
}
+
+
+void
+_gfortran_caf_co_sum (void *a __attribute__ ((unused)),
+ caf_vector_t vector[] __attribute__ ((unused)),
+ int result_image __attribute__ ((unused)),
+ int *stat, char *errmsg __attribute__ ((unused)),
+ int errmsg_len __attribute__ ((unused)))
+{
+ if (stat)
+ stat = 0;
+}
+
+void
+_gfortran_caf_co_min (void *a __attribute__ ((unused)),
+ caf_vector_t vector[] __attribute__ ((unused)),
+ int result_image __attribute__ ((unused)),
+ int *stat, char *errmsg __attribute__ ((unused)),
+ int src_len __attribute__ ((unused)),
+ int errmsg_len __attribute__ ((unused)))
+{
+ if (stat)
+ stat = 0;
+}
+
+void
+_gfortran_caf_co_max (void *a __attribute__ ((unused)),
+ caf_vector_t vector[] __attribute__ ((unused)),
+ int result_image __attribute__ ((unused)),
+ int *stat, char *errmsg __attribute__ ((unused)),
+ int src_len __attribute__ ((unused)),
+ int errmsg_len __attribute__ ((unused)))
+{
+ if (stat)
+ stat = 0;
+}