small rewrite in test_str_sep and test_strsplit

src/pro/imsl_erf.pro

@@ -1,8 +1,24 @@
 ; by Sylwester Arabas <[email protected]>
-function imsl_erf, x, double=dbl, inverse=inv
-  on_error, 2
-  if ~keyword_set(inv) then return, erf(x, double=dbl)
-  if total([x] ge 1 or [x] le -1) gt 0 then $
-    message, 'The inverse error function is defined only for -1 < x < 1'
-  return, gdl_erfinv(x, double=dbl)
+;
+; ---------------------------------------
+; Modifications history :
+;
+; - 2025-Dec-08 : AC. in fact, no /double in ERF() !
+; ---------------------------------------
+;
+function IMSL_ERF, x, double=dbl, inverse=inv
+;
+on_error, 2
+;
+if ~KEYWORD_SET(inv) then return, ERF(x)
+;
+if TYPENAME(x) EQ 'COMPLEX' or TYPENAME(x) EQ 'DCOMPLEX' then $
+   MESSAGE, 'Type (D)COMPLEX are not OK'
+;
+;  elegant way to test if we have values above 1 or below -1
+if TOTAL([x] ge 1 or [x] le -1) gt 0 then $
+   MESSAGE, 'The inverse error function is defined only for -1 < x < 1'
+;
+return, GDL_ERFINV(x, double=dbl)
+;
 end

testsuite/LIST

@@ -22,7 +22,6 @@ test_bug_3057520.pro
 test_bug_3061072.pro
 test_bug_3081887.pro
 test_bug_3085858.pro
-test_bug_3086851.pro
 test_bug_3091599.pro
 test_bug_3091610.pro
 test_bug_3100945.pro
@@ -36,7 +35,6 @@ test_bug_3152899.pro
 test_bug_3189072.pro
 test_bug_3199465.pro
 test_bug_3285659.pro
-test_bug_3286031.pro
 test_bug_3290532.pro
 test_bug_3296360.pro
 test_bug_3298378.pro

testsuite/test_antlr_issues.pro

@@ -1,18 +1,51 @@
-; not a formal test. GDL should pass these commands without trouble.
-pro test_antlr_issues
+;
+; GD. not a formal test. GDL should pass these commands without trouble.
+;
+; ---------------------------------------
+; Modifications history :
+; 
+;
+; AC 2025-12-08
+; - Few lines are not OK in IDL 8.8.x and below, fully ok since IDL 8.9
+;   in fact since IDL "compiles" before run the code, no way to fail
+;   before 8.9 ... (syntax error messagess)
+; - partially transform into a more formal test
+;
+; ---------------------------------------
+;
+pro TEST_ANTLR_ISSUES, help=help, test=test, verbose=verbose, no_exit=no_exit
+;
+if KEYWORD_SET(help) then begin
+   print, 'pro ANTLR_ISSUES, help=help, test=test, verbose=verbose, no_exit=no_exit'
+   return
+endif 
+;
+cumul_errors=0
+errors=0
+;
+; ---------------------
 ; crashing issues:
 ; issue #812
 a={z:[850.,1300.]}
 b=ptr_new(a)
-print,(*b).z(0)
+if KEYWORD_SET(verbose) then print,(*b).z(0)
+if ((*b).z(0) NE 850.000) then ERRORS_ADD, errors, 'Case (*b).z(0)'
+;
+; ---------------------
 ; issue #26
 struct={array7:[3,3,7,7,7,5,5],z:ptr_new(/allocate_heap)}
 zval=findgen(12)
 pointer=ptr_new(struct,/no_copy)
 *(*pointer).z=zval
-print,(*(*pointer).z)[0:(*pointer).array7[3]]
-print,(*(*pointer).z)((*pointer).array7[1])
-print,(*(*pointer).z)((*pointer).array7(1))
+res1=(*(*pointer).z)[0:(*pointer).array7[3]]
+res2=(*(*pointer).z)((*pointer).array7[1])
+res3=(*(*pointer).z)((*pointer).array7(1))
+if KEYWORD_SET(verbose) then print, res1, res2, res3
+if ~ARRAY_EQUAL(res1, FINDGEN(8)) then ERRORS_ADD, errors, 'Case res1'
+if (res2 NE 3.0) then ERRORS_ADD, errors, 'Case res2'
+if (res3 NE 3.0) then ERRORS_ADD, errors, 'Case res3'
+;
+; ---------------------
 ; format etc issues:
 ; issue #1577
 b=1 & z=cos((b+=2))
@@ -21,24 +54,46 @@ a = "123
 ;" //emacs IDLWAVE mode is fragile...
 if a ne 83 then exit,status=1
 a = "123"
-if ~ISA(a,/STRING)  then exit,status=1
-a="7ull
-if a ne 7ull then exit,status=1
+if ~ISA(a,/STRING)  then ERRORS_ADD, errors, 'Case Bad String 1'
+a="7ull  
+;;" //emacs IDLWAVE mode is fragile...
+if (a ne 7ull) then ERRORS_ADD, errors, 'Case Bad value 7ull'
 a="8ull & help,a
