Bug 29781 - -O3 -gnatVa triggers a bug box on working Dragonchess code
Summary: -O3 -gnatVa triggers a bug box on working Dragonchess code
Status: RESOLVED FIXED
Alias: None
Product: gcc
Classification: Unclassified
Component: tree-optimization (show other bugs)
Version: 4.1.2
: P3 normal
Target Milestone: 4.2.0
Assignee: Not yet assigned to anyone
URL:
Keywords: ice-on-valid-code
Depends on:
Blocks:
 
Reported: 2006-11-09 14:05 UTC by David Starner
Modified: 2006-11-11 10:35 UTC (History)
2 users (show)

See Also:
Host: x86_64-pc-linux-gnu
Target: x86_64-pc-linux-gnu
Build: x86_64-pc-linux-gnu
Known to work:
Known to fail:
Last reconfirmed: 2006-11-10 19:21:45


Attachments

Note You need to log in before you can comment on or make changes to this bug.
Description David Starner 2006-11-09 14:05:57 UTC
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;
Comment 1 Laurent GUERBY 2006-11-10 19:21:45 UTC
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).
Comment 2 Arnaud Charlet 2006-11-11 10:35:34 UTC
So closing as fixed in 4.2.0