Loading src/Strings.f90 +93 −12 Original line number Diff line number Diff line Loading @@ -129,9 +129,14 @@ TYPE :: StringType !> copybrief Strings::clear_str !> copydetails Strings::clear_str PROCEDURE,PASS :: clear => clear_str !> copybrief Strings::clean_str !> copydetails Strings::clean_str !FINAL :: clean_str PROCEDURE :: read_formatted_StringType GENERIC :: READ(FORMATTED) => read_formatted_StringType PROCEDURE :: read_unformatted_StringType GENERIC :: READ(UNFORMATTED) => read_unformatted_StringType PROCEDURE :: write_formatted_StringType GENERIC :: WRITE(FORMATTED) => write_formatted_StringType PROCEDURE :: write_unformatted_StringType GENERIC :: WRITE(UNFORMATTED) => write_unformatted_StringType ENDTYPE StringType INTERFACE StringType Loading Loading @@ -317,15 +322,6 @@ ENDINTERFACE ! !=============================================================================== CONTAINS !! !!------------------------------------------------------------------------------- !!> @brief cleans up string objects !!> @param this the StringType being garbaged collected !!> !ELEMENTAL SUBROUTINE clean_str(this) ! TYPE(StringType),INTENT(INOUT) :: this ! IF(ALLOCATED(this%s)) DEALLOCATE(this%s) !ENDSUBROUTINE clean_str ! !------------------------------------------------------------------------------- !> @brief cleans up string objects Loading Loading @@ -1381,4 +1377,89 @@ ELEMENTAL FUNCTION charToStringType(char) RESULT(string) string=char ENDFUNCTION charToStringType ! !------------------------------------------------------------------------------- !> @brief overrides @c READ(FORMATTED) for @c StringType !> @param dtv the string to read !> @param iotype the type of IO being done !> @param v_list intrinsic read interface parameter defined by fortran !> @param iostat the status after attempting the read !> @param iomsg the error message associated with @c iostat !> SUBROUTINE read_formatted_StringType(dtv,unit,iotype,v_list,iostat,iomsg) CLASS(StringType),INTENT(INOUT) :: dtv INTEGER,INTENT(IN) :: unit CHARACTER(LEN=*),INTENT(IN) :: iotype INTEGER,INTENT(IN) :: v_list(:) INTEGER,INTENT(OUT) :: iostat CHARACTER(LEN=*),INTENT(INOUT) :: iomsg ! CHARACTER(LEN=256) :: buffer CALL dtv%clear() buffer='' READ(unit,FMT='(a)',IOSTAT=iostat,IOMSG=iomsg) buffer dtv=TRIM(ADJUSTL(buffer)) ENDSUBROUTINE read_formatted_StringType ! !------------------------------------------------------------------------------- !> @brief overrides @c READ(UNFORMATTED) for @c StringType !> @param dtv the string to read !> @param iostat the status after attempting the read !> @param iomsg the error message associated with @c iostat !> !> This routine is not yet implemented and should not be used. !> SUBROUTINE read_unformatted_StringType(dtv,unit,iostat,iomsg) CLASS(StringType),INTENT(INOUT) :: dtv INTEGER,INTENT(IN) :: unit INTEGER,INTENT(OUT) :: iostat CHARACTER(LEN=*),INTENT(INOUT) :: iomsg STOP "Unformatted StringType reads are not supported" ENDSUBROUTINE read_unformatted_StringType ! !------------------------------------------------------------------------------- !> @brief overrides @c WRITE(FORMATTED) for @c StringType !> @param dtv the string to write !> @param iotype the type of IO being done !> @param v_list intrinsic read interface parameter defined by fortran !> @param iostat the status after attempting the write !> @param iomsg the error message associated with @c iostat !> SUBROUTINE write_formatted_StringType(dtv,unit,iotype,v_list,iostat,iomsg) CLASS(StringType),INTENT(IN) :: dtv INTEGER,INTENT(IN) :: unit CHARACTER(LEN=*),INTENT(IN) :: iotype INTEGER,INTENT(IN) :: v_list(:) INTEGER,INTENT(OUT) :: iostat CHARACTER(LEN=*),INTENT(INOUT) :: iomsg IF(ALLOCATED(dtv%s)) THEN WRITE(unit,FMT=*,IOSTAT=iostat,IOMSG=iomsg) dtv%s ELSE WRITE(unit,FMT=*,IOSTAT=iostat,IOMSG=iomsg) '' ENDIF ENDSUBROUTINE write_formatted_StringType ! !------------------------------------------------------------------------------- !> @brief overrides @c WRITE(UNFORMATTED) for @c StringType !> @param dtv the string to write !> @param iostat the status after attempting the write !> @param iomsg the error message associated with @c iostat !> !> This routine is not yet implemented and should not be used. !> SUBROUTINE write_unformatted_StringType(dtv,unit,iostat,iomsg) CLASS(StringType),INTENT(IN) :: dtv INTEGER,INTENT(IN) :: unit INTEGER,INTENT(OUT) :: iostat CHARACTER(LEN=*),INTENT(INOUT) :: iomsg STOP "Unformatted StringType writes are not supported" ENDSUBROUTINE write_unformatted_StringType ! ENDMODULE Strings unit_tests/testStrings/testStrings.f90 +123 −1 Original line number Diff line number Diff line Loading @@ -24,6 +24,7 @@ REGISTER_SUBTEST('Operator Overloading',testOperators) REGISTER_SUBTEST('Intrinsics',testIntrinsic) REGISTER_SUBTEST('string_functs',testStrFunct) REGISTER_SUBTEST('constructor',testConstructor) REGISTER_SUBTEST('IO',testIO) FINALIZE_TEST() ! !------------------------------------------------------------------------------- Loading Loading @@ -942,4 +943,125 @@ SUBROUTINE testConstructor ENDSUBROUTINE testConstructor ! !------------------------------------------------------------------------------- SUBROUTINE testIO() CHARACTER(LEN=*),PARAMETER :: testFileName='testFormattedIO.txt' LOGICAL(SBK) :: lexists TYPE(StringType) :: string,string2,string3 !Generate the test file INQUIRE(FILE=testFileName,EXIST=lexists) IF(lexists) THEN OPEN(UNIT=999,FILE=testFileName,STATUS='OLD') CLOSE(999,STATUS='DELETE') ENDIF OPEN(UNIT=999,FILE=testFileName,STATUS='NEW') WRITE(999,*) '' WRITE(999,*) 'ABCD' WRITE(999,*) 'E F G H' CLOSE(999) !Test various reads COMPONENT_TEST('Formatted Read, from file, *') OPEN(UNIT=999,FILE=testFileName,STATUS='OLD') string='E F G H' READ(999,*) string ASSERT_EQ(LEN(string),4,'length "ABCD"') ASSERT_EQ(CHAR(string),'ABCD','ABCD') READ(999,*) string ASSERT_EQ(string,'E F G H','E F G H') WRITE(*,*) string CLOSE(999) COMPONENT_TEST('Formatted Read, from file, ''(dt)''') OPEN(UNIT=999,FILE=testFileName,STATUS='OLD') string='E F G H' READ(999,'(dt)',ADVANCE='NO') string READ(999,'(dt)',ADVANCE='NO') string ASSERT_EQ(LEN(string),4,'length "ABCD"') ASSERT_EQ(CHAR(string),'ABCD','ABCD') READ(999,'(dt)',ADVANCE='NO') string ASSERT_EQ(string,'E F G H','E F G H') CLOSE(999) !Test various writes COMPONENT_TEST('Formatted Write, to stdout') string='' WRITE(*,*) string string='ABCD' WRITE(*,*) string string='E F G H' WRITE(*,*) string string='E F' string2='G' string3='H' WRITE(*,*) string,string2,string3 string='' WRITE(*,'(dt)') string string='ABCD' WRITE(*,'(dt)') string string='E F G H' WRITE(*,'(dt)') string string='E F' string2='G' string3='H' WRITE(*,'(3dt)') string,string2,string3 COMPONENT_TEST('Formatted Write, to file, ''(dt)''') INQUIRE(FILE=testFileName,EXIST=lexists) IF(lexists) THEN OPEN(UNIT=999,FILE=testFileName,STATUS='OLD') CLOSE(999,STATUS='DELETE') ENDIF OPEN(UNIT=999,FILE=testFileName,STATUS='NEW') string='' WRITE(999,'(dt)') string string='ABCD' WRITE(999,'(dt)') string string='E F' string2='G' string3='H' WRITE(999,'(3dt)') string,string2,string3 CLOSE(999) OPEN(UNIT=999,FILE=testFileName,STATUS='OLD') string='E F G H' READ(999,'(dt)',ADVANCE='NO') string READ(999,'(dt)',ADVANCE='NO') string ASSERT_EQ(LEN(string),4,'length "ABCD"') ASSERT_EQ(CHAR(string),'ABCD','ABCD') READ(999,'(dt)',ADVANCE='NO') string ASSERT_EQ(string,'E F G H','E F G H') CLOSE(999) COMPONENT_TEST('Formatted Write, to file, *') INQUIRE(FILE=testFileName,EXIST=lexists) IF(lexists) THEN OPEN(UNIT=999,FILE=testFileName,STATUS='OLD') CLOSE(999,STATUS='DELETE') ENDIF OPEN(UNIT=999,FILE=testFileName,STATUS='NEW') string='' WRITE(999,*) string string='ABCD' WRITE(999,*) string string='E F' string2='G' string3='H' WRITE(999,*) string,string2,string3 CLOSE(999) OPEN(UNIT=999,FILE=testFileName,STATUS='OLD') string='E F G H' READ(999,'(dt)',ADVANCE='NO') string READ(999,'(dt)',ADVANCE='NO') string ASSERT_EQ(LEN(string),4,'length "ABCD"') ASSERT_EQ(CHAR(string),'ABCD','ABCD') READ(999,'(dt)',ADVANCE='NO') string ASSERT_EQ(string,'E F G H','E F G H') CLOSE(999) ENDSUBROUTINE testIO ! ENDPROGRAM testStrings Loading
src/Strings.f90 +93 −12 Original line number Diff line number Diff line Loading @@ -129,9 +129,14 @@ TYPE :: StringType !> copybrief Strings::clear_str !> copydetails Strings::clear_str PROCEDURE,PASS :: clear => clear_str !> copybrief Strings::clean_str !> copydetails Strings::clean_str !FINAL :: clean_str PROCEDURE :: read_formatted_StringType GENERIC :: READ(FORMATTED) => read_formatted_StringType PROCEDURE :: read_unformatted_StringType GENERIC :: READ(UNFORMATTED) => read_unformatted_StringType PROCEDURE :: write_formatted_StringType GENERIC :: WRITE(FORMATTED) => write_formatted_StringType PROCEDURE :: write_unformatted_StringType GENERIC :: WRITE(UNFORMATTED) => write_unformatted_StringType ENDTYPE StringType INTERFACE StringType Loading Loading @@ -317,15 +322,6 @@ ENDINTERFACE ! !=============================================================================== CONTAINS !! !!------------------------------------------------------------------------------- !!> @brief cleans up string objects !!> @param this the StringType being garbaged collected !!> !ELEMENTAL SUBROUTINE clean_str(this) ! TYPE(StringType),INTENT(INOUT) :: this ! IF(ALLOCATED(this%s)) DEALLOCATE(this%s) !ENDSUBROUTINE clean_str ! !------------------------------------------------------------------------------- !> @brief cleans up string objects Loading Loading @@ -1381,4 +1377,89 @@ ELEMENTAL FUNCTION charToStringType(char) RESULT(string) string=char ENDFUNCTION charToStringType ! !------------------------------------------------------------------------------- !> @brief overrides @c READ(FORMATTED) for @c StringType !> @param dtv the string to read !> @param iotype the type of IO being done !> @param v_list intrinsic read interface parameter defined by fortran !> @param iostat the status after attempting the read !> @param iomsg the error message associated with @c iostat !> SUBROUTINE read_formatted_StringType(dtv,unit,iotype,v_list,iostat,iomsg) CLASS(StringType),INTENT(INOUT) :: dtv INTEGER,INTENT(IN) :: unit CHARACTER(LEN=*),INTENT(IN) :: iotype INTEGER,INTENT(IN) :: v_list(:) INTEGER,INTENT(OUT) :: iostat CHARACTER(LEN=*),INTENT(INOUT) :: iomsg ! CHARACTER(LEN=256) :: buffer CALL dtv%clear() buffer='' READ(unit,FMT='(a)',IOSTAT=iostat,IOMSG=iomsg) buffer dtv=TRIM(ADJUSTL(buffer)) ENDSUBROUTINE read_formatted_StringType ! !------------------------------------------------------------------------------- !> @brief overrides @c READ(UNFORMATTED) for @c StringType !> @param dtv the string to read !> @param iostat the status after attempting the read !> @param iomsg the error message associated with @c iostat !> !> This routine is not yet implemented and should not be used. !> SUBROUTINE read_unformatted_StringType(dtv,unit,iostat,iomsg) CLASS(StringType),INTENT(INOUT) :: dtv INTEGER,INTENT(IN) :: unit INTEGER,INTENT(OUT) :: iostat CHARACTER(LEN=*),INTENT(INOUT) :: iomsg STOP "Unformatted StringType reads are not supported" ENDSUBROUTINE read_unformatted_StringType ! !------------------------------------------------------------------------------- !> @brief overrides @c WRITE(FORMATTED) for @c StringType !> @param dtv the string to write !> @param iotype the type of IO being done !> @param v_list intrinsic read interface parameter defined by fortran !> @param iostat the status after attempting the write !> @param iomsg the error message associated with @c iostat !> SUBROUTINE write_formatted_StringType(dtv,unit,iotype,v_list,iostat,iomsg) CLASS(StringType),INTENT(IN) :: dtv INTEGER,INTENT(IN) :: unit CHARACTER(LEN=*),INTENT(IN) :: iotype INTEGER,INTENT(IN) :: v_list(:) INTEGER,INTENT(OUT) :: iostat CHARACTER(LEN=*),INTENT(INOUT) :: iomsg IF(ALLOCATED(dtv%s)) THEN WRITE(unit,FMT=*,IOSTAT=iostat,IOMSG=iomsg) dtv%s ELSE WRITE(unit,FMT=*,IOSTAT=iostat,IOMSG=iomsg) '' ENDIF ENDSUBROUTINE write_formatted_StringType ! !------------------------------------------------------------------------------- !> @brief overrides @c WRITE(UNFORMATTED) for @c StringType !> @param dtv the string to write !> @param iostat the status after attempting the write !> @param iomsg the error message associated with @c iostat !> !> This routine is not yet implemented and should not be used. !> SUBROUTINE write_unformatted_StringType(dtv,unit,iostat,iomsg) CLASS(StringType),INTENT(IN) :: dtv INTEGER,INTENT(IN) :: unit INTEGER,INTENT(OUT) :: iostat CHARACTER(LEN=*),INTENT(INOUT) :: iomsg STOP "Unformatted StringType writes are not supported" ENDSUBROUTINE write_unformatted_StringType ! ENDMODULE Strings
unit_tests/testStrings/testStrings.f90 +123 −1 Original line number Diff line number Diff line Loading @@ -24,6 +24,7 @@ REGISTER_SUBTEST('Operator Overloading',testOperators) REGISTER_SUBTEST('Intrinsics',testIntrinsic) REGISTER_SUBTEST('string_functs',testStrFunct) REGISTER_SUBTEST('constructor',testConstructor) REGISTER_SUBTEST('IO',testIO) FINALIZE_TEST() ! !------------------------------------------------------------------------------- Loading Loading @@ -942,4 +943,125 @@ SUBROUTINE testConstructor ENDSUBROUTINE testConstructor ! !------------------------------------------------------------------------------- SUBROUTINE testIO() CHARACTER(LEN=*),PARAMETER :: testFileName='testFormattedIO.txt' LOGICAL(SBK) :: lexists TYPE(StringType) :: string,string2,string3 !Generate the test file INQUIRE(FILE=testFileName,EXIST=lexists) IF(lexists) THEN OPEN(UNIT=999,FILE=testFileName,STATUS='OLD') CLOSE(999,STATUS='DELETE') ENDIF OPEN(UNIT=999,FILE=testFileName,STATUS='NEW') WRITE(999,*) '' WRITE(999,*) 'ABCD' WRITE(999,*) 'E F G H' CLOSE(999) !Test various reads COMPONENT_TEST('Formatted Read, from file, *') OPEN(UNIT=999,FILE=testFileName,STATUS='OLD') string='E F G H' READ(999,*) string ASSERT_EQ(LEN(string),4,'length "ABCD"') ASSERT_EQ(CHAR(string),'ABCD','ABCD') READ(999,*) string ASSERT_EQ(string,'E F G H','E F G H') WRITE(*,*) string CLOSE(999) COMPONENT_TEST('Formatted Read, from file, ''(dt)''') OPEN(UNIT=999,FILE=testFileName,STATUS='OLD') string='E F G H' READ(999,'(dt)',ADVANCE='NO') string READ(999,'(dt)',ADVANCE='NO') string ASSERT_EQ(LEN(string),4,'length "ABCD"') ASSERT_EQ(CHAR(string),'ABCD','ABCD') READ(999,'(dt)',ADVANCE='NO') string ASSERT_EQ(string,'E F G H','E F G H') CLOSE(999) !Test various writes COMPONENT_TEST('Formatted Write, to stdout') string='' WRITE(*,*) string string='ABCD' WRITE(*,*) string string='E F G H' WRITE(*,*) string string='E F' string2='G' string3='H' WRITE(*,*) string,string2,string3 string='' WRITE(*,'(dt)') string string='ABCD' WRITE(*,'(dt)') string string='E F G H' WRITE(*,'(dt)') string string='E F' string2='G' string3='H' WRITE(*,'(3dt)') string,string2,string3 COMPONENT_TEST('Formatted Write, to file, ''(dt)''') INQUIRE(FILE=testFileName,EXIST=lexists) IF(lexists) THEN OPEN(UNIT=999,FILE=testFileName,STATUS='OLD') CLOSE(999,STATUS='DELETE') ENDIF OPEN(UNIT=999,FILE=testFileName,STATUS='NEW') string='' WRITE(999,'(dt)') string string='ABCD' WRITE(999,'(dt)') string string='E F' string2='G' string3='H' WRITE(999,'(3dt)') string,string2,string3 CLOSE(999) OPEN(UNIT=999,FILE=testFileName,STATUS='OLD') string='E F G H' READ(999,'(dt)',ADVANCE='NO') string READ(999,'(dt)',ADVANCE='NO') string ASSERT_EQ(LEN(string),4,'length "ABCD"') ASSERT_EQ(CHAR(string),'ABCD','ABCD') READ(999,'(dt)',ADVANCE='NO') string ASSERT_EQ(string,'E F G H','E F G H') CLOSE(999) COMPONENT_TEST('Formatted Write, to file, *') INQUIRE(FILE=testFileName,EXIST=lexists) IF(lexists) THEN OPEN(UNIT=999,FILE=testFileName,STATUS='OLD') CLOSE(999,STATUS='DELETE') ENDIF OPEN(UNIT=999,FILE=testFileName,STATUS='NEW') string='' WRITE(999,*) string string='ABCD' WRITE(999,*) string string='E F' string2='G' string3='H' WRITE(999,*) string,string2,string3 CLOSE(999) OPEN(UNIT=999,FILE=testFileName,STATUS='OLD') string='E F G H' READ(999,'(dt)',ADVANCE='NO') string READ(999,'(dt)',ADVANCE='NO') string ASSERT_EQ(LEN(string),4,'length "ABCD"') ASSERT_EQ(CHAR(string),'ABCD','ABCD') READ(999,'(dt)',ADVANCE='NO') string ASSERT_EQ(string,'E F G H','E F G H') CLOSE(999) ENDSUBROUTINE testIO ! ENDPROGRAM testStrings
