This is the mail archive of the gcc-bugs@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[Bug tree-optimization/30911] VRP fails to eliminate range checks in Ada code



------- Comment #1 from baldrick at gcc dot gnu dot org  2007-02-21 15:17 -------
I've tried and failed to attach the source code (bugzilla problem), so here it
is inline (you can extract it using gnatchop):

with Join_Equal;
with JS;
procedure J is new Join_Equal (
  Source_Type => JS.S,
  Equal       => JS.E,
  Target_Type => JS.T,
  Move        => JS.M
);

package JS is
   type S is range 0 .. 100;
   type T is range 10 .. 20;
   function E (L, R : S) return Boolean;
   procedure M (
     First, Last : S;
     Destination : T
   );
end JS;

generic
   type Source_Type is (<>);
   with function Equal (Left, Right : Source_Type) return Boolean;
   type Target_Type is (<>);
   with procedure Move (
     First, Last : Source_Type;
     Destination : Target_Type
   );
procedure Join_Equal (
  Source_First : in     Source_Type;
  Source_Last  : in out Source_Type; -- returns last read
  Target_First : in     Target_Type;
  Target_Last  :    out Target_Type  -- returns last written
);
pragma Pure (Join_Equal);

procedure Join_Equal (
  Source_First : in     Source_Type;
  Source_Last  : in out Source_Type;
  Target_First : in     Target_Type;
  Target_Last  :    out Target_Type
) is
   Source : Source_Type := Source_First;
   Target : Target_Type := Target_First;
begin
   if Source_Last < Source_First then
      if Target_First = Target_Type'First then
         raise Constraint_Error;
      end if;
      Target_Last := Target_Type'Pred (Target_First);
      return;
   end if;
   loop
      declare
         Start : constant Source_Type := Source;
         Prev  : Source_Type := Source;
      begin
         loop
            if Source = Source_Last then
               Move (Start, Source, Target);
               Target_Last := Target;
               return;
            end if;
            Source := Source_Type'Succ (Source);
            exit when not Equal (Prev, Source);
            Prev := Source;
         end loop;
         Move (Start, Prev, Target);
         if Target = Target_Type'Last then
            Source_Last := Prev;
            Target_Last := Target;
            return;
         end if;
         Target := Target_Type'Succ (Target);
      end;
   end loop;
end Join_Equal;


-- 


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=30911


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]