/* -*- Mode: C++; c-basic-offset:4 ; -*- */

/*

 *

 *  (C) 2001 by Argonne National Laboratory.

 *      See COPYRIGHT in top-level directory.

 */

#include "mpi.h"

#include "mpitestconf.h"

#ifdef HAVE_IOSTREAM

// Not all C++ compilers have iostream instead of iostream.h

#include <iostream>

#ifdef HAVE_NAMESPACE_STD

// Those that do often need the std namespace; otherwise, a bare "cout"

// is likely to fail to compile

using namespace std;

#endif

#else

#include <iostream.h>

#endif

#include "mpitestcxx.h"

#include <stdlib.h>

#include <string.h>

static int dbgflag = 0;         /* Flag used for debugging */

static int wrank = -1;          /* World rank */

static int verbose = 0;         /* Message level (0 is none) */

static void MTestRMACleanup(void);

/*

 * Initialize and Finalize MTest

 */

/*

   Initialize MTest, initializing MPI if necessary.

 Environment Variables:

+ MPITEST_DEBUG - If set (to any value), turns on debugging output

- MPITEST_VERBOSE - If set to a numeric value, turns on that level of

  verbose output.

 */

void MTest_Init(void)

{

    bool flag;

    const char *envval = 0;

    int threadLevel, provided;

    threadLevel = MPI::THREAD_SINGLE;

    envval = getenv("MTEST_THREADLEVEL_DEFAULT");

    if (envval && *envval) {

        if (strcmp(envval, "MULTIPLE") == 0 || strcmp(envval, "multiple") == 0) {

            threadLevel = MPI::THREAD_MULTIPLE;

        } else if (strcmp(envval, "SERIALIZED") == 0 || strcmp(envval, "serialized") == 0) {

            threadLevel = MPI::THREAD_SERIALIZED;

        } else if (strcmp(envval, "FUNNELED") == 0 || strcmp(envval, "funneled") == 0) {

            threadLevel = MPI::THREAD_FUNNELED;

        } else if (strcmp(envval, "SINGLE") == 0 || strcmp(envval, "single") == 0) {

            threadLevel = MPI::THREAD_SINGLE;

        } else {

            cerr << "Unrecognized thread level " << envval << "\n";

            cerr.flush();

            /* Use exit since MPI_Init/Init_thread has not been called. */

            exit(1);

        }

    }

    flag = MPI::Is_initialized();

    if (!flag) {

        provided = MPI::Init_thread(threadLevel);

    }

#if defined(HAVE_MPI_IO)

    MPI::FILE_NULL.Set_errhandler(MPI::ERRORS_THROW_EXCEPTIONS);

#endif

    /* Check for debugging control */

    if (getenv("MPITEST_DEBUG")) {

        dbgflag = 1;

        wrank = MPI::COMM_WORLD.Get_rank();

    }

    /* Check for verbose control */

    envval = getenv("MPITEST_VERBOSE");

    if (envval) {

        char *s;

        long val = strtol(envval, &s, 0);

        if (s == envval) {

            /* This is the error case for strtol */

            cerr << "Warning: " << envval << " not valid for MPITEST_VERBOSE\n";

            cerr.flush();

        } else {

            if (val >= 0) {

                verbose = val;

            } else {

                cerr << "Warning: " << envval << " not valid for MPITEST_VERBOSE\n";

                cerr.flush();

            }

        }

    }

}

/*

  Finalize MTest.  errs is the number of errors on the calling process;

  this routine will write the total number of errors over all of MPI_COMM_WORLD

  to the process with rank zero, or " No Errors".

 */

void MTest_Finalize(int errs)

{

    int rank, toterrs;

    rank = MPI::COMM_WORLD.Get_rank();

    MPI::COMM_WORLD.Allreduce(&errs, &toterrs, 1, MPI::INT, MPI::SUM);

    if (rank == 0) {

        if (toterrs) {

            cout << " Found " << toterrs << " errors\n";

        } else {

            cout << " No Errors\n";

        }

        cout.flush();

    }

    // Clean up any persistent objects that we allocated

    MTestRMACleanup();

    MPI::Finalize();

}

/* ----------------------------------------------------------------------- */

/*

 * Create communicators.  Use separate routines for inter and intra

 * communicators (there is a routine to give both)

 * Note that the routines may return MPI::COMM_NULL, so code should test for

 * that return value as well.

 *

 */

static int interCommIdx = 0;

static int intraCommIdx = 0;

static const char *intraCommName = 0;