-if ~ISA(a,/STRING)  then exit,status=1
+;;" //emacs IDLWAVE mode is fragile...
+if ~ISA(a,/STRING)  then ERRORS_ADD, errors, 'Case Bad String 2'
+;
+; ---------------------
 ; various flavors new and old
 help,0xA9, 0xFA62, 0xFFFFFFuLL, 'A9'x, 'FA62'x, 'FFFFFFF'xull
-help,0o377, 0o777777UL,'377'o, '777777'oUL,"12, "12ub
-help,0b1010, 0b10101011111uLL,'1010'bb, '10101011111'bull
-help, 3+4j, 3e-2+4.6e-5i, -3.6+0.8dj
+;
+; this is OK in GDL and IDL only since 8.9. I don't know in FL
+;
+modern=1
+if (GDL_IDL_FL() EQ 'IDL') then if GDL_VERSION() LT 80900 then modern=0
+if (modern) then begin
+   res=EXECUTE("help,0o377, 0o777777UL,'377'o, '777777'oUL,""12, ""12ub")
+   res=EXECUTE("help,0b1010, 0b10101011111uLL,'1010'bb, '10101011111'bull")
+   res=EXECUTE("help, 3+4j, 3e-2+4.6e-5i, -3.6+0.8dj")
+endif
+;
+; ---------------------
 ; issue #830
 print,"a","b","c",format='(/a/a/a)'
 ; GDL knows 2 flavours of C-Type format
 print,"a","b","c",format='(%"%s-%s-%s")'
+formatres2=STRING("a","b","c",format='(%"%s-%s-%s")')
+if (formatres2 NE 'a-b-c') then ERRORS_ADD, errors, 'Case Bad Format 2'
 print,"a","b","c",format="%s-%s-%s"
+formatres3=STRING("a","b","c",format="%s-%s-%s")
+if (formatres3 NE 'a-b-c') then ERRORS_ADD, errors, 'Case Bad Format 3'
+;
+; ---------------------
 ; issue #541
-a = 'FF3A'x  ; existing notation
-a = 0xFF3A   ; new notation
+a1 = 'FF3A'x  ; existing notation
+a2 = 0xFF3A   ; new notation
+;
+if ~ARRAY_EQUAL(a1,a2,/no_type) then ERRORS_ADD, errors, 'Case New notation'
+; ---------------------
 ; issue #52: shothand notation, but will crash as this is not an interactive input. Removed.
 ; for i=0,2 do begin print,i
 ; four different ways must be accepted:
@@ -50,5 +105,17 @@ endfor
 for i=0,1 do begin
    print,i
 endfor
-
+;
+; ----------- back to normal convention ...
+;
+cumul_errors=errors
+;
+; ----------------- final message ----------
+;
+BANNER_FOR_TESTSUITE, 'TEST_ANTLR_ISSUES', cumul_errors, short=short
+;
+if (cumul_errors GT 0) AND ~KEYWORD_SET(no_exit) then EXIT, status=1
+;
+if KEYWORD_SET(test) then STOP
+;
 end

testsuite/test_erfinv.pro

@@ -1,24 +1,132 @@
-; by Sylwester Arabas <[email protected]>
-pro TEST_ERFINV
-
+;
+; Initial code by Sylwester Arabas <[email protected]>
+;
+; ---------------------------------------
+; Modifications history :
+;
+; - 2025-Dec-08 : AC. managing ISML licence on IDL
+;   ERF(/double) don't exist 
+; ---------------------------------------
+;
+pro TEST_ERFINV_NUMERIC, cumul_error, test=test, verbose=verbose
+;
+errors=0
+;
+esp_vect=2e-6  ; relative error
+;
+; ---------------------------------------
+; test on FLOAT
+;
 x = (2 * FINDGEN(100) / 99 - 1)[1 : 98]
 for i=0, N_ELEMENTS(x) - 1 do begin
-   if ABS(IMSL_ERF(ERF(x[i]), /inv) - x[i]) gt 1e-6 then begin
-      MESSAGE, 'erf-1(erf(float x)) != x', /conti
-      exit, status=1
+   ;; in a loop
+   if ABS(IMSL_ERF(ERF(x[i]), /inv) - x[i]) gt 1e-6 then  begin
+      ERRORS_ADD, errors, 'erf-1(erf(float x)) != x, index ['+STRING(i)+']'
    endif
-   if ABS(IMSL_ERF(ERF(x[i], /double), /inv, /double) - x[i]) gt 1e-7 then begin
+   ;; in a loop, promoting to double
+   if ABS(IMSL_ERF(ERF(DOUBLE(x[i])), /inv, /double) - x[i]) gt 1e-7 then begin
       MESSAGE, 'erf-1(erf(float x, /double), /double) != x', /conti
       EXIT, status=1
    endif
 endfor
