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 <schonb...@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.
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;