18176680887

Committed 01 Oct 2025 09:53PM UTC coverage: 94.58%. Remained the same

Build # 18176680887

Build Type

push

github

Committed by

web-flow

Commit Message

Bump crate-ci/typos from 1.35.7 to 1.37.0 (#67)

* Bump crate-ci/typos from 1.35.7 to 1.37.0

Bumps [crate-ci/typos](https://github.com/crate-ci/typos) from 1.35.7 to 1.37.0.
- [Release notes](https://github.com/crate-ci/typos/releases)
- [Changelog](https://github.com/crate-ci/typos/blob/master/CHANGELOG.md)
- [Commits](https://github.com/crate-ci/typos/compare/v1.35.7...v1.37.0)

---
updated-dependencies:
- dependency-name: crate-ci/typos
  dependency-version: 1.37.0
  dependency-type: direct:production
  update-type: version-update:semver-minor
...

Signed-off-by: dependabot[bot] <support@github.com>

* add indx to allowable typos

* adjust captialization to avoid spurious spellcheck issue

---------

Signed-off-by: dependabot[bot] <support@github.com>
Co-authored-by: dependabot[bot] <49699333+dependabot[bot]@users.noreply.github.com>
Co-authored-by: Andrew Winters <andrew.ross.winters@liu.se>

Run Details

18 of 21 new or added lines in 1 file covered. (85.71%)

2 existing lines in 1 file now uncovered.

2705 of 2860 relevant lines covered (94.58%)

15.3 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

88.64

/Source/FTObjects/FTStringSetClass.f90

! MIT License
!
! Copyright (c) 2010-present David A. Kopriva and other contributors: AUTHORS.md
!
! Permission is hereby granted, free of charge, to any person obtaining a copy
! of this software and associated documentation files (the "Software"), to deal
! in the Software without restriction, including without limitation the rights
! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
! copies of the Software, and to permit persons to whom the Software is
! furnished to do so, subject to the following conditions:
!
! The above copyright notice and this permission notice shall be included in all
! copies or substantial portions of the Software.
!
! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
! SOFTWARE.
!
! FTObjectLibrary contains code that, to the best of our knowledge, has been released as
! public domain software:
! * `b3hs_hash_key_jenkins`: originally by Rich Townsend,
! https://groups.google.com/forum/#!topic/comp.lang.fortran/RWoHZFt39ng, 2005
!
! --- End License

!
!////////////////////////////////////////////////////////////////////////
!
!      FTStringSet.f90
!
!>FTStringSet is a class for an unordered collection of strings. Use a FTStringSet
!>to store strings as an alternative to arrays when the order is not important, but
!>testing for membership is.
!>
!>##Definition
!>           TYPE(FTStringSet) :: varName
!>#Usage
!>##Initialization
!>       CLASS(FTStringSet)  :: FTStringSet
!>       integer             :: N = 11
!>       logical             :: cs = .true.
!>       CALL FTStringSet % initFTStringSet(N,cs)
!>
!>       CLASS(FTStringSet)  :: FTStringSet
!>       CHARACTER(LEN=*)    :: strings(:)
!>       CALL FTStringSet % initWithStrings(strings)
!>
!>#Destruction
!>      CALL FTStringSet  %  destuct() [Non Pointers]
!>      CALL releaseFTStringSet(stringSet) [Pointers]
!>#Adding Strings
!>         CALL set % addString(str)
!>#Testing membership:
!>      if(set % containsString(str))     THEN
!>#Getting an array of members
!>      CHARACTER(LEN=FTDICT_KWD_STRING_LENGTH) ,DIMENSION(:), POINTER :: s
!>      s => set % strings
!>      ... do something ...
!>      DEALLOCATE(s)
!>#Set operations, union, intersection, difference
!>      newSet => set1 % unionWithSet(set2)
!>      ... do something ...
!>      call releaseFTStringSet(newSet)
!>
!>      newSet => set1 % intersectionWithSet(set2)
!>      ... do something ...
!>      call releaseFTStringSet(newSet)
!>
!>      newSet => set1 % setFromDifference(set2)
!>      ... do something ...
!>      call releaseFTStringSet(newSet)
!
!
!////////////////////////////////////////////////////////////////////////
!
      MODULE FTStringSetClass
      USE FTObjectClass
      USE FTDictionaryClass
      IMPLICIT NONE

      TYPE, EXTENDS(FTObject) ::  FTStringSet
         TYPE(FTDictionary), PRIVATE  :: dict
!
!        --------
         CONTAINS
!        --------
!
         PROCEDURE, PUBLIC :: initFTStringSet
         PROCEDURE, PUBLIC :: initWithStrings

         FINAL             :: destructFTStringSet

         PROCEDURE, PUBLIC :: addString
         PROCEDURE, PUBLIC :: containsString
         PROCEDURE, PUBLIC :: strings
         PROCEDURE, PUBLIC :: unionWithSet
         PROCEDURE, PUBLIC :: intersectionWithSet
!         PROCEDURE, PUBLIC :: setIsCaseSensitive
!         PROCEDURE, PUBLIC :: isCaseSensitive
         PROCEDURE, PUBLIC :: setFromDifference
         PROCEDURE, PUBLIC :: isEmpty
         PROCEDURE, PUBLIC :: count => stringCount

         PROCEDURE, PUBLIC :: printDescription => printFTStringSet
         PROCEDURE, PUBLIC :: className        => FTStringSetClassName
!
      END TYPE

!      INTERFACE cast
!         MODULE PROCEDURE castToFTStringSet
!      END INTERFACE cast
!
!     ========
      CONTAINS
!     ========
!
!
!////////////////////////////////////////////////////////////////////////
!
!>
!> Designated initializer. Initializes the amount of storage, but
!> the FTStringSet remains empty.
!>
!> *Usage
!>       CLASS(FTStringSet)  :: FTStringSet
!>       integer             :: N = 11
!>       logical             :: cs = .true.
!>       CALL FTStringSet % initFTStringSet(N)
!>
      SUBROUTINE initFTStringSet( self, FTStringSetSize )
         IMPLICIT NONE
         CLASS( FTStringSet) :: self
         INTEGER             :: FTStringSetSize

         CALL self % FTObject % init()

         CALL self % dict % initWithSize(sze = FTStringSetSize)
!         self % dict % isCaseSensitive = caseSensitive

      END SUBROUTINE initFTStringSet
!
!////////////////////////////////////////////////////////////////////////
!
!>
!>  initializer. Initializes the amount of storage from the strings passed
!> *Usage
!>       CLASS(FTStringSet)  :: FTStringSet
!>       CHARACTER(LEN=*)    :: strings(:)
!>       CALL FTStringSet % initWithStrings(strings)
!>
      SUBROUTINE initWithStrings( self, strings )
         IMPLICIT NONE
!
!        ---------
!        Arguments
!        ---------
!
         CLASS( FTStringSet) :: self
         CHARACTER(LEN=*)    :: strings(:)
!
!        ---------------
!        Local variables
!        ---------------
!
         INTEGER                  :: stringCount, i, dictSize

         stringCount = SIZE(strings)
         dictSize    = 2**EXPONENT(REAL(stringCount)) ! Makes it a factor of two

         CALL self % initFTStringSet(FTStringSetSize = dictSize)

         DO i = 1, stringCount
            CALL self % addString(str = strings(i))
         END DO

      END SUBROUTINE initWithStrings
!
!////////////////////////////////////////////////////////////////////////
!
!>
!> Destructor for the class. This is called automatically when the
!> reference count reaches zero. Do not call this yourself on pointers
!>
      SUBROUTINE destructFTStringSet(self)
         IMPLICIT NONE
         TYPE( FTStringSet) :: self

      END SUBROUTINE destructFTStringSet
!
!------------------------------------------------
!> Public, generic name: release(self)
!>
!> Call release(self) on an object to release control
!> of an object. If its reference count is zero, then
!> it is deallocated.
!------------------------------------------------
!
!////////////////////////////////////////////////////////////////////////
!
      SUBROUTINE releaseFTStringSet(self)
         IMPLICIT NONE
         TYPE(FTStringSet) , POINTER :: self
         CLASS(FTObject)   , POINTER :: obj

         obj => self
         CALL release(self = obj)
         IF ( .NOT. ASSOCIATED(obj) )     THEN
            NULLIFY(self)
         END IF
      END SUBROUTINE releaseFTStringSet
!
!////////////////////////////////////////////////////////////////////////
!
      INTEGER FUNCTION stringCount(self)
         IMPLICIT NONE
         CLASS(FTStringSet) :: self
         stringCount = self % dict % COUNT()
      END FUNCTION stringCount
!
!////////////////////////////////////////////////////////////////////////
!
!      -----------------------------------------------------------------
!> AddString adds a string to the set if it is not already present
!>
!>### Usage:
!>        CALL set % addString(str)
!>
      SUBROUTINE AddString(self,str)
         IMPLICIT NONE
         CLASS(FTStringSet)          :: self
         CHARACTER(LEN=*)            :: str
         CLASS(FTObject)   , POINTER :: obj

         IF(self % dict % containsKey(key = str))     RETURN

         ALLOCATE(obj)
         CALL obj % init()
         CALL self % dict % addObjectForKey(object = obj,key = str)
         CALL release(obj)

      END SUBROUTINE AddString
!
!////////////////////////////////////////////////////////////////////////
!
!      -----------------------------------------------------------------
!> containsString returns .TRUE. if the set contains the string, .FALSE.
!> otherwise.
!>
!>### Usage:
!>        if(set % containsString(str))
!>
      LOGICAL FUNCTION containsString(self,str)
         IMPLICIT NONE
         CLASS(FTStringSet) :: self
         CHARACTER(LEN=*)   :: str

         containsString = self % dict % containsKey(key = str)

      END FUNCTION containsString
!
!////////////////////////////////////////////////////////////////////////
!
!      -----------------------------------------------------------------
!> strings returns a pointer to an array of strings that are in the set.
!> Deallocate this array when done with it.
!>
!>### Usage:
!>
!>      CHARACTER(LEN=FTDICT_KWD_STRING_LENGTH) ,DIMENSION(:), POINTER :: s
!>      s => set % strings
!>      ... do something ...
!>      DEALLOCATE(s)
!>
      FUNCTION strings(self)  RESULT(s)
          IMPLICIT NONE
          CLASS(FTStringSet)                                             :: self
          CHARACTER(LEN=FTDICT_KWD_STRING_LENGTH) ,DIMENSION(:), POINTER :: s

          s => self % dict % allKeys()

      END FUNCTION strings
!
!////////////////////////////////////////////////////////////////////////
!
!> unionWithSet returns a pointer to a new set that is the union of two sets.
!> the new set has reference count of 1. Release when done.
!>
!>### Usage:
!>
!>      newSet => set1 % unionWithSet(set2)
!>      ... do something ...
!>      call releaseFTStringSet(newSet)
!
      FUNCTION unionWithSet(self,set)  RESULT(newSet)
         IMPLICIT NONE
         CLASS(FTStringSet)                                             :: self, set
         CHARACTER(LEN=FTDICT_KWD_STRING_LENGTH) ,DIMENSION(:), POINTER :: s1, s2
         INTEGER                                                        :: i
         TYPE(FTStringSet), POINTER                                     :: newSet

         ALLOCATE(newSet)
         s1 => self % strings()
         CALL newSet % initWithStrings(strings = s1)
         DEALLOCATE(s1)

         s2 => set % strings()
         DO i = 1, SIZE(s2)
            CALL newSet % addString(str = s2(i))
         END DO
         DEALLOCATE(s2)

      END FUNCTION unionWithSet
!
!////////////////////////////////////////////////////////////////////////
!
!> intersectionWithSet returns a pointer to a new set that is the intersection of two sets.
!> the new set has reference count of 1. Release when done.
!>
!>### Usage:
!>
!>      newSet => set1 % intersectionWithSet(set2)
!>      ... do something ...
!>      call releaseFTStringSet(newSet)
!
      FUNCTION intersectionWithSet(self, set)  RESULT(newSet)
         IMPLICIT NONE
         CLASS(FTStringSet)                                             :: self, set
         CHARACTER(LEN=FTDICT_KWD_STRING_LENGTH) ,DIMENSION(:), POINTER :: strArray
         INTEGER                                                        :: i
         TYPE(FTStringSet), POINTER                                     :: newSet


         ALLOCATE(newSet)
         CALL newSet % initFTStringSet(FTStringSetSize = 16)

         strArray => self % strings()
         IF(.NOT.ASSOCIATED(strArray)) RETURN

         DO i = 1, SIZE(strArray)
            IF ( set % containsString(str = strArray(i)) )     THEN
               CALL newSet % addString(str = strArray(i))
            END IF
         END DO
         DEALLOCATE(strArray)

      END FUNCTION intersectionWithSet
!
!////////////////////////////////////////////////////////////////////////
!
!> setFromDifference returns a pointer to a new set that is the difference of two sets.
!> $$A - B = \{x: x \in A \;\rm{ and }\; x\notin B\}$$
!> the new set has reference count of 1. Release when done.
!>
!>### Usage:
!>
!>      newSet => set1 % setFromDifference(set2)
!>      ... do something ...
!>      call releaseFTStringSet(newSet)
!
      FUNCTION setFromDifference(self, set)  RESULT(newSet)
         IMPLICIT NONE
         CLASS(FTStringSet)                                             :: self, set
         CHARACTER(LEN=FTDICT_KWD_STRING_LENGTH) ,DIMENSION(:), POINTER :: strArray
         INTEGER                                                        :: i
         TYPE(FTStringSet), POINTER                                     :: newSet

         ALLOCATE(newSet)
         CALL newSet % initFTStringSet(FTStringSetSize = MAX(self % count(),8))

         IF(self % count() ==0 )     RETURN

         strArray => self % strings()
         IF(.NOT.ASSOCIATED(strArray)) RETURN

         DO i = 1, SIZE(strArray)
            IF ( .NOT.set % containsString(str = strArray(i)) )     THEN
               CALL newSet % addString(str = strArray(i))
            END IF
         END DO
         DEALLOCATE(strArray)

      END FUNCTION setFromDifference
!
!////////////////////////////////////////////////////////////////////////
!
      LOGICAL FUNCTION isEmpty(self)
         IMPLICIT NONE
         CLASS(FTStringSet) :: self
         isEmpty = .TRUE.
         IF(self % count() > 0)   isEmpty = .FALSE.
      END FUNCTION isEmpty
!
!////////////////////////////////////////////////////////////////////////
!
!      SUBROUTINE setIsCaseSensitive(self,sensitive)
!         IMPLICIT NONE
!         CLASS(FTStringSet) :: self
!         LOGICAL            :: sensitive
!         self % dict % isCaseSensitive = sensitive
!      END SUBROUTINE setIsCaseSensitive
!
!////////////////////////////////////////////////////////////////////////
!
!      LOGICAL FUNCTION isCaseSensitive(self)
!         IMPLICIT NONE
!         CLASS(FTStringSet) :: self
!         isCaseSensitive = self % dict % isCaseSensitive
!      END FUNCTION isCaseSensitive
!
!////////////////////////////////////////////////////////////////////////
!
      SUBROUTINE printFTStringSet(self,iUnit)
         IMPLICIT NONE
!
!        ---------
!        Arguments
!        ---------
!
         CLASS(FTStringSet)          :: self
         INTEGER                     :: iUnit
!
!        ---------------
!        Local Variables
!        ---------------
!
         INTEGER                                          :: i
         CHARACTER(LEN=FTDICT_KWD_STRING_LENGTH), POINTER :: keys(:)

         keys => self % dict % allKeys()
         DO i = 1, SIZE(keys)
            PRINT *, TRIM(keys(i))
         END DO
         DEALLOCATE(keys)

      END SUBROUTINE printFTStringSet

!
!---------------------------------------------------------------------------
!> Generic Name: cast
!>
!> Cast a pointer to the base class to an FTStringSet pointer
!---------------------------------------------------------------------------
!
!////////////////////////////////////////////////////////////////////////
!
      FUNCTION FTStringSetFromObject(obj) RESULT(cast)
!
!     -----------------------------------------------------
!     Cast the base class FTObject to the FTException class
!     -----------------------------------------------------
!
         IMPLICIT NONE
         CLASS(FTObject)            , POINTER :: obj
         CLASS(FTStringSet), POINTER :: cast

         cast => NULL()
         SELECT TYPE (e => obj)
            TYPE is (FTStringSet)
               cast => e
            CLASS DEFAULT

         END SELECT

      END FUNCTION FTStringSetFromObject
!
!////////////////////////////////////////////////////////////////////////
!
!      -----------------------------------------------------------------
!> Class name returns a string with the name of the type of the object
!>
!>### Usage:
!>
!>        PRINT *,  obj % className()
!>        if( obj % className = "FTStringSet")
!>
      FUNCTION FTStringSetClassName(self)  RESULT(s)
         IMPLICIT NONE
         CLASS(FTStringSet)                :: self
         CHARACTER(LEN=CLASS_NAME_CHARACTER_LENGTH) :: s

         s = "FTStringSet"

      END FUNCTION FTStringSetClassName


      END MODULE  FTStringSetClass

1	! MIT License
2	!
3	! Copyright (c) 2010-present David A. Kopriva and other contributors: AUTHORS.md
4	!
5	! Permission is hereby granted, free of charge, to any person obtaining a copy
6	! of this software and associated documentation files (the "Software"), to deal
7	! in the Software without restriction, including without limitation the rights
8	! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
9	! copies of the Software, and to permit persons to whom the Software is
10	! furnished to do so, subject to the following conditions:
11	!
12	! The above copyright notice and this permission notice shall be included in all
13	! copies or substantial portions of the Software.
14	!
15	! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
16	! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
17	! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
18	! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
19	! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
20	! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
21	! SOFTWARE.
22	!
23	! FTObjectLibrary contains code that, to the best of our knowledge, has been released as
24	! public domain software:
25	! * `b3hs_hash_key_jenkins`: originally by Rich Townsend,
26	! https://groups.google.com/forum/#!topic/comp.lang.fortran/RWoHZFt39ng, 2005
27	!
28	! --- End License
29
30	!
31	!////////////////////////////////////////////////////////////////////////
32	!
33	! FTStringSet.f90
34	!
35	!>FTStringSet is a class for an unordered collection of strings. Use a FTStringSet
36	!>to store strings as an alternative to arrays when the order is not important, but
37	!>testing for membership is.
38	!>
39	!>##Definition
40	!> TYPE(FTStringSet) :: varName
41	!>#Usage
42	!>##Initialization
43	!> CLASS(FTStringSet) :: FTStringSet
44	!> integer :: N = 11
45	!> logical :: cs = .true.
46	!> CALL FTStringSet % initFTStringSet(N,cs)
47	!>
48	!> CLASS(FTStringSet) :: FTStringSet
49	!> CHARACTER(LEN=*) :: strings(:)
50	!> CALL FTStringSet % initWithStrings(strings)
51	!>
52	!>#Destruction
53	!> CALL FTStringSet % destuct() [Non Pointers]
54	!> CALL releaseFTStringSet(stringSet) [Pointers]
55	!>#Adding Strings
56	!> CALL set % addString(str)
57	!>#Testing membership:
58	!> if(set % containsString(str)) THEN
59	!>#Getting an array of members
60	!> CHARACTER(LEN=FTDICT_KWD_STRING_LENGTH) ,DIMENSION(:), POINTER :: s
61	!> s => set % strings
62	!> ... do something ...
63	!> DEALLOCATE(s)
64	!>#Set operations, union, intersection, difference
65	!> newSet => set1 % unionWithSet(set2)
66	!> ... do something ...
67	!> call releaseFTStringSet(newSet)
68	!>
69	!> newSet => set1 % intersectionWithSet(set2)
70	!> ... do something ...
71	!> call releaseFTStringSet(newSet)
72	!>
73	!> newSet => set1 % setFromDifference(set2)
74	!> ... do something ...
75	!> call releaseFTStringSet(newSet)
76	!
77	!
78	!////////////////////////////////////////////////////////////////////////
79	!
80	MODULE FTStringSetClass
81	USE FTObjectClass
82	USE FTDictionaryClass
83	IMPLICIT NONE
84
85	TYPE, EXTENDS(FTObject) :: FTStringSet
86	TYPE(FTDictionary), PRIVATE :: dict
87	!
88	! --------
89	CONTAINS
90	! --------
91	!
92	PROCEDURE, PUBLIC :: initFTStringSet
93	PROCEDURE, PUBLIC :: initWithStrings
94
95	FINAL :: destructFTStringSet
96
97	PROCEDURE, PUBLIC :: addString
98	PROCEDURE, PUBLIC :: containsString
99	PROCEDURE, PUBLIC :: strings
100	PROCEDURE, PUBLIC :: unionWithSet
101	PROCEDURE, PUBLIC :: intersectionWithSet
102	! PROCEDURE, PUBLIC :: setIsCaseSensitive
103	! PROCEDURE, PUBLIC :: isCaseSensitive
104	PROCEDURE, PUBLIC :: setFromDifference
105	PROCEDURE, PUBLIC :: isEmpty
106	PROCEDURE, PUBLIC :: count => stringCount
107
108	PROCEDURE, PUBLIC :: printDescription => printFTStringSet
109	PROCEDURE, PUBLIC :: className => FTStringSetClassName
110	!
111	END TYPE
112
113	! INTERFACE cast
114	! MODULE PROCEDURE castToFTStringSet
115	! END INTERFACE cast
116	!
117	! ========
118	CONTAINS
119	! ========
120	!
121	!
122	!////////////////////////////////////////////////////////////////////////
123	!
124	!>
125	!> Designated initializer. Initializes the amount of storage, but
126	!> the FTStringSet remains empty.
127	!>
128	!> *Usage
129	!> CLASS(FTStringSet) :: FTStringSet
130	!> integer :: N = 11
131	!> logical :: cs = .true.
132	!> CALL FTStringSet % initFTStringSet(N)
133	!>
134	SUBROUTINE initFTStringSet( self, FTStringSetSize )	6✔
135	IMPLICIT NONE
136	CLASS( FTStringSet) :: self
137	INTEGER :: FTStringSetSize
138
139	CALL self % FTObject % init()	6✔
140
141	CALL self % dict % initWithSize(sze = FTStringSetSize)	6✔
142	! self % dict % isCaseSensitive = caseSensitive
143
144	END SUBROUTINE initFTStringSet	6✔
145	!
146	!////////////////////////////////////////////////////////////////////////
147	!
148	!>
149	!> initializer. Initializes the amount of storage from the strings passed
150	!> *Usage
151	!> CLASS(FTStringSet) :: FTStringSet
152	!> CHARACTER(LEN=*) :: strings(:)
153	!> CALL FTStringSet % initWithStrings(strings)
154	!>
155	SUBROUTINE initWithStrings( self, strings )	3✔
156	IMPLICIT NONE
157	!
158	! ---------
159	! Arguments
160	! ---------
161	!
162	CLASS( FTStringSet) :: self
163	CHARACTER(LEN=*) :: strings(:)
164	!
165	! ---------------
166	! Local variables
167	! ---------------
168	!
169	INTEGER :: stringCount, i, dictSize
170
171	stringCount = SIZE(strings)	3✔
172	dictSize = 2**EXPONENT(REAL(stringCount)) ! Makes it a factor of two	3✔
173
174	CALL self % initFTStringSet(FTStringSetSize = dictSize)	3✔
175
176	DO i = 1, stringCount	18✔
177	CALL self % addString(str = strings(i))	18✔
178	END DO
179
180	END SUBROUTINE initWithStrings	3✔
181	!
182	!////////////////////////////////////////////////////////////////////////
183	!
184	!>
185	!> Destructor for the class. This is called automatically when the
186	!> reference count reaches zero. Do not call this yourself on pointers
187	!>
188	SUBROUTINE destructFTStringSet(self)	6✔
189	IMPLICIT NONE
190	TYPE( FTStringSet) :: self
191
192	END SUBROUTINE destructFTStringSet	6✔
193	!
194	!------------------------------------------------
195	!> Public, generic name: release(self)
196	!>
197	!> Call release(self) on an object to release control
198	!> of an object. If its reference count is zero, then
199	!> it is deallocated.
200	!------------------------------------------------
201	!
202	!////////////////////////////////////////////////////////////////////////
203	!
204	SUBROUTINE releaseFTStringSet(self)	4✔
205	IMPLICIT NONE
206	TYPE(FTStringSet) , POINTER :: self
207	CLASS(FTObject) , POINTER :: obj
208
209	obj => self	4✔
210	CALL release(self = obj)	4✔
211	IF ( .NOT. ASSOCIATED(obj) ) THEN	4✔
212	NULLIFY(self)	4✔
213	END IF
214	END SUBROUTINE releaseFTStringSet	4✔
215	!
216	!////////////////////////////////////////////////////////////////////////
217	!
218	INTEGER FUNCTION stringCount(self)	13✔
219	IMPLICIT NONE
220	CLASS(FTStringSet) :: self
221	stringCount = self % dict % COUNT()	13✔
222	END FUNCTION stringCount	13✔
223	!
224	!////////////////////////////////////////////////////////////////////////
225	!
226	! -----------------------------------------------------------------
227	!> AddString adds a string to the set if it is not already present
228	!>
229	!>### Usage:
230	!> CALL set % addString(str)
231	!>
232	SUBROUTINE AddString(self,str)	29✔
233	IMPLICIT NONE
234	CLASS(FTStringSet) :: self
235	CHARACTER(LEN=*) :: str
236	CLASS(FTObject) , POINTER :: obj
237
238	IF(self % dict % containsKey(key = str)) RETURN	29✔
239
240	ALLOCATE(obj)	27✔
241	CALL obj % init()	27✔
242	CALL self % dict % addObjectForKey(object = obj,key = str)	27✔
243	CALL release(obj)	27✔
244
245	END SUBROUTINE AddString	29✔
246	!
247	!////////////////////////////////////////////////////////////////////////
248	!
249	! -----------------------------------------------------------------
250	!> containsString returns .TRUE. if the set contains the string, .FALSE.
251	!> otherwise.
252	!>
253	!>### Usage:
254	!> if(set % containsString(str))
255	!>
256	LOGICAL FUNCTION containsString(self,str)	49✔
257	IMPLICIT NONE
258	CLASS(FTStringSet) :: self
259	CHARACTER(LEN=*) :: str
260
261	containsString = self % dict % containsKey(key = str)	98✔
262
263	END FUNCTION containsString	49✔
264	!
265	!////////////////////////////////////////////////////////////////////////
266	!
267	! -----------------------------------------------------------------
268	!> strings returns a pointer to an array of strings that are in the set.
269	!> Deallocate this array when done with it.
270	!>
271	!>### Usage:
272	!>
273	!> CHARACTER(LEN=FTDICT_KWD_STRING_LENGTH) ,DIMENSION(:), POINTER :: s
274	!> s => set % strings
275	!> ... do something ...
276	!> DEALLOCATE(s)
277	!>
278	FUNCTION strings(self) RESULT(s)	7✔
279	IMPLICIT NONE
280	CLASS(FTStringSet) :: self
281	CHARACTER(LEN=FTDICT_KWD_STRING_LENGTH) ,DIMENSION(:), POINTER :: s
282
283	s => self % dict % allKeys()	7✔
284
285	END FUNCTION strings	7✔
286	!
287	!////////////////////////////////////////////////////////////////////////
288	!
289	!> unionWithSet returns a pointer to a new set that is the union of two sets.
290	!> the new set has reference count of 1. Release when done.
291	!>
292	!>### Usage:
293	!>
294	!> newSet => set1 % unionWithSet(set2)
295	!> ... do something ...
296	!> call releaseFTStringSet(newSet)
297	!
298	FUNCTION unionWithSet(self,set) RESULT(newSet)	1✔
299	IMPLICIT NONE
300	CLASS(FTStringSet) :: self, set
301	CHARACTER(LEN=FTDICT_KWD_STRING_LENGTH) ,DIMENSION(:), POINTER :: s1, s2	1✔
302	INTEGER :: i
303	TYPE(FTStringSet), POINTER :: newSet
304
305	ALLOCATE(newSet)	×
306	s1 => self % strings()	1✔
307	CALL newSet % initWithStrings(strings = s1)	1✔
308	DEALLOCATE(s1)	1✔
309
310	s2 => set % strings()	1✔
311	DO i = 1, SIZE(s2)	6✔
312	CALL newSet % addString(str = s2(i))	6✔
313	END DO
314	DEALLOCATE(s2)	1✔
315
316	END FUNCTION unionWithSet	2✔
317	!
318	!////////////////////////////////////////////////////////////////////////
319	!
320	!> intersectionWithSet returns a pointer to a new set that is the intersection of two sets.
321	!> the new set has reference count of 1. Release when done.
322	!>
323	!>### Usage:
324	!>
325	!> newSet => set1 % intersectionWithSet(set2)
326	!> ... do something ...
327	!> call releaseFTStringSet(newSet)
328	!
329	FUNCTION intersectionWithSet(self, set) RESULT(newSet)	1✔
330	IMPLICIT NONE
331	CLASS(FTStringSet) :: self, set
332	CHARACTER(LEN=FTDICT_KWD_STRING_LENGTH) ,DIMENSION(:), POINTER :: strArray	1✔
333	INTEGER :: i
334	TYPE(FTStringSet), POINTER :: newSet
335
336
UNCOV 337	ALLOCATE(newSet)	×
338	CALL newSet % initFTStringSet(FTStringSetSize = 16)	1✔
339
340	strArray => self % strings()	1✔
341	IF(.NOT.ASSOCIATED(strArray)) RETURN	1✔
342
343	DO i = 1, SIZE(strArray)	6✔
344	IF ( set % containsString(str = strArray(i)) ) THEN	6✔
345	CALL newSet % addString(str = strArray(i))	2✔
346	END IF
347	END DO
348	DEALLOCATE(strArray)	1✔
349
350	END FUNCTION intersectionWithSet	2✔
351	!
352	!////////////////////////////////////////////////////////////////////////
353	!
354	!> setFromDifference returns a pointer to a new set that is the difference of two sets.
355	!> $$A - B = \{x: x \in A \;\rm{ and }\; x\notin B\}$$
356	!> the new set has reference count of 1. Release when done.
357	!>
358	!>### Usage:
359	!>
360	!> newSet => set1 % setFromDifference(set2)
361	!> ... do something ...
362	!> call releaseFTStringSet(newSet)
363	!
364	FUNCTION setFromDifference(self, set) RESULT(newSet)	2✔
365	IMPLICIT NONE
366	CLASS(FTStringSet) :: self, set
367	CHARACTER(LEN=FTDICT_KWD_STRING_LENGTH) ,DIMENSION(:), POINTER :: strArray	2✔
368	INTEGER :: i
369	TYPE(FTStringSet), POINTER :: newSet
370
371	ALLOCATE(newSet)	×
372	CALL newSet % initFTStringSet(FTStringSetSize = MAX(self % count(),8))	2✔
373
374	IF(self % count() ==0 ) RETURN	2✔
375
376	strArray => self % strings()	2✔
377	IF(.NOT.ASSOCIATED(strArray)) RETURN	2✔
378
379	DO i = 1, SIZE(strArray)	12✔
380	IF ( .NOT.set % containsString(str = strArray(i)) ) THEN	12✔
381	CALL newSet % addString(str = strArray(i))	6✔
382	END IF
383	END DO
384	DEALLOCATE(strArray)	2✔
385
386	END FUNCTION setFromDifference	4✔
387	!
388	!////////////////////////////////////////////////////////////////////////
389	!
390	LOGICAL FUNCTION isEmpty(self)	1✔
391	IMPLICIT NONE
392	CLASS(FTStringSet) :: self
393	isEmpty = .TRUE.	1✔
394	IF(self % count() > 0) isEmpty = .FALSE.	1✔
395	END FUNCTION isEmpty	1✔
396	!
397	!////////////////////////////////////////////////////////////////////////
398	!
399	! SUBROUTINE setIsCaseSensitive(self,sensitive)
400	! IMPLICIT NONE
401	! CLASS(FTStringSet) :: self
402	! LOGICAL :: sensitive
403	! self % dict % isCaseSensitive = sensitive
404	! END SUBROUTINE setIsCaseSensitive
405	!
406	!////////////////////////////////////////////////////////////////////////
407	!
408	! LOGICAL FUNCTION isCaseSensitive(self)
409	! IMPLICIT NONE
410	! CLASS(FTStringSet) :: self
411	! isCaseSensitive = self % dict % isCaseSensitive
412	! END FUNCTION isCaseSensitive
413	!
414	!////////////////////////////////////////////////////////////////////////
415	!
NEW 416	SUBROUTINE printFTStringSet(self,iUnit)	×
417	IMPLICIT NONE
418	!
419	! ---------
420	! Arguments
421	! ---------
422	!
423	CLASS(FTStringSet) :: self
424	INTEGER :: iUnit
425	!
426	! ---------------
427	! Local Variables
428	! ---------------
429	!
430	INTEGER :: i
431	CHARACTER(LEN=FTDICT_KWD_STRING_LENGTH), POINTER :: keys(:)	×
432
433	keys => self % dict % allKeys()	×
NEW 434	DO i = 1, SIZE(keys)	×
NEW 435	PRINT *, TRIM(keys(i))	×
436	END DO
UNCOV 437	DEALLOCATE(keys)	×
438
439	END SUBROUTINE printFTStringSet	×
440
441	!
442	!---------------------------------------------------------------------------
443	!> Generic Name: cast
444	!>
445	!> Cast a pointer to the base class to an FTStringSet pointer
446	!---------------------------------------------------------------------------
447	!
448	!////////////////////////////////////////////////////////////////////////
449	!
450	FUNCTION FTStringSetFromObject(obj) RESULT(cast)	1✔
451	!
452	! -----------------------------------------------------
453	! Cast the base class FTObject to the FTException class
454	! -----------------------------------------------------
455	!
456	IMPLICIT NONE
457	CLASS(FTObject) , POINTER :: obj
458	CLASS(FTStringSet), POINTER :: cast
459
460	cast => NULL()	1✔
461	SELECT TYPE (e => obj)
462	TYPE is (FTStringSet)
463	cast => e	1✔
464	CLASS DEFAULT
465
466	END SELECT
467
468	END FUNCTION FTStringSetFromObject	1✔
469	!
470	!////////////////////////////////////////////////////////////////////////
471	!
472	! -----------------------------------------------------------------
473	!> Class name returns a string with the name of the type of the object
474	!>
475	!>### Usage:
476	!>
477	!> PRINT *, obj % className()
478	!> if( obj % className = "FTStringSet")
479	!>
480	FUNCTION FTStringSetClassName(self) RESULT(s)	1✔
481	IMPLICIT NONE
482	CLASS(FTStringSet) :: self
483	CHARACTER(LEN=CLASS_NAME_CHARACTER_LENGTH) :: s
484
485	s = "FTStringSet"	1✔
486
487	END FUNCTION FTStringSetClassName	1✔
488
489
490	END MODULE FTStringSetClass	13✔

trixi-framework / FTObjectLibrary / 18176680887

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous