gnatmake -c -u -P/home/voax/gps-prj/ada-2005/bugs/assert_failure.gpr
bugs_test.adb -d
gcc -c -gnat05 -I- -gnatA /home/voax/gps-prj/ada-2005/bugs/bugs_test.adb
+===========================GNAT BUG DETECTED==============================+
| 4.1.0 20060106 (prerelease) (i686-pc-linux-gnu) Assert_Failure einfo.adb:507|
| Error detected at bugs_test.adb:23:9 |
| Please submit a bug report; see http://gcc.gnu.org/bugs.html. |
| Use a subject line meaningful to you and us to track the bug. |
| Include the entire contents of this bug box in the report. |
| Include the exact gcc or gnatmake command that you entered. |
| Also include sources listed below in gnatchop format |
| (concatenated together with no headers between files). |
+==========================================================================+
Please include these source files with error report
Note that list may not be accurate in some cases,
so please double check that the problem can still
be reproduced with the set of files listed.
/home/voax/gps-prj/ada-2005/bugs/bugs_test.adb
/home/voax/gps-prj/ada-2005/bugs/implementing_interface.ads
/home/voax/gps-prj/ada-2005/bugs/abstract_interface.ads
compilation abandoned
gnatmake: "/home/voax/gps-prj/ada-2005/bugs/bugs_test.adb" compilation error
process exited with status 4
Here are the source files shown above
package Abstract_Interface is
type Base is interface;
-- type Task_Base is task interface;
type Mutex is task interface;
procedure Wait (Object : in out Mutex) is abstract;
procedure Signal (Object : in out Mutex) is abstract;
-- type Protected_Base is protected interface;
type Buffer is protected interface;
procedure Put (Object : in out Buffer;
Data : in Integer) is abstract;
procedure Get (Object : in out Buffer;
Data : out Integer) is abstract;
-- type Synchronized_Base is synchronized interface;
type Event is synchronized interface;
procedure Wait (Object : in out Event) is abstract;
procedure Signal (Object : in out Event) is abstract;
end Abstract_Interface;
with Abstract_Interface;
package Implementing_Interface is
type Storage_Type is array (Integer range <>) of Integer;
task Gary_Left is new Abstract_Interface.Mutex with
entry Wait;
entry Signal;
entry Shutdown;
end Gary_Left;
task Gary_Right is new Abstract_Interface.Mutex with
entry Wait;
entry Signal;
entry Shutdown;
end Gary_Right;
protected type Anh_Left is new Abstract_Interface.Buffer with
Procedure Put (Data : in Integer);
entry Get (Data : out Integer);
private
Data_Storage : Storage_Type (1 .. 10);
Size : Integer := 0;
In_Index : Positive := 1;
Out_Index : Positive := 1;
end Anh_Left;
protected type Anh_Right is new Abstract_Interface.Buffer with
Procedure Put (Data : in Integer);
entry Get (Data : out Integer);
private
Data_Storage : Storage_Type (1 .. 10);
Size : Integer := 0;
In_Index : Positive := 1;
Out_Index : Positive := 1;
end Anh_Right;
task type Brian_Left is new Abstract_Interface.Event with
entry Wait;
entry Signal;
end Brian_Left;
task type Brian_Right is new Abstract_Interface.Event with
entry Wait;
entry Signal;
end Brian_Right;
use Abstract_Interface;
procedure Serialized_Code (Obj : in out Mutex'Class);
procedure Consumer (Obj : in out Buffer'Class);
procedure Producer (Obj : in out Buffer'Class;
Data : in Integer);
procedure Serialized_Code (Obj : in out Event'Class);
end Implementing_Interface;
with Ada.Text_Io;
package body Implementing_Interface is
use Ada;
use Text_Io;
task body Gary_Left is
begin
Put_Line ("Task Gary_Left start executes");
loop
select
accept Wait do
Put_Line ("task Gary_Left Wait for some one");
end Wait;
or
accept Signal do
Put_Line ("task Gary_Left Notifies some one");
end Signal;
or
accept Shutdown;
exit;
end select;
end loop;
Put_Line ("task Gary_Left says goodbye");
end Gary_Left;
task body Gary_Right is
begin
Put_Line ("Task Gary_Right start executes");
loop
select
accept Wait do
Put_Line ("Wait for some one");
end Wait;
accept Signal do
Put_Line ("Notify some one");
end Signal;
else
select
accept Shutdown;
exit;
or
delay 1.0;
end select;
end select;
end loop;
Put_Line ("Task Gary_Right terminates");
end Gary_Right;
protected body Anh_Left is
Procedure Put (Data : in Integer) is
begin
Put_Line ("Put data in buffer");
Data_Storage (In_Index) := Data;
In_Index := In_Index mod Data_Storage'Length + 1;
Size := Size + 1;
end Put;
entry Get (Data : out Integer) when Size > 0 is
begin
Put_Line ("Extract data");
Data := Data_Storage (Out_Index);
Out_Index := Out_Index mod Data_Storage'Length + 1;
Size := Size - 1;
end Get;
end Anh_Left;
protected body Anh_Right is
Procedure Put (Data : in Integer) is
begin
Put_Line ("Put data in buffer");
Data_Storage (In_Index) := Data;
In_Index := In_Index mod Data_Storage'Length + 1;
Size := Size + 1;
end Put;
entry Get (Data : out Integer) when Size > 0 is
begin
Put_Line ("Extract data");
Data := Data_Storage (Out_Index);
Out_Index := Out_Index mod Data_Storage'Length + 1;
Size := Size - 1;
end Get;
end Anh_Right;
task body Brian_Left is
begin
loop
accept Wait do
Put_Line ("Wait for some one");
end Wait;
accept Signal do
Put_Line ("Notify some one");
end Signal;
end loop;
end Brian_Left;
task body Brian_Right is
begin
loop
accept Wait do
Put_Line ("Wait for some one");
end Wait;
accept Signal do
Put_Line ("Notify some one");
end Signal;
end loop;
end Brian_Right;
procedure Serialized_Code (Obj : in out Mutex'Class) is
begin
Obj.Wait;
Put_Line ("Modifying data while protected by Mutex");
Obj.Signal;
end Serialized_Code;
procedure Consumer (Obj : in out Buffer'Class) is
Data : Integer := -1;
begin
Obj.Get (Data);
Put_Line ("Data is extracted");
end Consumer;
procedure Producer (Obj : in out Buffer'Class;
Data : in Integer) is
begin
Obj.Put (Data);
Put_Line ("Data is put in the buffer");
end Producer;
procedure Serialized_Code (Obj : in out Event'Class) is
begin
Obj.Wait;
Put_Line ("Consume event notification by Event");
Obj.Signal;
end Serialized_Code;
end Implementing_Interface;
with Gnat.OS_Lib;
with Ada.Exceptions;
with Ada.Text_Io;
with Implementing_Interface;
procedure Bugs_Test is
use Ada;
use Text_Io;
begin
Put_Line ("Minimum codes used to demonstrate the Assert_Failure");
--$$$ Causing Assert_Failure (einfo.adb:507) in gnatgcc-4.1.0 and
gccgnat-4.2.0
declare
use Implementing_Interface;
begin
Serialized_Code (Gary_Left); -- Error occurs here
Gary_Left.Shutdown;
delay 2.0;
Serialized_Code (Gary_Right);
Gary_Right.Shutdown;
end;
-- Terminate all child tasks if they are still around
Gnat.OS_Lib.OS_Exit(0);
exception
when Error : others =>
Put_Line ("Show stopper ==> " & Exceptions.Exception_Information
(Error));
-- Terminate all child tasks if they still exist
Gnat.OS_Lib.OS_Exit(0);
end Bugs_Test;
project Assert_Failure is
for Main use ("bugs_test.adb");
package Pretty_Printer is
for Default_Switches ("ada") use ("-A4");
end Pretty_Printer;
package Compiler is
for Default_Switches ("ada") use ("-gnat05");
end Compiler;
end Assert_Failure;
--
Summary: Assert Failure with Bug Box
Product: gcc
Version: 4.1.0
Status: UNCONFIRMED
Severity: normal
Priority: P3
Component: ada
AssignedTo: unassigned at gcc dot gnu dot org
ReportedBy: anhvofrcaus at gmail dot com
GCC build triplet: 4.1.0 20060106 (prerelease) (i686-pc-linux-gnu)
GCC host triplet: Red Hat Linux 9.0 on i686
GCC target triplet: i686
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=25838
