30278888083

Committed 27 Jul 2026 03:12PM UTC coverage: 93.59% (-1.0%) from 94.58%

Build # 30278888083

Build Type

Pull #79

github

Committed by

web-flow

Commit Message

Merge 489183157 into 58212d52c

Pull Request Pull Request #79: Type mods2

Coverage Stats

114 of 133 new or added lines in 18 files covered. (85.71%)

16 existing lines in 4 files now uncovered.

2774 of 2964 relevant lines covered (93.59%)

14.89 hits per line

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

85.45

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

!
!////////////////////////////////////////////////////////////////////////
!
!      FTStackClass.f90
!      Created: January 25, 2013 12:56 PM 
!      By: David Kopriva  
!
!>Inherits from FTLinkedListClass : FTObjectClass
!>
!>##Definition (Subclass of FTLinkedListClass):
!>   TYPE(FTStack) :: list
!>
!>#Usage:
!>
!>##Initialization
!>
!>      ALLOCATE(stack)  If stack is a pointer
!>      CALL stack  %  init()
!>
!>##Destruction
!>      CALL releaseFTStack(stack) [Pointers]
!>
!>##Pushing an object onto the stack
!>
!>      TYPE(FTObject) :: objectPtr
!>      objectPtr => r1
!>      CALL stack % push(objectPtr)
!>
!>##Peeking at the top of the stack
!>
!>      objectPtr => stack % peek()  No change of ownership
!>      SELECT TYPE(objectPtr)
!>         TYPE is (*SubclassType*)
!>            … Do something with ObjectPtr as subclass
!>         CLASS DEFAULT
!>            … Problem with casting
!>      END SELECT
!>
!>##Popping the top of the stack
!>
!>      objectPtr => stack % pop()  Ownership transferred to caller
!>      SELECT TYPE(objectPtr)
!>         TYPE is (*SubclassType*)
!>            … Do something with ObjectPtr as subclass
!>         CLASS DEFAULT
!>            … Problem with casting
!>      END SELECT
!
!////////////////////////////////////////////////////////////////////////
!
      Module FTStackClass
      USE FTLinkedListClass
      IMPLICIT NONE
      
      TYPE, EXTENDS(FTLinkedList) :: FTStack
!
!        ========         
         CONTAINS
!        ========
!
         PROCEDURE :: init             => initFTStack
         PROCEDURE :: printDescription => printStackDescription
         PROCEDURE :: className        => stackClassName
         PROCEDURE :: push
         PROCEDURE :: pop
         PROCEDURE :: peek
      END TYPE FTStack
!
!     ----------
!     Procedures
!     ----------
!
!     ========
      CONTAINS
!     ========
!
!
!------------------------------------------------
!> Public, generic name: init()
!>
!> Initialize the stack.
!------------------------------------------------
!
!////////////////////////////////////////////////////////////////////////
!
      SUBROUTINE initFTStack(self) 
         IMPLICIT NONE 
         CLASS(FTStack) :: self
!
!        --------------------------------------------
!        Call the initializer of the superclass first
!        --------------------------------------------
!
         CALL self % FTLinkedList % init()
!
!        ---------------------------------
!        Then initialize ivars of subclass 
!        ---------------------------------
!
         !None to initialize
         
      END SUBROUTINE initFTStack
!
!//////////////////////////////////////////////////////////////////////// 
! 
      SUBROUTINE releaseFTStack(self)  
         IMPLICIT NONE
         TYPE(FTStack)  , POINTER :: self
         CLASS(FTObject), POINTER :: obj
            
         IF(.NOT. ASSOCIATED(self)) RETURN
       
         obj => self
         CALL release(obj) 
         IF(.NOT.ASSOCIATED(obj)) self => NULL()
      END SUBROUTINE releaseFTStack
!
!//////////////////////////////////////////////////////////////////////// 
! 
      SUBROUTINE releaseFTStackClass(self)  
         IMPLICIT NONE
         CLASS(FTStack)  , POINTER :: self
         CLASS(FTObject) , POINTER :: obj
            
         IF(.NOT. ASSOCIATED(self)) RETURN
       
         obj => self
         CALL release(obj) 
         IF(.NOT.ASSOCIATED(obj)) self => NULL()
      END SUBROUTINE releaseFTStackClass
!
!     -----------------------------------
!     push: Push an object onto the stack
!     -----------------------------------
!
!////////////////////////////////////////////////////////////////////////
!
      SUBROUTINE push(self,obj)
