changeset 5955:fc46f9c99028

[project @ 2006-08-22 18:37:43 by jwe]
author jwe
date Tue, 22 Aug 2006 18:37:43 +0000
parents 250e062c3393
children cdef72fcd206
files liboctave/ChangeLog liboctave/mx-inlines.cc scripts/ChangeLog scripts/pkg/pkg.m test/test_arith.m
diffstat 5 files changed, 188 insertions(+), 117 deletions(-) [+]
line wrap: on
line diff
--- a/liboctave/ChangeLog
+++ b/liboctave/ChangeLog
@@ -1,3 +1,10 @@
+2006-08-22  John W. Eaton  <jwe@octave.org>
+
+	* mx-inlines.cc (MX_ND_CUMULATIVE_OP): Correctly detect empty arrays.
+	If array is empty, return value is same size as array.
+	(MX_ND_REDUCTION): Correctly detect empty arrays.
+	If array is empty, produce correctly sized return value.
+
 2006-08-18  John W. Eaton  <jwe@octave.org>
 
 	* dMatrix.cc (Matrix::any_element_not_one_or_zero): New function.
--- a/liboctave/mx-inlines.cc
+++ b/liboctave/mx-inlines.cc
@@ -372,24 +372,17 @@
   dim_vector dv = this->dims (); \
   int nd = this->ndims (); \
  \
-  int empty = true; \
+  int empty = false; \
  \
   for (int i = 0; i < nd; i++) \
     { \
-      if (dv(i) > 0) \
+      if (dv(i) == 0) \
         { \
-          empty = false; \
+          empty = true; \
           break; \
         } \
     } \
  \
-  if (empty) \
-    { \
-      dim_vector retval_dv (1, 1); \
-      retval.resize (retval_dv, INIT_VAL); \
-      return retval; \
-    } \
- \
   /* We need to find first non-singleton dim.  */ \
  \
   if (dim == -1) \
@@ -435,36 +428,39 @@
  \
   retval.resize (dv, INIT_VAL); \
  \
-  octave_idx_type nel = dv.numel (); \
- \
-  octave_idx_type k = 1; \
- \
-  for (octave_idx_type result_idx = 0; result_idx < nel; result_idx++) \
+  if (! empty) \
     { \
-      OCTAVE_QUIT; \
+      octave_idx_type nel = dv.numel (); \
  \
-      for (octave_idx_type j = 0; j < n_elts; j++) \
+      octave_idx_type k = 1; \
+ \
+      for (octave_idx_type result_idx = 0; result_idx < nel; result_idx++) \
 	{ \
-          OCTAVE_QUIT; \
+	  OCTAVE_QUIT; \
  \
-	  EVAL_EXPR; \
+          for (octave_idx_type j = 0; j < n_elts; j++) \
+	    { \
+              OCTAVE_QUIT; \
+ \
+	      EVAL_EXPR; \
  \
-	  iter_idx += incr; \
-	} \
+	      iter_idx += incr; \
+	    } \
  \
-      if (k == reset_at) \
-        { \
-	  base = next_base; \
-	  next_base += base_incr; \
-	  iter_idx = base; \
-	  k = 1; \
-        } \
-      else \
-	{ \
-	  base++; \
-	  iter_idx = base; \
-	  k++; \
-         } \
+          if (k == reset_at) \
+	    { \
+	      base = next_base; \
+	      next_base += base_incr; \
+	      iter_idx = base; \
+	      k = 1; \
+	    } \
+	  else \
+	    { \
+	      base++; \
+	      iter_idx = base; \
+	      k++; \
+	     } \
+	} \
     } \
  \
   retval.chop_trailing_singletons (); \
@@ -487,24 +483,17 @@
   dim_vector dv = this->dims (); \
   int nd = this->ndims (); \
  \
-  int empty = true; \
+  bool empty = false; \
  \
   for (int i = 0; i < nd; i++) \
     { \
-      if (dv(i) > 0) \
+      if (dv(i) == 0) \
         { \
-          empty = false; \
+          empty = true; \
           break; \
         } \
     } \
  \
