Skip to content

Commit 4b96cdd

Browse files
authored
Merge pull request #418 from sakamoti/bugfix
Improved support for NAG
2 parents 888b5d3 + e08d051 commit 4b96cdd

File tree

4 files changed

+62
-23
lines changed

4 files changed

+62
-23
lines changed

Diff for: src/stdlib_logger.f90

+3-1
Original file line numberDiff line numberDiff line change
@@ -308,6 +308,7 @@ subroutine add_log_unit( self, unit, stat )
308308
integer :: lun
309309
character(12) :: specifier
310310
logical :: question
311+
integer :: istat
311312

312313
call validate_unit()
313314
if ( present(stat) ) then
@@ -350,7 +351,8 @@ subroutine validate_unit()
350351
end if
351352

352353
! Check that unit is opened
353-
inquire( unit, opened=question )
354+
inquire( unit, opened=question, iostat=istat )
355+
if(istat /= 0) question = .false.
354356
if ( .not. question ) then
355357
if ( present(stat) ) then
356358
stat = unopened_in_error

Diff for: src/stdlib_string_type.fypp

+55-20
Original file line numberDiff line numberDiff line change
@@ -421,7 +421,11 @@ contains
421421
type(string_type), intent(in) :: string
422422
integer :: ich
423423

424-
ich = merge(ichar(string%raw), 0, allocated(string%raw))
424+
if (allocated(string%raw) .and. len(string) > 0) then
425+
ich = ichar(string%raw(1:1))
426+
else
427+
ich = 0
428+
end if
425429

426430
end function ichar_string
427431

@@ -431,7 +435,11 @@ contains
431435
type(string_type), intent(in) :: string
432436
integer :: ich
433437

434-
ich = merge(iachar(string%raw), 0, allocated(string%raw))
438+
if (allocated(string%raw) .and. len(string) > 0) then
439+
ich = iachar(string%raw(1:1))
440+
else
441+
ich = 0
442+
end if
435443

436444
end function iachar_string
437445

@@ -571,8 +579,11 @@ contains
571579
logical, intent(in), optional :: back
572580
integer :: pos
573581

574-
pos = index(maybe(string), maybe(substring), &
575-
merge(back, .false., present(back)))
582+
if (present(back)) then
583+
pos = index(maybe(string), maybe(substring), back)
584+
else
585+
pos = index(maybe(string), maybe(substring), .false.)
586+
end if
576587

577588
end function index_string_string
578589

@@ -584,8 +595,11 @@ contains
584595
logical, intent(in), optional :: back
585596
integer :: pos
586597

587-
pos = index(maybe(string), substring, &
588-
merge(back, .false., present(back)))
598+
if (present(back)) then
599+
pos = index(maybe(string), substring, back)
600+
else
601+
pos = index(maybe(string), substring, .false.)
602+
end if
589603

590604
end function index_string_char
591605

@@ -597,8 +611,11 @@ contains
597611
logical, intent(in), optional :: back
598612
integer :: pos
599613

600-
pos = index(string, maybe(substring), &
601-
merge(back, .false., present(back)))
614+
if (present(back)) then
615+
pos = index(string, maybe(substring), back)
616+
else
617+
pos = index(string, maybe(substring), .false.)
618+
end if
602619

603620
end function index_char_string
604621

@@ -612,8 +629,11 @@ contains
612629
logical, intent(in), optional :: back
613630
integer :: pos
614631

615-
pos = scan(maybe(string), maybe(set), &
616-
merge(back, .false., present(back)))
632+
if (present(back)) then
633+
pos = scan(maybe(string), maybe(set), back)
634+
else
635+
pos = scan(maybe(string), maybe(set), .false.)
636+
end if
617637

618638
end function scan_string_string
619639

@@ -625,8 +645,11 @@ contains
625645
logical, intent(in), optional :: back
626646
integer :: pos
627647

628-
pos = scan(maybe(string), set, &
629-
merge(back, .false., present(back)))
648+
if (present(back)) then
649+
pos = scan(maybe(string), set, back)
650+
else
651+
pos = scan(maybe(string), set, .false.)
652+
end if
630653

631654
end function scan_string_char
632655

@@ -638,8 +661,11 @@ contains
638661
logical, intent(in), optional :: back
639662
integer :: pos
640663

641-
pos = scan(string, maybe(set), &
642-
merge(back, .false., present(back)))
664+
if (present(back)) then
665+
pos = scan(string, maybe(set), back)
666+
else
667+
pos = scan(string, maybe(set), .false.)
668+
end if
643669

644670
end function scan_char_string
645671

@@ -653,8 +679,11 @@ contains
653679
logical, intent(in), optional :: back
654680
integer :: pos
655681

656-
pos = verify(maybe(string), maybe(set), &
657-
merge(back, .false., present(back)))
682+
if (present(back)) then
683+
pos = verify(maybe(string), maybe(set), back)
684+
else
685+
pos = verify(maybe(string), maybe(set), .false.)
686+
end if
658687

659688
end function verify_string_string
660689

@@ -667,8 +696,11 @@ contains
667696
logical, intent(in), optional :: back
668697
integer :: pos
669698

670-
pos = verify(maybe(string), set, &
671-
merge(back, .false., present(back)))
699+
if (present(back)) then
700+
pos = verify(maybe(string), set, back)
701+
else
702+
pos = verify(maybe(string), set, .false.)
703+
end if
672704

673705
end function verify_string_char
674706

@@ -681,8 +713,11 @@ contains
681713
logical, intent(in), optional :: back
682714
integer :: pos
683715

684-
pos = verify(string, maybe(set), &
685-
merge(back, .false., present(back)))
716+
if (present(back)) then
717+
pos = verify(string, maybe(set), back)
718+
else
719+
pos = verify(string, maybe(set), .false.)
720+
end if
686721

687722
end function verify_char_string
688723

Diff for: src/tests/logger/test_stdlib_logger.f90

+3-1
Original file line numberDiff line numberDiff line change
@@ -417,6 +417,7 @@ end subroutine test_adding_log_files
417417
subroutine test_removing_log_units()
418418

419419
logical :: opened
420+
integer :: istat
420421

421422
print *
422423
print *, 'running test_removing_log_units'
@@ -462,7 +463,8 @@ subroutine test_removing_log_units()
462463

463464
end if
464465

465-
inquire( unit4, opened=opened )
466+
inquire( unit4, opened=opened, iostat=istat )
467+
if(istat /= 0) opened = .false.
466468
if ( opened ) then
467469
error stop 'UNIT4 is opened contrary to expectations.'
468470

Diff for: src/tests/stats/test_mean_f03.f90

+1-1
Original file line numberDiff line numberDiff line change
@@ -20,7 +20,7 @@ program test_mean
2020
call check( sum( abs( mean(d,2) - sum(d,2)/real(size(d,2), dp) )) < dptol)
2121

2222
!dp rank 8
23-
allocate(d8(size(d,1), size(d,2), 3, 4, 5, 6, 7, 8))
23+
allocate(d8(size(d,1), size(d,2), 3, 4, 5, 6, 7, 8), source=0.0_dp)
2424
d8(:, :, 1, 4, 5 ,6 ,7 ,8)=d;
2525
d8(:, :, 2, 4, 5 ,6 ,7 ,8)=d * 1.5_dp;
2626
d8(:, :, 3, 4, 5 ,6 ,7 ,8)=d * 4._dp;

0 commit comments

Comments
 (0)