!
!        ----------------------------------
!        Add object to the head of the list
!        ----------------------------------
!
         IMPLICIT NONE 
         CLASS(FTStack)                     :: self
         CLASS(FTObject)          , POINTER :: obj
         CLASS(FTLinkedListRecord), POINTER :: newRecord => NULL()
         CLASS(FTLinkedListRecord), POINTER :: tmp       => NULL()
         
         ALLOCATE(newRecord)
         CALL newRecord % initWithObject(obj)
         
         IF ( .NOT.ASSOCIATED(self % head) )     THEN
            self % head => newRecord
            self % tail => newRecord
         ELSE
            tmp                => self % head
            self % head        => newRecord
            self % head % next => tmp
            tmp  % previous    => newRecord
         END IF
         self % nRecords = self % nRecords + 1
         
      END SUBROUTINE push
!
!//////////////////////////////////////////////////////////////////////// 
! 
      FUNCTION peek(self)
!
!        -----------------------------------------
!        Return the object at the head of the list
!        ** No change of ownership **
!        -----------------------------------------
!
         IMPLICIT NONE 
         CLASS(FTStack)           :: self
         CLASS(FTObject), POINTER :: peek
         
         IF ( .NOT. ASSOCIATED(self % head) )     THEN
            peek => NULL()
            RETURN 
         END IF 

         peek => self % head % recordObject

      END FUNCTION peek    
!
!//////////////////////////////////////////////////////////////////////// 
! 
      SUBROUTINE pop(self,p)
!
!        ---------------------------------------------------
!        Remove the head of the list and return the object
!        that it points to. Calling routine gains ownership 
!        of the object.
!        ---------------------------------------------------
!
         IMPLICIT NONE  
         CLASS(FTStack)                     :: self
         CLASS(FTObject)          , POINTER :: p, obj
         CLASS(FTLinkedListRecord), POINTER :: tmp => NULL()
         
         IF ( .NOT. ASSOCIATED(self % head) )     THEN
            p => NULL()
            RETURN 
         END IF 
            
         p => self % head % recordObject
         IF(.NOT.ASSOCIATED(p)) RETURN 
         CALL p % retain()
         
         tmp => self % head
         self % head => self % head % next
         
         obj => tmp
         CALL release(obj)
         self % nRecords = self % nRecords - 1

      END SUBROUTINE pop
!
!//////////////////////////////////////////////////////////////////////// 
! 
      FUNCTION stackFromObject(obj) RESULT(cast)
!
!     -----------------------------------------------------
!     Cast the base class FTObject to the LinkedList class
!     -----------------------------------------------------
!
         IMPLICIT NONE  
         CLASS(FTObject), POINTER :: obj
         CLASS(FTStack) , POINTER :: cast
         
         cast => NULL()
         SELECT TYPE (e => obj)
            TYPE is (FTStack)
               cast => e
            CLASS DEFAULT
               
         END SELECT
         
      END FUNCTION stackFromObject
!
!////////////////////////////////////////////////////////////////////////
!
      SUBROUTINE printStackDescription(self, iUnit) 
         IMPLICIT NONE 
         CLASS(FTStack) :: self
         INTEGER        :: iUnit
         
         CALL self % FTLinkedList % printDescription(iUnit = iUnit)
         
      END SUBROUTINE printStackDescription
