30206241592

Committed 26 Jul 2026 02:31PM UTC coverage: 92.391% (-2.2%) from 94.58%

Build # 30206241592

Build Type

Pull #79

github

Committed by

web-flow

Commit Message

Merge 79dc9ef6b into 58212d52c

Pull Request Pull Request #79: Type mods2

Coverage Stats

89 of 126 new or added lines in 17 files covered. (70.63%)

33 existing lines in 4 files now uncovered.

2732 of 2957 relevant lines covered (92.39%)

14.8 hits per line

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

88.64

/Source/FTObjects/FTDataClass.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

!
!////////////////////////////////////////////////////////////////////////
!
!      FTDataClass.f90
!      Created: July 11, 2013 2:00 PM 
!      By: David Kopriva  
!
!>FTData defines a subclass of FTObject to contain immutable
!>generic data, including derived types. 
!>
!>The initializer
!>copies the data and takes ownership of that copy. FTData
!>gives a way to use derived types without having to subclass
!>FTObject.
!
!////////////////////////////////////////////////////////////////////////
!
      Module FTDataClass 
      USE FTObjectClass
      IMPLICIT NONE
!
!     ---------
!     Constants
!     ---------
!
      INTEGER, PARAMETER          :: DATA_CLASS_TYPE_LENGTH = 32
!
!     ---------------------
!     Class type definition
!     ---------------------
!
      TYPE, EXTENDS(FTObject) :: FTData
         PRIVATE 
         CHARACTER(LEN=DATA_CLASS_TYPE_LENGTH) :: dataType
         CHARACTER(LEN=1), POINTER             :: dataStorage(:) 
         INTEGER                               :: dataSize
!
!        ========         
         CONTAINS 
!        ========
!         
         PROCEDURE, PUBLIC :: initWithDataOfType
         PROCEDURE, PUBLIC :: storedData
         PROCEDURE, PUBLIC :: storedDataSize
         PROCEDURE, PUBLIC :: storedDataType
         PROCEDURE, PUBLIC :: dataIsOfType
         PROCEDURE, PUBLIC :: className => dataClassName
         FINAL             :: destructData
      END TYPE FTData
      
      CONTAINS 
!
!//////////////////////////////////////////////////////////////////////// 
! 
      SUBROUTINE initWithDataOfType(self, genericData, dataType)  
         IMPLICIT NONE  
         CLASS(FTData)    :: self
         CHARACTER(LEN=*) :: dataType
         CHARACTER(LEN=1) :: genericData(:)
         
         INTEGER          :: dataSize
          
          CALL self % FTObject % init()
          
          dataSize = SIZE(genericData)
          ALLOCATE(self % dataStorage(dataSize))
          
          self % dataStorage = genericData
          self % dataType    = dataType
          self % dataSize    = dataSize
          
      END SUBROUTINE initWithDataOfType
!
!////////////////////////////////////////////////////////////////////////
!
      SUBROUTINE destructData(self) 
         IMPLICIT NONE
         TYPE(FTData)  :: self
         
         IF(ASSOCIATED(self % dataStorage)) DEALLOCATE( self % dataStorage)
         
      END SUBROUTINE destructData
!
!//////////////////////////////////////////////////////////////////////// 
! 
      SUBROUTINE releaseFTData(self)  
         IMPLICIT NONE
         TYPE(FTData)   , POINTER :: self
         CLASS(FTObject), POINTER :: obj
         
         IF(.NOT. ASSOCIATED(self)) RETURN
        
         obj => self
         CALL release(obj) 
         IF(.NOT.ASSOCIATED(obj)) self => NULL()
      END SUBROUTINE releaseFTData
!
!//////////////////////////////////////////////////////////////////////// 
! 
      SUBROUTINE releaseFTDataClass(self)  
         IMPLICIT NONE
         CLASS(FTData)  , POINTER :: self
         CLASS(FTObject), POINTER :: obj
         
         IF(.NOT. ASSOCIATED(self)) RETURN
        
         obj => self
         CALL release(obj) 
         IF(.NOT.ASSOCIATED(obj)) self => NULL()
      END SUBROUTINE releaseFTDataClass
!@mark -
!
!//////////////////////////////////////////////////////////////////////// 
! 
      FUNCTION storedData(self)  RESULT(d)
         IMPLICIT NONE  
         CLASS(FTData)             :: self
         CHARACTER(LEN=1), POINTER :: d(:)
         d => self % dataStorage
      END FUNCTION storedData
!
!//////////////////////////////////////////////////////////////////////// 
! 
      INTEGER FUNCTION storedDataSize(self)
         IMPLICIT NONE  
         CLASS(FTData)    :: self
         storedDataSize = self % dataSize
      END FUNCTION storedDataSize
