Update copyright to LGPL on all files
[dyninst.git] / dyninstAPI / tests / src / test1.mutateeFort.F
1  !
2  ! Copyright (c) 1996-2009 Barton P. Miller
3  ! 
4  ! We provide the Paradyn Parallel Performance Tools (below
5  ! described as "Paradyn") on an AS IS basis, and do not warrant its
6  ! validity or performance.  We reserve the right to update, modify,
7  ! or discontinue this software at any time.  We shall have no
8  ! obligation to supply such updates or modifications or any other
9  ! form of support to you.
10  ! 
11  ! By your use of Paradyn, you understand and agree that we (or any
12  ! other person or entity with proprietary rights in Paradyn) are
13  ! under no obligation to provide either maintenance services,
14  ! update services, notices of latent defects, or correction of
15  ! defects for Paradyn.
16  ! 
17  ! This library is free software; you can redistribute it and/or
18  ! modify it under the terms of the GNU Lesser General Public
19  ! License as published by the Free Software Foundation; either
20  ! version 2.1 of the License, or (at your option) any later version.
21  ! 
22  ! This library is distributed in the hope that it will be useful,
23  ! but WITHOUT ANY WARRANTY; without even the implied warranty of
24  ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
25  ! Lesser General Public License for more details.
26  ! 
27  ! You should have received a copy of the GNU Lesser General Public
28  ! License along with this library; if not, write to the Free Software
29  ! Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
30 ! libdyninst validation suite test #1
31 ! author: Jon Beyer (6/1/01)
32 !       derived from a previous test by Jeff Hollingsworth
33
34 !------------------------------------------------------------------------------
35
36 ! AIX xlf90 does not insert underscores at end
37
38 #if !defined(XLF)
39 #define stop_process_ stop_process
40 #endif
41
42 #ifdef __GNUC__
43 #define AND iand
44 #define OR ior
45 #else
46 #define AND and
47 #define OR or
48 #endif
49
50 !------------------------------------------------------------------------------
51
52         SUBROUTINE init_globals
53 #include "test1_common.h"
54
55         globalVariable1_1 = 69
56         globalVariable3_1 = 31
57         globalVariable4_1 = 41
58         globalVariable5_1 = 51
59         globalVariable5_2 = 51
60
61         globalVariable6_1 = Z'deadbeef'
62         globalVariable6_2 = Z'deadbeef'
63         globalVariable6_3 = Z'deadbeef'
64         globalVariable6_4 = Z'deadbeef'
65         globalVariable6_5 = Z'deadbeef'
66         globalVariable6_6 = Z'deadbeef'
67         globalVariable6_1a = Z'deadbeef'
68         globalVariable6_2a = Z'deadbeef'
69         globalVariable6_3a = Z'deadbeef'
70         globalVariable6_4a = Z'deadbeef'
71         globalVariable6_5a = Z'deadbeef'
72         globalVariable6_6a = Z'deadbeef'
73
74         constVar0 = 0
75         constVar1 = 1
76         constVar2 = 2
77         constVar3 = 3
78         constVar4 = 4
79         constVar5 = 5
80         constVar6 = 6
81         constVar7 = 7
82         constVar9 = 9
83         constVar10 = 10
84         constVar60 = 60
85         constVar64 = 64
86         constVar66 = 66
87         constVar67 = 67
88
89         globalVariable7_1 = 71
90         globalVariable7_2 = 71
91         globalVariable7_3 = 71
92         globalVariable7_4 = 71
93         globalVariable7_5 = 71
94         globalVariable7_6 = 71
95         globalVariable7_7 = 71
96         globalVariable7_8 = 71
97         globalVariable7_9 = 71
98         globalVariable7_10 = 71
99         globalVariable7_11 = 71
100         globalVariable7_12 = 71
101         globalVariable7_13 = 71
102         globalVariable7_14 = 71
103         globalVariable7_15 = 71
104         globalVariable7_16 = 71
105
106         globalVariable7_1a = 73
107         globalVariable7_2a = 73
108         globalVariable7_3a = 73
109         globalVariable7_4a = 73
110         globalVariable7_5a = 73
111         globalVariable7_6a = 73
112         globalVariable7_7a = 73
113         globalVariable7_8a = 73
114         globalVariable7_9a = 73
115         globalVariable7_10a = 73
116         globalVariable7_11a = 73
117         globalVariable7_12a = 73
118         globalVariable7_13a = 73
119         globalVariable7_14a = 73
120         globalVariable7_15a = 73
121         globalVariable7_16a = 73
122
123         globalVariable8_1 = 1
124
125         globalVariable10_1 = 0
126         globalVariable10_2 = 0
127         globalVariable10_3 = 0
128         globalVariable10_4 = 0
129
130         globalVariable11_1 = 0
131         globalVariable11_2 = 0
132         globalVariable11_3 = 0
133         globalVariable11_4 = 0
134         globalVariable11_5 = 0
135
136         globalVariable12_1 = 0
137
138         globalVariable13_1 = 0
139
140         globalVariable14_1 = 0
141         globalVariable14_2 = 0
142
143         globalVariable15_1 = 0
144         globalVariable15_2 = 0
145         globalVariable15_3 = 0
146         globalVariable15_4 = 0
147
148         globalVariable16_1 = 0
149         globalVariable16_2 = 0
150         globalVariable16_3 = 0
151         globalVariable16_4 = 0
152         globalVariable16_5 = 0
153         globalVariable16_6 = 0
154         globalVariable16_7 = 0
155         globalVariable16_8 = 0
156         globalVariable16_9 = 0
157         globalVariable16_10 = 0
158
159         globalVariable17_1 = 0
160         globalVariable17_2 = 0
161
162         globalVariable19_1 = Z'deadbeef'
163         globalVariable19_2 = z'deadbeef'
164
165         globalVariable20_1 = Z'deadbeef'
166         globalVariable20_2 = 0.0
167
168         globalVariable26_2 = 26000000
169         globalVariable26_3 = 26000000
170         globalVariable26_4 = 26000000
171         globalVariable26_5 = 26000000
172         globalVariable26_6 = 26000000
173         globalVariable26_7 = 26000000
174         globalVariable26_8 = 26000000
175         globalVariable26_9 = 26000000
176         globalVariable26_10 = 26000000
177         globalVariable26_11 = 26000000
178         globalVariable26_12 = 26000000
179         globalVariable26_13 = 26000000
180
181         globalVariable27_5(1) = 0
182         globalVariable27_5(2) = 1
183         globalVariable27_5(3) = 2
184         globalVariable27_5(4) = 3
185         globalVariable27_5(5) = 4
186         globalVariable27_5(6) = 5
187         globalVariable27_5(7) = 6
188         globalVariable27_5(8) = 7
189         globalVariable27_5(9) = 8
190         globalVariable27_5(10) = 9
191         globalVariable27_6(1) = 0
192         globalVariable27_6(2) = 1
193         globalVariable27_6(3) = 2
194         globalVariable27_6(4) = 3
195         globalVariable27_6(5) = 4
196         globalVariable27_6(6) = 5
197         globalVariable27_6(7) = 6
198         globalVariable27_6(8) = 7
199         globalVariable27_6(9) = 8
200         globalVariable27_6(10) = 9
201         globalVariable27_7(1) = 0.0
202         globalVariable27_7(2) = 1.0
203         globalVariable27_7(3) = 2.0
204         globalVariable27_7(4) = 3.0
205         globalVariable27_7(5) = 4.0
206         globalVariable27_7(6) = 5.0
207         globalVariable27_7(7) = 6.0
208         globalVariable27_7(8) = 7.0
209         globalVariable27_7(9) = 8.0
210         globalVariable27_7(10) = 9.0
211
212 #if !defined (F77)
213         dummy1%field27_11 = 10
214         dummy2%field27_21 = 10
215         dummy3%field3 (1) = 10
216         dummy4%field3 (1) = 10
217 #endif
218
219         globalVariable31_1 = 0
220         globalVariable31_2 = 0
221         globalVariable31_3 = 0
222         globalVariable31_4 = 0
223
224         globalVariable32_1 = 0
225         globalVariable32_2 = 0
226         globalVariable32_3 = 0
227         globalVariable32_4 = 0
228
229         globalVariable36_1 = 0
230         globalVariable36_2 = 0
231         globalVariable36_3 = 0
232         globalVariable36_4 = 0
233         globalVariable36_5 = 0
234         globalVariable36_6 = 0
235         globalVariable36_7 = 0
236         globalVariable36_8 = 0
237         globalVariable36_9 = 0
238         globalVariable36_10 = 0
239         END
240
241 !------------------------------------------------------------------------------
242
243         SUBROUTINE func1_1
244 #include "test1_common.h"
245
246         CALL func1_2
247
248         if (globalVariable1_1 .eq. 11) then
249                 print *, 'F90: Passed test #1 (zero arg function call)'
250                 passedTest (1) = .true.
251         else
252                 print *, '**Failed** test #1 (zero arg function call)'
253         endif
254         END
255
256 !------------------------------------------------------------------------------
257
258         SUBROUTINE func1_2
259         INTEGER foo = 0
260         END
261
262 !------------------------------------------------------------------------------
263
264         SUBROUTINE call1_1
265 #include "test1_common.h"
266         globalVariable1_1 = 11
267         END
268
269 !------------------------------------------------------------------------------
270
271         SUBROUTINE func2_1
272         INTEGER foo = 0
273         END
274
275 !------------------------------------------------------------------------------
276
277         SUBROUTINE call2_1 (arg1, arg2, arg3)
278 #include "test1_common.h"
279         INTEGER arg1
280         INTEGER arg2
281         CHARACTER arg3 *(*)
282
283         if (arg1 .eq. 1 .and. arg2 .eq. 2 .and. arg3 .eq.
284      & "testString2_1") then
285                 print *, 'Passed test #2 (four paramater function)'
286                 passedTest (2) = .true.
287         else
288                 print *, '**Failed** test #2 (four parameter function)'
289                 if (arg1 .ne. 1) then
290                         print *, '      arg1 = ', arg1, ', should be 1'
291                 endif
292                 if (arg2 .ne. 2) then
293                         print *, '      arg2 = ', arg2, ', should be 2'
294                 endif
295                 if (arg3 .ne. 'testString2_1') then
296                         print *, '      arg3 = ', arg3, ', should be "testString2_1"'
297                 endif
298         endif
299         END
300
301 !------------------------------------------------------------------------------
302
303         SUBROUTINE func3_1
304         INTEGER foo = 0
305         END
306
307 !------------------------------------------------------------------------------
308
309         SUBROUTINE call3_1 (arg1, arg2)
310 #include "test1_common.h"
311         INTEGER arg1, arg2
312         if (arg1 .eq. 31 .and. arg2 .eq. 32) then
313                 print *, 'Passed test #3 (passing Variables to functions)'
314                 passedTest (3) = .true.
315         else
316                 print *, '**Failed** test #3 (passing Variables to functions)'
317                 print *, '      arg1 = ', arg1, ', should be 31'
318                 print *, '      arg2 = ', arg2, ', should be 32'
319         endif
320         END
321
322 !------------------------------------------------------------------------------
323
324         SUBROUTINE func4_1
325 #include "test1_common.h"
326         CALL func4_2
327         if (globalVariable4_1 .eq. 41) then
328                 print *, '**Failed** test #4 (sequence)'
329                 print *, '    none of the items were executed'
330         else
331                 if (globalVariable4_1 .eq. 42) then
332                         print *, '**Failed** test #4 (sequence)'
333                         print *, '    first item was the last (or only) one to execute'
334                 else
335                         if (globalVariable4_1 .eq. 43) then
336                                 print *, 'Passed test #4 (sequence)'
337                                 passedTest (4) = .true.
338                         endif
339                 endif
340         endif
341         END
342
343 !------------------------------------------------------------------------------
344
345         SUBROUTINE func4_2
346         INTEGER foo = 0
347         END
348
349 !------------------------------------------------------------------------------
350
351         SUBROUTINE func5_1
352 #include "test1_common.h"
353         CALL func5_2
354
355         if (globalVariable5_1 .eq. 51 .and. globalVariable5_2 .eq. 53)
356      & then
357                         print *, 'Passed test #5 (if w.o. else)'
358                         passedTest (5) = .true.
359                 else
360                         print *, '**Failed** test #5 (if w.o. else)'
361                         if (globalVariable5_1 .ne. 51) then
362                                 print *, '      condition executed for false'
363                                 print *, '              globalVariable5_1 = ', globalVariable5_1
364                         endif
365                         if (globalVariable5_2 .ne. 53) then
366                                 print *, '      condition not executed for true'
367                                 print *, '              globalVariable5_2 = ', globalVariable5_2
368                         endif
369         endif
370         END
371
372 !------------------------------------------------------------------------------
373
374         SUBROUTINE func5_2
375         INTEGER foo = 0
376         END
377
378 !------------------------------------------------------------------------------
379
380         SUBROUTINE func6_1
381 #include "test1_common.h"
382
383         CALL func6_2
384
385         if (globalVariable6_1 .eq. 60 + 2 .and.
386      & globalVariable6_2 .eq. (64 - 1) .and.
387      & globalVariable6_3 .eq. (66 / 3) .and.
388      & globalVariable6_4 .eq. (67 / 3) .and.
389      & globalVariable6_5 .eq. (6 * 5) .and.
390      & globalVariable6_6 .eq. 3 .and.
391      & globalVariable6_1a .eq. (60 + 2) .and.
392      & globalVariable6_2a .eq. (64 - 1) .and.
393      & globalVariable6_3a .eq. (66 / 3) .and.
394      & globalVariable6_4a .eq. (67 / 3) .and.
395      & globalVariable6_5a .eq. (6 * 5) .and.
396      & globalVariable6_6a .eq. 3) then
397                 print *, 'Passed test #6 (arithmetic operators)'
398                 passedTest (6) = .true.
399         else
400                 print *, '**Failed** test #6 (arithmetic operators)'
401
402                 if (globalVariable6_1 .ne. (60 + 2)) then
403                         print *, '     addition error 60+2 got ', globalVariable6_1
404                 endif
405                 if (globalVariable6_2 .ne. (64 - 1)) then
406                         print *, '     subtraction error 64-1 got ', globalVariable6_2
407                 endif
408                 if (globalVariable6_3 .ne. (66 / 3)) then
409                         print *, '     division error 66/3 got ', globalVariable6_3
410                 endif
411                 if (globalVariable6_4 .ne. (67 / 3)) then
412                         print *, '     division error 67/3 got ', globalVariable6_4
413                 endif
414                 if (globalVariable6_5 .ne. (6 * 5)) then
415                         print *, '     mult error 6*5 got ', globalVariable6_5
416                 endif
417                 if (globalVariable6_6 .ne. 3) then
418                         print *, '     comma error 10,3 got ', globalVariable6_6
419                 endif
420
421                 if (globalVariable6_1a .ne. (60 + 2)) then
422                         print *, '     addition error 60+2 got ', globalVariable6_1a
423                 endif
424                 if (globalVariable6_2a .ne. (64 - 1)) then
425                         print *, '     subtraction error 64-1 got ', globalVariable6_2a
426                 endif
427                 if (globalVariable6_3a .ne. (66 / 3)) then
428                         print *, '     division error 66/3 got ', globalVariable6_3a
429                 endif
430                 if (globalVariable6_4a .ne. (67 / 3)) then
431                         print *, '     division error 67/3 got ', globalVariable6_4a
432                 endif
433                 if (globalVariable6_5a .ne. (6 * 5)) then
434                         print *, '     mult error 6*5 got ', globalVariable6_5a
435                 endif
436                 if (globalVariable6_6a .ne. 3) then
437                         print *, '     comma error 10,3 got ', globalVariable6_6a
438                 endif
439         endif
440         END
441
442 !------------------------------------------------------------------------------
443
444         SUBROUTINE func6_2
445         INTEGER foo = 0
446         END
447
448 !------------------------------------------------------------------------------
449
450         SUBROUTINE fail7Print (tCase, fCase, op)
451         INTEGER tCase
452         INTEGER fCase
453         CHARACTER op *(*)
454
455         if (tCase .ne. 72) then
456                 print *, ' operator ', op, ' was not true when it should be',
457      & ' - const expr'
458         endif
459         if (fCase .ne. 71) then
460                 print *, ' operator ', op, ' was not false when it should be',
461      & ' - const expr'
462         endif
463         END
464
465 !------------------------------------------------------------------------------
466
467         SUBROUTINE fail7aPrint (tCase, fCase, op)
468         INTEGER tCase
469         INTEGER fCase
470         CHARACTER op *(*)
471
472         if (tCase .ne. 74) then
473                 print *, ' operator ', op, ' was not true when it should be',
474      & ' - var expr'
475         endif
476         if (fCase .ne. 73) then
477                 print *, ' operator ', op, ' was not false when it should be',
478      & ' - var expr'
479         endif
480         END
481
482 !------------------------------------------------------------------------------
483
484         SUBROUTINE func7_1
485 #include "test1_common.h"
486
487         CALL func7_2
488
489         if (globalVariable7_1 .eq. 72 .and.
490      & globalVariable7_2 .eq. 71 .and.
491      & globalVariable7_3 .eq. 72 .and.
492      & globalVariable7_4 .eq. 71 .and.
493      & globalVariable7_5 .eq. 72 .and.
494      & globalVariable7_6 .eq. 71 .and.
495      & globalVariable7_7 .eq. 72 .and.
496      & globalVariable7_8 .eq. 71 .and.
497      & globalVariable7_9 .eq. 72 .and.
498      & globalVariable7_10 .eq. 71 .and.
499      & globalVariable7_11 .eq. 72 .and.
500      & globalVariable7_12 .eq. 71 .and.
501      & globalVariable7_13 .eq. 72 .and.
502      & globalVariable7_14 .eq. 71 .and.
503      & globalVariable7_15 .eq. 72 .and.
504      & globalVariable7_16 .eq. 71 .and.
505      & globalVariable7_1a .eq. 74 .and.
506      & globalVariable7_2a .eq. 73 .and.
507      & globalVariable7_3a .eq. 74 .and.
508      & globalVariable7_4a .eq. 73 .and.
509      & globalVariable7_5a .eq. 74 .and.
510      & globalVariable7_6a .eq. 73 .and.
511      & globalVariable7_7a .eq. 74 .and.
512      & globalVariable7_8a .eq. 73 .and.
513      & globalVariable7_9a .eq. 74 .and.
514      & globalVariable7_10a .eq. 73 .and.
515      & globalVariable7_11a .eq. 74 .and.
516      & globalVariable7_12a .eq. 73 .and.
517      & globalVariable7_13a .eq. 74 .and.
518      & globalVariable7_14a .eq. 73 .and.
519      & globalVariable7_15a .eq. 74 .and.
520      & globalVariable7_16a .eq. 73) then
521                 print *, 'Passed test #7 (relational operators)'
522                 passedTest (7) = .true.
523         else
524                 print *, '**Failed** test #7 (relational operators)'
525                 CALL fail7Print(globalVariable7_1, globalVariable7_2,
526      & "BPatch_lt")
527                 CALL fail7Print(globalVariable7_3, globalVariable7_4,
528      & "BPatch_eq")
529                 CALL fail7Print(globalVariable7_5, globalVariable7_6,
530      & "BPatch_gt")
531                 CALL fail7Print(globalVariable7_7, globalVariable7_8,
532      & "BPatch_le")
533                 CALL fail7Print(globalVariable7_9, globalVariable7_10,
534      & "BPatch_ne")
535                 CALL fail7Print(globalVariable7_11, globalVariable7_12,
536      & "BPatch_ge")
537                 CALL fail7Print(globalVariable7_13, globalVariable7_14,
538      & "BPatch_and")
539                 CALL fail7Print(globalVariable7_15, globalVariable7_16,
540      & "BPatch_or")
541
542                 CALL fail7aPrint(globalVariable7_1a, globalVariable7_2a,
543      & "BPatch_lt")
544                 CALL fail7aPrint(globalVariable7_3a, globalVariable7_4a,
545      & "BPatch_eq")
546                 CALL fail7aPrint(globalVariable7_5a, globalVariable7_6a,
547      & "BPatch_gt")
548                 CALL fail7aPrint(globalVariable7_7a, globalVariable7_8a,
549      & "BPatch_le")
550                 CALL fail7aPrint(globalVariable7_9a, globalVariable7_10a,
551      & "BPatch_ne")
552                 CALL fail7aPrint(globalVariable7_11a, globalVariable7_12a,
553      & "BPatch_ge")
554                 CALL fail7aPrint(globalVariable7_13a, globalVariable7_14a,
555      & "BPatch_and")
556                 CALL fail7aPrint(globalVariable7_15a, globalVariable7_16a,
557      & "BPatch_or")
558         endif
559         END
560
561 !------------------------------------------------------------------------------
562
563         SUBROUTINE func7_2
564         INTEGER foo = 0
565         END
566
567 !------------------------------------------------------------------------------
568
569         SUBROUTINE func8_1 (p1, p2, p3, p4, p5, p6, p7, p8, p9, p10)
570 #include "test1_common.h"
571         INTEGER p1, p2, p3, p4, p5, p6, p7, p8, p9, p10
572
573         if (p1 .eq. 1 .and. p2 .eq. 2 .and. p3 .eq. 3 .and. p4 .eq. 4
574      & .and. p5 .eq. 5 .and. p6 .eq. 6 .and. p7 .eq. 7 .and. p8 .eq. 8
575      & .and. p9 .eq. 9 .and. p10 .eq. 10) then
576                 print *, 'Passed test #8 (preserve registers - expr)'
577                 passedTest (8) = .true.
578         else
579                 print *, '**Failed** test #8 (preserve registers - expr)'
580                 if (p1 .ne. 1) then
581                         print *, '    parameter #1 is ', p1, ' not 1'
582                 endif
583                 if (p2 .ne. 2) then
584                         print *, '    parameter #2 is ', p2, ' not 2'
585                 endif
586                 if (p3 .ne. 3) then
587                         print *, '    parameter #3 is ', p3, ' not 3'
588                 endif
589                 if (p4 .ne. 4) then
590                         print *, '    parameter #4 is ', p4, ' not 4'
591                 endif
592                 if (p5 .ne. 5) then
593                         print *, '    parameter #5 is ', p5, ' not 5'
594                 endif
595                 if (p6 .ne. 6) then
596                         print *, '    parameter #6 is ', p6, ' not 6'
597                 endif
598                 if (p7 .ne. 7) then
599                         print *, '    parameter #7 is ', p7, ' not 7'
600                 endif
601                 if (p8 .ne. 8) then
602                         print *, '    parameter #8 is ', p8, ' not 8'
603                 endif
604                 if (p9 .ne. 9) then
605                         print *, '    parameter #9 is ', p9, ' not 9'
606                 endif
607                 if (p10 .ne. 10) then
608                         print *, '    parameter #10 is ', p10, ' not 10'
609                 endif
610         endif
611         END
612
613 !------------------------------------------------------------------------------
614
615         SUBROUTINE func9_1 (p1, p2, p3, p4, p5, p6, p7, p8, p9, p10)
616 #include "test1_common.h"
617         INTEGER p1, p2, p3, p4, p5, p6, p7, p8, p9, p10
618
619         if (p1 .eq. 1 .and. p2 .eq. 2 .and. p3 .eq. 3 .and. p4 .eq. 4
620      & .and. p5 .eq. 5 .and. p6 .eq. 6 .and. p7 .eq. 7 .and. p8
621      & .eq. 8 .and. p9 .eq. 9 .and. p10 .eq. 10) then
622                 print *, 'Passed test #9 (preserve registers - funcCall)'
623                 passedTest (9) = .true.
624         else
625                 print *, '**Failed** test #9 (preserve registers - funcCall)'
626                 if (p1 .ne. 1) then
627                         print *, '      parameter #1 is ', p1, ' not 1'
628                 endif
629                 if (p2 .ne. 2) then
630                         print *, '      parameter #2 is ', p2, ' not 2'
631                 endif
632                 if (p3 .ne. 3) then
633                         print *, '      parameter #3 is ', p3, ' not 3'
634                 endif
635                 if (p4 .ne. 4) then
636                         print *, '      parameter #4 is ', p4, ' not 4'
637                 endif
638                 if (p5 .ne. 5) then
639                         print *, '      parameter #5 is ', p5, ' not 5'
640                 endif
641                 if (p6 .ne. 6) then
642                         print *, '      parameter #6 is ', p6, ' not 6'
643                 endif
644                 if (p7 .ne. 7) then
645                         print *, '      parameter #7 is ', p7, ' not 7'
646                 endif
647                 if (p8 .ne. 8) then
648                         print *, '      parameter #8 is ', p8, ' not 8'
649                 endif
650                 if (p9 .ne. 9) then
651                         print *, '      parameter #9 is ', p9, ' not 9'
652                 endif
653                 if (p10 .ne. 10) then
654                         print *, '      parameter #10 is ', p10, ' not 10'
655                 endif
656         endif
657         END
658
659 !------------------------------------------------------------------------------
660
661         SUBROUTINE call9_1 (p1, p2, p3, p4, p5)
662         INTEGER p1, p2, p3, p4, p5
663         INTEGER x
664
665         x = p1 + p2 + p3 + p4 + p5
666         if (x .ne. (91 + 92 + 93 + 94 + 95)) then
667                 print *, '**Failed** test #9 (preserve registers - funcCall)'
668                 if (p1 .ne. 91) then
669                         print *, '      call9_1 parameter 1 is ', p1, ' not 91'
670                 endif
671                 if (p2 .ne. 92) then
672                         print *, '      call9_1 parameter 2 is ', p2, ' not 92'
673                 endif
674                 if (p3 .ne. 93) then
675                         print *, '      call9_1 parameter 6 is ', p3, ' not 93'
676                 endif
677                 if (p4 .ne. 94) then
678                         print *, '      call9_1 parameter 4 is ', p4, ' not 94'
679                 endif
680                 if (p5 .ne. 95) then
681                         print *, '      call9_1 parameter 5 is ', p5, ' not 95'
682                 endif
683         endif
684         END
685
686 !-----------------------------------------------------------------------------
687
688         SUBROUTINE func10_1
689 #include "test1_common.h"
690
691         if (globalVariable10_1 .eq. 1 .and. globalVariable10_2 .eq. 1
692      & .and. globalVariable10_3 .eq. 1 .and. globalVariable10_4 .eq.
693      & 3) then
694                 print *, 'Passed test #10 (insert snippet order)'
695                 passedTest (10) = .true.
696         else
697                 print *, '**Failed test #10 (insert snippet order)'
698                 if (globalVariable10_1 .ne. 1) then
699                         print *, '     call10_1 was not called first'
700                 endif
701                 if (globalVariable10_2 .ne. 1) then
702                         print *, '     call10_2 was not called second'
703                 endif
704                 if (globalVariable10_3 .ne. 1) then
705                         print *, '     call10_3 was not called second'
706                 endif
707         endif
708         END
709
710 !------------------------------------------------------------------------------
711
712         SUBROUTINE call10_1
713 #include "test1_common.h"
714
715         if (globalVariable10_4 .eq. 0) then
716                 globalVariable10_4 = 1
717                 globalVariable10_1 = 1
718         endif
719         END
720
721 !------------------------------------------------------------------------------
722
723         SUBROUTINE call10_2
724 #include "test1_common.h"
725
726         if (globalVariable10_4 .eq. 1) then
727                 globalVariable10_4 = 2
728                 globalVariable10_2 = 1
729         endif
730         END
731
732 !------------------------------------------------------------------------------
733
734         SUBROUTINE call10_3
735 #include "test1_common.h"
736
737         if (globalVariable10_4 .eq. 2) then
738                 globalVariable10_4 = 3
739                 globalVariable10_3 = 1
740         endif
741         END
742
743 !------------------------------------------------------------------------------
744
745         SUBROUTINE func11_1
746 #include "test1_common.h"
747
748         globalVariable11_1 = 1
749         CALL func11_2
750         globalVariable11_1 = 3
751         END
752
753 !------------------------------------------------------------------------------
754
755         SUBROUTINE func11_2
756 #include "test1_common.h"
757
758         globalVariable11_1 = 2
759         END
760
761 !------------------------------------------------------------------------------
762
763         SUBROUTINE call11_1
764 #include "test1_common.h"
765
766         if (globalVariable11_1 .eq. 0) then
767                 globalVariable11_2 = 1
768         endif
769         END
770
771 !------------------------------------------------------------------------------
772
773         SUBROUTINE call11_2
774 #include "test1_common.h"
775
776         if (globalVariable11_1 .eq. 1) then
777                 globalVariable11_3 = 1
778         endif
779         END
780
781 !------------------------------------------------------------------------------
782
783         SUBROUTINE call11_3
784 #include "test1_common.h"
785
786         if (globalVariable11_1 .eq. 2) then
787                 globalVariable11_4 = 1
788         endif
789         END
790
791 !------------------------------------------------------------------------------
792
793         SUBROUTINE call11_4
794 #include "test1_common.h"
795
796         if (globalVariable11_1 .eq. 3) then
797                 globalVariable11_5 = 1
798         endif
799         if (globalVariable11_2 .ne. 0 .and. globalVariable11_3 .ne. 0
800      & .and. globalVariable11_4 .ne. 0 .and. globalVariable11_5
801      & .ne. 0) then
802                 print *, 'Passed test #11 (snippets at entry, exit, call)'
803                 passedTest (11) = .true.
804         else
805                 print *, '**Failed test #11 (snippets at entry,exit,call)'
806                 if (globalVariable11_2 .ne. 0) then
807                         print *, '     entry snippet not called at the correct time'
808                 endif
809                 if (globalVariable11_3 .ne. 0) then
810                         print *, '     pre call snippet not called at the correct time'
811                 endif
812                 if (globalVariable11_4 .ne. 0) then
813                         print *, '     post call snippet not called at the correct time'
814                 endif
815                 if (globalVariable11_5 .ne. 0) then
816                         print *, '     exit snippet not called at the correct time'
817                 endif
818         endif
819         END
820
821 !------------------------------------------------------------------------------
822
823         SUBROUTINE func12_1
824 #include "test1_common.h"
825
826         CALL func12_2
827         CALL stop_process_
828         CALL func12_2
829
830         if (globalVariable12_1 .eq. 1) then
831                 print *, 'Passed test #12 (insert/remove and malloc/free)'
832                 passedTest (12) = .true.
833         else
834                 print *, '**Failed test #12 (insert/remove and malloc/free)'
835                 print *, 'ZANDY: #12 failed because globalVariable12_1 = ',
836      & globalVariable12_1
837         endif
838         END
839
840 !------------------------------------------------------------------------------
841
842         SUBROUTINE func12_2
843         INTEGER foo = 0
844         END
845
846 !------------------------------------------------------------------------------
847
848         SUBROUTINE call12_1
849 #include "test1_common.h"
850
851         globalVariable12_1 = globalVariable12_1 + 1
852         END
853
854 !------------------------------------------------------------------------------
855
856         SUBROUTINE func13_1 (p1, p2, p3, p4, p5)
857 #include "test1_common.h"
858 #ifdef __GNUC__
859         INTRINSIC iand
860 #else
861         INTRINSIC and
862 #endif
863         INTEGER p1, p2, p3, p4, p5, temp, func13_2
864
865         temp = func13_2 ()
866
867         if (p1 .eq. 131 .and. p2 .eq. 132 .and. p3 .eq. 133 .and. p4 .eq.
868      & 134 .and. p5 .eq. 135 .and. globalVariable13_1 .eq. 63) then
869                 print *, 'Passed test #13 (paramExpr,retExpr,nullExpr)'
870                 passedTest (13) = .true.
871         else
872                 print *, '**Failed test#13 (paramExpr,retExpr,nullExpr)'
873                 print *, 'globalVariable13_1 = ', globalVariable13_1
874                 if (p1 .ne. 131) then
875                         print *, '  parameter 1 is ', p1, ', not 131'
876                 endif
877                 if (p2 .ne. 132) then
878                         print *, '  parameter 2 is ', p2, ', not 132'
879                 endif
880                 if (p3 .ne. 133) then
881                         print *, '  parameter 3 is ', p3, ', not 133'
882                 endif
883                 if (p4 .ne. 134) then
884                         print *, '  parameter 4 is ', p4, ', not 134'
885                 endif
886                 if (p5 .ne. 135) then
887                         print *, '  parameter 5 is ', p5, ', not 135'
888                 endif
889                 if (AND (globalVariable13_1, 1) .eq. 0) then
890                         print *, '    passed param a1 wrong'
891                 endif
892                 if (AND (globalVariable13_1, 2) .eq. 0) then
893                         print *, '    passed param a2 wrong'
894                 endif
895                 if (AND (globalVariable13_1, 4) .eq. 0) then
896                         print *, '    passed param a3 wrong'
897                 endif
898                 if (AND (globalVariable13_1, 8) .eq. 0) then
899                         print *, '    passed param a4 wrong'
900                 endif
901                 if (AND (globalVariable13_1, 16) .eq. 0) then
902                         print *, '    passed param a5 wrong'
903                 endif
904                 if (AND (globalVariable13_1, 32) .eq. 0) then
905                         print *, '    return value wrong'
906                 endif
907         endif
908         END
909
910 !------------------------------------------------------------------------------
911
912         INTEGER FUNCTION func13_2 ()
913         func13_2 = 1300100
914         RETURN
915         END
916
917 !------------------------------------------------------------------------------
918
919         SUBROUTINE call13_1 (a1, a2, a3, a4, a5)
920 #include "test1_common.h"
921 #ifdef __GNUC__
922         INTRINSIC ior
923 #else
924         INTRINSIC or
925 #endif
926         INTEGER a1, a2, a3, a4, a5
927
928         if (a1 .eq. 131) then
929                 globalVariable13_1 = OR (globalVariable13_1, 1)
930         endif
931         if (a2 .eq. 132) then
932                 globalVariable13_1 = OR (globalVariable13_1, 2)
933         endif
934         if (a3 .eq. 133) then
935                 globalVariable13_1 = OR (globalVariable13_1, 4)
936         endif
937         if (a4 .eq. 134) then
938                 globalVariable13_1 = OR (globalVariable13_1, 8)
939         endif
940         if (a5 .eq. 135) then
941                 globalVariable13_1 = OR (globalVariable13_1, 16)
942         endif
943         END
944
945 !------------------------------------------------------------------------------
946
947         SUBROUTINE call13_2 (ret)
948 #include "test1_common.h"
949 #ifdef __GNUC__
950         INTRINSIC ior
951 #else
952         INTRINSIC or
953 #endif
954         INTEGER ret
955
956         if (ret .eq. 1300100) then
957                 globalVariable13_1 = OR (globalVariable13_1, 32)
958         endif
959         END
960
961 !------------------------------------------------------------------------------
962
963         SUBROUTINE func14_1
964 #include "test1_common.h"
965         INTEGER kludge
966
967         kludge = 1
968         CALL func14_2
969         CALL func14_3
970
971         if (globalVariable14_1 .eq. 1 .and. globalVariable14_2
972      & .eq. 0) then
973                 print *, 'Passed test #14 (replace/remove function call)'
974                 passedTest (14) = .true.
975         else
976                 print *, '**Failed test #14 (replace/remove function call)'
977                 if (globalVariable14_1 .ne. 1) then
978                         print *, '     call to func14_2() was not replaced'
979                 endif
980                 if (globalVariable14_2 .ne. 0) then
981                         print *, '     call to func14_3() was not removed'
982                 endif
983         endif
984         END
985
986 !------------------------------------------------------------------------------
987
988         SUBROUTINE func14_2
989 #include "test1_common.h"
990
991         globalVariable14_1 = 2
992         END
993
994 !------------------------------------------------------------------------------
995
996         SUBROUTINE func14_3
997 #include "test1_common.h"
998
999         globalVariable14_2 = 1
1000         END
1001
1002 !------------------------------------------------------------------------------
1003
1004         SUBROUTINE call14_1
1005 #include "test1_common.h"
1006
1007         globalVariable14_1 = 1
1008         END
1009
1010 !------------------------------------------------------------------------------
1011
1012         SUBROUTINE func15_2
1013         INTEGER foo = 0
1014         END
1015
1016 !------------------------------------------------------------------------------
1017
1018         SUBROUTINE func15_3
1019 #include "test1_common.h"
1020
1021         globalVariable15_3 = 100
1022         globalVariable15_4 = globalVariable15_4 + 1
1023         END
1024
1025 !------------------------------------------------------------------------------
1026
1027         SUBROUTINE func15_4
1028         INTEGER kludge
1029
1030         kludge = 1
1031         CALL func15_3
1032         END
1033
1034 !------------------------------------------------------------------------------
1035
1036         SUBROUTINE call15_1
1037 #include "test1_common.h"
1038
1039         globalVariable15_1 = globalVariable15_1 + 1
1040         END
1041
1042 !------------------------------------------------------------------------------
1043
1044         SUBROUTINE call15_2
1045 #include "test1_common.h"
1046
1047         globalVariable15_2 = globalVariable15_2 + 1
1048         END
1049
1050 !------------------------------------------------------------------------------
1051
1052         SUBROUTINE call15_3
1053 #include "test1_common.h"
1054
1055         globalVariable15_3 = globalVariable15_3 + 1
1056         END
1057
1058 !------------------------------------------------------------------------------
1059
1060         SUBROUTINE func15_1
1061 #include "test1_common.h"
1062         LOGICAL failed
1063
1064         failed = .false.
1065
1066         CALL func15_2
1067         CALL check15result ('globalVariable15_1', globalVariable15_1, 1,
1068      & 'after first call to instrumented function', failed)
1069
1070         CALL func15_4
1071         CALL check15result ('globalVariable15_3', globalVariable15_3, 1,
1072      & 'after first call to instrumented function', failed)
1073
1074         CALL stop_process_
1075         CALL func15_2
1076         CALL check15result ('globalVariable15_1', globalVariable15_1, 1,
1077      & 'after second call to instrumented function', failed)
1078
1079         CALL func15_4
1080         CALL check15result ('globalVariable15_3', globalVariable15_3,
1081      & 100, 'after second call to instrumented function', failed)
1082
1083         CALL stop_process_
1084         CALL func15_2
1085         CALL check15result ('globalVariable15_1', globalVariable15_1, 2,
1086      & 'after third call to instrumented function', failed)
1087
1088         CALL func15_4
1089         CALL check15result ('globalVariable15_3', globalVariable15_3,
1090      & 101, 'after third call to instrumented function', failed)
1091
1092         if (failed .eqv. .false.) then
1093                 print *, 'Passed test #15 (setMutationsActive)'
1094                 passedTest (15) = .true.
1095         endif
1096         END
1097
1098 !------------------------------------------------------------------------------
1099
1100         SUBROUTINE check15result (varname, value, expected, errstr,
1101      & failed)
1102         CHARACTER *(*) varname
1103         INTEGER value, expected
1104         CHARACTER *(*) errstr
1105         LOGICAL failed
1106
1107         if (value .ne. expected) then
1108                 if (failed .eqv. .false.) then
1109                         print *, '**Failed test #15 (setMutationsActive)'
1110                 endif
1111                 failed = .true.
1112                 print *, '    ', varname, ' = ', value, ' ', errstr
1113         endif
1114         END     
1115
1116 !------------------------------------------------------------------------------
1117
1118         SUBROUTINE func16_1
1119 #include "test1_common.h"
1120         LOGICAL failed
1121
1122         failed = .false.
1123
1124         CALL func16_2
1125         if (globalVariable16_1 .ne. 1 .or. globalVariable16_2 .ne. 0) then
1126                 print *, '**Failed test #16 in spot 1 (if-else)'
1127                 if (globalVariable16_1 .ne. 1) then
1128                         print *, '    True clause of first if should have been',
1129      & ' executed but was not'
1130                 endif
1131                 if (globalVariable16_2 .ne. 0) then
1132                         print *, '    False clause of first if should not have',
1133      & ' been executed but was'
1134                 endif
1135                 failed = .true.
1136         endif
1137
1138         CALL func16_3
1139         if (globalVariable16_3 .ne. 0 .or. globalVariable16_4 .ne. 1) then
1140                 print *, '**Failed test #16 (if-else)'
1141                 if (globalVariable16_3 .ne. 1) then
1142                         print *, '    True clause of second if should not have',
1143      & ' been executed but was'
1144                 endif
1145                 if (globalVariable16_4 .ne. 0) then
1146                         print *, '    False clause of second if should have',
1147      & ' been executed but was not'
1148                 endif
1149                 failed = .true.
1150         endif
1151
1152         CALL func16_4
1153         if (globalVariable16_5 .ne. 0 .or. globalVariable16_6 .ne. 1
1154      & .or. globalVariable16_7 .ne. 0 .or. globalVariable16_8 .ne. 1
1155      & .or. globalVariable16_9 .ne. 0 .or. globalVariable16_10 .ne. 1)
1156      & then
1157                         print *, '    failed large if clauses tests'
1158                         failed = .true.
1159         endif
1160
1161         if (failed .eqv. .false.) then
1162                 print *, 'Passed test #16 (if-else)'
1163                 passedTest (16) = .true.
1164         endif
1165         END
1166
1167 !------------------------------------------------------------------------------
1168
1169         SUBROUTINE func16_2
1170         INTEGER foo = 0
1171         END
1172
1173 !------------------------------------------------------------------------------
1174
1175         SUBROUTINE func16_3
1176         INTEGER foo = 0
1177         END
1178
1179 !------------------------------------------------------------------------------
1180
1181         SUBROUTINE func16_4
1182         INTEGER foo = 0
1183         END
1184
1185 !------------------------------------------------------------------------------
1186
1187         SUBROUTINE func17_1
1188 #include "test1_common.h"
1189         INTEGER ret17_1
1190         INTEGER func17_2
1191
1192         ret17_1 = func17_2 ()
1193         CALL func17_3
1194
1195         if (ret17_1 .ne. 1700100 .or. globalVariable17_1 .ne. 1700200 .or.
1196      & globalVariable17_2 .ne. 1701000) then
1197                 print *, '**Failed** test case #17 (return values from func',
1198      & ' calls)'
1199                 if (ret17_1 .ne. 1700100) then
1200                         print *, '  return value was ', ret17_1, ', not 1700100'
1201                 endif
1202                 if (globalVariable17_1 .ne. 1700200) then
1203                         print *, '  return value was ', globalVariable17_1,
1204      & ', not 1700200'
1205                 endif
1206                 if (globalVariable17_2 .ne. 1701000) then
1207                         print *, '  function call17_2 was not inserted'
1208                 endif
1209         else
1210                 print *, 'Passed test #17 (return values from func calls)'
1211                 passedTest (17) = .true.
1212         endif
1213         END
1214
1215 !------------------------------------------------------------------------------
1216
1217         INTEGER FUNCTION func17_2 ()
1218         func17_2 = 1700100
1219         RETURN
1220         END
1221
1222 !------------------------------------------------------------------------------
1223
1224         SUBROUTINE func17_3
1225 #include "test1_common.h"
1226         INTEGER func17_4
1227
1228         globalVariable17_1 = func17_4()
1229         END
1230
1231 !------------------------------------------------------------------------------
1232         INTEGER FUNCTION func17_4 ()
1233         func17_4 = 1700200
1234         RETURN
1235         END
1236
1237 !------------------------------------------------------------------------------
1238
1239         INTEGER FUNCTION call17_1 (p1)
1240         INTEGER p1
1241         INTEGER a1, a2, a3, a4, a5, a6, a7
1242
1243         a1 = p1
1244         a2 = a1 + p1
1245         a3 = a1 * a2
1246         a4 = a3 / p1
1247         a5 = a4 + p1
1248         a6 = a5 + a1
1249         a7 = a6 + p1
1250         call17_1 = a7
1251         return
1252         END
1253
1254 !------------------------------------------------------------------------------
1255
1256         INTEGER FUNCTION call17_2 (p1)
1257 #include "test1_common.h"
1258         INTEGER p1
1259         INTEGER a1, a2, a3, a4, a5, a6, a7
1260
1261         a1 = p1
1262         a2 = a1 + p1
1263         a3 = a1 * a2
1264         a4 = a3 / p1
1265         a5 = a4 + p1
1266         a6 = a5 + a1
1267         a7 = a6 + p1
1268         globalVariable17_2 = 1701000
1269         call17_2 = a7
1270         return
1271         END
1272
1273 !------------------------------------------------------------------------------
1274
1275         SUBROUTINE func18_1
1276 #include "test1_common.h"
1277
1278         if (globalVariable18_1 .eq. 17) then
1279                 print *, 'Passed test #18 (read/write a value in the mutatee)'
1280                 passedTest (18) = .true.
1281         else
1282                 print *, '**Failed test #18 (read/write a value in the mutatee)'
1283                 if (globalVariable18_1 .eq. 42) then
1284                         print *, '    globalVariable18_1 still contains 42 (',
1285      & ' probably it was not written to)'
1286                 else
1287                         print *, '    globalVariable18_1 contained ',
1288      & globalVariable18_1, ', not 17 as expected'
1289                 endif
1290         endif
1291         END
1292
1293 !------------------------------------------------------------------------------
1294
1295         SUBROUTINE func19_1
1296 #include "test1_common.h"
1297
1298         CALL stop_process_
1299
1300         if (globalVariable19_1 .ne. 1900100) then
1301                 print *, '**Failed test #19 (oneTimeCode)'
1302                 print *, '     globalVariable19_1 contained ',
1303      & globalVariable19_1, ', not 1900100 as expected'
1304         endif
1305
1306         CALL stop_process_
1307
1308         if (globalVariable19_2 .eq. 1900200) then
1309                 print *, 'Passed test #19 (oneTimeCode)'
1310                 passedTest (19) = .true.
1311         else
1312                 print *, '**Failed test #19 (oneTimeCode)'
1313                 print *, '     globalVariable19_2 contained ',
1314      & globalVariable19_2, ', not 1900200 as expected'
1315         endif
1316         END
1317
1318 !------------------------------------------------------------------------------
1319
1320         SUBROUTINE call19_1
1321 #include "test1_common.h"
1322
1323         globalVariable19_1 = 1900100
1324         END
1325
1326 !------------------------------------------------------------------------------
1327
1328         SUBROUTINE call19_2
1329 #include "test1_common.h"
1330
1331         globalVariable19_2 = 1900200
1332         END
1333
1334 !------------------------------------------------------------------------------
1335
1336         SUBROUTINE call20_1
1337 #include "test1_common.h"
1338         INTEGER ta
1339         DOUBLE PRECISION tb
1340
1341         ta = 3
1342         tb = 4.3
1343
1344         globalVariable20_1 = ta + ta + ta + ta + ta + ta + ta + ta + ta +
1345      & ta + ta + ta + ta + ta + ta + ta + ta + ta + ta + ta + ta +
1346      & ta + ta + ta + ta + ta + ta + ta + ta + ta + ta + ta + ta +
1347      & ta + ta + ta + ta + ta + ta + ta + ta
1348         globalVariable20_2 = tb + tb + tb + tb + tb + tb + tb + tb + tb +
1349      & tb + tb + tb + tb + tb + tb + tb + tb + tb + tb + tb + tb +
1350      & tb + tb + tb + tb + tb + tb + tb + tb + tb + tb + tb + tb +
1351      & tb + tb + tb + tb + tb + tb + tb + tb
1352         END
1353
1354 !------------------------------------------------------------------------------
1355
1356         INTEGER FUNCTION func20_2 (int_val, double_val)
1357         INTEGER int_val
1358         DOUBLE PRECISION double_val
1359         INTEGER tc, i, ret
1360         DOUBLE PRECISION td
1361
1362         tc = 7
1363         td = 6.4
1364         ret = 1
1365
1366         int_val = tc + tc + tc + tc + tc + tc + tc + tc + tc + tc + tc +
1367      & tc + tc + tc + tc + tc + tc + tc + tc + tc + tc + tc + tc +
1368      & tc + tc + tc + tc + tc + tc + tc + tc + tc + tc + tc + tc +
1369      & tc + tc + tc + tc + tc + tc
1370         double_val = td + td + td + td + td + td + td + td + td + td +
1371      & td + td + td + td + td + td + td + td + td + td + td + td +
1372      & td + td + td + td + td + td + td + td + td + td + td + td +
1373      & td + td + td + td + td + td + td
1374
1375         DO i = 0, 49, 1
1376                 ret = ret * 3
1377                 if (mod (i, 2) .eq. 1) then
1378                         ret = ret * 5
1379                 elseif (i .lt. 10) then
1380                         ret = ret * 7
1381                 elseif (i .gt. 20) then
1382                         ret = ret * 11
1383                 endif
1384         ENDDO
1385
1386         func20_2 = ret
1387         RETURN
1388         END
1389
1390 !------------------------------------------------------------------------------
1391
1392         SUBROUTINE func20_1
1393 #include "test1_common.h"
1394         INTEGER ret, int_val, func20_2, eq_doubles
1395         DOUBLE PRECISION double_val, temp1, temp2
1396
1397         ret = func20_2 (int_val, double_val)
1398
1399         temp1 = 4.3 * 41
1400         temp2 = 6.4 * 41
1401
1402         if (globalVariable20_1 .eq. 3 * 41 .and. eq_doubles
1403      & (globalVariable20_2, temp1) .eq. 1 .and. int_val .eq.
1404      & 7 * 41 .and. eq_doubles (double_val, temp2) .eq. 1
1405      & .and. ret .eq. 1088896211) then
1406                 print *, 'Passed test #20 (instrument arbitrary points)'
1407                 passedTest (20) = .true.
1408         else
1409                 print *, '**Failed test #20 (instrument arbitrary points)'
1410                 if (globalVariable20_1 .ne. (3 * 41)) then
1411                         print *, '    globalVariable20_1 contained ',
1412      & globalVariable20_1, ', not ', 3 * 41, ' as expected'
1413                 endif
1414                 if (eq_doubles (globalVariable20_2, temp1) .ne. 1) then
1415                         print *, '    globalVariable20_2 contained ',
1416      & globalVariable20_2, ', not ', temp1, ' as expected'
1417                 endif
1418                 if (int_val .ne. (7 * 41)) then
1419                         print *, '    int_val contained ', int_val, ', not ',
1420      & (7 * 41), ' as expected'
1421                 endif
1422                 if (eq_doubles (double_val, temp2) .ne. 1) then
1423                         print *, '    double_val contained', double_val, ', not ',
1424      & temp2, ' as expected'
1425                 endif
1426                 if (ret .ne. 1088896211) then
1427                         print *, '    ret contained ', ret, ', not 1088896211 as',
1428      & ' expected'
1429                 endif
1430         endif
1431         END
1432
1433 !------------------------------------------------------------------------------
1434
1435         INTEGER FUNCTION eq_doubles (a, b)
1436         DOUBLE PRECISION a, b, diff
1437
1438         diff = a - b
1439
1440         if (diff .lt. 0) then
1441                 diff = -1 * diff
1442         endif
1443
1444         if (diff .lt. 0.01) then
1445                 eq_doubles = 1
1446         else
1447                 eq_doubles = 0
1448         endif
1449         RETURN
1450         END
1451
1452 !------------------------------------------------------------------------------
1453
1454         SUBROUTINE func21_1
1455 #include "test1_common.h"
1456
1457         print *, 'Passed test #21 (findFunction in module)'
1458         passedTest (21) = .true.
1459         END
1460
1461 !------------------------------------------------------------------------------
1462
1463         SUBROUTINE func22_1
1464 #include "test1_common.h"
1465         print *, 'Skipped test #22 (replace function)'
1466         print *, '       - not implemented for Fortran'
1467         passedTest (22) = .true.
1468         END
1469
1470 !------------------------------------------------------------------------------
1471
1472         SUBROUTINE func23_1
1473 #include "test1_common.h"
1474
1475         print *, 'Skipped test #23 (local Variables)'
1476         print *, '       - not implemented for Fortran'
1477         passedTest (23) = .true.
1478         END
1479
1480 !------------------------------------------------------------------------------
1481
1482         SUBROUTINE FverifyScalarValue (name, a, value, testNum, testName)
1483 #include "test1_common.h"
1484         CHARACTER *(*) name, testName
1485         INTEGER a, value, testNum
1486
1487         if (a .ne. value) then
1488                 if (passedTest (testNum + 1) .eqv. .true.) then
1489                         print *, '**Failed** test ', testNum, ' (', testName, ')'
1490                 endif
1491                 print *, '  ', name, ' = ', a, ', not ', value
1492                 passedTest (testNum + 1) = .false.
1493         endif
1494         END
1495
1496 !------------------------------------------------------------------------------
1497
1498         SUBROUTINE func24_1
1499 #include "test1_common.h"
1500
1501         print *, 'Skipped test #24 (arrary Variables)'
1502         print *, '       - not implemented for Fortran'
1503         passedTest (24) = .true.
1504         END
1505
1506 !------------------------------------------------------------------------------
1507
1508         SUBROUTINE func25_1
1509
1510 #include "test1_common.h"
1511 #if defined(mips_sgi_irix6_4)
1512         print *, 'Skipped test #25 (unary operators)'
1513         print *, '       - not implemented on this platform'
1514         passedTest (25) = .true.
1515 #else
1516         passedTest (25) = .true.
1517         globalVariable25_1 = 25000001
1518 !       globalVariable25_2 = (int *) 25000002
1519         globalVariable25_3 = 25000003
1520         globalVariable25_4 = 25000004
1521         globalVariable25_5 = 25000005
1522         globalVariable25_6 = -25000006
1523         globalVariable25_7 = 25000007
1524
1525         CALL call25_1
1526
1527         if (globalVariable25_3 .ne. globalVariable25_1) then
1528                 if (passedTest (25) .eqv. .true.) then
1529                         print *, '**Failed** test #25 (unary operators)'
1530                 endif
1531                 passedTest (25) = .false.
1532                 print *, '    globalVariable25_2 = ', globalVariable25_3,
1533      & ', not ', globalVariable25_1
1534         endif
1535
1536         if (globalVariable25_5 .ne. -1 * globalVariable25_4) then
1537                 if (passedTest (25) .eqv. .true.) then
1538                         print *, '**Failed** test #25 (unary operators)'
1539                 endif
1540                 passedTest (25) = .false.
1541                 print *, '    globalVariable25_5 = ', globalVariable25_5,
1542      & ', not ', -1 * globalVariable25_4
1543         endif
1544
1545         if (globalVariable25_7 .ne. -1 * globalVariable25_6) then
1546                 if (passedTest (25) .eqv. .true.) then
1547                         print *, '**Failed** test #25 (unary operators)'
1548                 endif
1549                 passedTest (25) = .false.
1550                 print *, '    globalVariable25_7 = ', globalVariable25_7,
1551      & ', not ', -1 * globalVariable25_6
1552         endif
1553
1554         if (passedTest (25) .eqv. .true.) then
1555                 print *, 'Passed test #25 (unary operators)'
1556         endif
1557 #endif
1558         END
1559
1560 !------------------------------------------------------------------------------
1561
1562         SUBROUTINE call25_1
1563 #include "test1_common.h"
1564         integer place
1565
1566         place = 23
1567         END
1568
1569 !------------------------------------------------------------------------------
1570
1571         SUBROUTINE func26_1
1572 #include "test1_common.h"
1573
1574         print *, 'Skipped test #26 (field operators)'
1575         print *, '       - not implemented in Fortran'
1576         passedTest (26) = .true.
1577 #if notdef
1578         INTEGER i
1579
1580         TYPE (struct26_2) globalVariable26_1
1581
1582         passedTest (26) = .true.
1583         globalVariable26_1%field1 = 26001001
1584         globalVariable26_1%field2 = 26001002
1585
1586         DO i = 1, 10, 1
1587         globalVariable26_1%field3 (i) = 26001002 + i
1588         ENDDO
1589
1590         globalVariable26_1%field4%field1 = 26000013;
1591         globalVariable26_1%field4%field2 = 26000014;
1592
1593         CALL call26_1
1594
1595         CALL FverifyScalarValue ("globalVariable26_2",
1596      & globalVariable26_2, 26001001, 26, "field operators")
1597         CALL FverifyScalarValue ("globalVariable26_3",
1598      & globalVariable26_3, 26001002, 26, "field operators")
1599         CALL FverifyScalarValue ("globalVariable26_4",
1600      & globalVariable26_4, 26001003, 26, "field operators")
1601         CALL FverifyScalarValue ("globalVariable26_5",
1602      & globalVariable26_5, 26001003+5, 26, "field operators")
1603         CALL FverifyScalarValue ("globalVariable26_6",
1604      & globalVariable26_6, 26000013, 26, "field operators")
1605         CALL FverifyScalarValue ("globalVariable26_7",
1606      & globalVariable26_7, 26000014, 26, "field operators")
1607
1608         CALL FverifyScalarValue ("globalVariable26_8",
1609      & globalVariable26_8, 26002001, 26, "field operators")
1610         CALL FverifyScalarValue ("globalVariable26_9",
1611      & globalVariable26_9, 26002002, 26, "field operators")
1612         CALL FverifyScalarValue ("globalVariable26_10",
1613      & globalVariable26_10, 26002003, 26, "field operators")
1614         CALL FverifyScalarValue ("globalVariable26_11",
1615      & globalVariable26_11, 26002003+5, 26, "field operators")
1616         CALL FverifyScalarValue ("globalVariable26_12",
1617      & globalVariable26_12, 26002013, 26, "field operators")
1618         CALL FverifyScalarValue ("globalVariable26_13",
1619      & globalVariable26_13, 26002014, 26, "field operators")
1620
1621         if (passedTest (26) .eqv. .true.) then
1622                 print *, 'Passed test #26 (field operators)'
1623         endif
1624 #else
1625 #endif
1626         END
1627
1628 !------------------------------------------------------------------------------
1629
1630         SUBROUTINE call26_1
1631 #include "test1_common.h"
1632
1633         INTEGER i
1634
1635 #if !defined (F77)
1636         TYPE (struct26_2) localVariable26_1
1637
1638         localVariable26_1%field1 = 26002001
1639         localVariable26_1%field2 = 26002002
1640
1641         DO i = 1, 10, 1
1642         localVariable26_1%field3 (i) = 26002002 + i
1643         ENDDO
1644
1645         localVariable26_1%field4%field1 = 26002013
1646         localVariable26_1%field4%field2 = 26002014
1647
1648         CALL call26_2
1649 #endif
1650         END
1651
1652 !------------------------------------------------------------------------------
1653
1654         SUBROUTINE call26_2
1655         INTEGER foo = 0
1656         END
1657
1658 !------------------------------------------------------------------------------
1659
1660         SUBROUTINE func27_1
1661 #include "test1_common.h"
1662
1663         passedTest (27) = .true.
1664         print *, 'Skipped test #27 (type compatibility)'
1665         print *, '       - not implemented for Fortran'
1666         END
1667
1668 !------------------------------------------------------------------------------
1669
1670         SUBROUTINE func28_1
1671 #include "test1_common.h"
1672         passedTest (28) = .true.
1673         print *, 'Skipped test #28 (user defined fields)'
1674         print *, '       - not implemented for Fortran'
1675         END
1676
1677 !------------------------------------------------------------------------------
1678
1679         SUBROUTINE func29_1
1680 #include "test1_common.h"
1681
1682         if (globalVariable29_1 .eq. 1) then
1683                 passedTest (29) = .true.
1684                 print *, 'Passed test #29 (BPatch_srcObj class)'
1685         endif
1686         END
1687
1688 !------------------------------------------------------------------------------
1689
1690         SUBROUTINE func30_1
1691 #include "test1_common.h"
1692         passedTest (30) = .true.
1693         print *, 'Skipped test #30 (line information)'
1694         print *, '       - not implemented for Fortran'
1695         END
1696
1697 !------------------------------------------------------------------------------
1698
1699         INTEGER FUNCTION func31_1 ()
1700 #include "test1_common.h"
1701
1702 #if defined(alpha_dec_osf4_0)
1703         print *, 'Skipped test #31 (non-recursive base tramp guard)'
1704         print *, '       - not implemented on this platform.'
1705         passedTest (31) = .true.
1706         END
1707 #else
1708
1709         globalVariable31_1 = 0
1710         globalVariable31_2 = 0
1711         globalVariable31_3 = 0
1712         globalVariable31_4 = 0
1713
1714         CALL func31_2
1715
1716         if (globalVariable31_3 .eq. 1) then
1717                 passedTest (31) = .true.
1718         endif
1719
1720         if (passedTest (31) .eqv. .false.) then
1721                 print *, '**Failed** test #31 (non-recursive base tramp guard)'
1722                 print *, '    globalVariable31_3 = ', globalVariable31_3,
1723      & ', should be 1 (no instrumentation got exectued?)'
1724                 func31_1 = 0
1725                 RETURN
1726         endif
1727
1728         if (globalVariable31_4 .eq. 0) then
1729                 passedTest (31) = .true.
1730         endif
1731
1732         if (passedTest (31) .eqv. .false.) then
1733                 print *, '**Failed** test #31 (non-recursive base tramp guard)'
1734                 print *, '    globalVariable31_4 = ', globalVariable31_4,
1735      & ', should be 0.'
1736                 if (globalVariable31_4 .eq. 0) then
1737                         print *, '    Recursive guard works find.'
1738                 elseif (globalVariable31_4 .eq. 1) then
1739                         print *, '    Pre-instr recursive guard does not work.'
1740                 elseif (globalVariable31_4 .eq. 2) then
1741                         print *, '    Post-instr recursive guard does not work.'
1742                 elseif (globalVariable31_4 .eq. 3) then
1743                         print *, '    None of the recursive guards work.'
1744                 else
1745                         print *, '    Something is really wrong.'
1746                 endif
1747                 func31_1 = 0
1748                 RETURN
1749         endif
1750
1751         passedTest (31) = .true.
1752         print *, 'Passed test #31 (non-recursive base tramp guard)'
1753
1754         func31_1 = 1
1755         RETURN
1756         END
1757 #endif
1758
1759 !------------------------------------------------------------------------------
1760
1761         SUBROUTINE func31_2
1762 #include "test1_common.h"
1763
1764         globalVariable31_2 = 1
1765         END
1766
1767 !------------------------------------------------------------------------------
1768
1769         SUBROUTINE func31_3
1770 #include "test1_common.h"
1771
1772         globalVariable31_3 = 1
1773         END
1774
1775 !------------------------------------------------------------------------------
1776
1777         SUBROUTINE func31_4 (value)
1778 #include "test1_common.h"
1779         INTEGER value
1780
1781         if (value .eq. 0) then
1782                 print *, 'func31_4 called with calue = 0 !'
1783         endif
1784         globalVariable31_4 = globalVariable31_4 + value
1785         END
1786
1787 !------------------------------------------------------------------------------
1788
1789         INTEGER FUNCTION func32_1 ()
1790 #include "test1_common.h"
1791
1792         globalVariable32_1 = 0
1793         globalVariable32_2 = 0
1794         globalVariable32_3 = 0
1795         globalVariable32_4 = 0
1796
1797         CALL func32_2
1798
1799         if (globalVariable32_3 .eq. 1) then
1800                 passedTest (32) = .true.
1801         endif
1802
1803         if (passedTest (32) .eqv. .false.) then
1804                 print *, '**Failed** test #32 (non-recursive base tramp guard)'
1805                 print *, '    globalVariable32_3 = ', globalVariable32_3,
1806      & ', should be 1 (no instrumentation got executed?)'
1807                 func32_1 = 0
1808                 RETURN
1809         endif
1810
1811         if (globalVariable32_4 .eq. 3) then
1812                 passedTest (32) = .true.
1813         endif
1814
1815         if (passedTest (32) .eqv. .false.) then
1816                 print *, '**Failed** test #32 (non-recursive base tramp guard)'
1817                 print *, '    globalVariable32_4 = ', globalVariable32_4,
1818      & ', should be 3.'
1819                 if (globalVariable32_4 .eq. 0) then
1820                         print *, '    Recursive guard works fine.'
1821                 elseif (globalVariable32_4 .eq. 1) then
1822                         print *, '    Pre-instr recursive guard does not work.'
1823                 elseif (globalVariable32_4 .eq. 2) then
1824                         print *, '    Post-instr recursive guard does not work.'
1825                 elseif (globalVariable32_4 .eq. 1) then
1826                         print *, '    None of the recursive guards work.'
1827                 else
1828                         print *, '    Something is really wrong.'
1829                 endif
1830
1831                 func32_1 = 0
1832                 RETURN
1833         endif
1834
1835         passedTest (32) = .true.
1836         print *, 'Passed test #32 (recursive base tramp guard)'
1837
1838         func32_1 = 1
1839         RETURN
1840         END
1841
1842 !------------------------------------------------------------------------------
1843
1844         SUBROUTINE func32_2
1845 #include "test1_common.h"
1846
1847         globalVariable32_2 = 1
1848         END
1849
1850 !------------------------------------------------------------------------------
1851
1852         SUBROUTINE func32_3
1853 #include "test1_common.h"
1854
1855         globalVariable32_3 = 1
1856         END
1857
1858 !------------------------------------------------------------------------------
1859
1860         SUBROUTINE func32_4 (value)
1861 #include "test1_common.h"
1862         INTEGER value
1863
1864         if (value .eq. 0) then
1865                 print *, 'func32_4 called with value = 0 !'
1866         endif
1867
1868         globalVariable32_4 = globalVariable32_4 + value
1869         END
1870
1871 !------------------------------------------------------------------------------
1872
1873         SUBROUTINE func33_1
1874 #include "test1_common.h"
1875
1876         passedTest (33) = .true.
1877         print *, 'Passed test #33 (control flow graphs)'
1878         END
1879
1880 !------------------------------------------------------------------------------
1881
1882         SUBROUTINE func33_2 (x)
1883 #include "test1_common.h"
1884         INTEGER x
1885
1886         print *, 'Hello'
1887
1888         if (x .eq. 1) then
1889                 print *, 'Goodbye.'
1890         else
1891                 print *, 'See you.'
1892         endif
1893
1894         print *, 'That"s all.'
1895         END
1896
1897 !------------------------------------------------------------------------------
1898
1899         INTEGER FUNCTION func33_3 (x)
1900         INTEGER x
1901 C       INTRINSIC IEOR, IAND, IOR
1902
1903         if (x .eq. 1) then
1904                 print *, '1'
1905                 x = x + 10
1906         elseif (x .eq. 2) then
1907                 print *, '2'
1908                 x = x -12
1909         elseif (x .eq. 3) then
1910                 print *, '3'
1911                 x = x * 33
1912         elseif (x .eq. 4) then
1913                 print *, '4'
1914                 x = x / 42
1915         elseif (x .eq. 5) then
1916                 print *, '5'
1917                 x = mod (x, 57)
1918         elseif (x .eq. 6) then
1919                 print *, '6'
1920                 x = mod (x, 2)
1921         elseif (x .eq. 7) then
1922                 print *, '7'
1923                 x = mod (x, 3)
1924         elseif (x .eq. 8) then
1925                 print *, '8'
1926                 x = mod (x, 4)
1927         elseif (x .eq. 9) then
1928                 print *, '9'
1929                 x = mod (x, 5)
1930         elseif (x .eq. 10) then
1931                 print *, '10'
1932                 x = mod (x, 6)
1933         endif
1934
1935         print *, 'Exit'
1936
1937         func33_3 = x
1938         RETURN
1939         END
1940
1941 !------------------------------------------------------------------------------
1942
1943         SUBROUTINE func34_1
1944 #include "test1_common.h"
1945
1946         passedTest (34) = .true.
1947         print *, 'Passed test #34 (loop information)'
1948         END
1949
1950 !------------------------------------------------------------------------------
1951
1952         SUBROUTINE func34_2
1953         INTEGER i, j, k, kludge
1954
1955         kludge = 1
1956         DO i = 0, 9, 1
1957                 print *, 'i = ', i
1958                 DO j = 0, 9, 1
1959                         print *, 'j = ', j
1960                         k = 0
1961
1962 10                      if (k .ge. 10) GOTO 20
1963                                 print *, 'k = ', k
1964                                 k = k + 1
1965                         GOTO 10
1966 20                      CONTINUE
1967                 ENDDO
1968
1969 30              CONTINUE
1970                 j = j + 1
1971                 print *, 'j = ', j
1972                 if (j .lt. 10) GOTO 30
1973         ENDDO
1974         END
1975
1976 !------------------------------------------------------------------------------
1977
1978         SUBROUTINE func35_1
1979 #include "test1_common.h"
1980         passedTest (35) = .true.
1981 #if defined(i386_unknown_solaris2_5) \
1982  || defined(i386_unknown_linux2_0) \
1983  || defined(x86_64_unknown_linux2_4) /* Blind duplication - Ray */ \
1984  || defined(sparc_sun_solaris2_4) \
1985  || defined(ia64_unknown_linux2_4)
1986         print *, 'Skipped test #35 (function relocation)'
1987         print *, '       - not tested for Fortran'
1988 #else
1989         print *, 'Skipped test #35 (function relocation)'
1990         print *, '       - not implemented on this platform'
1991 #endif
1992         END
1993
1994 !------------------------------------------------------------------------------
1995
1996         INTEGER FUNCTION call36_1(y1, y2, y3, y4, y5, y6, y7, y8, y9, y10)
1997 #include "test1_common.h"
1998         INTEGER y1, y2, y3, y4, y5, y6, y7, y8, y9, y10
1999         call36_1 = y1 + y2 + y3 + y4 + y5 + y6 + y7 + y8 + y9 + y10
2000         END FUNCTION call36_1
2001
2002
2003         SUBROUTINE func36_1
2004 #include "test1_common.h"
2005         INTEGER failure, result
2006         INTEGER call36_1
2007         globalVariable36_1 = 0
2008         globalVariable36_2 = 0
2009         globalVariable36_3 = 0
2010         globalVariable36_4 = 0
2011         globalVariable36_5 = 0
2012         globalVariable36_6 = 0
2013         globalVariable36_7 = 0
2014         globalVariable36_8 = 0
2015         globalVariable36_9 = 0
2016         globalVariable36_10 = 0
2017
2018 !  ==================================================
2019
2020 !  This was subtest was skipped for Fortran because
2021 !  findVariable(globalVariable36_x) fails when called by the mutator.
2022 !  Every other subtest that does a findVariable on some variable in
2023 !  this Fortran mutatee is skipped, so this must be an unimplemented
2024 !  feature on Fortran.  As soon as this is implemented, this test
2025 !  should be able to be activated.
2026
2027 !       passedTest (36) = .true.
2028 !       print *, 'Skipped test #36 (callsite parameter referencing)'
2029 !       print *, '       - not implemented for Fortran'
2030 !       RETURN
2031 !  ==================================================
2032
2033         result = call36_1(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)
2034         failure = 0
2035
2036         if (result .ne. 55) then
2037                 print *, '  for test 36, expecting a value of 55 from call36_1, '
2038                 print *, 'got: ', result
2039                 failure = 1
2040         endif
2041
2042 #if defined(rs6000_ibm_aix4_1) && !defined(AIX5)
2043         call xlf90_41_hack()
2044 #endif
2045
2046         if (globalVariable36_1 .ne. 1) then
2047                 print *, '  for test 36, expecting arg1 value of 1, got ',
2048      &          globalVariable36_1
2049                 failure = 1
2050         endif
2051
2052         if (globalVariable36_2 .ne. 2) then
2053                 print *, '  for test 36, expecting arg2 value of 2, got ',
2054      &          globalVariable36_2
2055                 failure = 1
2056         endif
2057
2058         if (globalVariable36_3 .ne. 3) then
2059                 print *, '  for test 36, expecting arg3 value of 3, got ',
2060      &          globalVariable36_3
2061                 failure = 1
2062         endif
2063
2064         if (globalVariable36_4 .ne. 4) then
2065                 print *, '  for test 36, expecting arg4 value of 4, got ',
2066      &          globalVariable36_4
2067                 failure = 1
2068         endif
2069
2070         if (globalVariable36_5 .ne. 5) then
2071                 print *, '  for test 36, expecting arg5 value of 5, got ',
2072      &          globalVariable36_5
2073                 failure = 1
2074         endif
2075
2076         if (globalVariable36_6 .ne. 6) then
2077                 print *, '  for test 36, expecting arg6 value of 6, got ',
2078      &          globalVariable36_6
2079                 failure = 1
2080         endif
2081
2082         if (globalVariable36_7 .ne. 7) then
2083                 print *, '  for test 36, expecting arg7 value of 7, got ',
2084      &          globalVariable36_7
2085 #if defined(alpha_dec_osf4_0)
2086                 print *, '  not an error since it needs to be implemented',
2087      &          ' on this platform'
2088 #else
2089                 failure = 1
2090 #endif
2091         endif
2092
2093         if (globalVariable36_8 .ne. 8) then
2094                 print *, '  for test 36, expecting arg8 value of 8, got ',
2095      &          globalVariable36_8
2096 #if defined(alpha_dec_osf4_0)
2097                 print *, '  not an error since it needs to be implemented',
2098      &          ' on this platform'
2099 #else
2100                 failure = 1
2101 #endif
2102         endif
2103
2104         if (globalVariable36_9 .ne. 9) then
2105                 print *, '  for test 36, expecting arg9 value of 9, got ',
2106      &          globalVariable36_9
2107 #if defined(sparc_sun_solaris2_4) \
2108  || defined(alpha_dec_osf4_0)
2109                 print *, '  not an error since it needs to be implemented',
2110      &          ' on this platform'
2111 #else
2112                 failure = 1
2113 #endif
2114         endif
2115
2116         if (globalVariable36_10 .ne. 10) then
2117                 print *, '  for test 36, expecting arg10 value of 10, got ',
2118      &          globalVariable36_10
2119 #if defined(sparc_sun_solaris2_4) \
2120  || defined(alpha_dec_osf4_0)
2121                 print *, '  not an error since it needs to be implemented',
2122      &          ' on this platform'
2123 #else
2124                 failure = 1
2125 #endif
2126         endif
2127
2128         if (failure .eq. 0) then
2129                 passedTest (36) = .true.
2130                 print *, 'Passed test #36 (callsite parameter referencing)'
2131         else
2132                 passedTest (36) = .false.
2133                 print *, '**Failed** test #36 (callsite parameter referencing)'
2134         endif
2135
2136         END
2137
2138 !------------------------------------------------------------------------------
2139
2140         SUBROUTINE func37_1
2141 #include "test1_common.h"
2142         passedTest (37) = .true.
2143         print *, 'Skipped test #37 (instrument loops)'
2144         print *, '       - not implemented for Fortran'
2145         END
2146
2147 !------------------------------------------------------------------------------
2148
2149         SUBROUTINE func38_1
2150 #include "test1_common.h"
2151         passedTest (38) = .true.
2152         print *, 'Skipped test #38 (basic block addresses)'
2153         print *, '       - not implemented for Fortran'
2154         END
2155
2156 !------------------------------------------------------------------------------
2157
2158         SUBROUTINE func39_1
2159 #include "test1_common.h"
2160         passedTest (39) = .true.
2161         print *, 'Passed test #39 (regex function search)'
2162         END
2163
2164 !------------------------------------------------------------------------------
2165
2166         SUBROUTINE func40_1
2167 #include "test1_common.h"
2168         passedTest (40) = .true.
2169         print *, 'Skipped test #40 (monitor dynamic call site)'
2170         print *, '       - not implemented for Fortran'
2171         END
2172
2173 !------------------------------------------------------------------------------
2174