@@ -363,47 +363,140 @@ The result is a allocatable length Character scalar.
363
363
#### Example
364
364
365
365
``` fortran
366
- program demo_strings_format_string
367
- use, non_intrinsic :: stdlib_strings, only: format_string
366
+ program test_strings_format_string
367
+ use stdlib_strings, only: format_string, starts_with
368
+ use stdlib_error, only: check
369
+ use stdlib_optval, only: optval
368
370
implicit none
369
371
print *, 'format_string(complex) : '
370
- print *, format_string((1, 1))
371
- print *, format_string((1, 1), '(F6.2)')
372
- print *, format_string((1, 1), '(F6.2)'), format_string((2, 2), '(F7.3)')
372
+ call check_formatter(format_string((1, 1)), "(1.0", &
373
+ & "Default formatter for complex number", partial=.true.)
374
+ call check_formatter(format_string((1, 1), '(F6.2)'), "( 1.00, 1.00)", &
375
+ & "Formatter for complex number")
376
+ call check_formatter(format_string((-1, -1), '(F6.2)'), "( -1.00, -1.00)", &
377
+ & "Formatter for negative complex number")
378
+ call check_formatter(format_string((1, 1), '(SP,F6.2)'), "( +1.00, +1.00)", &
379
+ & "Formatter with sign control descriptor for complex number")
380
+ call check_formatter(format_string((1, 1), '(F6.2)')//format_string((2, 2), '(F7.3)'), &
381
+ & "( 1.00, 1.00)( 2.000, 2.000)", &
382
+ & "Multiple formatters for complex numbers")
373
383
print *, 'format_string(integer) : '
374
- print *, format_string(100)
375
- print *, format_string(100, '(I6)')
376
- print *, format_string(100, '(I6)'), format_string(1000, '(I7)')
384
+ call check_formatter(format_string(100), "100", &
385
+ & "Default formatter for integer number")
386
+ call check_formatter(format_string(100, '(I6)'), " 100", &
387
+ & "Formatter for integer number")
388
+ call check_formatter(format_string(100, '(I0.6)'), "000100", &
389
+ & "Formatter with zero padding for integer number")
390
+ call check_formatter(format_string(100, '(I6)')//format_string(1000, '(I7)'), &
391
+ & " 100 1000", &
392
+ & "Multiple formatters for integers")
393
+ call check_formatter(format_string(34, '(B8)'), " 100010", &
394
+ & "Binary formatter for integer number")
395
+ call check_formatter(format_string(34, '(O0.3)'), "042", &
396
+ & "Octal formatter with zero padding for integer number")
397
+ call check_formatter(format_string(34, '(Z3)'), " 22", &
398
+ & "Hexadecimal formatter for integer number")
377
399
print *, 'format_string(real) : '
378
- print *, format_string(100.)
379
- print *, format_string(100., '(F12.2)')
380
- print *, format_string(100., '(F6.2)'), &
381
- format_string(1000., '(F7.3)'), format_string(1000, '(F7.3)')
382
- !! Wrong demonstration
400
+ call check_formatter(format_string(100.), "100.0", &
401
+ & "Default formatter for real number", partial=.true.)
402
+ call check_formatter(format_string(100., '(F6.2)'), "100.00", &
403
+ & "Formatter for real number")
404
+ call check_formatter(format_string(289., '(E7.2)'), ".29E+03", &
405
+ & "Exponential formatter with rounding for real number")
406
+ call check_formatter(format_string(128., '(ES8.2)'), "1.28E+02", &
407
+ & "Exponential formatter for real number")
408
+ ! Wrong demonstration
409
+ call check_formatter(format_string(-100., '(F6.2)'), "*", &
410
+ & "Too narrow formatter for signed real number", partial=.true.)
411
+ call check_formatter(format_string(1000., '(F6.3)'), "*", &
412
+ & "Too narrow formatter for real number", partial=.true.)
413
+ call check_formatter(format_string(1000, '(F7.3)'), "*", &
414
+ & "Real formatter for integer number", partial=.true.)
383
415
print *, 'format_string(logical) : '
384
- print *, format_string(.true.)
385
- print *, format_string(.true., '(L2)')
386
- print *, format_string(.false., '(L2)'), format_string(.true., '(L5)'), &
387
- format_string(.false., '(I5)')
388
- !! Wrong demonstration
389
- end program demo_strings_format_string
416
+ call check_formatter(format_string(.true.), "T", &
417
+ & "Default formatter for logcal value")
418
+ call check_formatter(format_string(.true., '(L2)'), " T", &
419
+ & "Formatter for logical value")
420
+ call check_formatter(format_string(.false., '(L2)')//format_string(.true., '(L5)'), &
421
+ & " F T", &
422
+ & "Multiple formatters for logical values")
423
+ ! Wrong demonstration
424
+ call check_formatter(format_string(.false., '(I5)'), "*", &
425
+ & "Integer formatter for logical value", partial=.true.)
426
+
427
+ contains
428
+ subroutine check_formatter(actual, expected, description, partial)
429
+ character(len=*), intent(in) :: actual, expected, description
430
+ logical, intent(in), optional :: partial
431
+ logical :: stat
432
+ character(len=:), allocatable :: msg
433
+
434
+ if (optval(partial, .false.)) then
435
+ stat = starts_with(actual, expected)
436
+ else
437
+ stat = actual == expected
438
+ end if
439
+ if (.not.stat) then
440
+ msg = description // new_line("a") // &
441
+ & "Expected: '"//expected//"' but got '"//actual//"'"
442
+ else
443
+ print '(" - ", a, /, " Result: ''", a, "''")', description, actual
444
+ end if
445
+ call check(stat, msg)
446
+ end subroutine check_formatter
447
+ end program test_strings_format_string
390
448
```
391
449
** Results**
392
450
``` fortran
393
- format_string(complex) :
394
- (1.00000000,1.00000000)
395
- ( 1.00, 1.00)
396
- ( 1.00, 1.00) ( 2.000, 2.000)
451
+ format_string(complex) :
452
+ - Default formatter for complex number
453
+ Result: '(1.00000000,1.00000000)' !! Different compilers have different widths here.
454
+ !! [link](https://github.com/fortran-lang/stdlib/pull/444#issuecomment-868965643)
455
+ - Formatter for complex number
456
+ Result: '( 1.00, 1.00)'
457
+ - Formatter for negative complex number
458
+ Result: '( -1.00, -1.00)'
459
+ - Formatter with sign control descriptor for complex number
460
+ Result: '( +1.00, +1.00)'
461
+ - Multiple formatters for complex numbers
462
+ Result: '( 1.00, 1.00)( 2.000, 2.000)'
397
463
format_string(integer) :
398
- 100
399
- 100
400
- 100 1000
464
+ - Default formatter for integer number
465
+ Result: '100'
466
+ - Formatter for integer number
467
+ Result: ' 100'
468
+ - Formatter with zero padding for integer number
469
+ Result: '000100'
470
+ - Multiple formatters for integers
471
+ Result: ' 100 1000'
472
+ - Binary formatter for integer number
473
+ Result: ' 100010'
474
+ - Octal formatter with zero padding for integer number
475
+ Result: '042'
476
+ - Hexadecimal formatter for integer number
477
+ Result: ' 22'
401
478
format_string(real) :
402
- 100.000000
403
- 100.00
404
- 100.00********
479
+ - Default formatter for real number
480
+ Result: '100.000000' !! Ditto
481
+ - Formatter for real number
482
+ Result: '100.00'
483
+ - Exponential formatter with rounding for real number
484
+ Result: '.29E+03'
485
+ - Exponential formatter for real number
486
+ Result: '1.28E+02'
487
+ - Too narrow formatter for signed real number
488
+ Result: '******'
489
+ - Too narrow formatter for real number
490
+ Result: '******'
491
+ - Real formatter for integer number
492
+ Result: '*'
405
493
format_string(logical) :
406
- T
407
- T
408
- F T*
494
+ - Default formatter for logcal value
495
+ Result: 'T'
496
+ - Formatter for logical value
497
+ Result: ' T'
498
+ - Multiple formatters for logical values
499
+ Result: ' F T'
500
+ - Integer formatter for logical value
501
+ Result: '*'
409
502
```
0 commit comments