I've added the bug box and the code below. This code compiled fine with previous versions of GNAT, and with -O2 or without -gnatVa. gcc-4.1 -c -I./ -gnatVa -O3 iterate_moves.adb +===========================GNAT BUG DETECTED==============================+ | 4.1.2 20061028 (prerelease) (Debian 4.1.1-19) (x86_64-pc-linux-gnu) GCC error:| | in simplify_cond_and_lookup_avail_expr, at tree-ssa-dom.c:2111 | | Error detected at iterate_moves.adb:147:1 | | 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-4.1 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. iterate_moves.adb iterate_moves.ads board_types.ads iterate_moves-next_piece.adb raised TYPES.UNRECOVERABLE_ERROR : comperr.adb:380 with Interfaces; -- Board_Types contains all the fundamental types representing the game. package Board_Types is -- Board_Types is and should continue to be conceptually pure. No -- global data or state. pragma Pure (Board_Types); type Board_Layer_Type is (Upper, Middle, Lower); type Piece_Type is (Sylph, Griffon, Dragon, King, Mage, Paladin, Thief, Cleric, Hero, Unicorn, Oliphant, Warrior, Dwarf, Basilisk, Elemental); type Player_Type is (Scarlet, Gold); type Board_Piece (Exists : Boolean := False) is record case Exists is when True => Piece : Piece_Type; Player : Player_Type; when False => null; end case; end record; type Row_Type is range 1 .. 8; type Column_Type is range 1 .. 12; type Board_Layer is array (Row_Type, Column_Type) of Board_Piece; type Board is array (Board_Layer_Type) of Board_Layer; type Board_Location is record Layer : Board_Layer_Type; Row : Row_Type; Column : Column_Type; end record; Initial_Board : constant Board := (others => (others => (others => (Exists => False)))); -- Helper functions function "not" (P : Player_Type) return Player_Type; pragma Inline ("not"); end Board_Types; -- with Validate; use Validate; package body Iterate_Moves is function Next_Piece (C: Player_Type; Piece: Board_Location; B : Board) return Board_Location is separate; subtype Int is Integer; -- Pawn_Advance/Retreat is to avoid having two type conversions -- all over the place. They should be completely inlined. function Pawn_Advance (R : Row_Type; C : Player_Type) return Row_Type is begin if C = Scarlet then return R - 1; else return R + 1; end if; end Pawn_Advance; pragma Inline (Pawn_Advance); function Pawn_Retreat (R : Row_Type; C : Player_Type) return Row_Type is begin if C = Scarlet then return R + 1; else return R - 1; end if; end Pawn_Retreat; pragma Inline (Pawn_Retreat); function Increment (C : Player_Type; I : Board_Move; B : Board) return Board_Move; function Inc (C : Player_Type; Start : Board_Location; B :Board) return Board_Move is begin return Increment (C, (Next_Piece (C, Start, B), (Upper, 1, 1), Increment, 0), B); end Inc; pragma Inline (Inc); function Sylph_Increment (C : Player_Type; Start : Board_Location; Move_Number_In : Natural; B : Board) return Board_Move is Move_Number : Natural := Move_Number_In; Orig_Row : Row_Type; begin if (Start.Layer = Upper and Move_Number > 4) or (Start.Layer = Middle and Move_Number > 7) then return Inc (C, Start, B); end if; case Start.Layer is when Upper => loop case Move_Number is when others => raise Program_Error; end case; end loop; when Middle => if C = Scarlet then Orig_Row := 7; else Orig_Row := 2; end if; loop case Move_Number is when 1 => if not B (Upper) (Start.Row, Start.Column).Exists then return (Start, (Upper, Start.Row, Start.Column), True_Move, Move_Number); else Move_Number := 2; end if; when 2 .. 6 => if not B (Upper) (Orig_Row, Column_Type (Move_Number * 2 - 3)).Exists and not (Orig_Row = Start.Row and Column_Type (Move_Number * 2 - 3) = Start.Column) then return (Start, (Upper, Orig_Row, Column_Type (Move_Number * 2 - 3)), True_Move, Move_Number); else Move_Number := Move_Number + 1; end if; when 7 => -- 7 * 2 - 3 = 11 if not B (Upper) (Orig_Row, 11).Exists and not (Orig_Row = Start.Row and 11 = Start.Column) then return (Start, (Upper, Orig_Row, 11), True_Move, Move_Number); else return Inc (C, Start, B); end if; when others => raise Program_Error; end case; end loop; when Lower => -- Shouldn't reach here if assertions are turned on raise Program_Error; end case; end Sylph_Increment; function Increment (C : Player_Type; I : Board_Move; B : Board) return Board_Move is Start : Board_Location renames I.Start_Loc; Move_Number : Natural := I.Move_Number; begin case B (Start.Layer) (Start.Row, Start.Column).Piece is when Sylph => return Sylph_Increment (C, Start, Move_Number, B); when others => raise Program_Error; end case; end Increment; function Next_Move (C: Player_Type; I: Board_Move; B: Board) return Board_Move is J : Board_Move := I; begin loop J := Increment (C, J, B); if not (B (J.End_Loc.Layer) (J.End_Loc.Row, J.End_Loc.Column).Exists and then B (J.End_Loc.Layer) (J.End_Loc.Row, J.End_Loc.Column).Player = C) then return J; end if; end loop; end Next_Move; end Iterate_Moves; with Board_Types; use Board_Types; package Iterate_Moves is pragma Pure (Iterate_Moves); type Board_Move is private; function Next_Move (C: Player_Type; I: Board_Move; B: Board) return Board_Move; No_Next_Move: exception; private type Board_Move_Type is (Forged, Initial, Increment, True_Move); type Board_Move is record Start_Loc : Board_Location; End_Loc : Board_Location; Move_Type : Board_Move_Type; Move_Number : Natural; end record; end Iterate_Moves; separate (Iterate_Moves) function Next_Piece (C: Player_Type; Piece: Board_Location; B : Board) return Board_Location is pragma Suppress (All_Checks); S : Board_Location := Piece; begin while (S.Column /= Column_Type'Last) loop S.Column := S.Column + 1; if B (S.Layer) (S.Row, S.Column).Exists and then B (S.Layer) (S.Row, S.Column).Player = C then return S; end if; end loop; loop if S.Row = Row_Type'Last then if S.Layer = Lower then raise No_Next_Move; elsif S.Layer = Middle then S := (Lower, 1, 1); else S := (Middle, 1, 1); end if; else S.Row := S.Row + 1; S.Column := 1; end if; for Column in Column_Type'Range loop if B (S.Layer) (S.Row, Column).Exists and then B (S.Layer) (S.Row, Column).Player = C then S.Column := Column; return S; end if; end loop; end loop; end Next_Piece;
Confirmed on 4.1.1, 4.1.2 and 4.0.3: $ gcc -c -O3 -gnatVa iterate_moves.adb +===========================GNAT BUG DETECTED==============================+ | 4.1.1 (x86_64-unknown-linux-gnu) GCC error: | | in simplify_cond_and_lookup_avail_expr, at tree-ssa-dom.c:2111 | $ gcc -c -O3 -gnatVa iterate_moves.adb +===========================GNAT BUG DETECTED==============================+ | 4.1.2 20060928 (prerelease) (Ubuntu 4.1.1-15ubuntu1) (x86_64-pc-linux-gnu) GCC error:| | in simplify_cond_and_lookup_avail_expr, at tree-ssa-dom.c:2111 | $ gcc -c -O3 -gnatVa iterate_moves.adb +===========================GNAT BUG DETECTED==============================+ | 4.0.3 (x86_64-unknown-linux-gnu) GCC error: | | in simplify_cond_and_lookup_avail_expr, at tree-ssa-dom.c:2119 | I don't have earlier versions handy, with what version did it work? But this compiles fine on 4.2.0 20061102 (prerelease) and 4.3.0 20061102 (experimental).
So closing as fixed in 4.2.0