!
!//////////////////////////////////////////////////////////////////////// 
! 
!      -----------------------------------------------------------------
!> Class name returns a string with the name of the type of the object
!>
!>  ### Usage:
!>
!>        PRINT *,  obj % className()
!>        if( obj % className = "FTStack")
!>
      FUNCTION stackClassName(self)  RESULT(s)
         IMPLICIT NONE  
         CLASS(FTStack)                             :: self
         CHARACTER(LEN=CLASS_NAME_CHARACTER_LENGTH) :: s
         
         IF(self % refCount() .ge. 0) CONTINUE
         s = "FTStack"
 
      END FUNCTION stackClassName
    
      END Module FTStackClass    

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	! FTStackClass.f90
34	! Created: January 25, 2013 12:56 PM
35	! By: David Kopriva
36	!
37	!>Inherits from FTLinkedListClass : FTObjectClass
38	!>
39	!>##Definition (Subclass of FTLinkedListClass):
40	!> TYPE(FTStack) :: list
41	!>
42	!>#Usage:
43	!>
44	!>##Initialization
45	!>
46	!> ALLOCATE(stack) If stack is a pointer
47	!> CALL stack % init()
48	!>
49	!>##Destruction
50	!> CALL releaseFTStack(stack) [Pointers]
51	!>
52	!>##Pushing an object onto the stack
53	!>
54	!> TYPE(FTObject) :: objectPtr
55	!> objectPtr => r1
56	!> CALL stack % push(objectPtr)
57	!>
58	!>##Peeking at the top of the stack
59	!>
60	!> objectPtr => stack % peek() No change of ownership
61	!> SELECT TYPE(objectPtr)
62	!> TYPE is (SubclassType)
63	!> … Do something with ObjectPtr as subclass
64	!> CLASS DEFAULT
65	!> … Problem with casting
66	!> END SELECT
67	!>
68	!>##Popping the top of the stack
69	!>
70	!> objectPtr => stack % pop() Ownership transferred to caller
71	!> SELECT TYPE(objectPtr)
72	!> TYPE is (SubclassType)
73	!> … Do something with ObjectPtr as subclass
74	!> CLASS DEFAULT
75	!> … Problem with casting
76	!> END SELECT
77	!
78	!////////////////////////////////////////////////////////////////////////
79	!
80	Module FTStackClass
81	USE FTLinkedListClass
82	IMPLICIT NONE
83
84	TYPE, EXTENDS(FTLinkedList) :: FTStack
85	!
86	! ========
87	CONTAINS
88	! ========
89	!
90	PROCEDURE :: init => initFTStack
91	PROCEDURE :: printDescription => printStackDescription
92	PROCEDURE :: className => stackClassName
93	PROCEDURE :: push
94	PROCEDURE :: pop
95	PROCEDURE :: peek
96	END TYPE FTStack
97	!
98	! ----------
99	! Procedures
100	! ----------
101	!
102	! ========
103	CONTAINS
104	! ========
105	!
106	!
107	!------------------------------------------------
108	!> Public, generic name: init()
109	!>
110	!> Initialize the stack.
111	!------------------------------------------------
112	!
113	!////////////////////////////////////////////////////////////////////////
114	!
115	SUBROUTINE initFTStack(self)	2✔
116	IMPLICIT NONE
117	CLASS(FTStack) :: self
118	!
119	! --------------------------------------------
120	! Call the initializer of the superclass first
121	! --------------------------------------------
122	!
123	CALL self % FTLinkedList % init()	2✔
124	!
125	! ---------------------------------
126	! Then initialize ivars of subclass
127	! ---------------------------------
128	!
129	!None to initialize
130
131	END SUBROUTINE initFTStack	2✔
132	!
133	!////////////////////////////////////////////////////////////////////////
134	!
135	SUBROUTINE releaseFTStack(self)	1✔
136	IMPLICIT NONE
137	TYPE(FTStack) , POINTER :: self
138	CLASS(FTObject), POINTER :: obj
139
140	IF(.NOT. ASSOCIATED(self)) RETURN	1✔
141
142	obj => self	1✔
143	CALL release(obj)	1✔
144	IF(.NOT.ASSOCIATED(obj)) self => NULL()	1✔
145	END SUBROUTINE releaseFTStack
146	!
147	!////////////////////////////////////////////////////////////////////////
148	!
NEW 149	SUBROUTINE releaseFTStackClass(self)	×
150	IMPLICIT NONE
151	CLASS(FTStack) , POINTER :: self
152	CLASS(FTObject) , POINTER :: obj
153
NEW 154	IF(.NOT. ASSOCIATED(self)) RETURN	×
155
NEW 156	obj => self	×
NEW 157	CALL release(obj)	×
NEW 158	IF(.NOT.ASSOCIATED(obj)) self => NULL()	×
159	END SUBROUTINE releaseFTStackClass
160	!
161	! -----------------------------------
162	! push: Push an object onto the stack
163	! -----------------------------------
164	!
165	!////////////////////////////////////////////////////////////////////////
166	!
167	SUBROUTINE push(self,obj)	7✔
168	!
169	! ----------------------------------
170	! Add object to the head of the list
171	! ----------------------------------
172	!
173	IMPLICIT NONE
174	CLASS(FTStack) :: self
175	CLASS(FTObject) , POINTER :: obj
176	CLASS(FTLinkedListRecord), POINTER :: newRecord => NULL()
177	CLASS(FTLinkedListRecord), POINTER :: tmp => NULL()
178
179	ALLOCATE(newRecord)	7✔
180	CALL newRecord % initWithObject(obj)	7✔
181
182	IF ( .NOT.ASSOCIATED(self % head) ) THEN	7✔
183	self % head => newRecord	2✔
184	self % tail => newRecord	2✔
185	ELSE
186	tmp => self % head	5✔
187	self % head => newRecord	5✔
188	self % head % next => tmp	5✔
189	tmp % previous => newRecord	5✔
190	END IF
191	self % nRecords = self % nRecords + 1	7✔
192
193	END SUBROUTINE push	7✔
194	!
195	!////////////////////////////////////////////////////////////////////////
196	!
197	FUNCTION peek(self)	4✔
198	!
199	! -----------------------------------------
200	! Return the object at the head of the list
201	! No change of ownership
202	! -----------------------------------------
203	!
204	IMPLICIT NONE
205	CLASS(FTStack) :: self
206	CLASS(FTObject), POINTER :: peek
207
208	IF ( .NOT. ASSOCIATED(self % head) ) THEN	4✔
209	peek => NULL()	1✔
210	RETURN	1✔
211	END IF
212
213	peek => self % head % recordObject	3✔
214
215	END FUNCTION peek	3✔
216	!
217	!////////////////////////////////////////////////////////////////////////
218	!
219	SUBROUTINE pop(self,p)	3✔
220	!
221	! ---------------------------------------------------
222	! Remove the head of the list and return the object
223	! that it points to. Calling routine gains ownership
224	! of the object.
225	! ---------------------------------------------------
226	!
227	IMPLICIT NONE
228	CLASS(FTStack) :: self
229	CLASS(FTObject) , POINTER :: p, obj
230	CLASS(FTLinkedListRecord), POINTER :: tmp => NULL()
231
232	IF ( .NOT. ASSOCIATED(self % head) ) THEN	3✔
233	p => NULL()	1✔
234	RETURN	1✔
235	END IF
236
237	p => self % head % recordObject	2✔
238	IF(.NOT.ASSOCIATED(p)) RETURN	2✔
239	CALL p % retain()	2✔
240
241	tmp => self % head	2✔
242	self % head => self % head % next	2✔
243
244	obj => tmp	2✔
245	CALL release(obj)	2✔
246	self % nRecords = self % nRecords - 1	2✔
247
248	END SUBROUTINE pop
249	!
250	!////////////////////////////////////////////////////////////////////////
251	!
252	FUNCTION stackFromObject(obj) RESULT(cast)	1✔
253	!
254	! -----------------------------------------------------
255	! Cast the base class FTObject to the LinkedList class
256	! -----------------------------------------------------
257	!
258	IMPLICIT NONE
259	CLASS(FTObject), POINTER :: obj
260	CLASS(FTStack) , POINTER :: cast
261
262	cast => NULL()	1✔
263	SELECT TYPE (e => obj)
264	TYPE is (FTStack)
265	cast => e	1✔
266	CLASS DEFAULT
267
268	END SELECT
269
270	END FUNCTION stackFromObject	1✔
271	!
272	!////////////////////////////////////////////////////////////////////////
273	!
274	SUBROUTINE printStackDescription(self, iUnit)	×
275	IMPLICIT NONE
276	CLASS(FTStack) :: self
277	INTEGER :: iUnit
278
279	CALL self % FTLinkedList % printDescription(iUnit = iUnit)	×
280
281	END SUBROUTINE printStackDescription	×
282	!
283	!////////////////////////////////////////////////////////////////////////
284	!
285	! -----------------------------------------------------------------
286	!> Class name returns a string with the name of the type of the object
287	!>
288	!> ### Usage:
289	!>
290	!> PRINT *, obj % className()
291	!> if( obj % className = "FTStack")
292	!>
293	FUNCTION stackClassName(self) RESULT(s)	1✔
294	IMPLICIT NONE
295	CLASS(FTStack) :: self
296	CHARACTER(LEN=CLASS_NAME_CHARACTER_LENGTH) :: s
297
298	IF(self % refCount() .ge. 0) CONTINUE	1✔
299	s = "FTStack"	1✔
300
301	END FUNCTION stackClassName	1✔
302
303	END Module FTStackClass	1✔

trixi-framework / FTObjectLibrary / 30278888083

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