changeset 1086:75fc98220389

[project @ 1995-01-31 04:17:15 by jwe]
author jwe
date Tue, 31 Jan 1995 04:17:15 +0000
parents 9f51d8b235ab
children 85731fac3a15
files src/colloc.cc src/fft.cc src/fft2.cc src/file-io.cc src/ifft.cc src/ifft2.cc src/npsol.cc src/pr-output.cc src/pt-plot.cc src/qpsol.cc src/rand.cc src/sysdep.cc src/tc-rep-ass.cc src/tc-rep-idx.cc src/tc-rep.cc src/user-prefs.cc src/utils.cc
diffstat 17 files changed, 313 insertions(+), 77 deletions(-) [+]
line wrap: on
line diff
--- a/src/colloc.cc
+++ b/src/colloc.cc
@@ -57,6 +57,12 @@
   if (error_state)
     return retval;
 
+  if (xisnan (tmp))
+    {
+      error ("colloc: NaN is invalid as NCOL");
+      return retval;
+    }
+
   int ncol = NINT (tmp);
   if (ncol < 0)
     {
--- a/src/fft.cc
+++ b/src/fft.cc
@@ -58,7 +58,13 @@
     n_points = arg.columns ();
 
   if (nargin == 2)
-    n_points = NINT (args(1).double_value ());
+    {
+      double dval = args(1).double_value ();
+      if (xisnan (dval))
+	error ("fft: NaN is invalid as the N_POINTS");
+      else
+	n_points = NINT (dval);
+    }
 
   if (error_state)
     return retval;
--- a/src/fft2.cc
+++ b/src/fft2.cc
@@ -57,14 +57,26 @@
 
   int n_rows = arg.rows ();
   if (nargin > 1)
-    n_rows = NINT (args(1).double_value ());
+    {
+      double dval = args(1).double_value ();
+      if (xisnan (dval))
+	error ("fft2: NaN is invalid as N_ROWS");
+      else
+	n_rows = NINT (dval);
+    }
 
   if (error_state)
     return retval;
 
   int n_cols = arg.columns ();
   if (nargin > 2)
-    n_cols = NINT (args(2).double_value ());
+    {
+      double dval = args(2).double_value ();
+      if (xisnan (dval))
+	error ("fft2: NaN is invalid as N_COLS");
+      else
+	n_cols = NINT (dval);
+    }
 
   if (error_state)
     return retval;
--- a/src/file-io.cc
+++ b/src/file-io.cc
@@ -165,7 +165,7 @@
 
       if (! error_state)
 	{
-	  if ((double) NINT (file_num) != file_num)
+	  if (D_NINT (file_num) != file_num)
 	    error ("file number not an integer value");
 	  else
 	    {
@@ -398,6 +398,12 @@
   if (error_state)
     return retval;
 
+  if (xisnan (dlen))
+    {
+      error ("fgets: NaN invalid as length");
+      return retval;
+    }
+
   int length = NINT (dlen);
 
   if ((double) length != dlen)
@@ -620,6 +626,12 @@
   if (error_state)
     return retval;
 
+  if (xisnan (doff))
+    {
+      error ("fseek: NaN invalid as offset");
+      return retval;
+    }
+
   long offset = NINT (doff);
 
   if ((double) offset != doff)
@@ -635,6 +647,12 @@
       if (error_state)
 	return retval;
 
+      if (xisnan (dorig))
+	{
+	  error ("fseek: NaN invalid as origin");
+	  return retval;
+	}
+
       origin = NINT (dorig);
 
       if ((double) dorig != origin)
@@ -774,7 +792,7 @@
 
       double tmp_len = args(fmt_arg_count++).double_value ();
 
-      if (error_state)
+      if (error_state || xisnan (tmp_len))
 	{
 	  error ("%s: `*' must be replaced by an integer", type);
 	  return -1;
@@ -815,7 +833,7 @@
 
       double tmp_len = args(fmt_arg_count++).double_value ();
 
-      if (error_state)
+      if (error_state || xisnan (tmp_len))
 	{
 	  error ("%s: `*' must be replaced by an integer", type);
 	  return -1;
@@ -858,9 +876,12 @@
       {
 	double d = args(fmt_arg_count++).double_value ();
 
+	if (error_state || xisnan (d))
+	  goto invalid_conversion;
+
 	int val = NINT (d);
 
-	if (error_state || (double) val != d)
+	if ((double) val != d)
 	  goto invalid_conversion;
 	else
 	  {
@@ -1618,24 +1639,53 @@
 
       if (xisinf (dnr))
 	{
-	  nc = NINT (dnc);
-	  int n = num_items_remaining (fptr, prec);
-	  nr = n / nc;
-	  if (n > nr * nc)
-	    nr++;
+	  if (xisnan (dnc))
+	    {
+	      error ("fread: NaN invalid as the number of columns");
+	      return retval;
+	    }
+	  else
+	    {
+	      nc = NINT (dnc);
+	      int n = num_items_remaining (fptr, prec);
+	      nr = n / nc;
+	      if (n > nr * nc)
+		nr++;
+	    }
 	}
       else if (xisinf (dnc))
 	{
-	  nr = NINT (dnr);
-	  int n = num_items_remaining (fptr, prec);
-	  nc = n / nr;
-	  if (n > nc * nr)
-	    nc++;
+	  if (xisnan (dnr))
+	    {
+	      error ("fread: NaN invalid as the number of rows");
+	      return retval;
+	    }
+	  else
+	    {
+	      nr = NINT (dnr);
+	      int n = num_items_remaining (fptr, prec);
+	      nc = n / nr;
+	      if (n > nc * nr)
+		nc++;
+	    }
 	}
       else
 	{
-	  nr = NINT (dnr);
-	  nc = NINT (dnc);
+	  if (xisnan (dnr))
+	    {
+	      error ("fread: NaN invalid as the number of rows");
+	      return retval;
+	    }
+	  else
+	    nr = NINT (dnr);
+
+	  if (xisnan (dnc))
+	    {
+	      error ("fread: NaN invalid as the number of columns");
+	      return retval;
+	    }
+	  else
+	    nc = NINT (dnc);
 	}
     }
   else
--- a/src/ifft.cc
+++ b/src/ifft.cc
@@ -58,7 +58,13 @@
     n_points = arg.columns ();
 
   if (nargin == 2)
-    n_points = NINT (args(1).double_value ());
+    {
+      double dval = args(1).double_value ();
+      if (xisnan (dval))
+	error ("fft: NaN is invalid as the N_POINTS");
+      else
+	n_points = NINT (dval);
+    }
 
   if (error_state)
     return retval;
--- a/src/ifft2.cc
+++ b/src/ifft2.cc
@@ -57,14 +57,26 @@
 
   int n_rows = arg.rows ();
   if (nargin > 1)
-    n_rows = NINT (args(1).double_value ());
+    {
+      double dval = args(1).double_value ();
+      if (xisnan (dval))
+	error ("fft2: NaN is invalid as N_ROWS");
+      else
+	n_rows = NINT (dval);
+    }
 
   if (error_state)
     return retval;
 
   int n_cols = arg.columns ();
   if (nargin > 2)
-    n_cols = NINT (args(2).double_value ());
+    {
+      double dval = args(2).double_value ();
+      if (xisnan (dval))
+	error ("fft2: NaN is invalid as N_COLS");
+      else
+	n_cols = NINT (dval);
+    }
 
   if (error_state)
     return retval;
--- a/src/npsol.cc
+++ b/src/npsol.cc
@@ -729,8 +729,15 @@
 	  if (list->d_set_fcn)
 	    (npsol_opts.*list->d_set_fcn) (val);
 	  else
-	    (npsol_opts.*list->i_set_fcn) (NINT (val));
-
+	    {
+	      if (xisnan (val))
+		{
+		  error ("npsol_options: %s: expecting integer, found NaN",
+			 keyword);
+		}
+	      else
+		(npsol_opts.*list->i_set_fcn) (NINT (val));
+	    }
 	  return;
 	}
       list++;
--- a/src/pr-output.cc
+++ b/src/pr-output.cc
@@ -667,7 +667,8 @@
   double b = r.base ();
   double i = r.inc ();
 
-  return ((double) NINT (b) == b && (double) NINT (i) == i);
+  return (! (xisnan (b) || xisnan (i))
+	  && (double) NINT (b) == b && (double) NINT (i) == i);
 }
 
 static inline void
--- a/src/pt-plot.cc
+++ b/src/pt-plot.cc
@@ -563,7 +563,14 @@
 	      if (error_state)
 		return -1;
 
+	      if (xisnan (val_tmp))
+		{
+		  ::error ("NaN is invalid as a column specifier");
+		  return -1;
+		}
+
 	      int n = NINT (val_tmp);
+
 	      if (n < 1 || n_max > 0 && n > n_max)
 		{
 		  ::error ("using: column %d out of range", n); 
@@ -682,7 +689,13 @@
 	  if (! error_state && tmp.is_defined ())
 	    {
 	      double val = tmp.double_value ();
-	      plot_buf << " " << NINT (val);
+	      if (xisnan (val))
+		{
+		  ::error ("NaN is invalid a plotting line style");
+		  return -1;
+		}
+	      else
+		plot_buf << " " << NINT (val);
 	    }
 	  else
 	    {
@@ -697,7 +710,13 @@
 	  if (! error_state && tmp.is_defined ())
 	    {
 	      double val = tmp.double_value ();
-	      plot_buf << " " << NINT (val);
+	      if (xisnan (val))
+		{
+		  ::error ("NaN is invalid a plotting point style");
+		  return -1;
+		}
+	      else
+		plot_buf << " " << NINT (val);
 	    }
 	  else
 	    {
--- a/src/qpsol.cc
+++ b/src/qpsol.cc
@@ -339,8 +339,15 @@
 	  if (list->d_set_fcn)
 	    (qpsol_opts.*list->d_set_fcn) (val);
 	  else
-	    (qpsol_opts.*list->i_set_fcn) (NINT (val));
-
+	    {
+	      if (xisnan (val))
+		{
+		  error ("qpsol_options: %s: expecting integer, found NaN",
+			 keyword);
+		}
+	      else
+		(qpsol_opts.*list->i_set_fcn) (NINT (val));
+	    }
 	  return;
 	}
       list++;
--- a/src/rand.cc
+++ b/src/rand.cc
@@ -185,22 +185,31 @@
 	}
       else if (tmp.is_scalar_type ())
 	{
-	  m = n = NINT (tmp.double_value ());
+	  double dval = tmp.double_value ();
 
-	  if (! error_state)
-	    goto gen_matrix;
+	  if (xisnan (dval))
+	    {
+	      error ("rand: NaN is invalid a matrix dimension");
+	    }
+	  else
+	    {
+	      m = n = NINT (tmp.double_value ());
+
+	      if (! error_state)
+		goto gen_matrix;
+	    }
 	}
       else if (tmp.is_range ())
 	{
 	  Range r = tmp.range_value ();
 	  n = 1;
-	  m = NINT (r.nelem ());
+	  m = r.nelem ();
 	  goto gen_matrix;
 	}
       else if (tmp.is_matrix_type ())
 	{
-	  n = NINT (args(0).rows ());
-	  m = NINT (args(0).columns ());
+	  n = args(0).rows ();
+	  m = args(0).columns ();
 	  goto gen_matrix;
 	}
       else
@@ -221,14 +230,23 @@
 	}
       else
 	{
-	  n = NINT (args(0).double_value ());
+	  double dval = args(0).double_value ();
 
-	  if (! error_state)
+	  if (xisnan (dval))
 	    {
-	      m = NINT (args(1).double_value ());
+	      error ("rand: NaN is invalid as a matrix dimension");
+	    }
+	  else
+	    {
+	      n = NINT (dval);
 
 	      if (! error_state)
-		goto gen_matrix;
+		{
+		  m = NINT (args(1).double_value ());
+
+		  if (! error_state)
+		    goto gen_matrix;
+		}
 	    }
 	}
     }
--- a/src/sysdep.cc
+++ b/src/sysdep.cc
@@ -455,9 +455,14 @@
 
 	    if (! error_state)
 	      {
-		int delay = NINT (dval);
-		if (delay > 0)
-		  sleep (delay);
+		if (xisnan (dval))
+		  warning ("pause: NaN is an invalid delay");
+		else
+		  {
+		    int delay = NINT (dval);
+		    if (delay > 0)
+		      sleep (delay);
+		  }
 	      }
 	  }
 	  break;
--- a/src/tc-rep-ass.cc
+++ b/src/tc-rep-ass.cc
@@ -357,7 +357,15 @@
     case complex_scalar_constant:
     case scalar_constant:
       {
-	int i = NINT (tmp_i.double_value ());
+	double dval = tmp_i.double_value ();
+
+	if (xisnan (dval))
+	  {
+	    error ("NaN is invalid as a matrix index");
+	    return;
+	  }
+
+	int i = NINT (dval);
 	int idx = i - 1;
 
 	if (rhs_nr == 0 && rhs_nc == 0)
--- a/src/tc-rep-idx.cc
+++ b/src/tc-rep-idx.cc
@@ -164,12 +164,26 @@
 		    return retval;
 		  }
 	      }
-	    else if (arg.const_type () == magic_colon
-		     || (arg.is_scalar_type ()
-			 && NINT (arg.double_value ()) == 1))
+	    else if (arg.const_type () == magic_colon)
 	      {
 		cols = 1;
 	      }
+	    else if (arg.is_scalar_type ())
+	      {
+		double dval = arg.double_value ();
+		if (! xisnan (dval))
+		  {
+		    int ival = NINT (dval);
+		    if (ival == 1)
+		      cols = 1;
+		    else if (ival == 0)
+		      cols = 0;
+		    else
+		      break;;
+		  }
+		else
+		  break;
+	      }
 	    else
 	      break;
 	  }
