1# Copyright (C) 2006-2016 Free Software Foundation, Inc. 2 3# This program is free software; you can redistribute it and/or modify 4# it under the terms of the GNU General Public License as published by 5# the Free Software Foundation; either version 3 of the License, or 6# (at your option) any later version. 7# 8# This program is distributed in the hope that it will be useful, 9# but WITHOUT ANY WARRANTY; without even the implied warranty of 10# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11# GNU General Public License for more details. 12# 13# You should have received a copy of the GNU General Public License 14# along with GCC; see the file COPYING3. If not see 15# <http://www.gnu.org/licenses/>. 16 17# This file was written by James A. Morrison (ja2morri@uwaterloo.ca) 18# based on gcc.exp written by Rob Savoye (rob@cygnus.com). 19 20# This file is loaded by the tool init file (eg: unix.exp). It provides 21# default definitions for gnat_start, etc. and other supporting cast members. 22 23load_lib prune.exp 24load_lib gcc-defs.exp 25load_lib gcc.exp 26load_lib timeout.exp 27 28# 29# GNAT_UNDER_TEST is the compiler under test. 30# 31 32# 33# default_gnat_version -- extract and print the version number of the compiler 34# 35 36proc default_gnat_version { } { 37 global GNAT_UNDER_TEST 38 39 gnat_init 40 41 # ignore any arguments after the command 42 set compiler [lindex $GNAT_UNDER_TEST 0] 43 44 if ![is_remote host] { 45 set compiler_name [which $compiler] 46 } else { 47 set compiler_name $compiler 48 } 49 50 # verify that the compiler exists 51 if { $compiler_name != 0 } then { 52 set tmp [remote_exec host "$compiler --version"] 53 set status [lindex $tmp 0] 54 set output [lindex $tmp 1] 55 regexp "^GNATMAKE (\[^\n\r\]*)" $output verline version 56 if { $status == 0 && [info exists version] } then { 57 # test_summary expects "version" as second field. 58 clone_output "$compiler_name version $version\n" 59 } else { 60 clone_output "Couldn't determine version of $compiler_name: $output\n" 61 } 62 } else { 63 # compiler does not exist (this should have already been detected) 64 warning "$compiler does not exist" 65 } 66} 67 68# 69# gnat_version -- Call default_gnat_version, so we can override it if needed. 70# 71 72proc gnat_version { } { 73 default_gnat_version 74} 75 76# 77# gnat_init -- called at the start of each .exp script. 78# 79 80set gnat_initialized 0 81 82proc gnat_init { args } { 83 global rootme 84 global tmpdir 85 global libdir 86 global gluefile wrap_flags 87 global gnat_initialized 88 global GNAT_UNDER_TEST 89 global TOOL_EXECUTABLE 90 global gnat_target_current 91 92 set gnat_target_current "" 93 94 if { $gnat_initialized == 1 } { return } 95 96 if ![info exists GNAT_UNDER_TEST] then { 97 if [info exists TOOL_EXECUTABLE] { 98 set GNAT_UNDER_TEST "$TOOL_EXECUTABLE" 99 } else { 100 set GNAT_UNDER_TEST "[local_find_gnatmake]" 101 } 102 } 103 104 if ![info exists tmpdir] then { 105 set tmpdir /tmp 106 } 107} 108 109proc gnat_target_compile { source dest type options } { 110 global rootme 111 global tmpdir 112 global gluefile wrap_flags 113 global srcdir 114 global GNAT_UNDER_TEST 115 global TOOL_OPTIONS 116 global gnat_target_current 117 global TEST_ALWAYS_FLAGS 118 119 # dg-require-effective-target tests must be compiled as C. 120 if [ string match "*.c" $source ] then { 121 return [gcc_target_compile $source $dest $type $options] 122 } 123 124 # If we detect a change of target, we need to recompute both 125 # GNAT_UNDER_TEST and the appropriate RTS. 126 if { $gnat_target_current!="[current_target_name]" } { 127 set gnat_target_current "[current_target_name]" 128 if [info exists TOOL_OPTIONS] { 129 set rtsdir "[get_multilibs ${TOOL_OPTIONS}]/libada" 130 } else { 131 set rtsdir "[get_multilibs]/libada" 132 } 133 if [info exists TOOL_EXECUTABLE] { 134 set GNAT_UNDER_TEST "$TOOL_EXECUTABLE" 135 } else { 136 set GNAT_UNDER_TEST "[local_find_gnatmake]" 137 } 138 set GNAT_UNDER_TEST "$GNAT_UNDER_TEST --RTS=$rtsdir" 139 140 # gnatlink looks for system.ads itself and has no --RTS option, so 141 # specify via environment 142 setenv ADA_INCLUDE_PATH "$rtsdir/adainclude" 143 setenv ADA_OBJECTS_PATH "$rtsdir/adainclude" 144 # Always log so compilations can be repeated manually. 145 verbose -log "ADA_INCLUDE_PATH=$rtsdir/adainclude" 146 verbose -log "ADA_OBJECTS_PATH=$rtsdir/adainclude" 147 } 148 149 lappend options "compiler=$GNAT_UNDER_TEST -q -f" 150 lappend options "timeout=[timeout_value]" 151 152 if { [target_info needs_status_wrapper]!="" && [info exists gluefile] } { 153 lappend options "libs=${gluefile}" 154 lappend options "ldflags=$wrap_flags" 155 } 156 157 # TEST_ALWAYS_FLAGS are flags that should be passed to every 158 # compilation. They are passed first to allow individual 159 # tests to override them. 160 if [info exists TEST_ALWAYS_FLAGS] { 161 set options [concat "{additional_flags=$TEST_ALWAYS_FLAGS}" $options] 162 } 163 164 # TOOL_OPTIONS must come first, so that it doesn't override testcase 165 # specific options. 166 if [info exists TOOL_OPTIONS] { 167 set options [concat "additional_flags=$TOOL_OPTIONS" $options] 168 } 169 170 return [target_compile $source $dest $type $options] 171} 172 173# Prune messages from GNAT that aren't useful. 174 175proc prune_gnat_output { text } { 176 #send_user "Before:$text\n" 177 regsub -all "(^|\n)\[^\n\]*: In (function|method) \[^\n\]*" $text "" text 178 regsub -all "(^|\n)\[^\n\]*: At top level:\[^\n\]*" $text "" text 179 180 # prune the output from gnatmake. 181 regsub -all "(^|\n)\[^\n\]*gnatmake: [^\n\]*" $text "" text 182 183 # It would be nice to avoid passing anything to gnat that would cause it to 184 # issue these messages (since ignoring them seems like a hack on our part), 185 # but that's too difficult in the general case. For example, sometimes 186 # you need to use -B to point gnat at crt0.o, but there are some targets 187 # that don't have crt0.o. 188 regsub -all "(^|\n)\[^\n\]*file path prefix \[^\n\]* never used" $text "" text 189 regsub -all "(^|\n)\[^\n\]*linker input file unused since linking not done" $text "" text 190 191 #send_user "After:$text\n" 192 193 return $text 194} 195 196# find_gnatmake for some version of DejaGnu will hardcode a -I...rts/ada flag 197# which prevent multilib from working, so define a new one. 198 199proc local_find_gnatmake {} { 200 global tool_root_dir 201 202 if ![is_remote host] { 203 set file [lookfor_file $tool_root_dir gnatmake] 204 if { $file == "" } { 205 set file [lookfor_file $tool_root_dir gcc/gnatmake] 206 } 207 if { $file != "" } { 208 set root [file dirname $file] 209 # Need to pass full --GCC, including multilib flags, to gnatlink, 210 # otherwise gcc from PATH is invoked. 211 set dest [target_info name] 212 set gnatlink_gcc "--GCC=$root/xgcc -B$root [board_info $dest multilib_flags]" 213 # Escape blanks to get them through DejaGnu's exec machinery. 214 regsub -all {\s} "$gnatlink_gcc" {\\&} gnatlink_gcc 215 set CC "$file --GCC=$root/xgcc --GNATBIND=$root/gnatbind --GNATLINK=$root/gnatlink -cargs -B$root -largs $gnatlink_gcc -margs"; 216 } else { 217 set CC [transform gnatmake] 218 } 219 } else { 220 set CC [transform gnatmake] 221 } 222 return $CC 223} 224 225proc find_gnatclean {} { 226 global tool_root_dir 227 228 if ![is_remote host] { 229 set file [lookfor_file $tool_root_dir gnatclean] 230 if { $file == "" } { 231 set file [lookfor_file $tool_root_dir gcc/gnatclean] 232 } 233 if { $file != "" } { 234 set gnatclean $file; 235 } else { 236 set gnatclean [transform gnatclean] 237 } 238 } else { 239 set gnatclean [transform gnatclean] 240 } 241 return $gnatclean 242} 243 244# Local Variables: 245# tcl-indent-level:4 246# End: 247