pascal.exp revision 1.1 
1# Copyright 2007-2014 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 this program.  If not, see <http://www.gnu.org/licenses/>.
15
16load_lib libgloss.exp
17
18set pascal_init_done 0
19
20# This procedure looks for a suitable pascal compiler
21# For now only GNU pascal compiler and Free Pascal compiler
22# are searched.
23# First, environment variable GPC is checked
24# if present, GPC compiler is assumed to be the value of
25# that environment variable.
26# Second, environment variable FPC is checked
27# if present, Free Pascal compiler is assumed to be the value of
28# that environment variable.
29# Third, gpc executable is searched using `which gpc`
30# Lastly, fpc executable is searched using `which fpc`
31# Using environment variable allows to force
32# which compiler is used in testsuite
33
34proc pascal_init {} {
35    global pascal_init_done
36    global pascal_compiler_is_gpc
37    global pascal_compiler_is_fpc
38    global gpc_compiler
39    global fpc_compiler
40    global env
41
42    if { $pascal_init_done == 1 } {
43	return
44    }
45
46    set pascal_compiler_is_gpc 0
47    set pascal_compiler_is_fpc 0
48    set gpc_compiler [transform gpc]
49    set fpc_compiler [transform fpc]
50
51    if ![is_remote host] {
52	if { [info exists env(GPC)] } {
53	    set pascal_compiler_is_gpc 1
54	    set gpc_compiler $env(GPC)
55	    verbose -log "Assuming GNU Pascal ($gpc_compiler)"
56	} elseif { [info exists env(FPC)] } {
57	    set pascal_compiler_is_fpc 1
58	    set fpc_compiler $env(FPC)
59	    verbose -log "Assuming Free Pascal ($fpc_compiler)"
60	} elseif { [which $gpc_compiler] != 0 } {
61	    set pascal_compiler_is_gpc 1
62	    verbose -log "GNU Pascal compiler found"
63        } elseif { [which $fpc_compiler] != 0 } {
64	    set pascal_compiler_is_fpc 1
65	    verbose -log "Free Pascal compiler found"
66	}
67    }
68    set pascal_init_done 1
69}
70
71proc gpc_compile {source dest type options} {
72    global gpc_compiler
73    set add_flags ""
74    if {$type == "object"} {
75	append add_flags " -c"
76    }
77
78    if { $type == "preprocess" } {
79	append add_flags " -E"
80    }
81
82    if { $type == "assembly" } {
83	append add_flags " -S"
84    }
85
86    foreach i $options {
87	if { $i == "debug" } {
88	    if [board_info $dest exists debug_flags] {
89		append add_flags " [board_info $dest debug_flags]"
90	    } else {
91		append add_flags " -g"
92	    }
93	}
94    }
95
96    set result [remote_exec host $gpc_compiler "-o $dest --automake $add_flags $source"]
97    return $result
98}
99
100proc fpc_compile {source dest type options} {
101    global fpc_compiler
102    set add_flags ""
103    if {$type == "object"} {
104	append add_flags " -Cn"
105    }
106
107    if { $type == "preprocess" } {
108	return "Free Pascal can not preprocess"
109    }
110
111    if { $type == "assembly" } {
112	append add_flags " -al"
113    }
114
115    foreach i $options {
116	if { $i == "debug" } {
117	    if [board_info $dest exists debug_flags] {
118		append add_flags " [board_info $dest debug_flags]"
119	    } else {
120		append add_flags " -g"
121	    }
122	}
123    }
124
125    set result [remote_exec host $fpc_compiler "-o$dest $add_flags $source"]
126    return $result
127}
128
129proc gdb_compile_pascal {source dest type options} {
130    global pascal_init_done
131    global pascal_compiler_is_gpc
132    global pascal_compiler_is_fpc
133
134    if { $pascal_init_done == 0 } {
135	pascal_init
136    }
137
138    if { $pascal_compiler_is_fpc == 1 } {
139        set result [fpc_compile $source $dest $type $options]
140    } elseif { $pascal_compiler_is_gpc == 1 } {
141        set result [gpc_compile $source $dest $type $options]
142    } else {
143	unsupported "No pascal compiler found"
144	return "No pascal compiler. Compilation failed."
145    }
146
147    if ![file exists $dest] {
148        unsupported "Pascal compilation failed: $result"
149        return "Pascal compilation failed."
150    }
151}
152
153# Auxiliary function to set the language to pascal.
154# The result is 1 (true) for success, 0 (false) for failure.
155
156proc set_lang_pascal {} {
157    if [gdb_test_no_output "set language pascal"] {
158	return 0
159    }
160    if [gdb_test "show language" ".* source language is \"pascal\"." \
161	   "set language to \"pascal\""] {
162	return 0
163    }
164    return 1
165}
166