! $Id: aniso_varying_string-tests.f90 2416 2016-09-02 21:04:21Z ian $ !******************************************************************************* !! !> Series of simple tests of the aniso_varying_string module, mostly !! dealing with input/output. PROGRAM AnisoVaryingStringTests ! We don't USE the module here, so the accessibility of the various ! bits from the module can be tested independently in the scopes ! of the various test procedures below. IMPLICIT NONE ! Prefix for test file names. CHARACTER(*), PARAMETER :: test_file_name = 'AnisoVaryingStringTests' ! Content (string value) for various tests. The content is at least ! five characters long, has a single internal blank, ! and one and only one `r` character, and no 'q' characters. CHARACTER(*), PARAMETER :: misc_test_content = 'Hello world' !***************************************************************************** CALL run_tests CONTAINS !***************************************************************************** ! ! Executes the sequence of tests SUBROUTINE run_tests !--------------------------------------------------------------------------- ! Locals INTEGER :: unit ! Unit for logging test progress. !*************************************************************************** OPEN( & NEWUNIT=unit, & FILE=test_file_name // '.testlog', & ACTION='WRITE', & STATUS='REPLACE' ) CALL do_test(unit, 'get01', test_get01) CALL do_test(unit, 'get02', test_get02) CALL do_test(unit, 'put01', test_put01) CALL do_test(unit, 'put_line01', test_put_line01) CALL do_test(unit, 'write_formatted01', test_write_formatted01) CALL do_test(unit, 'write_formatted02', test_write_formatted02) CALL do_test(unit, 'write_formatted03', test_write_formatted03) CALL do_test(unit, 'write_formatted04', test_write_formatted04) CALL do_test(unit, 'write_formatted05', test_write_formatted05) CALL do_test(unit, 'write_formatted06', test_write_formatted06) ! See https://software.intel.com/en-us/forums/intel-visual-fortran-compiler-for-windows/topic/618870 CALL do_test(unit, 'read_formatted01', test_read_formatted01) CALL do_test(unit, 'read_formatted02', test_read_formatted02) CALL do_test(unit, 'read_formatted03', test_read_formatted03) ! See https://software.intel.com/en-us/forums/intel-visual-fortran-compiler-for-windows/topic/618870 CALL do_test(unit, 'read_formatted04', test_read_formatted04) CALL do_test(unit, 'read_formatted05', test_read_formatted05) CALL do_test(unit, 'read_formatted06', test_read_formatted06) CALL do_test(unit, 'read_formatted07', test_read_formatted07) CALL do_test(unit, 'read_formatted08', test_read_formatted08) CALL do_test(unit, 'read_formatted09', test_read_formatted09) CALL do_test(unit, 'write_unformatted01', test_write_unformatted01) CALL do_test(unit, 'write_unformatted02', test_write_unformatted02) CALL do_test(unit, 'write_unformatted03', test_write_unformatted03) CALL do_test(unit, 'read_unformatted01', test_read_unformatted01) CALL do_test(unit, 'read_unformatted02', test_read_unformatted02) ! See https://software.intel.com/en-us/forums/intel-visual-fortran-compiler-for-windows/topic/618870#comment-1864502 CALL do_test(unit, 'read_unformatted03', test_read_unformatted03) CLOSE(unit) END SUBROUTINE run_tests !***************************************************************************** ! ! Execute a particular test. SUBROUTINE do_test(unit, name, proc) !--------------------------------------------------------------------------- ! Arguments ! The unit for logging test progress. INTEGER, INTENT(IN) :: unit ! The name for reporting of the test result. CHARACTER(*), INTENT(IN) :: name INTERFACE ! The test procedure to execute. SUBROUTINE proc(unit, stat) IMPLICIT NONE ! The unit for logging test progress. INTEGER, INTENT(IN) :: unit ! Test result - non-zero on failure. Tests are written assuming that ! program execution will cease shortly after a non-zero stat return - ! we don't bother closing test files or similar. INTEGER, INTENT(OUT) :: stat END SUBROUTINE proc END INTERFACE !--------------------------------------------------------------------------- ! Locals ! Format specification to announce a test. CHARACTER(*), PARAMETER :: fmt_test = "('Test: ',A)" INTEGER :: stat ! The result from each test. !*************************************************************************** PRINT fmt_test, name WRITE (unit, fmt_test) name CALL proc(unit, stat) IF (stat /= 0) THEN WRITE (unit, "(2X,'Test failed:',I0)") stat STOP 'Test failed' END IF END SUBROUTINE do_test !----------------------------------------------------------------------------- !----------------------------------------------------------------------------- ! ! Tests of the GET generic. !***************************************************************************** ! ! GET from formatted sequential unit. SUBROUTINE test_get01(unit, stat) USE aniso_varying_string !--------------------------------------------------------------------------- ! Arguments. INTEGER, INTENT(IN) :: unit INTEGER, INTENT(OUT) :: stat !--------------------------------------------------------------------------- ! Locals INTEGER :: test_unit ! Unit to read from. !*************************************************************************** ! Create single record test file. OPEN( & NEWUNIT=test_unit, & FILE=test_file_name // '-get01.txt', & STATUS='REPLACE', & POSITION='REWIND', & ACTION='READWRITE' ) WRITE (test_unit, "(A)") misc_test_content REWIND(test_unit) CALL get_tests(test_unit, unit, stat) IF (stat /= 0) RETURN CLOSE(test_unit) stat = 0 END SUBROUTINE test_get01 !***************************************************************************** ! ! GET from formatted stream unit. SUBROUTINE test_get02(unit, stat) USE aniso_varying_string !--------------------------------------------------------------------------- ! Arguments. INTEGER, INTENT(IN) :: unit INTEGER, INTENT(OUT) :: stat !--------------------------------------------------------------------------- ! Locals TYPE(varying_string) :: vs INTEGER :: test_unit INTEGER :: iostat ! IOSTAT code. CHARACTER(100) :: iomsg ! IOMSG buffer !*************************************************************************** ! Create a single record formatted stream test file. OPEN( & NEWUNIT=test_unit, & FILE=test_file_name // '-get02a.txt', & STATUS='REPLACE', & POSITION='REWIND', & ACCESS='STREAM', & FORM='FORMATTED', & ACTION='READWRITE' ) WRITE (test_unit, "(A)") misc_test_content REWIND(test_unit) CALL get_tests(test_unit, unit, stat) IF (stat /= 0) RETURN CLOSE(test_unit) ! Create a single incomplete(!) record. This is not portable. OPEN( & NEWUNIT=test_unit, & FILE=test_file_name // '-get02b.txt', & STATUS='REPLACE', & POSITION='REWIND', & ACCESS='STREAM', & FORM='UNFORMATTED', & ACTION='WRITE' ) WRITE (test_unit) misc_test_content CLOSE (test_unit) ! Open the file for formatted stream input. OPEN( & NEWUNIT=test_unit, & FILE=test_file_name // '-get02b.txt', & STATUS='OLD', & POSITION='REWIND', & ACCESS='STREAM', & FORM='FORMATTED', & ACTION='READ' ) ! We expect EOF and the contents of the string. CALL Get(test_unit, vs, IOSTAT=iostat, IOMSG=iomsg) WRITE (unit, "(2X,'Got ""',A,'"".')") vs%chars WRITE (unit, "(2X,'Got IOSTAT=',I0,', IOMSG=""',A,'"".')") iostat, iomsg IF ( (vs%chars /= misc_test_content) .OR. & (.NOT. IS_IOSTAT_END(iostat)) ) THEN stat = 1 RETURN END IF CLOSE(test_unit) stat = 0 END SUBROUTINE test_get02 !***************************************************************************** ! ! Worker for test_get01 and test_get02. SUBROUTINE get_tests(test_unit, unit, stat) USE aniso_varying_string !--------------------------------------------------------------------------- ! Arguments. ! Unit for reading test data from. INTEGER, INTENT(IN) :: test_unit ! Unit for logging test progress. INTEGER, INTENT(IN) :: unit ! Test result - non-zero on error. INTEGER, INTENT(OUT) :: stat !--------------------------------------------------------------------------- ! Locals TYPE(varying_string) :: vs INTEGER :: iostat ! IOSTAT code. CHARACTER(100) :: iomsg ! IOMSG buffer ! SEPARATOR result. TYPE(varying_string) :: vs_sep !*************************************************************************** ! Get the whole record. CALL Get(test_unit, vs) WRITE (unit, "(2X,'Got ""',A,'"".')") vs%chars IF (vs%chars /= misc_test_content) THEN stat = 1 RETURN END IF ! See if we get EOF. CALL Get(test_unit, vs, IOSTAT=iostat, IOMSG=iomsg) WRITE (unit, "(2X,'Got IOSTAT=',I0,', IOMSG=""',A,'"".')") iostat, iomsg IF (.NOT. IS_IOSTAT_END(iostat)) THEN stat = 1 RETURN END IF REWIND test_unit ! Expect end of record. CALL Get(test_unit, vs, IOSTAT=iostat, IOMSG=iomsg) WRITE (unit, "(2X,'Got IOSTAT=',I0,', IOMSG=""',A,'"".')") iostat, iomsg IF (.NOT. IS_IOSTAT_EOR(iostat)) THEN stat = 1 RETURN END IF REWIND test_unit ! Get part of a record (five characters) CALL Get(test_unit, vs, 5) WRITE (unit, "(2X,'Got ""',A,'"".')") vs%chars IF (vs%chars /= misc_test_content(:5)) THEN stat = 1 RETURN END IF ! Should be able to get the rest of the string, then EOF. CALL Get(test_unit, vs) WRITE (unit, "(2X,'Got ""',A,'"".')") vs%chars IF (vs%chars /= misc_test_content(6:)) THEN stat = 1 RETURN END IF CALL Get(test_unit, vs, IOSTAT=iostat, IOMSG=iomsg) WRITE (unit, "(2X,'Got IOSTAT=',I0,', IOMSG=""',A,'"".')") iostat, iomsg IF (.NOT. IS_IOSTAT_END(iostat)) THEN stat = 1 RETURN END IF REWIND test_unit ! Try and get too much. CALL Get(test_unit, vs, LEN(misc_test_content) + 5) WRITE (unit, "(2X,'Got ""',A,'"".')") vs%chars IF (vs%chars /= misc_test_content) THEN stat = 1 RETURN END IF REWIND test_unit ! Try and get too much - expect EOR. CALL Get(test_unit, vs, IOSTAT=iostat, IOMSG=iomsg) WRITE (unit, "(2X,'Got IOSTAT=',I0,', IOMSG=""',A,'"".')") iostat, iomsg IF (.NOT. IS_IOSTAT_EOR(iostat)) THEN stat = 1 RETURN END IF REWIND test_unit ! Get with a set of terminators. CALL Get(test_unit, vs, 'r', SEPARATOR=vs_sep) WRITE (unit, "(2X,'Got ""',A,'"" and ""',A,'"".')") vs%chars, vs_sep%chars IF ( vs /= misc_test_content(:SCAN(misc_test_content, 'r')-1) & .OR. vs_sep /= 'r' ) THEN stat = 1 RETURN END IF ! Get the rest. CALL Get(test_unit, vs) WRITE (unit, "(2X,'Got ""',A,'"".')") vs%chars IF (vs /= misc_test_content(SCAN(misc_test_content, 'r')+1:)) THEN stat = 1 RETURN END IF REWIND test_unit ! Get a terminator that isn't there. CALL Get(test_unit, vs, 'q') WRITE (unit, "(2X,'Got ""',A,'"".')") vs%chars IF (vs%chars /= misc_test_content) THEN stat = 1 RETURN END IF stat = 0 END SUBROUTINE get_tests !----------------------------------------------------------------------------- !----------------------------------------------------------------------------- ! ! Tests of the PUT generic !***************************************************************************** ! ! PUT to a unit connected formatted sequential. ! ! Manual inspection of test output is required to confirm the tests work. SUBROUTINE test_put01(unit, stat) USE aniso_varying_string !--------------------------------------------------------------------------- ! Arguments. INTEGER, INTENT(IN) :: unit INTEGER, INTENT(OUT) :: stat !--------------------------------------------------------------------------- ! Locals TYPE(varying_string) :: vs !*************************************************************************** vs = 'Hello world' ! Start a record with varying_string output. CALL put(unit, vs) ! Finish the record off. WRITE (unit, "(A)") '-end' ! Write something at the start of the record. WRITE (unit, "(A)", ADVANCE='NO') 'start-' ! Write some varying_string output. CALL put(unit, vs) ! Finish the record off. WRITE (unit, "(A)") '-end' stat = 0 END SUBROUTINE test_put01 !----------------------------------------------------------------------------- !----------------------------------------------------------------------------- ! ! Tests of the PUT_LINE generic !***************************************************************************** ! ! PUT_LINE to a unit connected formatted sequential. ! ! Manual inspection of test output is required to confirm the tests work. SUBROUTINE test_put_line01(unit, stat) USE aniso_varying_string !--------------------------------------------------------------------------- ! Arguments. INTEGER, INTENT(IN) :: unit INTEGER, INTENT(OUT) :: stat !--------------------------------------------------------------------------- ! Locals TYPE(varying_string) :: vs !*************************************************************************** vs = misc_test_content ! Write a complete record with varying_string output. CALL put_line(unit, vs) ! Write something at the start of the record. WRITE (unit, "(A)", ADVANCE='NO') 'start-' ! Finish the record off with some varying_string output. CALL put_line(unit, vs) stat = 0 END SUBROUTINE test_put_line01 !----------------------------------------------------------------------------- !----------------------------------------------------------------------------- ! ! Tests of formatted defined output. !***************************************************************************** ! ! Internal list directed defined output. ! ! Manual inspection of test output is required to confirm the tests work. SUBROUTINE test_write_formatted01(unit, stat) USE aniso_varying_string !--------------------------------------------------------------------------- ! Arguments. INTEGER, INTENT(IN) :: unit INTEGER, INTENT(OUT) :: stat !--------------------------------------------------------------------------- ! Locals TYPE(varying_string) :: vs CHARACTER(30) :: buffer ! The internal file. !*************************************************************************** vs = 'NoSpaces' WRITE (buffer, *) vs WRITE (unit, "(2X,'Wrote ""',A,'"".')") buffer vs = 'Has spaces' WRITE (buffer, *) vs WRITE (unit, "(2X,'Wrote ""',A,'"".')") buffer vs = 'Has spaces delim=quote' WRITE (buffer, *, DELIM='QUOTE') vs WRITE (unit, "(2X,'Wrote ""',A,'"".')") buffer vs = 'Has spaces delim=apos' WRITE (buffer, *, DELIM='APOSTROPHE') vs WRITE (unit, "(2X,'Wrote ""',A,'"".')") buffer stat = 0 END SUBROUTINE test_write_formatted01 !***************************************************************************** ! ! Internal explicitly formatted defined output. ! ! Manual inspection of test output is required to confirm the tests work. SUBROUTINE test_write_formatted02(unit, stat) USE aniso_varying_string !--------------------------------------------------------------------------- ! Arguments. INTEGER, INTENT(IN) :: unit INTEGER, INTENT(OUT) :: stat !--------------------------------------------------------------------------- ! Locals TYPE(varying_string) :: vs CHARACTER(30) :: buffer ! The internal file. !*************************************************************************** vs = 'NoSpaces' WRITE (buffer, "(DT)") vs WRITE (unit, "(2X,'Wrote ""',A,'"".')") buffer vs = 'Has spaces' WRITE (buffer, "(DT)") vs WRITE (unit, "(2X,'Wrote ""',A,'"".')") buffer ! Cannot use DELIM with anything other than namelist or ! list directed output! ! vs = 'Has spaces delim=quote' ! WRITE (buffer, "(DT)", DELIM='QUOTE') vs ! WRITE (unit, "(2X,'Wrote ""',A,'"".')") buffer ! vs = 'Has spaces delim=apos' ! WRITE (buffer, "(DT)", DELIM='APOSTROPHE') vs ! WRITE (unit, "(2X,'Wrote ""',A,'"".')") buffer vs = 'Has ''apos''' WRITE (buffer, "(DT)") vs WRITE (unit, "(2X,'Wrote ""',A,'"".')") buffer ! vs = 'Has ''apos'' delim=apos' ! WRITE (buffer, "(DT)", DELIM='APOSTROPHE') vs ! WRITE (unit, "(2X,'Wrote ""',A,'"".')") buffer ! vs = 'Has "quotes" delim=quote' ! WRITE (buffer, "(DT)", DELIM='QUOTE') vs ! WRITE (unit, "(2X,'Wrote ""',A,'"".')") buffer stat = 0 END SUBROUTINE test_write_formatted02 !***************************************************************************** ! ! Internal namelist defined output. ! ! Manual inspection of test output is required to confirm the tests work. SUBROUTINE test_write_formatted03(unit, stat) USE aniso_varying_string !--------------------------------------------------------------------------- ! Arguments. INTEGER, INTENT(IN) :: unit INTEGER, INTENT(OUT) :: stat !--------------------------------------------------------------------------- ! Locals TYPE(varying_string) :: vs ! Namelist being written. NAMELIST /nml_vs/ vs ! The internal file. CHARACTER(30) :: buffer(5) !*************************************************************************** buffer = '' vs = 'Hello world' WRITE (buffer, nml_vs) WRITE (unit, "(2X,'Wrote :',/,*(9X,'""',A,'""',:,/))") buffer stat = 0 END SUBROUTINE test_write_formatted03 !***************************************************************************** ! ! External list directed defined output. ! ! Manual inspection of test output is required to confirm the tests work. SUBROUTINE test_write_formatted04(unit, stat) USE aniso_varying_string !--------------------------------------------------------------------------- ! Arguments. INTEGER, INTENT(IN) :: unit INTEGER, INTENT(OUT) :: stat !--------------------------------------------------------------------------- ! Locals TYPE(varying_string) :: vs !*************************************************************************** vs = 'NoSpaces' WRITE (unit, *) vs WRITE (unit, *) vs%chars vs = 'Has spaces' WRITE (unit, *) vs WRITE (unit, *) vs%chars vs = 'Has spaces delim=quote' WRITE (unit, *, DELIM='QUOTE') vs WRITE (unit, *, DELIM='QUOTE') vs%chars vs = 'Has spaces delim=apos' WRITE (unit, *, DELIM='APOSTROPHE') vs WRITE (unit, *, DELIM='APOSTROPHE') vs%chars vs = 'Has ''apos''' WRITE (unit, *) vs WRITE (unit, *) vs%chars vs = 'Has ''apos'' delim=apos' WRITE (unit, *, DELIM='APOSTROPHE') vs WRITE (unit, *, DELIM='APOSTROPHE') vs vs = 'Has "quotes" delim=quote' WRITE (unit, *, DELIM='QUOTE') vs WRITE (unit, *, DELIM='QUOTE') vs vs = 'string' WRITE (unit, *) 123, vs, 456 stat = 0 END SUBROUTINE test_write_formatted04 !***************************************************************************** ! ! External explicitly formatted defined output. ! ! Manual inspection of test output is required to confirm the tests work. SUBROUTINE test_write_formatted05(unit, stat) USE aniso_varying_string !--------------------------------------------------------------------------- ! Arguments. INTEGER, INTENT(IN) :: unit INTEGER, INTENT(OUT) :: stat !--------------------------------------------------------------------------- ! Locals TYPE(varying_string) :: vs !*************************************************************************** vs = 'NoSpaces' WRITE (unit, "(2X,DT)") vs WRITE (unit, "(2X,A)") vs%chars vs = 'Has spaces' WRITE (unit, "(2X,DT)") vs WRITE (unit, "(2X,A)") vs%chars ! Cannot use DELIM= with anything other than list directed or ! namelist output! vs = 'Has spaces delim=quote' ! WRITE (unit, "(2X,DT)", DELIM='QUOTE') vs ! WRITE (unit, "(2X,A)", DELIM='QUOTE') vs%chars vs = 'Has spaces delim=apos' ! WRITE (unit, "(2X,DT)", DELIM='APOSTROPHE') vs ! WRITE (unit, "(2X,A)", DELIM='APOSTROPHE') vs%chars vs = 'Has ''apos''' WRITE (unit, "(2X,DT)") vs WRITE (unit, "(2X,A)") vs%chars vs = 'Has ''apos'' delim=apos' ! WRITE (unit, "(2X,DT)", DELIM='APOSTROPHE') vs ! WRITE (unit, "(2X,A)", DELIM='APOSTROPHE') vs%chars vs = 'Has "quotes" delim=quote' ! WRITE (unit, "(2X,DT)", DELIM='QUOTE') vs ! WRITE (unit, "(2X,A)", DELIM='QUOTE') vs%chars stat = 0 END SUBROUTINE test_write_formatted05 !***************************************************************************** ! ! External namelist defined output. ! ! Manual inspection of test output is required to confirm the tests work. SUBROUTINE test_write_formatted06(unit, stat) USE aniso_varying_string !--------------------------------------------------------------------------- ! Arguments. INTEGER, INTENT(IN) :: unit INTEGER, INTENT(OUT) :: stat !--------------------------------------------------------------------------- ! Locals TYPE(varying_string) :: vs CHARACTER(:), ALLOCATABLE :: ch NAMELIST /nml_vs/vs NAMELIST /nml_ch/ch !*************************************************************************** ch = 'NoSpaces' vs = ch WRITE (unit, nml_vs) WRITE (unit, nml_ch) stat = 0 END SUBROUTINE test_write_formatted06 !----------------------------------------------------------------------------- !----------------------------------------------------------------------------- ! ! Tests of formatted defined input. !***************************************************************************** ! ! Internal list directed defined input. SUBROUTINE test_read_formatted01(unit, stat) USE aniso_varying_string !--------------------------------------------------------------------------- ! Arguments. INTEGER, INTENT(IN) :: unit INTEGER, INTENT(OUT) :: stat !--------------------------------------------------------------------------- ! Locals TYPE(varying_string) :: vs CHARACTER(30) :: buffer ! The internal file. !*************************************************************************** buffer = 'NoSpaces' READ (buffer, *) vs WRITE (unit, "(2X,'Got ""',A,'"".')") vs%chars IF (vs /= 'NoSpaces') THEN stat = 1 RETURN END IF buffer = 'No quotes' READ (buffer, *) vs WRITE (unit, "(2X,'Got ""',A,'"".')") vs%chars IF (vs /= 'No') THEN stat = 1 RETURN END IF buffer = '"Has quotes"' READ (buffer, *) vs WRITE (unit, "(2X,'Got ""',A,'"".')") vs%chars IF (vs /= '"Has quotes"') THEN stat = 1 RETURN END IF buffer = '"Internal "" quotes"' READ (buffer, *) vs WRITE (unit, "(2X,'Got ""',A,'"".')") vs%chars IF (vs /= 'Internal " quotes') THEN stat = 1 RETURN END IF stat = 0 END SUBROUTINE test_read_formatted01 !***************************************************************************** ! ! Internal explicitly formatted defined input. SUBROUTINE test_read_formatted02(unit, stat) USE aniso_varying_string !--------------------------------------------------------------------------- ! Arguments. INTEGER, INTENT(IN) :: unit INTEGER, INTENT(OUT) :: stat !--------------------------------------------------------------------------- ! Locals TYPE(varying_string) :: vs ! The internal file. CHARACTER(:), ALLOCATABLE :: buffer INTEGER :: iostat ! IOSTAT result. CHARACTER(100) :: iomsg ! IOMSG result. !*************************************************************************** iomsg = REPEAT('x', LEN(iomsg)) ! Empty record - get zero length string and EOR. ! ifort EOR issue prevents testing for EOR. ! buffer = '' ! READ (buffer, "(DT)", IOSTAT=iostat, IOMSG=iomsg) vs ! WRITE (unit, "(2X,'Got IOSTAT of ',I0,' ""',A,'""')") iostat, TRIM(iomsg) ! IF (.NOT. IS_IOSTAT_EOR(iostat)) THEN ! stat = 1 ! RETURN ! END IF ! IF (vs /= '') THEN ! stat = 1 ! RETURN ! END IF ! All blanks - get zero length string and EOR. ! ifort EOR issue prevents testing for EOR. ! buffer = REPEAT(' ', 8) ! READ (buffer, "(DT)", IOSTAT=iostat, IOMSG=iomsg) vs ! WRITE (unit, "(2X,'Got IOSTAT of ',I0,' ""',A,'""')") iostat, TRIM(iomsg) ! IF (.NOT. IS_IOSTAT_EOR(iostat)) THEN ! stat = 1 ! RETURN ! END IF ! WRITE (unit, "(2X,'Got ""',A,'"".')") vs%chars ! IF (vs /= buffer) THEN ! stat = 1 ! RETURN ! END IF ! No other separators before EOR. ! (ifort currently "works" by accident here due to returning blanks.) buffer = 'NoSpaces' READ (buffer, "(DT)") vs WRITE (unit, "(2X,'Got ""',A,'"".')") vs%chars IF (vs /= 'NoSpaces') THEN stat = 1 RETURN END IF ! Blank terminates, no EOR. buffer = 'No quotes' READ (buffer, "(DT)") vs WRITE (unit, "(2X,'Got ""',A,'"".')") vs%chars IF (vs /= 'No') THEN stat = 1 RETURN END IF ! Get dequoted value, plus EOR. buffer = '"Has quotes"' READ (buffer, "(DT)") vs WRITE (unit, "(2X,'Got ""',A,'"".')") vs%chars IF (vs /= 'Has quotes') THEN stat = 1 RETURN END IF buffer = '"Internal "" quotes"' READ (buffer, "(DT)") vs WRITE (unit, "(2X,'Got ""',A,'"".')") vs%chars IF (vs /= 'Internal " quotes') THEN stat = 1 RETURN END IF stat = 0 END SUBROUTINE test_read_formatted02 !***************************************************************************** ! ! Internal namelist formatted defined input. SUBROUTINE test_read_formatted03(unit, stat) USE aniso_varying_string !--------------------------------------------------------------------------- ! Arguments INTEGER, INTENT(IN) :: unit INTEGER, INTENT(OUT) :: stat !--------------------------------------------------------------------------- ! Locals TYPE(varying_string) :: vs ! The namelist being read. NAMELIST /nml_vs/ vs ! The internal file. CHARACTER(:), ALLOCATABLE :: buffer(:) INTEGER :: iostat ! IOSTAT result. CHARACTER(100) :: iomsg ! IOMSG result. !*************************************************************************** iomsg = REPEAT('x', LEN(iomsg)) buffer = [ & '&NML_VS ', & 'VS="Has quotes"/' ] READ (buffer, nml_vs) WRITE (unit, "(2X,'Got ""',A,'"".')") vs%chars buffer = [ & '&NML_VS VS= "LeadingSpaces"/' ] READ (buffer, nml_vs) WRITE (unit, "(2X,'Got ""',A,'"".')") vs%chars ! See https://software.intel.com/en-us/forums/intel-visual-fortran-compiler-for-windows/topic/618870#comment-1864365 ! buffer = [ & ! '&NML_VS VS= ', & ! '"NextRecord"/ ' ] ! READ (buffer, nml_vs) ! WRITE (unit, "(2X,'Got ""',A,'"".')") vs%chars ! We expect an error - the value must be quoted. buffer = [ & '&NML_VS VS=NoQuotes/ ' ] READ (buffer, nml_vs, IOSTAT=iostat, IOMSG=iomsg) WRITE (unit, "(2X,'Got IOSTAT=',I0, ' ',A)") iostat, TRIM(iomsg) stat = 0 END SUBROUTINE test_read_formatted03 !***************************************************************************** ! ! External list directed defined input. SUBROUTINE test_read_formatted04(unit, stat) USE aniso_varying_string !--------------------------------------------------------------------------- ! Arguments INTEGER, INTENT(IN) :: unit INTEGER, INTENT(OUT) :: stat !--------------------------------------------------------------------------- ! Locals TYPE(varying_string) :: vs INTEGER :: test_unit ! Unit for the external file. !*************************************************************************** OPEN( & NEWUNIT=test_unit, & FILE=test_file_name // '-read_formatted04.txt', & STATUS='REPLACE', & ACTION='READWRITE' ) WRITE (test_unit, "(A)") 'NoSpaces' WRITE (test_unit, "(A)") 'Has spaces' WRITE (test_unit, "(A)") '"In quotes"' WRITE (test_unit, "(A)") ' LeadingSpace' WRITE (test_unit, "(A)") 'TrailingSpace ' WRITE (test_unit, "()") ! Empty record. WRITE (test_unit, "(A)") 'value-on-next-line' REWIND(test_unit) ! End-of-record terminated. READ (test_unit, *) vs WRITE (unit, "(2X,'Got ""',A,'"".')") vs%chars IF (vs /= 'NoSpaces') THEN stat = 1 RETURN END IF ! Blank terminated. READ (test_unit, *) vs WRITE (unit, "(2X,'Got ""',A,'"".')") vs%chars IF (vs /= 'Has') THEN stat = 1 RETURN END IF ! Delimited string. READ (test_unit, *) vs WRITE (unit, "(2X,'Got ""',A,'"".')") vs%chars IF (vs /= 'In quotes') THEN stat = 1 RETURN END IF ! Skip leading space. READ (test_unit, *) vs WRITE (unit, "(2X,'Got ""',A,'"".')") vs%chars IF (vs /= 'LeadingSpace') THEN stat = 1 RETURN END IF ! Blank terminated. READ (test_unit, *) vs WRITE (unit, "(2X,'Got ""',A,'"".')") vs%chars IF (vs /= 'TrailingSpace') THEN stat = 1 RETURN END IF ! Skip blank record. READ (test_unit, *) vs WRITE (unit, "(2X,'Got ""',A,'"".')") vs%chars IF (vs /= 'value-on-next-line') THEN stat = 1 RETURN END IF CLOSE(test_unit) stat = 0 END SUBROUTINE test_read_formatted04 !***************************************************************************** ! ! External explicitly formatted defined input on formatted sequential. SUBROUTINE test_read_formatted05(unit, stat) USE aniso_varying_string !--------------------------------------------------------------------------- ! Arguments INTEGER, INTENT(IN) :: unit INTEGER, INTENT(OUT) :: stat !--------------------------------------------------------------------------- ! Locals TYPE(varying_string) :: vs INTEGER :: test_unit ! Unit for the external file. INTEGER :: iostat ! IOSTAT result. CHARACTER(100) :: iomsg ! IOMSG result. INTEGER :: itmp1 ! Integer temporary for testing. INTEGER :: itmp2 ! Integer temporary for testing. !*************************************************************************** iomsg = REPEAT('x', LEN(iomsg)) OPEN( & NEWUNIT=test_unit, & FILE=test_file_name // '-read_formatted05.txt', & STATUS='REPLACE', & ACTION='READWRITE' ) ! WRITE (test_unit, "()") ! Empty record. ! WRITE (test_unit, "(A)") ' ' ! All blank record. WRITE (test_unit, "(A)") 'NoSpaces' WRITE (test_unit, "(A)") 'Has spaces' WRITE (test_unit, "(A)") '"In quotes"' WRITE (test_unit, "(I3,A,1X,I3)") 123, 'in-the-middle', 456 REWIND(test_unit) ! Empty record gives zero length string and EOR. ! ifort EOR issue mean we cannot test this. ! READ (test_unit, "(DT)", IOSTAT=iostat, IOMSG=iomsg) vs ! WRITE (unit, "(2X,'Got IOSTAT of ',I0,' ""',A,'""')") iostat, TRIM(iomsg) ! IF (.NOT. IS_IOSTAT_EOR(iostat)) THEN ! stat = 1 ! RETURN ! END IF ! WRITE (unit, "(2X,'Got ""',A,'"".')") vs%chars ! IF (vs /= '') THEN ! stat = 1 ! RETURN ! END IF ! All blank record gives zero length string and EOR. ! ifort EOR issue mean we cannot test this. ! READ (test_unit, "(DT)", IOSTAT=iostat, IOMSG=iomsg) vs ! WRITE (unit, "(2X,'Got IOSTAT of ',I0,' ""',A,'""')") iostat, TRIM(iomsg) ! IF (.NOT. IS_IOSTAT_EOR(iostat)) THEN ! stat = 1 ! RETURN ! END IF ! WRITE (unit, "(2X,'Got ""',A,'"".')") vs%chars ! IF (vs /= '') THEN ! stat = 1 ! RETURN ! END IF ! EOR terminated. READ (test_unit, "(DT)") vs WRITE (unit, "(2X,'Got ""',A,'"".')") vs%chars IF (vs /= 'NoSpaces') THEN stat = 1 RETURN END IF ! Blank terminated. READ (test_unit, "(DT)") vs WRITE (unit, "(2X,'Got ""',A,'"".')") vs%chars IF (vs /= 'Has') THEN stat = 1 RETURN END IF ! Quote terminated. READ (test_unit, "(DT)") vs WRITE (unit, "(2X,'Got ""',A,'"".')") vs%chars IF (vs /= 'In quotes') THEN stat = 1 RETURN END IF ! non-fixed varying_string in the middle of other input. READ (test_unit, "(I3,DT,1X,I3)") itmp1, vs, itmp2 WRITE (unit, "(2X,'Got ',I0,', ""',A,'"" and ',I0,'.')") & itmp1, vs%chars, itmp2 IF (itmp1 /= 123 .OR. vs /= 'in-the-middle' .OR. itmp2 /= 456) THEN stat = 1 RETURN END IF CLOSE(test_unit) stat = 0 END SUBROUTINE test_read_formatted05 !***************************************************************************** ! ! External namelist formatting defined input. SUBROUTINE test_read_formatted06(unit, stat) USE aniso_varying_string !--------------------------------------------------------------------------- ! Arguments INTEGER, INTENT(IN) :: unit INTEGER, INTENT(OUT) :: stat !--------------------------------------------------------------------------- ! Locals TYPE(varying_string) :: vs ! The namelist being read. NAMELIST /nml_vs/ vs INTEGER :: test_unit ! Unit for the external file. INTEGER :: iostat ! IOSTAT result. CHARACTER(100) :: iomsg ! IOMSG result. !*************************************************************************** iomsg = REPEAT('x', LEN(iomsg)) OPEN( & NEWUNIT=test_unit, & FILE=test_file_name // '-read_formatted06.txt', & STATUS='REPLACE', & ACTION='READWRITE' ) WRITE (test_unit, "(A)") '&NML_VS VS="First record"/' WRITE (test_unit, "(A)") '&NML_VS' WRITE (test_unit, "(A)") 'VS="Second record"/' ! See https://software.intel.com/en-us/forums/intel-visual-fortran-compiler-for-windows/topic/618870#comment-1864365 ! WRITE (test_unit, "(A)") '&NML_VS VS= ' ! WRITE (test_unit, "(A)") '"Second record"/' WRITE (test_unit, "(A)") '&NML_VS' WRITE (test_unit, "(A)") 'VS=NoSpaces/' REWIND(test_unit) READ (test_unit, nml_vs) WRITE (unit, "(2X,'Got ""',A,'"".')") vs%chars IF (vs /= 'First record') THEN stat = 1 RETURN END IF READ (test_unit, nml_vs) WRITE (unit, "(2X,'Got ""',A,'"".')") vs%chars IF (vs /= 'Second record') THEN stat = 1 RETURN END IF ! See https://software.intel.com/en-us/forums/intel-visual-fortran-compiler-for-windows/topic/618870#comment-1864365 ! READ (test_unit, nml_vs) ! WRITE (unit, "(2X,'Got ""',A,'"".')") vs%chars ! IF (vs /= 'Second record') THEN ! stat = 1 ! RETURN ! END IF ! Expect a non-zero IOSTAT with missing spaces. READ (test_unit, nml_vs, IOSTAT=iostat, IOMSG=iomsg) WRITE (unit, "(2X,'Got IOSTAT of ',I0,' ""',A,'""')") iostat, TRIM(iomsg) IF (iostat <= 0) THEN stat = 1 RETURN END IF CLOSE(test_unit) stat = 0 END SUBROUTINE test_read_formatted06 !***************************************************************************** ! ! Invalid DT modifiers. SUBROUTINE test_read_formatted07(unit, stat) USE aniso_varying_string !--------------------------------------------------------------------------- ! Arguments. INTEGER, INTENT(IN) :: unit INTEGER, INTENT(OUT) :: stat !--------------------------------------------------------------------------- ! Locals TYPE(varying_string) :: vs CHARACTER(20) :: buffer ! Internal file. INTEGER :: iostat ! IOSTAT result. CHARACTER(100) :: iomsg ! IOMSG result. !*************************************************************************** ! The content should never actually be read. buffer = misc_test_content READ (buffer, "(DT'wtf')", IOSTAT=iostat, IOMSG=iomsg) vs WRITE (unit, "(2X,'Got IOSTAT of ',I0,' ""',A,'""')") iostat, TRIM(iomsg) IF (iostat <= 0) THEN ; stat = 1 ; RETURN ; END IF READ (buffer, "(DT'fixed')", IOSTAT=iostat, IOMSG=iomsg) vs WRITE (unit, "(2X,'Got IOSTAT of ',I0,' ""',A,'""')") iostat, TRIM(iomsg) IF (iostat <= 0) THEN ; stat = 1 ; RETURN ; END IF READ (buffer, "(DT'fixed(')", IOSTAT=iostat, IOMSG=iomsg) vs WRITE (unit, "(2X,'Got IOSTAT of ',I0,' ""',A,'""')") iostat, TRIM(iomsg) IF (iostat <= 0) THEN ; stat = 1 ; RETURN ; END IF READ (buffer, "(DT'fixed()')", IOSTAT=iostat, IOMSG=iomsg) vs WRITE (unit, "(2X,'Got IOSTAT of ',I0,' ""',A,'""')") iostat, TRIM(iomsg) IF (iostat <= 0) THEN ; stat = 1 ; RETURN ; END IF READ (buffer, "(DT'fixed(xx)')", IOSTAT=iostat, IOMSG=iomsg) vs WRITE (unit, "(2X,'Got IOSTAT of ',I0,' ""',A,'""')") iostat, TRIM(iomsg) IF (iostat <= 0) THEN ; stat = 1 ; RETURN ; END IF READ (buffer, "(DT'fixed(123')", IOSTAT=iostat, IOMSG=iomsg) vs WRITE (unit, "(2X,'Got IOSTAT of ',I0,' ""',A,'""')") iostat, TRIM(iomsg) IF (iostat <= 0) THEN ; stat = 1 ; RETURN ; END IF READ (buffer, "(DT'delim')", IOSTAT=iostat, IOMSG=iomsg) vs WRITE (unit, "(2X,'Got IOSTAT of ',I0,' ""',A,'""')") iostat, TRIM(iomsg) IF (iostat <= 0) THEN ; stat = 1 ; RETURN ; END IF READ (buffer, "(DT'delim(')", IOSTAT=iostat, IOMSG=iomsg) vs WRITE (unit, "(2X,'Got IOSTAT of ',I0,' ""',A,'""')") iostat, TRIM(iomsg) IF (iostat <= 0) THEN ; stat = 1 ; RETURN ; END IF READ (buffer, "(DT'delim()')", IOSTAT=iostat, IOMSG=iomsg) vs WRITE (unit, "(2X,'Got IOSTAT of ',I0,' ""',A,'""')") iostat, TRIM(iomsg) IF (iostat <= 0) THEN ; stat = 1 ; RETURN ; END IF READ (buffer, "(DT'delim(123)')", IOSTAT=iostat, IOMSG=iomsg) vs WRITE (unit, "(2X,'Got IOSTAT of ',I0,' ""',A,'""')") iostat, TRIM(iomsg) IF (iostat <= 0) THEN ; stat = 1 ; RETURN ; END IF ! This appears to make gfortran trunk r239953 choke. ! READ (buffer, "(DT'delim(''abc')", IOSTAT=iostat, IOMSG=iomsg) vs ! WRITE (unit, "(2X,'Got IOSTAT of ',I0,' ""',A,'""')") iostat, TRIM(iomsg) ! IF (iostat <= 0) THEN ; stat = 1 ; RETURN ; END IF ! This appears to make gfortran trunk r239953 choke. ! READ (buffer, "(DT'delim(''abc''')", IOSTAT=iostat, IOMSG=iomsg) vs ! WRITE (unit, "(2X,'Got IOSTAT of ',I0,' ""',A,'""')") iostat, TRIM(iomsg) ! IF (iostat <= 0) THEN ; stat = 1 ; RETURN ; END IF READ (buffer, "(DT'eor,')", IOSTAT=iostat, IOMSG=iomsg) vs WRITE (unit, "(2X,'Got IOSTAT of ',I0,' ""',A,'""')") iostat, TRIM(iomsg) IF (iostat <= 0) THEN ; stat = 1 ; RETURN ; END IF READ (buffer, "(DT'eor,fixed(10)')", IOSTAT=iostat, IOMSG=iomsg) vs WRITE (unit, "(2X,'Got IOSTAT of ',I0,' ""',A,'""')") iostat, TRIM(iomsg) IF (iostat <= 0) THEN ; stat = 1 ; RETURN ; END IF READ (buffer, "(DT'eor,eor')", IOSTAT=iostat, IOMSG=iomsg) vs WRITE (unit, "(2X,'Got IOSTAT of ',I0,' ""',A,'""')") iostat, TRIM(iomsg) IF (iostat <= 0) THEN ; stat = 1 ; RETURN ; END IF ! This appears to make gfortran trunk r239953 choke. ! READ ( buffer, "(DT'delim(''a''),delim(''b'')')", & ! IOSTAT=iostat, IOMSG=iomsg ) vs ! WRITE (unit, "(2X,'Got IOSTAT of ',I0,' ""',A,'""')") iostat, TRIM(iomsg) ! IF (iostat <= 0) THEN ; stat = 1 ; RETURN ; END IF READ (buffer, "(DT'fixed(10),fixed(20)')", IOSTAT=iostat, IOMSG=iomsg) vs WRITE (unit, "(2X,'Got IOSTAT of ',I0,' ""',A,'""')") iostat, TRIM(iomsg) IF (iostat <= 0) THEN ; stat = 1 ; RETURN ; END IF stat = 0 END SUBROUTINE test_read_formatted07 !***************************************************************************** ! ! External explicit DT with keywords other than fixed. SUBROUTINE test_read_formatted08(unit, stat) USE aniso_varying_string !--------------------------------------------------------------------------- ! Arguments. INTEGER, INTENT(IN) :: unit INTEGER, INTENT(OUT) :: stat !--------------------------------------------------------------------------- ! Locals TYPE(varying_string) :: vs, vs2, vs3 INTEGER :: test_unit ! Unit for the external file. INTEGER :: iostat ! IOSTAT result. CHARACTER(100) :: iomsg ! IOMSG result. CHARACTER(3) :: before ! Character temp. CHARACTER(3) :: after ! Character temp. !*************************************************************************** OPEN( & NEWUNIT=test_unit, & FILE=test_file_name // '-read_formatted08.txt', & STATUS='REPLACE', & ACTION='READWRITE' ) ! WRITE (test_unit, "(A)") 'xyzzy' ! WRITE (test_unit, "(A)") 'Read a whole line through to EOR' WRITE (test_unit, "(A,1X,A)") '"Delimited string"', 'following-rubbish' WRITE (test_unit, "(A)") 'Comma,Separated,Values' WRITE (test_unit, "(A)") '"Quoted string,with commas"' ! WRITE (test_unit, "(A)") 'More comma,separated,values' ! WRITE (test_unit, "(A)") 'More comma,separated,values' ! WRITE (test_unit, "(A)") 'blank "sep a rated" values' ! WRITE (test_unit, "(A)") 'slash/separated/values' WRITE (test_unit, "(A)") 'abcFixedWidthxyz' REWIND(test_unit) ! Read till EOR, expect EOR. ! See https://software.intel.com/en-us/forums/intel-visual-fortran-compiler-for-windows/topic/618870#comment-1864365 ! (ifort never returns EOR, so we cannot detect when input should ! finish.) ! READ (test_unit, "(DT'eor')", IOSTAT=iostat, IOMSG=iomsg) vs ! IF (.NOT. IS_IOSTAT_EOR(iostat)) THEN ! stat = 1 ! RETURN ! END IF ! WRITE (unit, "(2X,'Got ""',A,'"".')") vs%chars ! IF (vs /= 'xyzzy') THEN ! stat = 1 ! RETURN ! END IF ! As above. ! READ (test_unit, "(DT'eor')", IOSTAT=iostat, IOMSG=iomsg) vs ! IF (.NOT. IS_IOSTAT_EOR(iostat)) THEN ! stat = 1 ! RETURN ! END IF ! WRITE (unit, "(2X,'Got ""',A,'"".')") vs%chars ! IF (vs /= 'xyzzy') THEN ! stat = 1 ! RETURN ! END IF ! Input terminates at the end of the delimited string READ (test_unit, "(DT'eor')") vs WRITE (unit, "(2X,'Got ""',A,'"".')") vs%chars IF (vs /= 'Delimited string') THEN stat = 1 RETURN END IF ! Input terminates at the comma. READ (test_unit, "(DT'comma')") vs WRITE (unit, "(2X,'Got ""',A,'"".')") vs%chars IF (vs /= 'Comma') THEN stat = 1 RETURN END IF ! Input terminates at end of quoted string READ (test_unit, "(DT'comma')") vs WRITE (unit, "(2X,'Got ""',A,'"".')") vs%chars IF (vs /= 'Quoted string,with commas') THEN stat = 1 RETURN END IF ! EOR issue ! READ (test_unit, "(DT'comma,noskipblank',1X,DT'comma,noskipblank',1X,DT'comma,noskipblank')") vs, vs2, vs3 ! WRITE (unit, "(2X,'Got ',*('""',A,'""',:,','))") & ! vs%chars, vs2%chars, vs3%chars ! IF (vs /= 'More comma' .OR. vs2 /= 'separated' .OR. vs3 /= 'values') THEN ! stat = 1 ! RETURN ! END IF ! ifort has issue with DT with repeat - see ! https://software.intel.com/en-us/forums/intel-visual-fortran-compiler-for-windows/topic/618870#comment-1866199 ! Read CSV record with fixed number of fields. ! READ (test_unit, "(*(DT'comma,noskipblank',:,1X))") vs, vs2, vs3 ! WRITE (unit, "(2X,'Got ',*('""',A,'""',:,','))") & ! vs%chars, vs2%chars, vs3%chars ! IF (vs /= 'More comma' .OR. vs2 /= 'separated' .OR. vs3 /= 'values') THEN ! stat = 1 ! RETURN ! END IF ! READ (test_unit, "(3DT'blank')") & ! vs, vs2, vs3 ! WRITE (unit, "(2X,'Got ""',A,'"".')") vs%chars ! IF (vs /= 'blank' .OR. vs2 /= 'sep a rated' .OR. vs3 /= 'values') THEN ! stat = 1 ! RETURN ! END IF ! READ (test_unit, "(3(DT'slash',:,1X))") vs, vs2, vs3 ! WRITE (unit, "(2X,'Got ""',A,'"".')") vs%chars ! IF (vs /= 'slash' .OR. vs2 /= 'separated' .OR. vs3 /= 'values') THEN ! stat = 1 ! RETURN ! END IF READ (test_unit, "(A,DT'fixed(10)',A)") before, vs, after WRITE (unit, "(2X,'Got ""',A,'"".')") vs%chars IF (before /= 'abc' .OR. vs /= 'FixedWidth' .OR. after /= 'xyz') THEN stat = 1 RETURN END IF CLOSE(test_unit) stat = 0 END SUBROUTINE test_read_formatted08 !***************************************************************************** ! ! External explicit DT with fixed keyword. SUBROUTINE test_read_formatted09(unit, stat) USE aniso_varying_string !--------------------------------------------------------------------------- ! Arguments. INTEGER, INTENT(IN) :: unit INTEGER, INTENT(OUT) :: stat !--------------------------------------------------------------------------- ! Locals TYPE(varying_string) :: vs INTEGER :: test_unit ! Unit for the external file. INTEGER :: iostat ! IOSTAT result. CHARACTER(100) :: iomsg ! IOMSG result. CHARACTER :: before ! Character temporary CHARACTER :: after ! Character temporary !*************************************************************************** OPEN( & NEWUNIT=test_unit, & FILE=test_file_name // '-read_formatted09.txt', & STATUS='REPLACE', & ACTION='READWRITE' ) WRITE (test_unit, "(A)") 'abcdef' REWIND(test_unit) ! part record. READ (test_unit, "(DT'fixed(3)')") vs WRITE (unit, "(2X,'Got ""',A,'"".')") vs%chars IF (vs /= 'abc') THEN stat = 1 RETURN END IF REWIND(test_unit) ! part record, with leading and trailing bits of other type. READ (test_unit, "(A,DT'fixed(3)',A)") before, vs, after WRITE (unit, "(2X,'Got ""',A,'"".')") vs%chars IF (before /= 'a') THEN stat = 1 RETURN END IF IF (vs /= 'bcd') THEN stat = 1 RETURN END IF IF (after /= 'e') THEN stat = 1 RETURN END IF REWIND(test_unit) ! Full record. READ (test_unit, "(DT'fixed(6)')") vs WRITE (unit, "(2X,'Got ""',A,'"".')") vs%chars IF (vs /= 'abcdef') THEN stat = 1 RETURN END IF REWIND(test_unit) ! More than a full record. READ (test_unit, "(DT'fixed(9)')", IOSTAT=iostat, IOMSG=iomsg) vs WRITE (unit, "(2X,'Got ""',A,'"".')") vs%chars WRITE (unit, "(2X,'Got IOSTAT of ',I0,' ""',A,'""')") iostat, TRIM(iomsg) IF (vs /= 'abcdef') THEN stat = 1 RETURN END IF IF (.NOT. IS_IOSTAT_EOR(iostat)) THEN stat = 1 RETURN END IF CLOSE(test_unit) stat = 0 END SUBROUTINE test_read_formatted09 !----------------------------------------------------------------------------- !----------------------------------------------------------------------------- ! ! Tests of unformatted defined output. !***************************************************************************** ! ! Unformatted sequential defined output. ! ! Inspect a hexdump or similar of the output file (which will be ! processor dependent) to confirm the test worked. The file may ! also contain things like record lengths or record separators. SUBROUTINE test_write_unformatted01(unit, stat) USE aniso_varying_string !--------------------------------------------------------------------------- ! Arguments. INTEGER, INTENT(IN) :: unit INTEGER, INTENT(OUT) :: stat !--------------------------------------------------------------------------- ! Locals TYPE(varying_string) :: vs INTEGER :: test_unit ! Unit for the external file. !*************************************************************************** OPEN( & NEWUNIT=test_unit, & FILE=test_file_name // '-write_unformatted01.bin', & STATUS='REPLACE', & ACTION='WRITE', & FORM='UNFORMATTED' ) vs = misc_test_content WRITE (test_unit) vs WRITE (test_unit) 123, vs, 456 CLOSE(test_unit) stat = 0 END SUBROUTINE test_write_unformatted01 !***************************************************************************** ! ! Unformatted direct defined output. ! ! Inspect a hexdump or similar of the output file (which will be ! processor dependent) to confirm the test worked. The file may ! also contain things like record lengths or record separators. SUBROUTINE test_write_unformatted02(unit, stat) USE aniso_varying_string !--------------------------------------------------------------------------- ! Arguments. INTEGER, INTENT(IN) :: unit INTEGER, INTENT(OUT) :: stat !--------------------------------------------------------------------------- ! Locals TYPE(varying_string) :: vs INTEGER :: test_unit ! Unit for the external file. !*************************************************************************** OPEN( & NEWUNIT=test_unit, & FILE=test_file_name // '-write_unformatted02.bin', & STATUS='REPLACE', & ACTION='WRITE', & FORM='UNFORMATTED', & ACCESS='DIRECT', & RECL=80 ) vs = misc_test_content WRITE (test_unit, REC=1) vs WRITE (test_unit, REC=2) 123, vs, 456 CLOSE(test_unit) stat = 0 END SUBROUTINE test_write_unformatted02 !***************************************************************************** ! ! Unformatted stream defined output. ! ! Inspect a hexdump or similar of the output file (which will be ! processor dependent) to confirm the test worked. The file should ! contain the unformatted stream representation of a default integer, ! followed by the unformatted stream representation of each ! character in the test string. SUBROUTINE test_write_unformatted03(unit, stat) USE aniso_varying_string !--------------------------------------------------------------------------- ! Arguments. INTEGER, INTENT(IN) :: unit INTEGER, INTENT(OUT) :: stat !--------------------------------------------------------------------------- ! Locals TYPE(varying_string) :: vs INTEGER :: test_unit ! Unit for the external file. !*************************************************************************** OPEN( & NEWUNIT=test_unit, & FILE=test_file_name // '-write_unformatted03.bin', & STATUS='REPLACE', & ACTION='WRITE', & FORM='UNFORMATTED', & ACCESS='STREAM' ) vs = misc_test_content WRITE (test_unit) vs WRITE (test_unit) 123, vs, 456 CLOSE(test_unit) stat = 0 END SUBROUTINE test_write_unformatted03 !----------------------------------------------------------------------------- !----------------------------------------------------------------------------- ! ! Tests of unformatted defined input. ! ! Many of these tests implicitly assume that unformatted defined output ! is already working (or they test defined output as well as defined ! input). !***************************************************************************** ! ! Unformatted sequential defined input (and defined output too). SUBROUTINE test_read_unformatted01(unit, stat) USE aniso_varying_string !--------------------------------------------------------------------------- ! Arguments. INTEGER, INTENT(IN) :: unit INTEGER, INTENT(OUT) :: stat !--------------------------------------------------------------------------- ! Locals ! Varying string read. TYPE(varying_string) :: vs ! Varying string written. TYPE(varying_string) :: vs_out INTEGER :: test_unit ! Unit for the external file. INTEGER :: itmp1 ! Integer temporary INTEGER :: itmp2 ! Integer temporary !*************************************************************************** ! Prepare test input. OPEN( & NEWUNIT=test_unit, & FILE=test_file_name // '-write_unformatted01.bin', & STATUS='REPLACE', & ACTION='READWRITE', & FORM='UNFORMATTED' ) vs_out = misc_test_content WRITE (test_unit) vs_out WRITE (test_unit) 123, vs_out, 456 REWIND(test_unit) READ (test_unit) vs WRITE (unit, "(2X,'Got ""',A,'"".')") vs%chars IF (vs /= misc_test_content) THEN stat = 1 RETURN END IF READ (test_unit) itmp1, vs, itmp2 WRITE (unit, "(2X,'Got ',I0,', ""',A,'"", ',I0)") itmp1, vs%chars, itmp2 IF (itmp1 /= 123 .OR. vs /= misc_test_content .OR. itmp2 /= 456) THEN stat = 1 RETURN END IF CLOSE(test_unit) stat = 0 END SUBROUTINE test_read_unformatted01 !***************************************************************************** ! ! Unformatted direct defined input (and defined output too). SUBROUTINE test_read_unformatted02(unit, stat) USE aniso_varying_string !--------------------------------------------------------------------------- ! Arguments. INTEGER, INTENT(IN) :: unit INTEGER, INTENT(OUT) :: stat !--------------------------------------------------------------------------- ! Locals ! Varying string read. TYPE(varying_string) :: vs ! Varying string written. TYPE(varying_string) :: vs_out INTEGER :: test_unit ! Unit for the external file. INTEGER :: itmp1 ! Integer temporary INTEGER :: itmp2 ! Integer temporary !*************************************************************************** ! Prepare test input. OPEN( & NEWUNIT=test_unit, & FILE=test_file_name // '-write_unformatted02.bin', & STATUS='REPLACE', & ACTION='READWRITE', & FORM='UNFORMATTED', & ACCESS='DIRECT', & RECL=80 ) vs_out = misc_test_content WRITE (test_unit, REC=1) vs_out WRITE (test_unit, REC=2) 123, vs_out, 456 REWIND(test_unit) READ (test_unit, REC=1) vs WRITE (unit, "(2X,'Got ""',A,'"".')") vs%chars IF (vs /= misc_test_content) THEN stat = 1 RETURN END IF READ (test_unit, REC=2) itmp1, vs, itmp2 WRITE (unit, "(2X,'Got ',I0,', ""',A,'"", ',I0)") itmp1, vs%chars, itmp2 IF (itmp1 /= 123 .OR. vs /= misc_test_content .OR. itmp2 /= 456) THEN stat = 1 RETURN END IF CLOSE(test_unit) stat = 0 END SUBROUTINE test_read_unformatted02 !***************************************************************************** ! ! Unformatted sequential defined input (and defined output too). SUBROUTINE test_read_unformatted03(unit, stat) USE aniso_varying_string !--------------------------------------------------------------------------- ! Arguments. INTEGER, INTENT(IN) :: unit INTEGER, INTENT(OUT) :: stat !--------------------------------------------------------------------------- ! Locals ! Varying string read. TYPE(varying_string) :: vs ! Varying string written. TYPE(varying_string) :: vs_out INTEGER :: test_unit ! Unit for the external file. INTEGER :: itmp1 ! Integer temporary INTEGER :: itmp2 ! Integer temporary !*************************************************************************** ! Prepare test input. OPEN( & NEWUNIT=test_unit, & FILE=test_file_name // '-write_unformatted03.bin', & STATUS='REPLACE', & ACTION='READWRITE', & FORM='UNFORMATTED', & ACCESS='STREAM' ) vs_out = misc_test_content WRITE (test_unit) vs_out WRITE (test_unit) 123, vs_out, 456 REWIND(test_unit) READ (test_unit) vs WRITE (unit, "(2X,'Got ""',A,'"".')") vs%chars IF (vs /= misc_test_content) THEN stat = 1 RETURN END IF READ (test_unit) itmp1, vs, itmp2 WRITE (unit, "(2X,'Got ',I0,', ""',A,'"", ',I0)") itmp1, vs%chars, itmp2 IF (itmp1 /= 123 .OR. vs /= misc_test_content .OR. itmp2 /= 456) THEN stat = 1 RETURN END IF CLOSE(test_unit) stat = 0 END SUBROUTINE test_read_unformatted03 END PROGRAM AnisoVaryingStringTests