operations.def: Fix indentation.
[pspp-builds.git] / src / language / expressions / operations.def
index d3044043df4a168bac21a466422eb4038ea38388..bdb6ed2b911c70af0915e3e689c3308c9dadc67d 100644 (file)
@@ -1,7 +1,7 @@
 // -*- c -*-
 //
 // PSPP - a program for statistical analysis.
-// Copyright (C) 2005, 2006, 2009 Free Software Foundation, Inc.
+// Copyright (C) 2005, 2006, 2009, 2010, 2011 Free Software Foundation, Inc.
 // 
 // This program is free software: you can redistribute it and/or modify
 // it under the terms of the GNU General Public License as published by
@@ -63,12 +63,12 @@ boolean operator LT (a, b) = a < b;
 boolean operator NE (a, b) = a != b;
 
 // String relational operators.
-boolean operator EQ_STRING (string a, string b) = compare_string (&a, &b) == 0;
-boolean operator GE_STRING (string a, string b) = compare_string (&a, &b) >= 0;
-boolean operator GT_STRING (string a, string b) = compare_string (&a, &b) > 0;
-boolean operator LE_STRING (string a, string b) = compare_string (&a, &b) <= 0;
-boolean operator LT_STRING (string a, string b) = compare_string (&a, &b) < 0;
-boolean operator NE_STRING (string a, string b) = compare_string (&a, &b) != 0;
+boolean operator EQ_STRING (string a, string b) = compare_string_3way (&a, &b) == 0;
+boolean operator GE_STRING (string a, string b) = compare_string_3way (&a, &b) >= 0;
+boolean operator GT_STRING (string a, string b) = compare_string_3way (&a, &b) > 0;
+boolean operator LE_STRING (string a, string b) = compare_string_3way (&a, &b) <= 0;
+boolean operator LT_STRING (string a, string b) = compare_string_3way (&a, &b) < 0;
+boolean operator NE_STRING (string a, string b) = compare_string_3way (&a, &b) != 0;
 
 // Unary functions.
 function ABS (x) = fabs (x);
@@ -118,7 +118,7 @@ boolean function ANY (string x, string a[n])
   size_t i;
 
   for (i = 0; i < n; i++)
-    if (!compare_string (&x, &a[i]))
+    if (!compare_string_3way (&x, &a[i]))
       return 1.;
   return 0.;
 }
@@ -154,7 +154,7 @@ string function MAX (string a[n])
 
   max = &a[0];
   for (i = 1; i < n; i++)
-    if (compare_string (&a[i], max) > 0)
+    if (compare_string_3way (&a[i], max) > 0)
       max = &a[i];
   return *max;
 }
@@ -185,7 +185,7 @@ string function MIN (string a[n])
 
   min = &a[0];
   for (i = 1; i < n; i++)
-    if (compare_string (&a[i], min) < 0)
+    if (compare_string_3way (&a[i], min) < 0)
       min = &a[i];
   return *min;
 }
@@ -238,7 +238,7 @@ boolean function RANGE (string x, string a[n*2])
     {
       struct substring *w = &a[2 * i];
       struct substring *y = &a[2 * i + 1];
-      if (compare_string (w, &x) <= 0 && compare_string (&x, y) <= 0)
+      if (compare_string_3way (w, &x) <= 0 && compare_string_3way (&x, y) <= 0)
         return 1.;
     }
   return 0.;
@@ -291,7 +291,15 @@ function CTIME.SECONDS (time) = time;
 function DATE.DMY (d, m, y) = expr_ymd_to_date (y, m, d);
 function DATE.MDY (m, d, y) = expr_ymd_to_date (y, m, d);
 function DATE.MOYR (m, y) = expr_ymd_to_date (y, m, 1);
-function DATE.QYR (q, y) = expr_ymd_to_date (y, q * 3 - 2, 1);
+function DATE.QYR (q, y)
+{
+  if (q < 1.0 || q > 4.0 || q != (int) q)
+    {
+      msg (SW, _("The first argument to DATE.QYR must be 1, 2, 3, or 4."));
+      return SYSMIS;
+    }
+   return expr_ymd_to_date (y, q * 3 - 2, 1);
+}
 function DATE.WKYR (w, y) = expr_wkyr_to_date (w, y);
 function DATE.YRDAY (y, yday) = expr_yrday_to_date (y, yday);
 function YRMODA (y, m, d) = expr_yrmoda (y, m, d);
@@ -573,7 +581,19 @@ string function RTRIM (string s, string c)
 function NUMBER (string s, ni_format f)
 {
   union value out;
-  data_in (ss_head (s, f->w), LEGACY_NATIVE, f->type, f->d, 0, 0, NULL, &out, 0);
+  char *error;
+
+  if (s.length > f->w)
+    s.length = f->w;
+  error = data_in (s, LEGACY_NATIVE, f->type, &out, 0, NULL);
+  if (error == NULL)
+    data_in_imply_decimals (s, LEGACY_NATIVE, f->type, f->d, &out);
+  else
+    {
+      msg (SE, "Cannot parse `%.*s' as format %s: %s",
+           (int) s.length, s.string, fmt_name (f->type), error);
+      free (error);
+    }
   return out.f;
 }
 
@@ -953,7 +973,8 @@ absorb_miss no_opt string operator VEC_ELEM_STR (idx)
   if (idx >= 1 && idx <= vector_get_var_cnt (v))
     {
       struct variable *var = vector_get_var (v, (size_t) idx - 1);
-      return copy_string (e, case_str (c, var), var_get_width (var));
+      return copy_string (e, CHAR_CAST_BUG (char *, case_str (c, var)),
+                          var_get_width (var));
     }
   else
     {
@@ -1021,7 +1042,8 @@ no_opt perm_only string function LAG (str_var v, pos_int n_before)
 {
   const struct ccase *c = lagged_case (ds, n_before);
   if (c != NULL)
-    return copy_string (e, case_str (c, v), var_get_width (v));
+    return copy_string (e, CHAR_CAST_BUG (char *, case_str (c, v)),
+                        var_get_width (v));
   else
     return empty_string;
 }
@@ -1032,7 +1054,8 @@ no_opt perm_only string function LAG (str_var v)
 {
   const struct ccase *c = lagged_case (ds, 1);
   if (c != NULL)
-    return copy_string (e, case_str (c, v), var_get_width (v));
+    return copy_string (e, CHAR_CAST_BUG (char *, case_str (c, v)),
+                        var_get_width (v));
   else
     return empty_string;
 }