!
!//////////////////////////////////////////////////////////////////////// 
! 
      FUNCTION storedDataType(self)  RESULT(t)
         IMPLICIT NONE  
         CLASS(FTData)    :: self
         CHARACTER(LEN=DATA_CLASS_TYPE_LENGTH) :: t
         t = self % dataType
      END FUNCTION storedDataType
!
!//////////////////////////////////////////////////////////////////////// 
! 
      FUNCTION dataFromObject(obj) RESULT(cast)
!
!     -----------------------------------------------------
!     Cast the base class FTObject to the FTException class
!     -----------------------------------------------------
!
         IMPLICIT NONE  
         CLASS(FTObject) , POINTER :: obj
         CLASS(FTData)   , POINTER :: cast
         
         cast => NULL()
         SELECT TYPE (e => obj)
            TYPE is (FTData)
               cast => e
            CLASS DEFAULT
               
         END SELECT
         
      END FUNCTION dataFromObject
!
!//////////////////////////////////////////////////////////////////////// 
! 
!      -----------------------------------------------------------------
!> Class name returns a string with the name of the type of the object
!>
!>  ### Usage:
!>
!>        PRINT *,  obj % className()
!>        if( obj % className = "FTData")
!>
      FUNCTION dataClassName(self)  RESULT(s)
         IMPLICIT NONE  
         CLASS(FTData)                              :: self
         CHARACTER(LEN=CLASS_NAME_CHARACTER_LENGTH) :: s
         
         s = "FTData"
         IF( self % refCount() >= 0 ) CONTINUE 
 
      END FUNCTION dataClassName