static const char *interCommName = 0;

/*

 * Get an intracommunicator with at least min_size members.  If "allowSmaller"

 * is true, allow the communicator to be smaller than MPI::COMM_WORLD and

 * for this routine to return MPI::COMM_NULL for some values.  Returns 0 if

 * no more communicators are available.

 */

int MTestGetIntracommGeneral(MPI::Intracomm & comm, int min_size, bool allowSmaller)

{

    int size, rank;

    bool done = false;

    bool isBasic = false;

    /* The while loop allows us to skip communicators that are too small.

     * MPI::COMM_NULL is always considered large enough */

    while (!done) {

        switch (intraCommIdx) {

            case 0:

                comm = MPI::COMM_WORLD;

                isBasic = true;

                intraCommName = "MPI::COMM_WORLD";

                break;

            case 1:

                /* dup of world */

                comm = MPI::COMM_WORLD.Dup();

                intraCommName = "Dup of MPI::COMM_WORLD";

                break;

            case 2:

                /* reverse ranks */

                size = MPI::COMM_WORLD.Get_size();

                rank = MPI::COMM_WORLD.Get_rank();

                comm = MPI::COMM_WORLD.Split(0, size - rank);

                intraCommName = "Rank reverse of MPI::COMM_WORLD";

                break;

            case 3:

                /* subset of world, with reversed ranks */

                size = MPI::COMM_WORLD.Get_size();

                rank = MPI::COMM_WORLD.Get_rank();

                comm = MPI::COMM_WORLD.Split((rank < size / 2), size - rank);

                intraCommName = "Rank reverse of half of MPI::COMM_WORLD";

                break;

            case 4:

                comm = MPI::COMM_SELF;

                isBasic = true;

                intraCommName = "MPI::COMM_SELF";

                break;

                /* These next cases are communicators that include some

                 * but not all of the processes */

            case 5:

            case 6:

            case 7:

            case 8:

                {

                    int newsize;

                    size = MPI::COMM_WORLD.Get_size();

                    newsize = size - (intraCommIdx - 4);

                    if (allowSmaller && newsize >= min_size) {

                        rank = MPI::COMM_WORLD.Get_rank();

                        comm = MPI::COMM_WORLD.Split(rank < newsize, rank);

                        if (rank >= newsize) {

                            comm.Free();

                            comm = MPI::COMM_NULL;

                        }

                    } else {

                        /* Act like default */

                        comm = MPI::COMM_NULL;

                        isBasic = true;

                        intraCommName = "MPI::COMM_NULL";

                        intraCommIdx = -1;

                    }

                }

                break;

                /* Other ideas: dup of self, cart comm, graph comm */

            default:

                comm = MPI::COMM_NULL;

                isBasic = true;

                intraCommName = "MPI::COMM_NULL";

                intraCommIdx = -1;

                break;

        }

        if (comm != MPI::COMM_NULL) {

            size = comm.Get_size();

            if (size >= min_size)

                done = true;

            else {

                /* Try again */

                if (!isBasic)

                    comm.Free();

                intraCommIdx++;

            }

        } else

            done = true;

    }

    intraCommIdx++;

    return intraCommIdx;

}

/*

 * Get an intracommunicator with at least min_size members.

 */

int MTestGetIntracomm(MPI::Intracomm & comm, int min_size)

{

    return MTestGetIntracommGeneral(comm, min_size, false);

}

/* Return the name of an intra communicator */

const char *MTestGetIntracommName(void)

{

    return intraCommName;

}

/*

 * Return an intercomm; set isLeftGroup to 1 if the calling process is

 * a member of the "left" group.

 */

int MTestGetIntercomm(MPI::Intercomm & comm, int &isLeftGroup, int min_size)