@@ -198,16 +212,26 @@
 		    return retval;
 		  }
 	      }
-	    else if (arg.const_type () == magic_colon
-		     || (arg.is_scalar_type ()
-			 && NINT (arg.double_value ()) == 1))
+	    else if (arg.const_type () == magic_colon)
 	      {
 		rows = 1;
 	      }
-	    else if (arg.is_scalar_type ()
-		     && NINT (arg.double_value ()) == 0)
+	    else if (arg.is_scalar_type ())
 	      {
-		return Matrix ();
+		double dval = arg.double_value ();
+
+		if (! xisnan (dval))
+		  {
+		    int ival = NINT (dval);
+		    if (ival == 1)
+		      rows = 1;
+		    else if (ival == 0)
+		      rows = 0;
+		    else
+		      break;
+		  }
+		else
+		  break;
 	      }
 	    else
 	      break;
@@ -441,14 +465,24 @@
     case complex_scalar_constant:
     case scalar_constant:
       {
-	int i = NINT (tmp_i.double_value ());
-	int ii = fortran_row (i, nr) - 1;
-	int jj = fortran_column (i, nr) - 1;
-	if (index_check (i-1, "") < 0)
-	  return tree_constant ();
-	if (range_max_check (i-1, nr * nc) < 0)
-	  return tree_constant ();
-	retval = do_matrix_index (ii, jj);
+	double dval = tmp_i.double_value ();
+
+	if (xisnan (dval))
+	  {
+	    ::error ("NaN is invalid as a matrix index");
+	    return tree_constant ();
+	  }
+	else
+	  {
+	    int i = NINT (dval);
+	    int ii = fortran_row (i, nr) - 1;
+	    int jj = fortran_column (i, nr) - 1;
+	    if (index_check (i-1, "") < 0)
+	      return tree_constant ();
+	    if (range_max_check (i-1, nr * nc) < 0)
+	      return tree_constant ();
+	    retval = do_matrix_index (ii, jj);
+	  }
       }
       break;
 
