pascal.exp revision 1.3 
1# Copyright 2007-2015 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	if { $i == "class" } {
95	    if [board_info $dest exists pascal_class_flags] {
96		append add_flags " [board_info $dest pascal_class_flags]"
97	    } else {
98		append add_flags " --extended-syntax"
99	    }
100	}
101    }
102
103    set result [remote_exec host $gpc_compiler "-o $dest --automake $add_flags $source"]
104    return $result
105}
106
107proc fpc_compile {source dest type options} {
108    global fpc_compiler
109    set add_flags ""
110    if {$type == "object"} {
111	append add_flags " -Cn"
112    }
113
114    if { $type == "preprocess" } {
115	return "Free Pascal can not preprocess"
116    }
117
118    if { $type == "assembly" } {
119	append add_flags " -al"
120    }
121
122    foreach i $options {
123	if { $i == "debug" } {
124	    if [board_info $dest exists debug_flags] {
125		append add_flags " [board_info $dest debug_flags]"
126	    } else {
127		append add_flags " -g"
128	    }
129	}
130	if { $i == "class" } {
131	    if [board_info $dest exists pascal_class_flags] {
132		append add_flags " [board_info $dest pascal_class_flags]"
133	    } else {
134		append add_flags " -Mobjfpc"
135	    }
136	}
137    }
138
139    set result [remote_exec host $fpc_compiler "-o$dest $add_flags $source"]
140    return $result
141}
142
143proc gdb_compile_pascal {source dest type options} {
144    global pascal_init_done
145    global pascal_compiler_is_gpc
146    global pascal_compiler_is_fpc
147
148    if { $pascal_init_done == 0 } {
149	pascal_init
150    }
151
152    if { $pascal_compiler_is_fpc == 1 } {
153        set result [fpc_compile $source $dest $type $options]
154    } elseif { $pascal_compiler_is_gpc == 1 } {
155        set result [gpc_compile $source $dest $type $options]
156    } else {
157	unsupported "No pascal compiler found"
158	return "No pascal compiler. Compilation failed."
159    }
160
161    if ![file exists $dest] {
162        unsupported "Pascal compilation failed: $result"
163        return "Pascal compilation failed."
164    }
165}
166
167# Auxiliary function to set the language to pascal.
168# The result is 1 (true) for success, 0 (false) for failure.
169
170proc set_lang_pascal {} {
171    if [gdb_test_no_output "set language pascal"] {
172	return 0
173    }
174    if [gdb_test "show language" ".* source language is \"pascal\"." \
175	   "set language to \"pascal\""] {
176	return 0
177    }
178    return 1
179}
180