source: git/Singular/LIB/tst.lib @ bee06d

/////////////////////////////////////////////////////////////////////////////

version="$Id$";
category="Utilities";
info="
LIBRARY:  tst.lib      Procedures for running automatic tst Tests

PROCEDURES:
 tst_system(s)          returns string which is stdout of system(\"sh\", s)
 tst_ignore(any,[keyword], [link]) writes string(any) to link (or stdout),
                                   prepending prefix \"// tst_ignore:\"
 tst_init()             writes some identification data to GetTstStatusFile()
 tst_status([any])      writes status info to GetTstStatusFile()
 tst_InitTimer()        initialize tst-Timer
 tst_StopTimer()        stop Tst-Timer
 tst_GetTimer           get value of Tst-Timer
 tst_ReportTimer        report value of Tst-Timer
 tst_groebnerTest(ideal i)
                        tests groebner command
 tst_stdEqual(ideal i1, ideal i2)
                        test whether two std's are \"equal\"

 tst_test_res(ideal i)  test different res commands for homog ideal i
";

/////////////////////////////////////////////////////////////////////////////
proc tst_system(string s, list #)
"USAGE:    tst_system(s); s string
RETURN:   string which is stdout and stderr of system(\"sh\", s)
EXAMPLE:  example tst_system; shows examples"
{
  string tmpfile = "/tmp/tst_" + string(system("pid"));
  int errno;

  s = s + " 1>" + tmpfile + " 2>&1";
  errno = system("sh", s);
  s = read(tmpfile);
  errno = system("sh", "rm -f " + tmpfile);
  if (size(#) > 0 && size(s) > 1)
  {
    s = s[1, size(s) -1];
  }
  return (s);
}
example
{
  "EXAMPLE"; echo = 2;
  string s = tst_system("echo This is an example of tst_system");
  "The following is what the system call wrote to stdout: " + s;
}

proc tst_ignore(list #)
"USAGE:    tst_ignore(any,[keyword], [link])
            any     -- valid argument to string()
            keyword -- an arbitrary string
            link    -- a link which can be written to
RETURN:   none; writes string(any) to link (or stdout, if no link given),
          prepending prefix \"// tst_ignore:\", or
                            \"// tst_ignore:keyword hostname:\",
                            if keyword was given.
          Should be used in tst files to output system dependent data
          (like date, pathnames).
EXAMPLE:  example tst_ignore; shows examples
"
{
  if (! defined(tst_no_status))
  {
    string s;
    string keyword = "";
    link outlink = "";

    // Check # of args
    if (size(#) < 1 || size(#) > 3)
    {
      "Error tst_ignore: Wrong number of arguments";
      "Usage: tst_ignore (any,[keyword], [link]);";
      return();
    }

    // Get Args
    s = string(#[1]);
    if (size(#) == 3)
    {
      keyword = #[2];
      outlink = #[3];
    }
    if (size(#) == 2)
    {
      if (typeof(#[2]) == "string")
      {
        keyword = #[2];
      }
      else
      {
        outlink = #[2];
      }
    }

    // check args
    if (typeof(keyword) != "string")
    {
      "Error tst_ignore: Keyword must be a string";
      "Usage: tst_ignore (any,[keyword], [link]);";
      return();
    }

    if (status(outlink, "open", "no"))
    {
      open(outlink);
    }

    if (status(outlink, "write", "not ready"))
    {
      "Error tst_ignore: Cannot write to link";
      outlink;
      "Usage: tst_ignore (any,[keyword], [link]);";
      return();
    }

    // ready -- do the actual work
    if (keyword != "")
    {
      write(outlink,"// tst_ignore:" + keyword + " :: " + tst_system("hostname", 1) + ":" + s);
    }
    else
    {
      write(outlink, "// tst_ignore: " + s);
    }
  }
}
example
{
  "EXAMPLE";
  "System independent data can safely be output in tst files;";
  "However, system dependent data like dates, or pathnames, should be output";
  "using the command tst_ignore(...), like";
  echo = 2;
  tst_ignore(tst_system("date"));
  int t1 = timer;
  tst_ignore(t1, "time");
  tst_ignore(memory(1), "memory");
}

static proc Get_tst_timer()
{
  if (! defined (tst_timer))
  {
    string tst_timer = "// tst_ignore:0";
    export tst_timer;
    return (0);
  }
  else
  {
    execute("int tst_int_timer = " + tst_timer[15,size(tst_timer)] + ";");
    return (tst_int_timer);
  }
}

static proc Set_tst_timer (int this_time)
{
  tst_timer = tst_timer[1,14] + string(this_time);
}

static proc GetTstStatusFile()
{
  if (!defined(tst_status_file))
  {
    return ("tst_status.out");
  }
  else
  {
    return (tst_status_file);
  }
}

static proc tst_status_out (def prefix, def what, list #)
{
  string outstring;

  outstring = string(prefix) + " >> " + string(what);
  if (size(#) > 0)
  {
    outstring = outstring + " :: " +
      tst_system("hostname", 1) + ":" + string(#[1]);
  }
  write(":a " + GetTstStatusFile(), outstring);
}

proc tst_status (list #)
"USAGE:   tst_status([prefix [, start_up]])
           prefix -- string
           start_up -- int
RETURN:   none
PURPOSE: writes to tst-output the current memory usage and used CPU time.
         If no integer argument is given, the elapsed CPU time since
         the last call to tst_status() is reported.
         If an integer argument is given, the elapsed CPU time since the
         start-up of @sc{Singular} is reported.
         If prefix is given, output reported start with prefix.
NOTE:     Should be used regularly within tst files to enable automatic
          tracking of memory and time performance.
EXAMPLE: example tst_status; shows example
SEE ALSO: tst_init
"
{
  int start_up;

  if (size(#) > 0)
  {
    if (typeof(#[1]) == "string")
    {
      string prefix = #[1];
      if (size(#) > 1)
      {
        start_up = 1;
      }
    }
    else
    {
      start_up = 1;
    }
  }
  if (! defined(tst_no_status))
  {
    if (! defined(tst_status_counter))
    {
      int tst_status_counter = 1;
      export tst_status_counter;
    }
    else
    {
      tst_status_counter++;
    }

    if (!defined(prefix))
    {
      def prefix = tst_status_counter;
    }
    tst_status_out(prefix, "tst_memory_0", memory(0));
    tst_status_out(prefix, "tst_memory_1", memory(1));
    tst_status_out(prefix, "tst_memory_2", memory(2));
    if (start_up > 0)
    {
      tst_status_out(prefix, "tst_timer_1", timer);
    }
    else
    {
      tst_status_out(prefix, "tst_timer", timer - Get_tst_timer());
      Set_tst_timer(timer);
    }
  }
}
example
{
  "EXAMPLE";  echo = 2;
  tst_status();
  ring r;
  poly p = (x+y+z)^40;
  tst_status();
  tst_status(1);
}


proc tst_init(list #)
"USAGE:   tst_init([file])
            file -- string
RETURN:  none
PURPOSE: initializes further calls to tst routines:
         If no arguments are given, and if tst_status_file is not defined,
         then tst-output is written to stdout, else tst-output is written
         to file.
EXAMPLE: example tst_init; shows example
"
{
  if (! defined(tst_no_status))
  {
    string outfile = "";

    if (size(#) > 0)
    {
      if (typeof(#[1]) == string)
      {
        outfile  = #[1];
      }
    }
    if (!defined(tst_status_file))
    {
      string tst_status_file = outfile;
      export tst_status_file;
    }
    if (GetTstStatusFile() != "")
    {
      write(":w " + GetTstStatusFile(), "Status Output of " + GetTstStatusFile());
    }
    tst_status_out("init", "USER    :" + system("getenv", "USER"));
    tst_status_out("init", "HOSTNAME:" + tst_system("hostname", 1));
    tst_status_out("init", "uname -a:" + tst_system("uname -a", 1));
    tst_status_out("init", "date    :" + tst_system("date", 1));
    tst_status_out("init", "version :" + string(system("version")));
    tst_status_out("init", "ticks   :" + string(system("--ticks-per-sec")));
    "init >> " + GetTstStatusFile();
  }
}
example
{
  "EXAMPLE";  echo = 2;
  tst_init();
}

proc tst_InitTimer(list #)
"USAGE: tst_InitTime([ticks_per_second])
          ticks_per_second -- int
RETURN: none
PURPOSE: initializes tst timer for subsequent calls to tst_StopTimer or
         tst_ReportTimer.
         If the ticks_per_second argument is given, then the timer resolution
         is set to this value. Otherwise, the default timer resolution is used.
SEE ALSO: tst_StopTimer, tst_GetTimer, tst_ReportTimer
"
{
  if (!defined(tst_Timer))
  {
    int tst_Timer;
    export tst_Timer;
  }
  if (size(#) > 0)
  {
    if (typeof(#[1]) == "int")
    {
      if (#[1] > 0)
      {
        system("--ticks-per-sec", #[1]);
      }
      else
      {
        ERROR("need integer argument > 0");
      }
    }
    else
    {
      ERROR("need integer argument");
    }
  }
  tst_Timer = timer;
}

proc tst_StopTimer()
"USAGE: tst_StopTimer()
RETURN: int, timer ticks of elapsed CPU time since last call to tst_InitTimer
PUPOSE: stops the timer initialized by previous call to tst_InitTimer
SEE ALSO: tst_InitTimer, tst_GetTimer, tst_ReportTimer
"
{
  tst_Timer = timer - tst_Timer;
  return (tst_Timer);
}

proc tst_GetTimer()
"USAGE: tst_GetTimer()
RETURN: int, timer ticks of elapsed CPU time since last call to tst_Init
NOTE:  does NOT stop the time initialized by previous call to tst_InitTimer
SEE ALSO: tst_InitTimer, tst_GetTimer, tst_ReportTimer
"
{
  int tt = timer - tst_Timer;
  return (tt);
}

proc tst_ReportTimer(list #)
"USAGE: tst_ReportTimer([prefix])
RETURN: none
PUPOSE: stops the timer initialized by previous call to tst_InitTimer;
        reports time to tst-output;
        if prefix is given, timer output is prefixed by it.
SEE ALSO: tst_InitTimer, tst_GetTimer, tst_StopTimer, tst_OutTimer, tst_init
"
{
  tst_Timer = timer - tst_Timer;
  tst_OutTimer(tst_Timer, #);
}

proc tst_OutTimer(int tt, list #)
"USAGE: tst_OutTimer(ticks [, prefix])
RETURN: none
PURPOSE: reports value of tt to tst-output;
         if prefix is given, timer output is prefixed by it.
SEE ALSO: tst_InitTimer, tst_GetTimer, tst_StopTimer, tst_ReportTimer, tst_init
"
{
  string prefix = "OutTimer";

  if (size(#) > 0)
  {
    prefix = string(#[1]);
  }
  tst_status_out(prefix, "tst-Timer", tt);
}

///////////////////////////////////////////////////////////////////////

proc tst_groebnerTest(ideal i, list #)
"USAGE: tst_groebnerTesti,[v]) : ideal i, [int v]
RETURN: 1, if groebner command produced \"equal\" std as std command
        0, otherwise
        Two std's are \"equal\" here, if their redSB's are element-wise equal,
        and if they reduce each other to zero, and if their leading ideals
        are equal
        On success, times of std - groebner is written with tst_ignore, and
        times are added to global variables tst_std_time and
        tst_groebner_time. If v given, and <= 0, short ideal
        characteristic is printed, if v > 0, ideals are printed.
        On failure, Error message and ideals are printed.
EXAMPLE: example tst_groebner; shows an example
"
{
  int st = timer;
  ideal si = std(i);
  st = timer - st;

  int gt = timer;
  ideal gi = groebner(i);
  gt = timer - gt;

  if (tst_stdEqual(si, gi))
  {
    tst_ignore(string(st) + " - " + string(gt) + " == " + string(st - gt));
    if (! defined(tst_groebner_time))
    {
      int tst_groebner_time;
      int tst_std_time;
      export tst_groebner_time, tst_std_time;
    }
    tst_std_time = tst_std_time + st;
    tst_groebner_time = tst_groebner_time + gt;
    if (size(#))
    {
      if (typeof(#[1] == "int"))
      {
        if (#[1] <= 0)
        {
          idPrintShort(si, "si");
          idPrintShort(gi, "gi");
        }
        else
        {
          si;
          gi;
        }
      }
    }
    return (1);
  }
  return (0);
}
example
{
  "EXAMPLE: "; echo = 2;
  ring r = 0, (a,b,c,d), lp;
  ideal i = a+b+c+d, ab+ad+bc+cd, abc+abd+acd+bcd, abcd-1; // cyclic 4
  tst_groebnerTest(i);
  tst_groebnerTest(i, 0);
  tst_groebnerTest(i, 1);
}


//
// A routine which test for equality of "std-bases"
//
proc tst_stdEqual(ideal i1, ideal i2)
"USAGE: tst_stdEqual(i1, i2)  ideal i1, i2
RETURN 1, if i1 \"equald\" i2 as a std bases
       0, otherwise
       Two std's are \"equal\" here, if their redSB's are element-wise equal,
       and if they reduce each other to zero, and if their leading ideals
       are equal
       On failure, error message is printed.
EXAMPLE: example tst_stdEqual; shows an example
"
{
  int i;
  int back;
  intvec opts = option(get);
  option(redSB);

  ideal ri1 = simplify(interred(i1), 1);
  ideal ri2 = simplify(interred(i2), 1);

  option(set, opts);

  if (size(ri1) != size(ri2))
  {
    "Error in tst_stdEqual: Reduced sizes differ";
    size(ri1);
    size(ri2);
    return(0);
  }

  for (i=1; i<=size(ri1); i++)
  {
    if (ri1[i] != ri2[i])
    {
      "Error in tst_stdEqual: " + string(i) + " th polynomials differ";
      ri1[i];
      ri2[i];
      return(0);
    }
  }

  // reduced SB are now equal
  if (size(reduce(i1, i2, 1)) == 0)
  {
    if (size(reduce(i2, i1, 1)) == 0)
    {
      poly p1, p2;

      ideal si1 = simplify(i1, 7);
      ideal si2 = simplify(i2, 7);

      if (size(si1) == size(si2))
      {
        for (i=1; i<=size(si1); i++)
        {
          p1 = p1 + lead(si1[i]);
          p2 = p2 + lead(si2[i]);
        }
        if (p1 != p2)
        {
          "Error in tst_stdEqual: Lead monoms differ:";
          p1;
          p2;
          return(0);
        }
      }
      else
      {
        "Error in tst_stdEqual: size differs:";
        size(si1);
        size(si2);
        return(0);
      }
    }
    else
    {
      "Error in tst_stdEqual: reduce(i2, i1) != 0";
      return(0);
    }
  }
  else
  {
    back = 1; "Error in tst_stdEqual: reduce(i1, i2) != 0";
    return(0);
  }

  return (1);
}
example
{
  "EXAMPLE: "; echo = 2;
  ring r = 0, (a,b,c,d), lp;
  ideal i = a+b+c+d, ab+ad+bc+cd, abc+abd+acd+bcd, abcd-1; // cyclic 4
  tst_stdEqual(groebner(i), std(i));
  tst_stdEqual(std(i), i);
}

static proc idPrintShort(ideal id, string name)
{
  "Summary of " + name + " (leading monoms and size of polys):";
  int i;
  for (i = 1; i<=size(id); i++)
  {
    "[" + string(i) + "]: #" + string(size(id[i])) + ":" + string(lead(id[i]));
  }
}


proc tst_test_res(ideal i, list #)

"USAGE:    tst_test_res(ideal i, only_lres_and_hres)
RETURN:    1, if ok; 0 on error
PURPOSE:   Tests sres, lres, hres, mres with betti commands and conversions
           If optinal third argument is given, test only lres and hres
EXAMPLE:  example tst_test_res shows an example"
{
  int ret = 1;

  if (! homog(i))
  {
    ERROR("ERROR: input ideal needs to be homogenous ");
  }

  if (size(#) == 0)
  {
    resolution rs = sres(std(i), 0);
    resolution rm = mres(i,0);
  }

  resolution rh = hres(i,0);
  resolution rl = lres(i, 0);

  if (size(#) == 0)
  {
    intmat is = betti(rs);
    intmat im = betti(rm);
  }

  intmat ih = betti(rh);
  intmat il = betti(rl);

  if (size(ih) != size(il)){"ERROR: size(ih) != size(il)";return(0);}
  if (size(#) == 0)
  {
    if (size(ih) != size(is)){"ERROR: size(ih) != size(is)";return(0);}
    if (size(ih) != size(im)){"ERROR: size(ih) != size(im)";return(0);}
  }

  if (ih != il){"ERROR: ih != il";return(0);}
  if (size(#) == 0)
  {
    if (ih != is){"ERROR: ih != is";return(0);}
    if (ih != im){"ERROR: ih != im";return(0);}
  }

  if (size(#) == 0)
  {
    list ls = list(rs);
    list lm = list(rm);
  }
  list lh = list(rh);
  list ll = list(rl);

  if (size(#) == 0)
  {
    intmat is_1 = betti(ls);
    intmat im_1 = betti(lm);
  }
  intmat ih_1 = betti(lh);
  intmat il_1 = betti(ll);

  if (size(ih_1) != size(il_1)){"ERROR: size(ih_1) != size(il_1)";return(0);}
  if (size(#) == 0)
  {
    if (size(ih_1) != size(is_1)){"ERROR: size(ih_1) != size(is_1)";return(0);}
    if (size(ih_1) != size(im_1)){"ERROR: size(ih_1) != size(im_1)";return(0);}
  }

  if (ih_1 != il_1){"ERROR: ih_1 != il_1";return(0);}
  if (size(#) == 0)
  {
    if (ih_1 != is_1){"ERROR: ih_1 != is_1";return(0);}
    if (ih_1 != im_1){"ERROR: ih_1 != im_1";return(0);}
  }


  if (size(ih) != size(ih_1)) {"ERROR: size(ih) != size(ih_1)";return(0);}
  if (ih != ih_1) {"ERROR: ih != ih_1";return(0);}

  return (ret);
}
example
{
  "EXAMPLE: "; echo = 2;
  ring an=0,(w,x,y,z),(dp,C);
  ideal i=
    1w2xy+1w2xz+1w2yz+1wxyz+1x2yz+1xy2z+1xyz2,
    1w4x+1w4z+1w3yz+1w2xyz+1wx2yz+1x2y2z+1xy2z2,
    1w6+1w5z+1w4xz+1w3xyz+1w2xy2z+1wx2y2z+1x2y2z2;
  tst_test_res(i);
  kill an;
}

/////////////////////////////////////////////////////////////////////////////
proc tst_rgen_init_weights(int n)
{
  intvec v = 1..n;
  return (v);
}

proc tst_rgen_init_matrix(int n)
{
  intmat m[n][n];
  int i;
  // let us emulate lp
  for (i=1; i<= n; i++)
  {
    m[i,i] = 1;
  }
  return (m);
}

proc tst_rgen_generate_block(int n_vars, string simple_ordering, int extra_weights)
{
  string order = simple_ordering;
  if (extra_weights > n_vars)
  {
    extra_weights = n_vars;
  }

  if ((simple_ordering[1] == "W") || (simple_ordering[1] == "w"))
  {
    order = order + "(" + string(tst_rgen_init_weights(n_vars)) + ")";
  }
  else
  {
    if (simple_ordering[1] == "M")
    {
      order = order + "(" + string(tst_rgen_init_matrix(n_vars)) + ")";
    }
    else
    {
      order = order + "(" + string(n_vars) + ")";
    }
  }
  if (extra_weights >= 1)
  {
    order = "a(" + string(tst_rgen_init_weights(extra_weights)) + ")," + order;
  }
  return (order);
}

proc tst_rgen_generate_blocks(int n_vars, list simple_orderings, intvec extra_weights)
{
  int i;
  int j;
  list blocks;

  for (i=1; i<=size(simple_orderings); i++)
  {
    for (j=1; j<=size(extra_weights); j++)
    {
      blocks = blocks + list(tst_rgen_generate_block(n_vars, simple_orderings[i], extra_weights[j]));
    }
  }
  return (blocks);
}

proc tst_rgen_generate_product_orderings(int n_vars, list simple_orderings, intvec extra_weights, intvec products)
{
  list p_orderings;
  int i;
  int nn_vars, j, k,l;
  list nb_orderings;
  string n_ordering;

  for (i=1;i<=size(products);i++)
  {
    if (products[i] > 1 && products[i] <= n_vars)
    {
      nn_vars = n_vars / products[i];
      nb_orderings = tst_rgen_generate_blocks(nn_vars, simple_orderings, extra_weights);
      for (j=1; j<=size(nb_orderings); j++)
      {
        n_ordering = nb_orderings[j];
        for (k=2; k<=products[i]; k++)
        {
          l = (j + k - 1) %  size(nb_orderings);
          if (l == 0)
          {
            l = size(nb_orderings);
          }
          n_ordering = n_ordering + "," + nb_orderings[l];
        }
        if (products[i]*nn_vars < n_vars)
        {
          n_ordering = n_ordering + ", lp";
        }
        p_orderings = p_orderings + list(n_ordering);
      }
    }
    else
    {
      if (products[i] == 1)
      {
        p_orderings = p_orderings + tst_rgen_generate_blocks(n_vars, simple_orderings, extra_weights);
      }
    }
  }
  if (size(p_orderings) < 1)
  {
    p_orderings = tst_rgen_generate_blocks(n_vars, simple_orderings, extra_weights);
  }
  return (p_orderings);
}


proc tst_rgen_init()
{
  if (! defined(tst_rgen_charstrs))
  {
    list tst_rgen_charstrs;
    export(tst_rgen_charstrs);
    tst_rgen_charstrs = list("32003", "0");
  }
  if (! defined(tst_rgen_nvars))
  {
    intvec tst_rgen_nvars;
    export(tst_rgen_nvars);
    tst_rgen_nvars = 1..10;
  }
  if (! defined(tst_rgen_simple_orderings))
  {
    list tst_rgen_simple_orderings;
    export(tst_rgen_simple_orderings);
    tst_rgen_simple_orderings = list("lp", "dp", "Dp", "ls", "ds", "Ds", "wp","Wp","ws","Ws","M");
  }
  if (! defined(tst_rgen_comp_orderings))
  {
    list tst_rgen_comp_orderings;
    exportto(Top,tst_rgen_comp_orderings);
    tst_rgen_comp_orderings = list("", "C", "c", "CC", "cc");
  }
  if (! defined(tst_rgen_products))
  {
    intvec tst_rgen_products;
    export(tst_rgen_products);
    tst_rgen_products = 1..3;
  }
  if (! defined(tst_rgen_extra_weights))
  {
    intvec tst_rgen_extra_weights;
    export(tst_rgen_extra_weights);
    tst_rgen_extra_weights = 0..2;
  }

  if (! defined(tst_rgen_exp_bounds))
  {
    list tst_rgen_exp_bounds;
    export(tst_rgen_exp_bounds);
  }

  if (! defined(tst_rgen_char_index))
  {
    int tst_rgen_char_index, tst_rgen_var_index, tst_rgen_comp_index, tst_rgen_ordering_index, tst_rgen_exp_bounds_index;
    list tst_rgen_orderings;
    exportto(Top, tst_rgen_char_index);
    exportto(Top, tst_rgen_var_index);
    exportto(Top, tst_rgen_comp_index);
    exportto(Top, tst_rgen_ordering_index);
    exportto(Top, tst_rgen_orderings);
    exportto(Top, tst_rgen_exp_bounds_index);
  }
  tst_rgen_char_index = 1;
  tst_rgen_var_index = 1;
  tst_rgen_comp_index = 1;
  tst_rgen_ordering_index = 0;
  tst_rgen_exp_bounds_index = 1;
  tst_rgen_orderings = tst_rgen_generate_product_orderings(tst_rgen_nvars[1], tst_rgen_simple_orderings, tst_rgen_extra_weights, tst_rgen_products);
}

proc tst_next_ring()
{
  tst_rgen_ordering_index++;
  if (tst_rgen_ordering_index > size(tst_rgen_orderings))
  {
    tst_rgen_comp_index++;
    if (tst_rgen_comp_index > size(tst_rgen_comp_orderings))
    {
      tst_rgen_exp_bounds_index++;
      if (tst_rgen_exp_bounds_index > size(tst_rgen_exp_bounds))
      {
        tst_rgen_var_index++;
        if (tst_rgen_var_index > size(tst_rgen_nvars))
        {
          tst_rgen_char_index++;
          if (tst_rgen_char_index > size(tst_rgen_charstrs))
          {
            return ("");
          }
          tst_rgen_var_index = 1;
        }
        tst_rgen_exp_bounds_index = 1;
      }
      tst_rgen_comp_index = 1;
      tst_rgen_orderings =  tst_rgen_generate_product_orderings(tst_rgen_nvars[tst_rgen_var_index], tst_rgen_simple_orderings, tst_rgen_extra_weights, tst_rgen_products);
    }
    tst_rgen_ordering_index = 1;
  }

  if (tst_rgen_nvars[tst_rgen_var_index] <= 26)
  {
    string rs = "(" + tst_rgen_charstrs[tst_rgen_char_index] + "),(" + A_Z("a", tst_rgen_nvars[tst_rgen_var_index]) + "),(";
  }
  else
  {
    string rs = "(" + tst_rgen_charstrs[tst_rgen_char_index] + "),(x(1.." + string(tst_rgen_nvars[tst_rgen_var_index]) + ")),(";
  }

  if (tst_rgen_comp_orderings[tst_rgen_comp_index] == "CC")
  {
    rs = rs + "C," + tst_rgen_orderings[tst_rgen_ordering_index];
  }
  else
  {
    if (tst_rgen_comp_orderings[tst_rgen_comp_index] == "cc")
    {
      rs = rs + "c," + tst_rgen_orderings[tst_rgen_ordering_index];
    }
    else
    {
      if (tst_rgen_comp_orderings[tst_rgen_comp_index] == "C")
      {
        rs = rs + tst_rgen_orderings[tst_rgen_ordering_index] + ", C";
      }
      else
      {
        if (tst_rgen_comp_orderings[tst_rgen_comp_index] == "c")
        {
          rs = rs + tst_rgen_orderings[tst_rgen_ordering_index] + ",c";
        }
        else
        {
          rs = rs + tst_rgen_orderings[tst_rgen_ordering_index];
        }
      }
    }
  }
  if (size(tst_rgen_exp_bounds) > 0)
  {
    if (! defined(tst_rgen_Lring))
    {
      string tst_rgen_Lring;
      exportto(Top,tst_rgen_Lring);
    }
    tst_rgen_Lring = rs + ",L(" + string(tst_rgen_exp_bounds[tst_rgen_exp_bounds_index]) + "))";
    if (system("version") >= 1309)
    {
      rs = tst_rgen_Lring;
    }
    else
    {
      rs = rs + ")";
    }
  }
  else
  {
    rs = rs + ")";
  }

  return (rs);
}


proc tst_FullIdeal()
{
  ideal id, mid;
  int n_vars = nvars(basering);
  int i,j;
  for (i=1; i<=n_vars; i++)
  {
    mid = maxideal(i);
    id[i] = mid[1];
    for (j=2;j<=size(mid); j++)
    {
      id[i] = id[i] + mid[j];
    }
  }
  return (id);
}

proc tst_cyclic(int n)
{
  int i, j, k, l;
  ideal id;

  poly p, q;
  for (i=1; i<n; i++)
  {
    p = 0;
    k = 1;
    for (j=1; j<=n; j++)
    {
      q = var(j);
      k = j + 1;
        if (k > n)
        {
          k=1;
        }
      for (l=2; l <= i; l++)
      {
        q = q*var(k);
        k++;
        if (k > n)
        {
          k=1;
        }
      }
      p = p + q;
    }
    id[i] = p;
  }

  p = var(1);
  for (i=2;i<=n;i++)
  {
    p = p*var(i);
  }
  id[n] = p -1;
  return (id);
}

proc tst_hom_cyclic(int n)
{
  ideal i = tst_cyclic(n);
  i[n] = i[n] + 1 + var(n+1)^n;
  return (i);
}

proc tst_TestMult(ideal id, int how_often, int Module)
{
  int i, j, l, is, s;
  module m;
  def ret;
  poly p;
  if (Module > 0)
  {
    for (i=1; i<= size(id); i++)
    {
      m[i] = id[i] + gen(2)*id[i];
    }
    ret = m;
  }
  else
  {
    ret = id;
  }
  l = 0;
  for (i=1; i<= how_often; i++)
  {
    l++;
    if (l > size(id))
    {
      l = 1;
    }
    for (j=1;j<=size(id);j++)
    {
      ret[j] = ret[j]*id[l];
    }
  }
  for (i=1; i<=size(ret); i++)
  {
    is = size(ret[i]);
    s = s + is;
    string(i) + " : " + string(is) + " : " + string(lead(ret[i]));
  }
  "s : " + string(s);
}

proc tst_TestAdd(ideal id, int how_often, int Module)
{
  int i, j, k, l;
  module m;
  ideal idl = 1, maxideal(1);

  if (Module > 0)
  {
    for (i=1; i<= size(id); i++)
    {
      m[i] = id[i] + gen(2)*id[i];
    }
  }
  def r,p;
  if (Module > 0)
  {
    r = m;
  }
  else
  {
    r = id;
  }
  l = 0;
  for (j=1; j<= how_often; j++)
  {
    l++;
    if (l > size(idl))
    {
      l = 1;
    }
    for (k=1; k<=size(r); k++)
    {
      p = idl[l]*r[k];
      for (i=1; i<=k;i++)
      {
        p = p + r[i];
      }
      r[k] = p;
    }
  }
  int is, s;
  for (i=1; i<=size(r); i++)
  {
    is = size(r[i]);
    s = s + is;
    string(i) + " : " + string(is) + " : " + string(lead(r[i]));
  }
  "s : " + string(s);
}

proc tst_PrintStats(def id)
{
  int i, is, s;

  for (i=1; i<=size(id); i++)
  {
    is = size(id[i]);
    s = s + is;
    string(i) + " : " + string(is) + " : " + string(lead(id[i]));
  }
  "s : " + string(s);
}