--- a/src/tc-rep.cc
+++ b/src/tc-rep.cc
@@ -646,19 +646,28 @@
 TC_REP::valid_as_scalar_index (void) const
 {
   return (type_tag == magic_colon
-	  || (type_tag == scalar_constant && NINT (scalar) == 1)
+	  || (type_tag == scalar_constant 
+	      && ! xisnan (scalar)
+	      && NINT (scalar) == 1)
 	  || (type_tag == range_constant
-	      && range->nelem () == 1 && NINT (range->base ()) == 1));
+	      && range->nelem () == 1
+	      && ! xisnan (range->base ())
+	      && NINT (range->base ()) == 1));
 }
 
 int
 TC_REP::valid_as_zero_index (void) const
 {
-  return ((type_tag == scalar_constant  && NINT (scalar) == 0)
+  return ((type_tag == scalar_constant
+	   && ! xisnan (scalar)
+	   && NINT (scalar) == 0)
 	  || (type_tag == matrix_constant
-	      && matrix->rows () == 0 && matrix->columns () == 0)
+	      && matrix->rows () == 0
+	      && matrix->columns () == 0)
 	  || (type_tag == range_constant
-	      && range->nelem () == 1 && NINT (range->base ()) == 0));
+	      && range->nelem () == 1
+	      && ! xisnan (range->base ())
+	      && NINT (range->base ()) == 0));
 }
 
 int