!
!//////////////////////////////////////////////////////////////////////// 
! 
      FUNCTION dataIsOfType(self, dataType)  RESULT(t)
         IMPLICIT NONE  
         CLASS(FTData)    :: self
         CHARACTER(LEN=*) :: dataType
         LOGICAL          :: t
         
         IF ( dataType == self % dataType )     THEN
            t = .TRUE. 
         ELSE 
            t = .FALSE. 
         END IF 
      END FUNCTION dataIsOfType
      
      END Module FTDataClass

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	! FTDataClass.f90
34	! Created: July 11, 2013 2:00 PM
35	! By: David Kopriva
36	!
37	!>FTData defines a subclass of FTObject to contain immutable
38	!>generic data, including derived types.
39	!>
40	!>The initializer
41	!>copies the data and takes ownership of that copy. FTData
42	!>gives a way to use derived types without having to subclass
43	!>FTObject.
44	!
45	!////////////////////////////////////////////////////////////////////////
46	!
47	Module FTDataClass
48	USE FTObjectClass
49	IMPLICIT NONE
50	!
51	! ---------
52	! Constants
53	! ---------
54	!
55	INTEGER, PARAMETER :: DATA_CLASS_TYPE_LENGTH = 32
56	!
57	! ---------------------
58	! Class type definition
59	! ---------------------
60	!
61	TYPE, EXTENDS(FTObject) :: FTData
62	PRIVATE
63	CHARACTER(LEN=DATA_CLASS_TYPE_LENGTH) :: dataType
64	CHARACTER(LEN=1), POINTER :: dataStorage(:)
65	INTEGER :: dataSize
66	!
67	! ========
68	CONTAINS
69	! ========
70	!
71	PROCEDURE, PUBLIC :: initWithDataOfType
72	PROCEDURE, PUBLIC :: storedData
73	PROCEDURE, PUBLIC :: storedDataSize
74	PROCEDURE, PUBLIC :: storedDataType
75	PROCEDURE, PUBLIC :: dataIsOfType
76	PROCEDURE, PUBLIC :: className => dataClassName
77	FINAL :: destructData
78	END TYPE FTData
79
80	CONTAINS
81	!
82	!////////////////////////////////////////////////////////////////////////
83	!
84	SUBROUTINE initWithDataOfType(self, genericData, dataType)	1✔
85	IMPLICIT NONE
86	CLASS(FTData) :: self
87	CHARACTER(LEN=*) :: dataType
88	CHARACTER(LEN=1) :: genericData(:)
89
90	INTEGER :: dataSize
91
92	CALL self % FTObject % init()	1✔
93
94	dataSize = SIZE(genericData)	1✔
95	ALLOCATE(self % dataStorage(dataSize))	1✔
96
97	self % dataStorage = genericData	12✔
98	self % dataType = dataType	1✔
99	self % dataSize = dataSize	1✔
100
101	END SUBROUTINE initWithDataOfType	1✔
102	!
103	!////////////////////////////////////////////////////////////////////////
104	!
105	SUBROUTINE destructData(self)	1✔
106	IMPLICIT NONE
107	TYPE(FTData) :: self
108
109	IF(ASSOCIATED(self % dataStorage)) DEALLOCATE( self % dataStorage)	1✔
110
111	END SUBROUTINE destructData	1✔
112	!
113	!////////////////////////////////////////////////////////////////////////
114	!
UNCOV 115	SUBROUTINE releaseFTData(self)	×
116	IMPLICIT NONE
117	TYPE(FTData) , POINTER :: self
118	CLASS(FTObject), POINTER :: obj
119
UNCOV 120	IF(.NOT. ASSOCIATED(self)) RETURN	×
121
UNCOV 122	obj => self	×
UNCOV 123	CALL release(obj)	×
UNCOV 124	IF(.NOT.ASSOCIATED(obj)) self => NULL()	×
125	END SUBROUTINE releaseFTData
126	!
127	!////////////////////////////////////////////////////////////////////////
128	!
129	SUBROUTINE releaseFTDataClass(self)	1✔
130	IMPLICIT NONE
131	CLASS(FTData) , POINTER :: self
132	CLASS(FTObject), POINTER :: obj
133
134	IF(.NOT. ASSOCIATED(self)) RETURN	1✔
135
136	obj => self	1✔
137	CALL release(obj)	1✔
138	IF(.NOT.ASSOCIATED(obj)) self => NULL()	1✔
139	END SUBROUTINE releaseFTDataClass
140	!@mark -
141	!
142	!////////////////////////////////////////////////////////////////////////
143	!
144	FUNCTION storedData(self) RESULT(d)	1✔
145	IMPLICIT NONE
146	CLASS(FTData) :: self
147	CHARACTER(LEN=1), POINTER :: d(:)
148	d => self % dataStorage	1✔
149	END FUNCTION storedData	1✔
150	!
151	!////////////////////////////////////////////////////////////////////////
152	!
153	INTEGER FUNCTION storedDataSize(self)	1✔
154	IMPLICIT NONE
155	CLASS(FTData) :: self
156	storedDataSize = self % dataSize	1✔
157	END FUNCTION storedDataSize	1✔
158	!
159	!////////////////////////////////////////////////////////////////////////
160	!
161	FUNCTION storedDataType(self) RESULT(t)	1✔
162	IMPLICIT NONE
163	CLASS(FTData) :: self
164	CHARACTER(LEN=DATA_CLASS_TYPE_LENGTH) :: t
165	t = self % dataType	1✔
166	END FUNCTION storedDataType	1✔
167	!
168	!////////////////////////////////////////////////////////////////////////
169	!
170	FUNCTION dataFromObject(obj) RESULT(cast)	1✔
171	!
172	! -----------------------------------------------------
173	! Cast the base class FTObject to the FTException class
174	! -----------------------------------------------------
175	!
176	IMPLICIT NONE
177	CLASS(FTObject) , POINTER :: obj
178	CLASS(FTData) , POINTER :: cast
179
180	cast => NULL()	1✔
181	SELECT TYPE (e => obj)
182	TYPE is (FTData)
183	cast => e	1✔
184	CLASS DEFAULT
185
186	END SELECT
187
188	END FUNCTION dataFromObject	1✔
189	!
190	!////////////////////////////////////////////////////////////////////////
191	!
192	! -----------------------------------------------------------------
193	!> Class name returns a string with the name of the type of the object
194	!>
195	!> ### Usage:
196	!>
197	!> PRINT *, obj % className()
198	!> if( obj % className = "FTData")
199	!>
200	FUNCTION dataClassName(self) RESULT(s)	1✔
201	IMPLICIT NONE
202	CLASS(FTData) :: self
203	CHARACTER(LEN=CLASS_NAME_CHARACTER_LENGTH) :: s
204
205	s = "FTData"	1✔
206	IF( self % refCount() >= 0 ) CONTINUE	1✔
207
208	END FUNCTION dataClassName	1✔
209	!
210	!////////////////////////////////////////////////////////////////////////
211	!
212	FUNCTION dataIsOfType(self, dataType) RESULT(t)	2✔
213	IMPLICIT NONE
214	CLASS(FTData) :: self
215	CHARACTER(LEN=*) :: dataType
216	LOGICAL :: t
217
218	IF ( dataType == self % dataType ) THEN	2✔
219	t = .TRUE.	1✔
220	ELSE
221	t = .FALSE.	1✔
222	END IF
223	END FUNCTION dataIsOfType	4✔
224
225	END Module FTDataClass	2✔

trixi-framework / FTObjectLibrary / 30206241592

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