Remove old testsuite
[dyninst.git] / testsuite / src / dyninst / test1_17F_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_17f_init_globals
65 #include "test1_17F_common.h"
66
67         globalVariable17_1 = 0
68         globalVariable17_2 = 0
69         END
70
71 !------------------------------------------------------------------------------
72
73         SUBROUTINE test1_17_func1
74 #include "test1_17F_common.h"
75         INTEGER ret17_1
76         INTEGER test1_17_func2
77
78         ret17_1 = test1_17_func2 ()
79         CALL test1_17_func3
80
81         if (ret17_1 .ne. 1700100 .or. globalVariable17_1 .ne. 1700200 .or.
82      & globalVariable17_2 .ne. 1701000) then
83                 print *, '**Failed** test case #17 (return values from func',
84      & ' calls)'
85                 if (ret17_1 .ne. 1700100) then
86                         print *, '  return value was ', ret17_1, ', not 1700100'
87                 endif
88                 if (globalVariable17_1 .ne. 1700200) then
89                         print *, '  return value was ', globalVariable17_1,
90      & ', not 1700200'
91                 endif
92                 if (globalVariable17_2 .ne. 1701000) then
93                         print *, '  function test1_17_call2 was not inserted'
94                 endif
95         else
96                 passedTest = 1
97         endif
98         END
99
100 !------------------------------------------------------------------------------
101
102         INTEGER FUNCTION test1_17_func2 ()
103         test1_17_func2 = 1700100
104         RETURN
105         END
106
107 !------------------------------------------------------------------------------
108
109         SUBROUTINE test1_17_func3
110 #include "test1_17F_common.h"
111         INTEGER test1_17_func4
112
113         globalVariable17_1 = test1_17_func4()
114         END
115
116 !------------------------------------------------------------------------------
117         INTEGER FUNCTION test1_17_func4 ()
118         test1_17_func4 = 1700200
119         RETURN
120         END
121
122 !------------------------------------------------------------------------------
123
124         INTEGER FUNCTION test1_17_call1 (p1)
125         INTEGER p1
126         INTEGER a1, a2, a3, a4, a5, a6, a7
127
128         a1 = p1
129         a2 = a1 + p1
130         a3 = a1 * a2
131         a4 = a3 / p1
132         a5 = a4 + p1
133         a6 = a5 + a1
134         a7 = a6 + p1
135         test1_17_call1 = a7
136         return
137         END
138
139 !------------------------------------------------------------------------------
140
141         INTEGER FUNCTION test1_17_call2 (p1)
142 #include "test1_17F_common.h"
143         INTEGER p1
144         INTEGER a1, a2, a3, a4, a5, a6, a7
145
146         a1 = p1
147         a2 = a1 + p1
148         a3 = a1 * a2
149         a4 = a3 / p1
150         a5 = a4 + p1
151         a6 = a5 + a1
152         a7 = a6 + p1
153         globalVariable17_2 = 1701000
154         test1_17_call2 = a7
155         return
156         END
157
158 !------------------------------------------------------------------------------