@@ -1156,12 +1165,21 @@
     case scalar_constant:
       {
 	double d = double_value ();
-	int i = NINT (d);
+
+	if (xisnan (d))
+	  {
+	    ::error ("invalid conversion from NaN to character");
+	    return retval;
+	  }
+	else
+	  {
+	    int i = NINT (d);
 // Warn about out of range conversions?
-	char s[2];
-	s[0] = (char) i;
-	s[1] = '\0';
-	retval = tree_constant (s);
+	    char s[2];
+	    s[0] = (char) i;
+	    s[1] = '\0';
+	    retval = tree_constant (s);
+	  }
       }
       break;
 
@@ -1189,9 +1207,19 @@
 		for (int i = 0; i < len; i++)
 		  {
 		    double d = v.elem (i);
-		    int ival = NINT (d);
+
+		    if (xisnan (d))
+		      {
+			::error ("invalid conversion from NaN to character");
+			delete [] s;
+			return retval;
+		      }
+		    else
+		      {
+			int ival = NINT (d);
 // Warn about out of range conversions?
-		    s[i] = (char) ival;
+			s[i] = (char) ival;
+		      }
 		  }
 		retval = tree_constant (s);
 		delete [] s;
@@ -1211,9 +1239,19 @@
 	for (int i = 0; i < nel; i++)
 	  {
 	    double d = b + i * incr;
-	    int ival = NINT (d);
+
+	    if (xisnan (d))
+	      {
+		::error ("invalid conversion from NaN to character");
+		delete [] s;
+		return retval;
+	      }
+	    else
+	      {
+		int ival = NINT (d);
 // Warn about out of range conversions?
-	    s[i] = (char) ival;
+		s[i] = (char) ival;
+	      }
 	  }
 	retval = tree_constant (s);
 	delete [] s;
