@@ -166,7 +166,6 @@ subroutine test_make_directory(error)
166
166
! Clean up: remove the empty directory
167
167
call execute_command_line(' rmdir ' // filename, exitstat= ios, cmdstat= iocmd, cmdmsg= msg)
168
168
call check(error, ios== 0 .and. iocmd== 0 , ' Cannot cleanup make_directory test: ' // trim (msg))
169
- if (allocated (error)) return
170
169
end subroutine test_make_directory
171
170
172
171
subroutine test_make_directory_existing (error )
@@ -187,8 +186,12 @@ subroutine test_make_directory_existing(error)
187
186
188
187
! Clean up: remove the empty directory
189
188
call execute_command_line(' rmdir ' // filename, exitstat= ios, cmdstat= iocmd, cmdmsg= msg)
189
+ if (allocated (error)) then
190
+ ! if previous error is allocated as well
191
+ call check(error, ios== 0 .and. iocmd== 0 , error% message // ' and cannot cleanup make_directory test: ' // trim (msg))
192
+ return
193
+ end if
190
194
call check(error, ios== 0 .and. iocmd== 0 , ' Cannot cleanup make_directory test: ' // trim (msg))
191
- if (allocated (error)) return
192
195
end subroutine test_make_directory_existing
193
196
194
197
subroutine test_remove_directory (error )
@@ -209,8 +212,7 @@ subroutine test_remove_directory(error)
209
212
if (allocated (error)) then
210
213
! Clean up: remove the empty directory
211
214
call execute_command_line(' rmdir ' // filename, exitstat= ios, cmdstat= iocmd, cmdmsg= msg)
212
- call check(error, ios== 0 .and. iocmd== 0 , ' Cannot cleanup make_directory test: ' // trim (msg))
213
- if (allocated (error)) return
215
+ call check(error, ios== 0 .and. iocmd== 0 , error% message // ' and cannot cleanup make_directory test: ' // trim (msg))
214
216
end if
215
217
end subroutine test_remove_directory
216
218
0 commit comments