Remove old testsuite
[dyninst.git] / newtestsuite / src / dyninst / test1_15F_fortran.F
1  !
2  ! Copyright (c) 1996-2004 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  ! This license is for research uses.  For such uses, there is no
12  ! charge. We define "research use" to mean you may freely use it
13  ! inside your organization for whatever purposes you see fit. But you
14  ! may not re-distribute Paradyn or parts of Paradyn, in any form
15  ! source or binary (including derivatives), electronic or otherwise,
16  ! to any other organization or entity without our permission.
17  ! 
18  ! (for other uses, please contact us at paradyn@cs.wisc.edu)
19  ! 
20  ! All warranties, including without limitation, any warranty of
21  ! merchantability or fitness for a particular purpose, are hereby
22  ! excluded.
23  ! 
24  ! By your use of Paradyn, you understand and agree that we (or any
25  ! other person or entity with proprietary rights in Paradyn) are
26  ! under no obligation to provide either maintenance services,
27  ! update services, notices of latent defects, or correction of
28  ! defects for Paradyn.
29  ! 
30  ! Even if advised of the possibility of such damages, under no
31  ! circumstances shall we (or any other person or entity with
32  ! proprietary rights in the software licensed hereunder) be liable
33  ! to you or any third party for direct, indirect, or consequential
34  ! damages of any character regardless of type of action, including,
35  ! without limitation, loss of profits, loss of use, loss of good
36  ! will, or computer failure or malfunction.  You agree to indemnify
37  ! us (and any other person or entity with proprietary rights in the
38  ! software licensed hereunder) for any and all liability it may
39  ! incur to third parties resulting from your use of Paradyn.
40  !
41
42 ! libdyninst validation suite test #1
43 ! author: Jon Beyer (6/1/01)
44 !       derived from a previous test by Jeff Hollingsworth
45
46 !------------------------------------------------------------------------------
47
48 ! AIX xlf90 does not insert underscores at end
49
50 #if !defined(XLF)
51 #define stop_process_ stop_process
52 #endif
53
54 #ifdef __GNUC__
55 #define AND iand
56 #define OR ior
57 #else
58 #define AND and
59 #define OR or
60 #endif
61
62 !------------------------------------------------------------------------------
63
64         SUBROUTINE init_globals
65 #include "test1_15F_common.h"
66
67         globalVariable15_1 = 0
68         globalVariable15_2 = 0
69         globalVariable15_3 = 0
70         globalVariable15_4 = 0
71         END
72
73 !------------------------------------------------------------------------------
74
75         SUBROUTINE test1_15_func2
76         INTEGER foo = 0
77         END
78
79 !------------------------------------------------------------------------------
80
81         SUBROUTINE test1_15_func3
82 #include "test1_15F_common.h"
83
84         globalVariable15_3 = 100
85         globalVariable15_4 = globalVariable15_4 + 1
86         END
87
88 !------------------------------------------------------------------------------
89
90         SUBROUTINE test1_15_func4
91         INTEGER kludge
92
93         kludge = 1
94         CALL test1_15_func3
95         END
96
97 !------------------------------------------------------------------------------
98
99         SUBROUTINE test1_15_call1
100 #include "test1_15F_common.h"
101
102         globalVariable15_1 = globalVariable15_1 + 1
103         END
104
105 !------------------------------------------------------------------------------
106
107         SUBROUTINE test1_15_call2
108 #include "test1_15F_common.h"
109
110         globalVariable15_2 = globalVariable15_2 + 1
111         END
112
113 !------------------------------------------------------------------------------
114
115         SUBROUTINE test1_15_call3
116 #include "test1_15F_common.h"
117
118         globalVariable15_3 = globalVariable15_3 + 1
119         END
120
121 !------------------------------------------------------------------------------
122
123         SUBROUTINE test1_15_func1
124 #include "test1_15F_common.h"
125         LOGICAL failed
126
127         failed = .false.
128
129         CALL test1_15_func2
130         CALL check15result ('globalVariable15_1', globalVariable15_1, 1,
131      & 'after first call to instrumented function', failed)
132
133         CALL test1_15_func4
134         CALL check15result ('globalVariable15_3', globalVariable15_3, 1,
135      & 'after first call to instrumented function', failed)
136
137         CALL stop_process_
138         CALL test1_15_func2
139         CALL check15result ('globalVariable15_1', globalVariable15_1, 1,
140      & 'after second call to instrumented function', failed)
141
142         CALL test1_15_func4
143         CALL check15result ('globalVariable15_3', globalVariable15_3,
144      & 100, 'after second call to instrumented function', failed)
145
146         CALL stop_process_
147         CALL test1_15_func2
148         CALL check15result ('globalVariable15_1', globalVariable15_1, 2,
149      & 'after third call to instrumented function', failed)
150
151         CALL test1_15_func4
152         CALL check15result ('globalVariable15_3', globalVariable15_3,
153      & 101, 'after third call to instrumented function', failed)
154
155         if (failed .eqv. .false.) then
156                 passedTest = 1
157         endif
158         END
159
160 !------------------------------------------------------------------------------
161
162         SUBROUTINE check15result (varname, value, expected, errstr,
163      & failed)
164         CHARACTER *(*) varname
165         INTEGER value, expected
166         CHARACTER *(*) errstr
167         LOGICAL failed
168
169         if (value .ne. expected) then
170                 if (failed .eqv. .false.) then
171                         print *, '**Failed test #15 (setMutationsActive)'
172                 endif
173                 failed = .true.
174                 print *, '    ', varname, ' = ', value, ' ', errstr
175         endif
176         END     
177
178 !------------------------------------------------------------------------------