[Ada] Constraint_Error on spurious ambiguity in instance

[Arnaud Charlet <charlet at adacore dot com>]

This match modifies the processing of generics to aid overload resolution of
binary and unary operators in instances. This is achieved by installing type
conversions in the form of qualified expressions for each operand that yields
a universal type.

------------
-- Source --
------------

--  px.ads

package PX is
   pragma Pure;
   Min_Integer : constant := -2**31;
   Max_Integer : constant := 2**31 - 1;

   subtype Integer_T is Integer   range Min_Integer .. Max_Integer;
   subtype Natural_T is Integer_T range 0 .. Integer_T'last;
   subtype String_T  is String;
end PX;

--  pg.ads

with PX;

generic
   type Element_T is (<>);
   type Index_T is (<>);
   type String_T is array (Index_T range <>) of Element_T;
   Blank_Element : in Element_T;

package PG is
   function Left_Piece
     (Str           : in String_T;
      Size          : in PX.Natural_T;
      Pad_Character : in Element_T := Blank_Element) return String_T;
end PG;

--  pg.adb

package body PG is
   subtype Null_String_T is String_T (Index_T'Last .. Index_T'First);
   Null_String : constant Null_String_T := (others => Element_T'First);

   function "+" (L : in PX.Integer_T; R : in Index_T     ) return Index_T;
   function "+" (L : in Index_T;      R : in PX.Integer_T) return Index_T; 
   function "-" (L : in Index_T;      R : in PX.Integer_T) return Index_T;

   function "+" (L : in PX.Integer_T; R : in Index_T) return Index_T is
   begin
      return Index_T'Val (L + Index_T'Pos(R));
   end "+";

   function "+" (L : in Index_T; R : in PX.Integer_T) return Index_T is
   begin
      return Index_T'Val (Index_T'Pos (L) + R);
   end "+";

   function "-" (L : in Index_T; R : in PX.Integer_T) return Index_T is
   begin
      return Index_T'Val (Index_T'Pos (L) - R);
   end "-";

   function Left_Piece
     (Str           : in String_T;
      Size          : in PX.Natural_T;
      Pad_Character : in Element_T := Blank_Element) return String_T
   is
   begin
      if Size > 0 then
         declare
            Result : String_T (Index_T'First .. Index_T'First + Size - 1);

         begin
            if Size < Str'Length then
               Result := Str (Str'First .. Str'First + Size - 1);

            elsif Size = Str'Length then
               Result := Str;

            else
               if Str'Length > 0 then
                  Result (Result'First .. Result'First + Str'Length - 1) :=
                    Str;
               end if;

               Result (Result'First + Str'Length .. Result'Last) :=
                 (others => Pad_Character);
            end if;

            return Result;
         end;

      else
         return Null_String;
      end if;
   end Left_Piece;
end PG;

--  nullstr.adb

with Ada.Text_IO; use Ada.Text_IO;
with PG;

procedure Nullstr is
   package PPG is new PG
     (Element_T     => Character,
      Index_T       => Positive,
      String_T      => String,
      Blank_Element => '$');

begin
   Put_Line (PPG.Left_Piece ("abcdef", 6));
   Put_Line (PPG.Left_Piece ("abcde", 6));
   Put_Line (PPG.Left_Piece ("", 6));
end Nullstr;

----------------------------
-- Compilation and output --
----------------------------

$ gnatmake -q nullstr.adb
$ ./nullstr
abcdef
abcde$
$$$$$$

Tested on x86_64-pc-linux-gnu, committed on trunk

2016-04-20  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_ch12.adb (Qualify_Universal_Operands): New routine.
	(Save_References_In_Operator): Add explicit qualifications in
	the generic template for all operands of universal type.
	* sem_type.adb (Disambiguate): Update the call to Matches.
	(Matches): Reimplemented.
	* sem_util.ads, sem_util.adb (Yields_Universal_Type): New routine.

Attachment: difs
Description: Text document