--- a/src/user-prefs.cc
+++ b/src/user-prefs.cc
@@ -28,6 +28,7 @@
 #include <string.h>
 
 #include "user-prefs.h"
+#include "mappers.h"
 #include "error.h"
 #include "variables.h"
 #include "utils.h"
@@ -483,7 +484,8 @@
   static int kludge = 0;
 
   double val;
-  if (builtin_real_scalar_variable ("output_max_field_width", val) == 0)
+  if (builtin_real_scalar_variable ("output_max_field_width", val) == 0
+      && ! xisnan (val))
     {
       int ival = NINT (val);
       if (ival > 0 && (double) ival == val)
@@ -512,7 +514,8 @@
   static int kludge = 0;
 
   double val;
-  if (builtin_real_scalar_variable ("output_precision", val) == 0)
+  if (builtin_real_scalar_variable ("output_precision", val) == 0
+      && ! xisnan (val))
     {
       int ival = NINT (val);
       if (ival >= 0 && (double) ival == val)
@@ -541,7 +544,8 @@
   static int kludge = 0;
 
   double val;
-  if (builtin_real_scalar_variable ("save_precision", val) == 0)
+  if (builtin_real_scalar_variable ("save_precision", val) == 0
+      && ! xisnan (val))
     {
       int ival = NINT (val);
       if (ival >= 0 && (double) ival == val)
--- a/src/utils.cc
+++ b/src/utils.cc
@@ -501,6 +501,9 @@
   return retval;
 }
 
+// Convert X to the nearest integer value.  Should not pass NaN to
+// this function.
+
 int
 NINT (double x)
 {