* gdb.ada/atomic_enum: New test program.

* gdb.ada/atomic_enum.exp: New testcase.
This commit is contained in:
Joel Brobecker 2008-04-19 01:35:49 +00:00
parent 9e3867569f
commit 9c1137add5
5 changed files with 133 additions and 0 deletions

View File

@ -1,3 +1,8 @@
2008-04-18 Joel Brobecker <brobecker@adacore.com>
* gdb.ada/atomic_enum: New test program.
* gdb.ada/atomic_enum.exp: New testcase.
2008-04-17 Doug Evans <dje@google.com>
* gdb.opt/Makefile.in: Fix whitespace.

View File

@ -0,0 +1,47 @@
# Copyright 2008 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 this program. If not, see <http://www.gnu.org/licenses/>.
if $tracelevel then {
strace $tracelevel
}
load_lib "ada.exp"
set testdir "atomic_enum"
set testfile "${testdir}/foo"
set srcfile ${srcdir}/${subdir}/${testfile}.adb
set binfile ${objdir}/${subdir}/${testfile}
file mkdir ${objdir}/${subdir}/${testdir}
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug additional_flags=-gnat05 ]] != "" } {
return -1
}
gdb_exit
gdb_start
gdb_reinitialize_dir $srcdir/$subdir
gdb_load ${binfile}
set test "ptype pck.data_flag"
gdb_test_multiple "$test" $test {
-re "type = \\(one, two, three\\).*$gdb_prompt $" {
pass $test
}
-re "type = \\(\\).*$gdb_prompt $" {
# This is a known compiler problem with Stabs.
xfail $test
}
}

View File

@ -0,0 +1,23 @@
-- Copyright 2008 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 this program. If not, see <http://www.gnu.org/licenses/>.
with Pck; use Pck;
procedure Foo is
begin
if Is_First then
Increment;
end if;
end Foo;

View File

@ -0,0 +1,37 @@
-- Copyright 2008 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 this program. If not, see <http://www.gnu.org/licenses/>.
package body Pck is
type Data_T is (One, Two, Three);
pragma Atomic (Data_T);
Data_Flag : Data_T := One;
procedure Increment is
begin
if Data_Flag = Data_T'Last then
Data_Flag := Data_T'First;
else
Data_Flag := Data_T'Succ (Data_Flag);
end if;
end Increment;
function Is_First return Boolean is
begin
return Data_Flag = Data_T'First;
end Is_First;
end Pck;

View File

@ -0,0 +1,21 @@
-- Copyright 2008 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 this program. If not, see <http://www.gnu.org/licenses/>.
package Pck is
procedure Increment;
function Is_First return Boolean;
end Pck;