blob: 506a8155737bf76b208cdb790b9f96aa80010963 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
|
# Copyright (C) 2003-2023 Free Software Foundation, Inc.
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with GCC; see the file COPYING3. If not see
# <http://www.gnu.org/licenses/>.
# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
# for GNU Modula-2
load_lib file-format.exp
load_lib gm2.exp
set gm2_keep_executable 0
#
# gm2-simple-compile -- runs the compiler
#
# SRC is the full pathname of the testcase.
# OPTION is the specific compiler flag we're testing (eg: -O2).
#
proc gm2-simple-compile { src option } {
global output
global srcdir tmpdir
global host_triplet
set output "$tmpdir/[file tail [file rootname $src]].o"
regsub "^$srcdir/?" $src "" testcase
# If we couldn't rip $srcdir out of `src' then just do the best we can.
# The point is to reduce the unnecessary noise in the logs. Don't strip
# out too much because different testcases with the same name can confuse
# `test-tool'.
if [string match "/*" $testcase] {
set testcase "[file tail [file dirname $src]]/[file tail $src]"
}
verbose "Testing $testcase, $option" 1
# Run the compiler and analyze the results.
set options ""
lappend options "additional_flags=$option"
set comp_output [gm2_target_compile "$src" "$output" object $options];
gm2_check_compile $testcase $option $output $comp_output
remote_file build delete $output
verbose "$comp_output" 1
}
#
# gm2-simple-execute -- utility to compile and execute a testcase
#
# SOURCES is a list of full pathnames to the test source files.
# The first filename in this list forms the "testcase".
#
# If the testcase has an associated .x file, we source that to run the
# test instead. We use .x so that we don't lengthen the existing filename
# to more than 14 chars.
#
proc gm2-simple-execute { sources args option } {
global tmpdir tool srcdir output compiler_conditional_xfail_data;
global gm2_link_libraries;
global gm2_link_path;
global gm2_link_objects;
global gm2_keep_executable;
# Use the first source filename given as the filename under test.
set src [lindex $sources 0];
if { [llength $args] > 0 } {
set additional_flags [lindex $args 0];
} else {
set additional_flags "";
}
# Check for alternate driver.
if [file exists [file rootname $src].x] {
verbose "Using alternate driver [file rootname [file tail $src]].x" 2
set done_p 0;
catch "set done_p \[source [file rootname $src].x\]"
if { $done_p } {
return
}
}
set executable $tmpdir/[file tail [file rootname $src].x];
set objectfile $tmpdir/[file tail [file rootname $src].o];
regsub "^$srcdir/?" $src "" testcase
# If we couldn't rip $srcdir out of `src' then just do the best we can.
# The point is to reduce the unnecessary noise in the logs. Don't strip
# out too much because different testcases with the same name can confuse
# `test-tool'.
if [string match "/*" $testcase] {
set testcase "[file tail [file dirname $src]]/[file tail $src]"
}
set execname "${executable}";
remote_file build delete $execname;
verbose "Testing $testcase, $option" 1
# start by setting options with option
set options [concat "{additional_flags=$gm2_link_objects} " $option]
# now append path -fno-libs=- and objects
set options [concat "{additional_flags=$gm2_link_path} " $options]
set options [concat "{additional_flags=-fno-libs=-} " $options]
set comp_output [gm2_target_compile "${sources}" "${execname}" executable ${options}];
if ![gm2_check_compile "${testcase} compilation" ${option} ${execname} $comp_output] {
unresolved "${testcase} execution, ${option}"
remote_file build delete $objectfile
return 0
}
set result [gm2_load "$execname" "" ""]
set status [lindex $result 0];
set output [lindex $result 1];
if { $status == "fail" } {
${tool}_fail $testcase $option
send_log "executed $execname with result $status"
}
if { $status == "pass" } {
${tool}_pass $testcase $option
# puts stderr $execname
if { ! $gm2_keep_executable } {
remote_file build delete $execname;
}
}
return 1
}
|
