Rename newtestsuite to testsuite
[dyninst.git] / testsuite / src / dyninst / test1_31F_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 test1_31f_init_globals
65 #include "test1_31F_common.h"
66
67         globalVariable31_1 = 0
68         globalVariable31_2 = 0
69         globalVariable31_3 = 0
70         globalVariable31_4 = 0
71         END
72
73 !------------------------------------------------------------------------------
74
75         INTEGER FUNCTION test1_31_func1 ()
76 #include "test1_31F_common.h"
77
78         globalVariable31_1 = 0
79         globalVariable31_2 = 0
80         globalVariable31_3 = 0
81         globalVariable31_4 = 0
82
83         CALL test1_31_func2
84
85         if (globalVariable31_3 .eq. 1) then
86                 passedTest = 1
87         endif
88
89         if (passedTest .eq. 0) then
90                 print *, '**Failed** test #31 (non-recursive base tramp guard)'
91                 print *, '    globalVariable31_3 = ', globalVariable31_3,
92      & ', should be 1 (no instrumentation got exectued?)'
93                 test1_31_func1 = 0
94                 RETURN
95         endif
96
97         if (globalVariable31_4 .eq. 0) then
98                 passedTest = 1
99         endif
100
101         if (passedTest .eq. 0) then
102                 print *, '**Failed** test #31 (non-recursive base tramp guard)'
103                 print *, '    globalVariable31_4 = ', globalVariable31_4,
104      & ', should be 0.'
105                 if (globalVariable31_4 .eq. 0) then
106                         print *, '    Recursive guard works find.'
107                 elseif (globalVariable31_4 .eq. 1) then
108                         print *, '    Pre-instr recursive guard does not work.'
109                 elseif (globalVariable31_4 .eq. 2) then
110                         print *, '    Post-instr recursive guard does not work.'
111                 elseif (globalVariable31_4 .eq. 3) then
112                         print *, '    None of the recursive guards work.'
113                 else
114                         print *, '    Something is really wrong.'
115                 endif
116                 test1_31_func1 = 0
117                 RETURN
118         endif
119
120         passedTest = 1
121
122         test1_31_func1 = 1
123         RETURN
124         END
125
126 !------------------------------------------------------------------------------
127
128         SUBROUTINE test1_31_func2
129 #include "test1_31F_common.h"
130
131         globalVariable31_2 = 1
132         END
133
134 !------------------------------------------------------------------------------
135
136         SUBROUTINE test1_31_func3
137 #include "test1_31F_common.h"
138
139         globalVariable31_3 = 1
140         END
141
142 !------------------------------------------------------------------------------
143
144         SUBROUTINE test1_31_func4 (value)
145 #include "test1_31F_common.h"
146         INTEGER value
147
148         if (value .eq. 0) then
149                 print *, 'test1_31_func4 called with calue = 0 !'
150         endif
151         globalVariable31_4 = globalVariable31_4 + value
152         END
153
154 !------------------------------------------------------------------------------