source: git/Singular/LIB/tst.lib @ 7baf8c

// $Id: tst.lib,v 1.12 1998-09-01 12:03:13 obachman Exp $
//(obachman, last modified 6/30/98)
/////////////////////////////////////////////////////////////////////////////

version="$Id: tst.lib,v 1.12 1998-09-01 12:03:13 obachman Exp $";
info="
LIBRARY:  tst.lib      PROCEDURES FOR RUNNING AUTOMATIC TST TESTS


 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 to GetTstStatusFile()
 tst_groebnerTest(ideal i)  
                        tests groebner command 
 tst_stdEqual(ideal i1, ideal i2) 
                        test whether two std's are \"equal\"
";

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

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)
  {
      s = s[1, size(s) -1];
  }
  return (s);
}
example
{
  "EXAMPLE"; echo = 2;
  string s = tst_system("echo This is 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: Can not 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([any])
RETURN:   none; writes to stdout the current memory usage and used time
          since last call to tst_status(), if no argument is given, or, 
          since start-up of Singular, if an argument is given.
NOTE:     Should be used regularly within tst files to enable automatic 
          tracking of memory and time performance.
EXAMPLE: example tst_status; shows example
"
{
  if (! defined(tst_no_status))
  {
    if (! defined(tst_status_counter))
    {
      int tst_status_counter = 1;
      export tst_status_counter;
    }
    else
    {
      tst_status_counter++;
    }
  
    tst_status_out(tst_status_counter, "tst_memory_0", memory(0));
    tst_status_out(tst_status_counter, "tst_memory_1", memory(1));
    tst_status_out(tst_status_counter, "tst_memory_2", memory(2));
    if (size(#) > 0)
    {
      tst_status_out(tst_status_counter, "tst_timer_1", timer);
    }
    else
    {
      tst_status_out(tst_status_counter, "tst_timer", timer - Get_tst_timer());
      Set_tst_timer(timer);
    }
    string(tst_status_counter) + " >> " + GetTstStatusFile();
  }
}
example
{
  "EXAMPLE";  echo = 2;
  tst_status();
  ring r;
  poly p = (x+y+z)^40;
  tst_status();
  tst_status(1);
}

  
proc tst_init()
"USAGE:   tst_init()
RETURN:  none; writes some identification data to stdout;
         should be called as first routine in a tst file
EXAMPLE: example tst_init; shows example
"
{
  if (! defined(tst_no_status))
  {
    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   :" + system("--ticks-per-sec"));
    "init >> " + GetTstStatusFile();
  }
}
example
{
  "EXAMPLE";  echo = 2;
  tst_init();
}

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

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 poly 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]));
  }
}