I managed to recompile autoconf 2.59 and it
seems to work.
I added several new files for this pascal testsuite.
Even these basic tests already add two failures
to the testsuite:
One from types.exp
ptyp 'a simple string'
does not recognize this as a string.
A second one from hello.exp
this is specific to gpc compiler as
explained in my previous email, because start
does not stop the program at the logical expected
first line of the main procedure in the program source.
lib/pascal.exp contains code to look for both gpc and fpc
but the result is inconsistent for me:
On the bash prompt I find both gpc in /usr/bin
and fpc in /usr/local/bin
but the expect which function seems to only find gpc :(
I struggled a lot with the expect syntax,
and the result is probably far from nice for
people used to program that kind of language.
Comments most welcome...
Pierre Muller
GDB pascal language maintainer
2007-04-13 Pierre Muller <muller(a)ics.u-strasbg.fr>
* lib/pascal.exp: New file.
* gdb.pascal/types.exp: New file.
Simply tests the type of literals,
adapted from gdb.fortran/types.exp
* gdb.pascal/hello/hello.pas: New file.
Simple program printing 'Hello, world!'.
* gdb.pascal/hello.exp: New file.
Small tests on hello.pas source.
* gdb.pascal/Makefile.in: New file.
* configure.ac: gdb.pascal sub directory added to list of
directories.
* configure: Regenerated using autoconf 2.59.
Index: configure
===================================================================
RCS file: /cvs/src/src/gdb/testsuite/configure,v
retrieving revision 1.23
diff -u -p -r1.23 configure
--- configure 23 Jan 2007 17:11:54 -0000 1.23
+++ configure 13 Apr 2007 14:51:51 -0000
@@ -3669,6 +3669,7 @@ do
"gdb.threads/Makefile" ) CONFIG_FILES="$CONFIG_FILES
gdb.threads/Makefile" ;;
"gdb.trace/Makefile" ) CONFIG_FILES="$CONFIG_FILES gdb.trace/Makefile" ;;
"gdb.xml/Makefile" ) CONFIG_FILES="$CONFIG_FILES gdb.xml/Makefile" ;;
+ "gdb.pascal/Makefile" ) CONFIG_FILES="$CONFIG_FILES gdb.pascal/Makefile"
;;
*) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target"
>&5
echo "$as_me: error: invalid argument: $ac_config_target" >&2;}
{ (exit 1); exit 1; }; };;
Index: configure.ac
===================================================================
RCS file: /cvs/src/src/gdb/testsuite/configure.ac,v
retrieving revision 1.6
diff -u -p -r1.6 configure.ac
--- configure.ac 23 Jan 2007 17:11:55 -0000 1.6
+++ configure.ac 13 Apr 2007 14:51:51 -0000
@@ -117,4 +117,4 @@ AC_OUTPUT([Makefile \
gdb.fortran/Makefile gdb.server/Makefile \
gdb.java/Makefile gdb.mi/Makefile \
gdb.objc/Makefile gdb.threads/Makefile gdb.trace/Makefile \
- gdb.xml/Makefile])
+ gdb.xml/Makefile gdb.pascal/Makefile])
Index: gdb.pascal/Makefile.in
===================================================================
RCS file: gdb.pascal/Makefile.in
diff -N gdb.pascal/Makefile.in
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ gdb.pascal/Makefile.in 13 Apr 2007 14:51:54 -0000
@@ -0,0 +1,24 @@
+VPATH = @srcdir@
+srcdir = @srcdir@
+
+EXECUTABLES = hello/hello
+
+MISCELLANEOUS =
+
+all info install-info dvi install uninstall installcheck check:
+ @echo "Nothing to be done for $@..."
+
+clean mostlyclean:
+ -find . -name '*.o' -print | xargs rm -f
+ -find . -name '*.ali' -print | xargs rm -f
+ -find . -name 'b~*.ad[sb]' -print | xargs rm -f
+ -rm -f *~ a.out xgdb *.x *.ci *.tmp
+ -rm -f *~ *.o a.out xgdb *.x *.ci *.tmp
+ -rm -f core core.coremaker coremaker.core corefile $(EXECUTABLES)
+ -rm -f $(MISCELLANEOUS) twice-tmp.c
+
+distclean maintainer-clean realclean: clean
+ -rm -f *~ core
+ -rm -f Makefile config.status config.log
+ -rm -f *-init.exp
+ -rm -fr *.log summary detail *.plog *.sum *.psum site.*
Index: gdb.pascal/hello.exp
===================================================================
RCS file: gdb.pascal/hello.exp
diff -N gdb.pascal/hello.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ gdb.pascal/hello.exp 13 Apr 2007 14:51:54 -0000
@@ -0,0 +1,59 @@
+# Copyright 2007 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 2 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 this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+# USA.
+
+if $tracelevel then {
+ strace $tracelevel
+}
+
+load_lib "pascal.exp"
+
+set testdir "hello"
+set testfile "${testdir}/hello"
+set srcfile ${srcdir}/${subdir}/${testfile}.pas
+set binfile ${objdir}/${subdir}/${testfile}
+
+file mkdir ${objdir}/${subdir}/${testdir}
+if {[gdb_compile_pascal "${srcfile}" "${binfile}" executable [list debug ]]
!= "" } {
+ return -1
+}
+
+gdb_exit
+gdb_start
+gdb_reinitialize_dir $srcdir/$subdir
+gdb_load ${binfile}
+
+# Verify that "start" lands inside the right procedure.
+if { [gdb_start_cmd] < 0 } {
+ untested start
+ return -1
+}
+gdb_test "" \
+ ".* at .*hello.pas.*" \
+ "start"
+gdb_test "break print_hello" \
+ ".* at .*hello.pas.*" \
+ "break print_hello"
+gdb_test "cont" \
+ "Breakpoint .*, print_hello.* at .*hello.pas.*" \
+ "cont"
+gdb_test "print st" \
+ ".* = ''.*" \
+ ""
+send_gdb "next\n"
+gdb_test " print st" \
+ ".* = 'Hello, world!'.*" \
+ ""
Index: gdb.pascal/types.exp
===================================================================
RCS file: gdb.pascal/types.exp
diff -N gdb.pascal/types.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ gdb.pascal/types.exp 13 Apr 2007 14:51:54 -0000
@@ -0,0 +1,109 @@
+# Copyright 1994, 1995, 1997, 1998, 2007 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 2 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 this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
USA.
+
+# Please email any bugs, comments, and/or additions to this file to:
+# bug-gdb(a)prep.ai.mit.edu
+
+# This file was adapted from old Chill tests by Stan Shebs
+# (shebs(a)cygnus.com).
+# Adapted to pascal by Pierre Muller
+
+if $tracelevel then {
+ strace $tracelevel
+}
+
+set prms_id 0
+set bug_id 0
+
+# Set the current language to pascal. This counts as a test. If it
+# fails, then we skip the other tests.
+
+proc set_lang_pascal {} {
+ global gdb_prompt
+
+ if [gdb_test "set language pascal" ""] {
+ return 0;
+ }
+
+ if ![gdb_test "show language" ".* source language is \"pascal\".*"] {
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+proc test_integer_literal_types_accepted {} {
+ global gdb_prompt
+
+ # Test various decimal values.
+ # Should be integer*4 probably.
+ gdb_test "pt 123" "type = int"
+}
+proc test_character_literal_types_accepted {} {
+ global gdb_prompt
+
+ # Test various character values.
+
+ gdb_test "pt 'a'" "type = char"
+}
+
+proc test_string_literal_types_accepted {} {
+ global gdb_prompt
+
+ # Test various character values.
+
+ gdb_test "pt 'a simple string'" "type = string"
+}
+
+proc test_logical_literal_types_accepted {} {
+ global gdb_prompt
+
+ # Test the only possible values for a logical, TRUE and FALSE.
+
+ gdb_test "pt TRUE" "type = bool"
+ gdb_test "pt FALSE" "type = bool"
+}
+
+proc test_float_literal_types_accepted {} {
+ global gdb_prompt
+
+ # Test various floating point formats
+
+ # this used to guess whether to look for "real*4" or
+ # "real*8" based on a target config variable, but noone
+ # maintained it properly.
+
+ gdb_test "pt .44" "type = double"
+ gdb_test "pt 44.0" "type = double"
+ gdb_test "pt 10e20" "type = double"
+ gdb_test "pt 10E20" "type = double"
+}
+
+# Start with a fresh gdb.
+
+gdb_exit
+gdb_start
+gdb_reinitialize_dir $srcdir/$subdir
+
+if [set_lang_pascal] then {
+ test_integer_literal_types_accepted
+ test_logical_literal_types_accepted
+ test_character_literal_types_accepted
+ test_string_literal_types_accepted
+ test_float_literal_types_accepted
+} else {
+ warning "$test_name tests suppressed." 0
+}
Index: gdb.pascal/hello/hello.pas
===================================================================
RCS file: gdb.pascal/hello/hello.pas
diff -N gdb.pascal/hello/hello.pas
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ gdb.pascal/hello/hello.pas 13 Apr 2007 14:51:54 -0000
@@ -0,0 +1,14 @@
+program hello;
+
+var
+ st : string;
+
+procedure print_hello;
+begin
+ st:='Hello, world!';
+ writeln(st);
+end;
+
+begin
+ print_hello;
+end.
Index: lib/pascal.exp
===================================================================
RCS file: lib/pascal.exp
diff -N lib/pascal.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ lib/pascal.exp 13 Apr 2007 14:51:55 -0000
@@ -0,0 +1,123 @@
+# Copyright 2007 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 2 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 this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+# USA.
+
+load_lib libgloss.exp
+
+set pascal_compiler_is_gpc 0
+set pascal_compiler_is_fpc 0
+set pascal_compiler ""
+set gpc_compiler "gpc"
+set fpc_compiler "fpc"
+set pascal_init_done 0
+proc pascal_init {} {
+ global pascal_init_done
+ global pascal_compiler_is_gpc
+ global pascal_compiler_is_fpc
+ global gpc_compiler
+ global fpc_compiler
+ global tool_root_dir
+
+ if { $pascal_init_done == 1 } {
+ exit;
+ }
+ if ![is_remote host] {
+ if { [which $gpc_compiler] != 0 } {
+ set pascal_compiler "$gpc_compiler";
+ set pascal_compiler_is_gpc 1;
+ verbose -log "GNU pascal compiler found";
+ }
+# } elseif { [which $fpc_compiler] != 0 } {
+ if { [which $fpc_compiler] != 0 } {
+ set pascal_compiler "$fpc_compiler";
+ set pascal_compiler_is_fpc 1;
+ verbose -log "Free Pascal pascal compiler found";
+ }
+ }
+ set pascal_init_done 1;
+ return $pascal_compiler
+}
+
+proc gpc_compile {source dest type options} {
+ global gpc_compiler
+ set add_flags "";
+ if {$type == "object"} {
+ append add_flags " -c"
+ }
+
+ if { $type == "preprocess" } {
+ append add_flags " -E"
+ }
+
+ if { $type == "assembly" } {
+ append add_flags " -S"
+ }
+
+ if { $options == "debug" } {
+ append add_flags " -g"
+ }
+
+ set result [remote_exec host $gpc_compiler "-o $dest --automake
$add_flags $source"];
+ return $result;
+}
+
+proc fpc_compile {source dest type options} {
+ global fpc_compiler
+ set add_flags "";
+ if {$type == "object"} {
+ append add_flags " -Cn"
+ }
+
+ if { $type == "preprocess" } {
+# There is no such option for Free Pascal
+# append add_flags " -E"
+ }
+
+ if { $type == "assembly" } {
+ append add_flags " -al"
+ }
+
+ if { $options == "debug" } {
+ append add_flags " -g"
+ }
+
+ set result [remote_exec host $fpc_compiler "-o$dest $add_flags
$source"];
+ return $result;
+}
+
+proc gdb_compile_pascal {source dest type options} {
+ global pascal_init_done
+ global pascal_compiler_is_gpc
+ global pascal_compiler_is_fpc
+
+ if { $pascal_init_done == 0 } {
+ pascal_init;
+ }
+ if { $pascal_compiler_is_fpc == 1 } {
+ set result [fpc_compile $source $dest $type $options]
+ } elseif { $pascal_compiler_is_gpc == 1 } {
+ set result [gpc_compile $source $dest $type $options]
+ } else {
+ unsupported "No pascal compiler found";
+ return "No pascal compiler. Compilation failed."
+ }
+
+ if ![file exists $dest] {
+ unsupported "Pascal compilation failed: $result"
+ return "Pascal compilation failed."
+ }
+}
+
