Update copyright to LGPL on all files
[dyninst.git] / testsuite / src / dyninst / test1_17F_fortran.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  !
31
32 ! libdyninst validation suite test #1
33 ! author: Jon Beyer (6/1/01)
34 !       derived from a previous test by Jeff Hollingsworth
35
36 !------------------------------------------------------------------------------
37
38 ! AIX xlf90 does not insert underscores at end
39
40 #if !defined(XLF)
41 #define stop_process_ stop_process
42 #endif
43
44 #ifdef __GNUC__
45 #define AND iand
46 #define OR ior
47 #else
48 #define AND and
49 #define OR or
50 #endif
51
52 !------------------------------------------------------------------------------
53
54         SUBROUTINE test1_17f_init_globals
55 #include "test1_17F_common.h"
56
57         globalVariable17_1 = 0
58         globalVariable17_2 = 0
59         END
60
61 !------------------------------------------------------------------------------
62
63         SUBROUTINE test1_17_func1
64 #include "test1_17F_common.h"
65         INTEGER ret17_1
66         INTEGER test1_17_func2
67
68         ret17_1 = test1_17_func2 ()
69         CALL test1_17_func3
70
71         if (ret17_1 .ne. 1700100 .or. globalVariable17_1 .ne. 1700200 .or.
72      & globalVariable17_2 .ne. 1701000) then
73                 print *, '**Failed** test case #17 (return values from func',
74      & ' calls)'
75                 if (ret17_1 .ne. 1700100) then
76                         print *, '  return value was ', ret17_1, ', not 1700100'
77                 endif
78                 if (globalVariable17_1 .ne. 1700200) then
79                         print *, '  return value was ', globalVariable17_1,
80      & ', not 1700200'
81                 endif
82                 if (globalVariable17_2 .ne. 1701000) then
83                         print *, '  function test1_17_call2 was not inserted'
84                 endif
85         else
86                 passedTest = 1
87         endif
88         END
89
90 !------------------------------------------------------------------------------
91
92         INTEGER FUNCTION test1_17_func2 ()
93         test1_17_func2 = 1700100
94         RETURN
95         END
96
97 !------------------------------------------------------------------------------
98
99         SUBROUTINE test1_17_func3
100 #include "test1_17F_common.h"
101         INTEGER test1_17_func4
102
103         globalVariable17_1 = test1_17_func4()
104         END
105
106 !------------------------------------------------------------------------------
107         INTEGER FUNCTION test1_17_func4 ()
108         test1_17_func4 = 1700200
109         RETURN
110         END
111
112 !------------------------------------------------------------------------------
113
114         INTEGER FUNCTION test1_17_call1 (p1)
115         INTEGER p1
116         INTEGER a1, a2, a3, a4, a5, a6, a7
117
118         a1 = p1
119         a2 = a1 + p1
120         a3 = a1 * a2
121         a4 = a3 / p1
122         a5 = a4 + p1
123         a6 = a5 + a1
124         a7 = a6 + p1
125         test1_17_call1 = a7
126         return
127         END
128
129 !------------------------------------------------------------------------------
130
131         INTEGER FUNCTION test1_17_call2 (p1)
132 #include "test1_17F_common.h"
133         INTEGER p1
134         INTEGER a1, a2, a3, a4, a5, a6, a7
135
136         a1 = p1
137         a2 = a1 + p1
138         a3 = a1 * a2
139         a4 = a3 / p1
140         a5 = a4 + p1
141         a6 = a5 + a1
142         a7 = a6 + p1
143         globalVariable17_2 = 1701000
144         test1_17_call2 = a7
145         return
146         END
147
148 !------------------------------------------------------------------------------