{

    int size, rank, remsize;

    bool done = false;

    MPI::Intracomm mcomm;

    int rleader;

    /* The while loop allows us to skip communicators that are too small.

     * MPI::COMM_NULL is always considered large enough.  The size is

     * the sum of the sizes of the local and remote groups */

    while (!done) {

        comm = MPI::COMM_NULL;

        isLeftGroup = 0;

        interCommName = "MPI_COMM_NULL";

        switch (interCommIdx) {

            case 0:

                /* Split comm world in half */

                rank = MPI::COMM_WORLD.Get_rank();

                size = MPI::COMM_WORLD.Get_size();

                if (size > 1) {

                    mcomm = MPI::COMM_WORLD.Split((rank < size / 2), rank);

                    if (rank == 0) {

                        rleader = size / 2;

                    } else if (rank == size / 2) {

                        rleader = 0;

                    } else {

                        /* Remote leader is signficant only for the processes

                         * designated local leaders */

                        rleader = -1;

                    }

                    isLeftGroup = rank < size / 2;

                    comm = mcomm.Create_intercomm(0, MPI::COMM_WORLD, rleader, 12345);

                    mcomm.Free();

                    interCommName = "Intercomm by splitting MPI::COMM_WORLD";

                } else {

                    comm = MPI::COMM_NULL;

                }

                break;

            case 1:

                /* Split comm world in to 1 and the rest */

                rank = MPI::COMM_WORLD.Get_rank();

                size = MPI::COMM_WORLD.Get_size();

                if (size > 1) {

                    mcomm = MPI::COMM_WORLD.Split(rank == 0, rank);

                    if (rank == 0) {

                        rleader = 1;

                    } else if (rank == 1) {

                        rleader = 0;

                    } else {

                        /* Remote leader is signficant only for the processes

                         * designated local leaders */

                        rleader = -1;

                    }

                    isLeftGroup = rank == 0;

                    comm = mcomm.Create_intercomm(0, MPI::COMM_WORLD, rleader, 12346);

                    mcomm.Free();

                    interCommName = "Intercomm by splitting MPI::COMM_WORLD into 1, rest";

                } else {

                    comm = MPI::COMM_NULL;

                }

                break;

            case 2:

                /* Split comm world in to 2 and the rest */

                rank = MPI::COMM_WORLD.Get_rank();

                size = MPI::COMM_WORLD.Get_size();

                if (size > 3) {

                    mcomm = MPI::COMM_WORLD.Split(rank < 2, rank);

                    if (rank == 0) {

                        rleader = 2;

                    } else if (rank == 2) {

                        rleader = 0;

                    } else {

                        /* Remote leader is signficant only for the processes

                         * designated local leaders */

                        rleader = -1;

                    }

                    isLeftGroup = rank < 2;

                    comm = mcomm.Create_intercomm(0, MPI::COMM_WORLD, rleader, 12347);

                    mcomm.Free();

                    interCommName = "Intercomm by splitting MPI::COMM_WORLD into 2, rest";

                } else {

                    comm = MPI::COMM_NULL;

                }

                break;

            default:

                comm = MPI::COMM_NULL;

                interCommName = "MPI::COMM_NULL";

                interCommIdx = -1;

                break;

        }

        if (comm != MPI::COMM_NULL) {

            size = comm.Get_size();

            remsize = comm.Get_remote_size();

            if (size + remsize >= min_size)

                done = true;

        } else

            done = true;

        /* we are only done if all processes are done */

        MPI::COMM_WORLD.Allreduce(MPI_IN_PLACE, &done, 1, MPI::BOOL, MPI::LAND);

        /* Advance the comm index whether we are done or not, otherwise we could

         * spin forever trying to allocate a too-small communicator over and

         * over again. */

        interCommIdx++;

        if (!done && comm != MPI::COMM_NULL) {

            comm.Free();

        }

    }

    return interCommIdx;

}

/* Return the name of an intercommunicator */

const char *MTestGetIntercommName(void)

{

    return interCommName;

}

/* Get a communicator of a given minimum size.  Both intra and inter

   communicators are provided

   Because Comm is an abstract base class, you can only have references

   to a Comm.*/

int MTestGetComm(MPI::Comm ** comm, int min_size)

{

    int idx;

    static int getinter = 0;

    if (!getinter) {

        MPI::Intracomm rcomm;

        idx = MTestGetIntracomm(rcomm, min_size);

        if (idx == 0) {

            getinter = 1;

        } else {

            MPI::Intracomm * ncomm = new MPI::Intracomm(rcomm);

            *comm = ncomm;

        }

    }

    if (getinter) {

        MPI::Intercomm icomm;

        int isLeft;

        idx = MTestGetIntercomm(icomm, isLeft, min_size);

        if (idx == 0) {

            getinter = 0;

        } else {

            MPI::Intercomm * ncomm = new MPI::Intercomm(icomm);

            *comm = ncomm;

        }

    }

    return idx;

}

/* Free a communicator.  It may be called with a predefined communicator

 or MPI_COMM_NULL */

void MTestFreeComm(MPI::Comm & comm)

{

    if (comm != MPI::COMM_WORLD && comm != MPI::COMM_SELF && comm != MPI::COMM_NULL) {

        comm.Free();

    }

}