-  if (empty) \
-    { \
-      dim_vector retval_dv (1, 1); \
-      retval.resize (retval_dv, INIT_VAL); \
-      return retval; \
-    } \
- \
   /* We need to find first non-singleton dim.  */ \
  \
   if (dim == -1) \
@@ -548,47 +537,50 @@
  \
   retval.resize (dv, INIT_VAL); \
  \
-  octave_idx_type nel = dv.numel () / n_elts; \
+  if (! empty) \
+    { \
+      octave_idx_type nel = dv.numel () / n_elts; \
  \
-  octave_idx_type k = 1; \
+      octave_idx_type k = 1; \
  \
-  for (octave_idx_type i = 0; i < nel; i++) \
-    { \
-      OCTAVE_QUIT; \
+      for (octave_idx_type i = 0; i < nel; i++) \
+	{ \
+	  OCTAVE_QUIT; \
+ \
+          ACC_TYPE prev_val = INIT_VAL; \
+ \
+	  for (octave_idx_type j = 0; j < n_elts; j++) \
+	    { \
+	      OCTAVE_QUIT; \
  \
-      ACC_TYPE prev_val = INIT_VAL; \
+	      if (j == 0) \
+		{ \
+		  retval(iter_idx) = elem (iter_idx); \
+		  prev_val = retval(iter_idx); \
+		} \
+	      else \
+		{ \
+		  prev_val = prev_val OP elem (iter_idx); \
+		  retval(iter_idx) = prev_val; \
+		} \
  \
-      for (octave_idx_type j = 0; j < n_elts; j++) \
-	{ \
-          OCTAVE_QUIT; \
+	      iter_idx += incr; \
+	    } \
  \
-	  if (j == 0) \
+	  if (k == reset_at) \
 	    { \
-	      retval(iter_idx) = elem (iter_idx); \
-	      prev_val = retval(iter_idx); \
+	      base = next_base; \
+	      next_base += base_incr; \
+	      iter_idx = base; \
+	      k = 1; \
 	    } \
 	  else \
 	    { \
-	      prev_val = prev_val OP elem (iter_idx); \
-	      retval(iter_idx) = prev_val; \
-	    } \
- \
-	  iter_idx += incr; \
+	      base++; \
+	      iter_idx = base; \
+	      k++; \
+	     } \
 	} \
- \
-      if (k == reset_at) \
-        { \
-	  base = next_base; \
-	  next_base += base_incr; \
-	  iter_idx = base; \
-	  k = 1; \
-        } \
-      else \
-	{ \
-	  base++; \
-	  iter_idx = base; \
-	  k++; \
-         } \
     } \
  \
   retval.chop_trailing_singletons (); \
--- a/scripts/ChangeLog
+++ b/scripts/ChangeLog
@@ -1,3 +1,10 @@
+2006-08-22  David Bateman  <dbateman@free.fr>
+
+	* pkg/pkg.m (extract_pkgadd, create_pkgadd): New functions to 
+	Search inst/*.m and src/*.m files in the package for
+	PKG_ADD directives and append user supplied PKG_ADD.
+	(pkg): Call create_pkgadd after copying files.
+
 2006-08-21  Søren Hauberg  <soren@hauberg.org>
 
 	* pkg/pkg.m: Handle multiple packages in a single file.
--- a/scripts/pkg/pkg.m
+++ b/scripts/pkg/pkg.m
@@ -252,6 +252,7 @@
             desc = descriptions{i};
             pdir = packdirs{i};
             copy_files(desc, pdir);
+	    create_pkgadd(desc, pdir);
             finish_installation (desc, pdir)
         endfor
     catch
@@ -498,6 +499,61 @@
     endif
 endfunction
 
+function pkgadd = extract_pkgadd (nm, pat)
+  fid = fopen (nm, "rt");
+  pkgadd = "";
+  if (fid >= 0)
+    while (! feof(fid))
+      ln = fgetl (fid);
+      if (ln > 0)
+	t = regexp(ln, pat, "tokens","dotexceptnewline");
+	if (!isempty(t))
+          pkgadd = [pkgadd, "\n", t{1}{1}];
+	endif
+      endif
+    endwhile
+    if (!isempty(pkgadd))
+      pkgadd = [pkgadd, "\n"];
+    endif
+    fclose (fid);
+  endif
+endfunction
+
+function create_pkgadd (desc, packdir)
+  pkgadd = [desc.dir "/PKG_ADD"];
+  fid = fopen(pkgadd, "wt");
+  if (fid >= 0)
+    ## Search all dot-m files for PKG_ADD commands
+    lst = dir ([packdir "inst/*.m"]);
+    for i=1:length(lst)
+      nm = lst(i).name;
+      fwrite (fid, extract_pkgadd (nm, '^[#%][#%]* *PKG_ADD: *(.*)$'));
+    endfor
+
+    ## Search all C++ source files for PKG_ADD commands
+    lst = dir ([packdir "src/*.cc"]);
+    for i=1:length(lst)
+      nm = lst(i).name;
+      fwrite (fid, extract_pkgadd (nm, '^//* *PKG_ADD: *(.*)$'));
+      fwrite (fid, extract_pkgadd (nm, '^/\** *PKG_ADD: *(.*) *\*/$'));
+    endfor
+
+    ## Add developer included PKG_ADD commands
+    if (exist([packdir "PKG_ADD"],"file"))
+      fid2 = fopen([packdir "PKG_ADD"],"rt");
+      if (fid2 >= 0)
+        while (! feof(fid2))
+          ln = fgets (fid2);
+          if (ln > 0)
+            fwrite(fid, ln);
+          endif
+        endwhile
+      endif
+    endif
+    fclose(fid);
+  endif
+endfunction
+
 function copy_files (desc, packdir)
     ## Copy the files from "inst" to installdir
     [status, output] = system(["cp -R " packdir "inst/* " desc.dir]);
--- a/test/test_arith.m
+++ b/test/test_arith.m
@@ -143,7 +143,8 @@
 %! fail("lcm (s)");
 
 %% test/octave.test/arith/max-1.m
-%!assert(max ([1, 4, 2, 3]) == 4 && max ([1; -10; 5; -2]) == 5);
+%!assert (max ([1, 4, 2, 3]) == 4);
+%!assert (max ([1; -10; 5; -2]) == 5);
 
 %% test/octave.test/arith/max-2.m
 %!assert(all (max ([4, i 4.999; -2, 2, 3+4i]) == [4, 2, 3+4i]));
@@ -155,7 +156,8 @@
 %!error <Invalid call to max.*> max (1, 2, 3, 4);
 
 %% test/octave.test/arith/min-1.m
-%!assert(min ([1, 4, 2, 3]) == 1 && min ([1; -10; 5; -2]) == -10);
+%!assert (min ([1, 4, 2, 3]) == 1);
+%!assert (min ([1; -10; 5; -2]) == -10);
 
 %% test/octave.test/arith/min-2.m
 %!assert(all (min ([4, i; -2, 2]) == [-2, i]));
@@ -700,24 +702,29 @@
 %!error <Invalid call to sum.*> sum ();
 
 %% test/octave.test/arith/sum-4.m
-%!assert((all (sum ([1, 2; 3, 4], 1) == [4, 6])
-%! && all (sum ([1, 2; 3, 4], 2) == [3; 7])
-%! && sum (zeros (1, 0)) == 0
-%! && all (size (sum (zeros (1, 0), 1)) == [1, 0])
-%! && sum (zeros (1, 0), 2) == 0
-%! && sum (zeros (0, 1)) == 0
-%! && sum (zeros (0, 1), 1) == 0
-%! && all (size (sum (zeros (0, 1), 2)) == [0, 1])
-%! && all (size (sum (zeros (2, 0))) == [1, 0])
-%! && all (size (sum (zeros (2, 0), 1)) == [1, 0])
-%! && all (sum (zeros (2, 0), 2) == [0; 0])
-%! && all (sum (zeros (0, 2)) == [0, 0])
-%! && all (sum (zeros (0, 2), 1) == [0, 0])
-%! && all (size (sum (zeros (0, 2), 2)) == [0, 1])));
+%!assert (all (sum ([1, 2; 3, 4], 1) == [4, 6]));
+%!assert (all (sum ([1, 2; 3, 4], 2) == [3; 7]));
+%!assert (sum (zeros (1, 0)) == 0);
+%!assert (all (size (sum (zeros (1, 0), 1)) == [1, 0]));
+%!assert (sum (zeros (1, 0), 2) == 0);
+%!assert (sum (zeros (0, 1)) == 0);
+%!assert (sum (zeros (0, 1), 1) == 0);
+%!assert (all (size (sum (zeros (0, 1), 2)) == [0, 1]));
+%!assert (all (size (sum (zeros (2, 0))) == [1, 0]));
+%!assert (all (size (sum (zeros (2, 0), 1)) == [1, 0]));
+%!assert (all (sum (zeros (2, 0), 2) == [0; 0]));
+%!assert (all (sum (zeros (0, 2)) == [0, 0]));
+%!assert (all (sum (zeros (0, 2), 1) == [0, 0]));
+%!assert (all (size (sum (zeros (0, 2), 2)) == [0, 1]));
+%!assert (all (size (sum (zeros (2, 2, 0, 3))) == [1, 2, 0, 3]));
+%!assert (all (size (sum (zeros (2, 2, 0, 3), 2)) == [2, 1, 0, 3]));
+%!assert (all (size (sum (zeros (2, 2, 0, 3), 3)) == [2, 2, 1, 3]));
+%!assert (all (size (sum (zeros (2, 2, 0, 3), 4)) == [2, 2, 0]));
+%!assert (all (size (sum (zeros (2, 2, 0, 3), 7)) == [2, 2, 0, 3]));
 
 %% test/octave.test/arith/prod-1.m
-%!assert((prod ([1, 2, 3]) == 6 && prod ([-1; -2; -3]) == -6
-%! && prod ([i, 2+i, -3+2i, 4]) == -4-32i));
+%!assert (prod ([1, 2, 3]) == 6 && prod ([-1; -2; -3]) == -6);
+%!assert (prod ([i, 2+i, -3+2i, 4]) == -4-32i);
 
 %% test/octave.test/arith/prod-2.m
 %!assert(all (all (prod ([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i])
@@ -727,24 +734,25 @@
 %!error <Invalid call to prod.*> prod ();
 
 %% test/octave.test/arith/prod-4.m
-%!assert((all (prod ([1, 2; 3, 4], 1) == [3, 8])
-%! && all (prod ([1, 2; 3, 4], 2) == [2; 12])
-%! && prod (zeros (1, 0)) == 1
-%! && all (size (prod (zeros (1, 0), 1)) == [1, 0])
-%! && prod (zeros (1, 0), 2) == 1
-%! && prod (zeros (0, 1)) == 1
-%! && prod (zeros (0, 1), 1) == 1
-%! && all (size (prod (zeros (0, 1), 2)) == [0, 1])
-%! && all (size (prod (zeros (2, 0))) == [1, 0])
-%! && all (size (prod (zeros (2, 0), 1)) == [1, 0])
-%! && all (prod (zeros (2, 0), 2) == [1; 1])
-%! && all (prod (zeros (0, 2)) == [1, 1])
-%! && all (prod (zeros (0, 2), 1) == [1, 1])
-%! && all (size (prod (zeros (0, 2), 2)) == [0, 1])));
+%!assert (all (prod ([1, 2; 3, 4], 1) == [3, 8]));
+%!assert (all (prod ([1, 2; 3, 4], 2) == [2; 12]));
+%!assert (prod (zeros (1, 0)) == 1);
+%!assert (all (size (prod (zeros (1, 0), 1)) == [1, 0]));
+%!assert (prod (zeros (1, 0), 2) == 1);
+%!assert (prod (zeros (0, 1)) == 1);
+%!assert (prod (zeros (0, 1), 1) == 1);
+%!assert (all (size (prod (zeros (0, 1), 2)) == [0, 1]));
+%!assert (all (size (prod (zeros (2, 0))) == [1, 0]));
+%!assert (all (size (prod (zeros (2, 0), 1)) == [1, 0]));
+%!assert (all (prod (zeros (2, 0), 2) == [1; 1]));
+%!assert (all (prod (zeros (0, 2)) == [1, 1]));
+%!assert (all (prod (zeros (0, 2), 1) == [1, 1]));
+%!assert (all (size (prod (zeros (0, 2), 2)) == [0, 1]));
 
 %% test/octave.test/arith/cumsum-1.m
-%!assert((cumsum ([1, 2, 3]) == [1, 3, 6] && cumsum ([-1; -2; -3]) == [-1; -3; -6]
-%! && cumsum ([i, 2+i, -3+2i, 4]) == [i, 2+2i, -1+4i, 3+4i]));
+%!assert (cumsum ([1, 2, 3]) == [1, 3, 6]);
+%!assert (cumsum ([-1; -2; -3]) == [-1; -3; -6]);
+%!assert (cumsum ([i, 2+i, -3+2i, 4]) == [i, 2+2i, -1+4i, 3+4i]);
 
 %% test/octave.test/arith/cumsum-2.m
 %!assert(all (all (cumsum ([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i])
@@ -754,12 +762,13 @@
 %!error <Invalid call to cumsum.*> cumsum ();
 
 %% test/octave.test/arith/cumsum-4.m
-%!assert((all (cumsum ([1, 2; 3, 4], 1) == [1, 2; 4, 6])
-%! && all (cumsum ([1, 2; 3, 4], 2) == [1, 3; 3, 7])));
+%!assert (all (cumsum ([1, 2; 3, 4], 1) == [1, 2; 4, 6]));
+%!assert (all (cumsum ([1, 2; 3, 4], 2) == [1, 3; 3, 7]));
 
 %% test/octave.test/arith/cumprod-1.m
-%!assert((cumprod ([1, 2, 3]) == [1, 2, 6] && cumprod ([-1; -2; -3]) == [-1; 2; -6]
-%! && cumprod ([i, 2+i, -3+2i, 4]) == [i, -1+2i, -1-8i, -4-32i]));
+%!assert (cumprod ([1, 2, 3]) == [1, 2, 6]);
+%!assert (cumprod ([-1; -2; -3]) == [-1; 2; -6]);
+%!assert (cumprod ([i, 2+i, -3+2i, 4]) == [i, -1+2i, -1-8i, -4-32i]);
 
 %% test/octave.test/arith/cumprod-2.m
 %!assert(all (all (cumprod ([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i])
@@ -769,8 +778,8 @@
 %!error <Invalid call to cumprod.*> cumprod ();
 
 %% test/octave.test/arith/cumprod-4.m
-%!assert((all (cumprod ([2, 3; 4, 5], 1) == [2, 3; 8, 15])
-%! && all (cumprod ([2, 3; 4, 5], 2) == [2, 6; 4, 20])));
+%!assert (all (cumprod ([2, 3; 4, 5], 1) == [2, 3; 8, 15]));
+%!assert (all (cumprod ([2, 3; 4, 5], 2) == [2, 6; 4, 20]));
 
 %% test/octave.test/arith/sumsq-1.m
 %!assert(sumsq ([1, 2, 3]) == 14 && sumsq ([-1; -2; 4i]) == 21);
@@ -782,8 +791,8 @@
 %!error <Invalid call to sumsq.*> sumsq ();
 
 %% test/octave.test/arith/sumsq-4.m
-%!assert((all (sumsq ([1, 2; 3, 4], 1) == [10, 20])
-%! && all (sumsq ([1, 2; 3, 4], 2) == [5; 25])));
+%!assert (all (sumsq ([1, 2; 3, 4], 1) == [10, 20]));
+%!assert (all (sumsq ([1, 2; 3, 4], 2) == [5; 25]));
 
 %% test/octave.test/arith/bincoeff-1.m
 %!assert(bincoeff (5, 2) == 10 && bincoeff (50, 6) == 15890700);