diff mbox series

[Ada] Resolution of set membersip operations with overloaded alternatives

Message ID 20170906094758.GA111188@adacore.com
State New
Headers show
Series [Ada] Resolution of set membersip operations with overloaded alternatives | expand

Commit Message

Arnaud Charlet Sept. 6, 2017, 9:47 a.m. UTC
This patch fixes a bug in the resolution of set membership operations when
the expression and/or the alternatives on the right-hand side are overloaded.
If a given overloaded alternative is resolved to a unique type by intersection
with the types of previous alternatives, the type is used subsequently to
resolve the expression itself. If the alternative is an enumeration literal,
it must be replaced by the literal correspoding to the selected interpretation,
because subsequent resolution will not replace the entity itself.

The following must compile and run quietly:

gnatmake -q -gnatws c45
c45

---
with Text_IO; use Text_IO;
procedure C45 is
   procedure Failed (Msg : String) is
   begin
      Put_Line (Msg);
   end;

   type Month is (Jan, Feb, Mar, Apr, May, Jun, Jul, Aug, Sep, Oct, Nov, Dec);
   type Radix is (Bin, Oct, Dec, Hex);
   type Shape is (Tri, Sqr, Pnt, Hex, Oct);
      -- Oct is defined for all three types; Dec for all but Shape; and Hex for
      -- all but Month.

   -- Three identical functions, one for each type. These provide no
   -- overloading information at all.
   function Item return Month is
   begin
      return Aug;
   end Item;

   function Item return Radix is
   begin
      return Dec;
   end Item;

   function Item return Shape is
   begin
      return Hex;
   end Item;


begin

   -- No overloading in the choices:
   if Item in Jan .. Mar then -- type Month
      Failed ("Wrong result - no choice overloading (1)");
   end if;

   if Item in Tri | Sqr | Pnt then -- type Radix
      Failed ("Wrong result - no choice overloading (2)");
   end if;

   -- A single overloaded choice:
   if Item not in May .. Oct then -- type Month
      Failed ("Wrong result - single overloaded choice (3)");
   end if;

   if Item not in Bin | Dec then -- type Radix
      Failed ("Wrong result - single overloaded choice (4)");
   end if;

   if Item not in Tri | Sqr | Hex then -- type Shape
      Failed ("Wrong result - single overloaded choice (5)");
   end if;

   -- At least one choice without overloading:
   if Item in Jan | Oct .. Dec then -- type Month
      Failed ("Wrong result - a non-overloaded choice (6)");
   end if;

   if Item not in Oct .. Hex | Bin then -- type Radix
      Failed ("Wrong result - a non-overloaded choice (7)");
   end if;

   if Item not in Oct | Sqr | Hex then -- type Shape
      Failed ("Wrong result - a non-overloaded choice (8)");
   end if;

   if Item not in Oct | Sqr | Hex | Tri then -- type Shape
      Failed ("Wrong result - a non-overloaded choice (9)");
   end if;

   if Item not in Dec | Hex | Oct | Bin then -- type Radix
      Failed ("Wrong result - a non-overloaded choice (10");
   end if;

   -- The ultimate: everything is overloaded, but there still is only
   -- one possible solution.
   if Item not in Oct | Dec | Hex then -- type Radix
      Failed ("Wrong result - everything overloaded (11)");
   end if;

end C45;

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

2017-09-06  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch4.adb (Analyze_Set_Membership):  If an alternative
	in a set membership is an overloaded enumeration literal, and
	the type of the alternative is resolved from a previous one,
	replace the entity of the alternative as well as the type,
	to prevent inconsistencies between the entity and the type.
diff mbox series

Patch

Index: sem_ch4.adb
===================================================================
--- sem_ch4.adb	(revision 251753)
+++ sem_ch4.adb	(working copy)
@@ -2935,11 +2935,20 @@ 
                   --  for all of them.
 
                   Set_Etype (Alt, It.Typ);
+
+                  --  If the alternative is an enumeration literal, use
+                  --  the one for this interpretation.
+
+                  if Is_Entity_Name (Alt) then
+                     Set_Entity (Alt, It.Nam);
+                  end if;
+
                   Get_Next_Interp (Index, It);
 
                   if No (It.Typ) then
                      Set_Is_Overloaded (Alt, False);
                      Common_Type := Etype (Alt);
+
                   end if;
 
                   Candidate_Interps := Alt;