/* ------------------------------------------------------------------------ */

void MTestPrintError(int errcode)

{

    int errclass, slen;

    char string[MPI_MAX_ERROR_STRING];

    errclass = MPI::Get_error_class(errcode);

    MPI::Get_error_string(errcode, string, slen);

    cout << "Error class " << errclass << "(" << string << ")\n";

    cout.flush();

}

void MTestPrintErrorMsg(const char msg[], int errcode)

{

    int errclass, slen;

    char string[MPI_MAX_ERROR_STRING];

    errclass = MPI::Get_error_class(errcode);

    MPI::Get_error_string(errcode, string, slen);

    cout << msg << ": Error class " << errclass << " (" << string << ")\n";

    cout.flush();

}

/* ------------------------------------------------------------------------ */

/* Fatal error.  Report and exit */

void MTestError(const char *msg)

{

    cerr << msg << "\n";

    cerr.flush();

    MPI::COMM_WORLD.Abort(1);

}

#ifdef HAVE_MPI_WIN_CREATE

/*

 * Create MPI Windows

 */

static int win_index = 0;

static const char *winName;

/* Use an attribute to remember the type of memory allocation (static,

   malloc, or MPI_Alloc_mem) */

static int mem_keyval = MPI::KEYVAL_INVALID;

int MTestGetWin(MPI::Win & win, bool mustBePassive)

{

    static char actbuf[1024];

    static char *pasbuf;

    char *buf;

    int n, rank;

    MPI::Info info;

    if (mem_keyval == MPI::KEYVAL_INVALID) {

        /* Create the keyval */

        mem_keyval = MPI::Win::Create_keyval(MPI::Win::NULL_COPY_FN, MPI::Win::NULL_DELETE_FN, 0);

    }

    switch (win_index) {

        case 0:

            /* Active target window */

            win = MPI::Win::Create(actbuf, 1024, 1, MPI::INFO_NULL, MPI::COMM_WORLD);

            winName = "active-window";

            win.Set_attr(mem_keyval, (void *) 0);

            break;

        case 1:

            /* Passive target window */

            pasbuf = (char *) MPI::Alloc_mem(1024, MPI::INFO_NULL);

            win = MPI::Win::Create(pasbuf, 1024, 1, MPI::INFO_NULL, MPI::COMM_WORLD);

            winName = "passive-window";

            win.Set_attr(mem_keyval, (void *) 2);

            break;

        case 2:

            /* Active target; all windows different sizes */

            rank = MPI::COMM_WORLD.Get_rank();

            n = rank * 64;

            if (n)

                buf = (char *) malloc(n);

            else

                buf = 0;

            win = MPI::Win::Create(buf, n, 1, MPI::INFO_NULL, MPI::COMM_WORLD);

            winName = "active-all-different-win";

            win.Set_attr(mem_keyval, (void *) 1);

            break;

        case 3:

            /* Active target, no locks set */

            rank = MPI::COMM_WORLD.Get_rank();

            n = rank * 64;

            if (n)

                buf = (char *) malloc(n);

            else

                buf = 0;

            info = MPI::Info::Create();

            info.Set("nolocks", "true");

            win = MPI::Win::Create(buf, n, 1, info, MPI::COMM_WORLD);

            info.Free();

            winName = "active-nolocks-all-different-win";

            win.Set_attr(mem_keyval, (void *) 1);

            break;

        default:

            win_index = -1;

    }

    win_index++;

    return win_index;

}

/* Return a pointer to the name associated with a window object */

const char *MTestGetWinName(void)

{

    return winName;

}

/* Free the storage associated with a window object */

void MTestFreeWin(MPI::Win & win)

{

    void *addr;

    bool flag;

    flag = win.Get_attr(MPI_WIN_BASE, &addr);

    if (!flag) {

        MTestError("Could not get WIN_BASE from window");

    }

    if (addr) {

        void *val;

        flag = win.Get_attr(mem_keyval, &val;;

        if (flag) {

            if (val == (void *) 1) {

                free(addr);

            } else if (val == (void *) 2) {

                MPI::Free_mem(addr);

            }

            /* if val == (void *)0, then static data that must not be freed */

        }

    }

    win.Free();

}

static void MTestRMACleanup(void)

{

    if (mem_keyval != MPI::KEYVAL_INVALID) {

        MPI::Win::Free_keyval(mem_keyval);

    }

}

#else

static void MTestRMACleanup(void)

{

}

#endif