-
-x = (2 * dindgen(100) / 99 - 1)[1 : 98]
+;; vector
+if TOTAL(ABS(IMSL_ERF(ERF(x),/inv)-x)) GT esp_vect then begin
+   ERRORS_ADD, errors, 'erf-1(erf( x)) != x, FLOAT Vector'
+endif
+if TOTAL(ABS(IMSL_ERF(ERF(DOUBLE(x)),/inv)-x)) GT esp_vect then begin
+   ERRORS_ADD, errors, 'erf-1(erf( x)) != x, FLOAT DOUBLE Double'
+endif
+;
+; ---------------------------------------
+; test on DOUBLE
+x = (2 * DINDGEN(100) / 99 - 1)[1 : 98]
+;; loop
 for i=0, n_elements(x) - 1 do begin
    if ABS(IMSL_ERF(ERF(x[i]), /inv) - x[i]) gt 1e-7 then begin
-      MESSAGE, 'erf-1(erf(double x)) != x', /conti
-      EXIT, status=1
+      ERRORS_ADD, errors, 'erf-1(erf(double x)) != x, index ['+STRING(i)+']'
+   endif
+endfor
+; vector
+if TOTAL(ABS(IMSL_ERF(ERF(x),/inv)-x)) GT esp_vect then begin
+   ERRORS_ADD, errors, 'erf-1(erf( x)) != x, DOUBLE Vector '
+endif
+;
+; --------------
+;
+BANNER_FOR_TESTSUITE, "TEST_ERFINV_NUMERIC", errors, /short, verb=verbose
+ERRORS_CUMUL, cumul_errors, errors
+if KEYWORD_SET(test) then STOP
+;
+end
+;
+; ---------------------------------------
+;
+pro TEST_ERFINV_TYPE, cumul_error, test=test, verbose=verbose
+;
+errors=0
+;
+GIVE_LIST_NUMERIC, list_numeric_types
+nb_types=N_ELEMENTS(list_numeric_types)
+;
+expect=REPLICATE('FLOAT', nb_types)
+expect[4:6]=['DOUBLE','COMPLEX','DCOMPLEX']
+;
+; For ERF() and IMSL_ERF() all types are OK, including Complex & DComplex
+;
+for ii=0, nb_types-1 do begin
+   if TYPENAME(ERF(FIX(0., type=list_numeric_types[ii]))) NE expect[ii] then $
+      ERRORS_ADD, errors, 'Bad type in ERF() '+list_numeric_types[ii]
+   if TYPENAME(IMSL_ERF(FIX(0., type=list_numeric_types[ii]))) NE expect[ii] then $
+      ERRORS_ADD, errors, 'Bad type in ERF() '+list_numeric_types[ii]
+endfor
+;
+; For IMSL_ERF(/inv) Complex & DComplex should be skipped !
+;
+for ii=0, nb_types-1 do begin
+   res_exe=EXECUTE("val=IMSL_ERF(FIX(0., type=list_numeric_types[ii]),/inv)")
+   if (res_exe GT 0) then begin
+      if TYPENAME(val) NE expect[ii] then $
+         ERRORS_ADD, errors, 'Bad type in IMSL_ERF(/inv) '+list_numeric_types[ii]
    endif
 endfor
-
+;
+; --------------
+;
+BANNER_FOR_TESTSUITE, "TEST_ERFINV_TYPE", errors, /short, verb=verbose
+ERRORS_CUMUL, cumul_errors, errors
+if KEYWORD_SET(test) then STOP
+;
+end
+;
+; ---------------------------------------
+;
+pro TEST_ERFINV, test=test, no_exit=no_exit, help=help
+;
+if KEYWORD_SET(help) then begin
+   print, 'pro TEST_ERFINV, test=test, no_exit=no_exit, help=help'
+   return
+endif
+;
+cumul_errors=0
+;
+; we need a IMSL licence to run IMSL_ERF() in IDL 
+;
+if (GDL_IDL_FL() EQ 'IDL') then begin
+   if ~LMGR('idlimsl') then begin
+      MESSAGE, 'ISML licence missing in IDL', /continue
+      if KEYWORD_SET(no_exit) then STOP else EXIT, status=77
+   endif else  MESSAGE, 'ISML licence activated in IDL', /continue
+endif
+;
+TEST_ERFINV_TYPE, cumul_error, test=test, verbose=verbose
+TEST_ERFINV_NUMERIC, cumul_error, test=test, verbose=verbose
+;
+; ----------------- final message ----------
+;
+BANNER_FOR_TESTSUITE, 'TEST_ERFINV', cumul_errors, short=short
+;
+if (cumul_errors GT 0) AND ~KEYWORD_SET(no_exit) then EXIT, status=1
+;
+if KEYWORD_SET(test) then STOP
+;
 end