[Ada] Fix restriction No_Enumeration_Maps on both Image attributes

Message ID 20210506075812.GA125537@adacore.com
State New
Headers show
Series
  • [Ada] Fix restriction No_Enumeration_Maps on both Image attributes
Related show

Commit Message

Pierre-Marie de Rodat May 6, 2021, 7:58 a.m.
Restriction No_Enumeration_Maps was only checked on Value attribute (and
its Wide and Wide_Wide variants). Now it is checked also on Img, Image
and its Wide and Wide_Wide variants, just like described in the GNAT RM.

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

gcc/ada/

	* sem_attr.adb (Check_Enum_Image): Reword comment; add
	Check_Enumeration_Maps parameter.  Now this routine combines
	both referencing enumeration literals and checking restriction
	No_Enumeration_Maps, if required.
	(Analyze_Attribute): Remove duplicated code and instead call
	Check_Enum_Image.

Patch

diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -318,14 +318,20 @@  package body Sem_Attr is
       procedure Check_E2;
       --  Check that two attribute arguments are present
 
-      procedure Check_Enum_Image;
-      --  If the prefix type of 'Image is an enumeration type, set all its
-      --  literals as referenced, since the image function could possibly end
-      --  up referencing any of the literals indirectly. Same for Enum_Val.
-      --  Set the flag only if the reference is in the main code unit. Same
-      --  restriction when resolving 'Value; otherwise an improperly set
-      --  reference when analyzing an inlined body will lose a proper
-      --  warning on a useless with_clause.
+      procedure Check_Enum_Image (Check_Enumeration_Maps : Boolean := False);
+      --  Common processing for the Image and Value family of attributes,
+      --  including their Wide and Wide_Wide versions, Enum_Val and Img.
+      --
+      --  If the prefix type of an attribute is an enumeration type, set all
+      --  its literals as referenced, since the attribute function can
+      --  indirectly reference any of the literals. Set the referenced flag
+      --  only if the attribute is in the main code unit; otherwise an
+      --  improperly set reference when analyzing an inlined body will lose a
+      --  proper warning on a useless with_clause.
+      --
+      --  If Check_Enumeration_Maps is True, then the attribute expansion
+      --  requires enumeration maps, so check whether restriction
+      --  No_Enumeration_Maps is active.
 
       procedure Check_First_Last_Valid;
       --  Perform all checks for First_Valid and Last_Valid attributes
@@ -1527,7 +1533,7 @@  package body Sem_Attr is
             Validate_Non_Static_Attribute_Function_Call;
          end if;
 
-         Check_Enum_Image;
+         Check_Enum_Image (Check_Enumeration_Maps => True);
 
          --  Check restriction No_Fixed_IO. Note the check of Comes_From_Source
          --  to avoid giving a duplicate message for when Image attributes
@@ -1962,10 +1968,22 @@  package body Sem_Attr is
       -- Check_Enum_Image --
       ----------------------
 
-      procedure Check_Enum_Image is
+      procedure Check_Enum_Image (Check_Enumeration_Maps : Boolean := False) is
          Lit : Entity_Id;
 
       begin
+         --  Ensure that Check_Enumeration_Maps parameter is set precisely for
+         --  attributes whose implementation requires enumeration maps.
+
+         pragma Assert
+           (Check_Enumeration_Maps = (Attr_Id in Attribute_Image
+                                               | Attribute_Img
+                                               | Attribute_Value
+                                               | Attribute_Wide_Image
+                                               | Attribute_Wide_Value
+                                               | Attribute_Wide_Wide_Image
+                                               | Attribute_Wide_Wide_Value));
+
          --  When an enumeration type appears in an attribute reference, all
          --  literals of the type are marked as referenced. This must only be
          --  done if the attribute reference appears in the current source.
@@ -1975,6 +1993,10 @@  package body Sem_Attr is
          if Is_Enumeration_Type (P_Base_Type)
            and then In_Extended_Main_Code_Unit (N)
          then
+            if Check_Enumeration_Maps then
+               Check_Restriction (No_Enumeration_Maps, N);
+            end if;
+
             Lit := First_Literal (P_Base_Type);
             while Present (Lit) loop
                Set_Referenced (Lit);
@@ -7116,33 +7138,7 @@  package body Sem_Attr is
       =>
          Check_E1;
          Check_Scalar_Type;
-
-         --  Case of enumeration type
-
-         --  When an enumeration type appears in an attribute reference, all
-         --  literals of the type are marked as referenced. This must only be
-         --  done if the attribute reference appears in the current source.
-         --  Otherwise the information on references may differ between a
-         --  normal compilation and one that performs inlining.
-
-         if Is_Enumeration_Type (P_Type)
-           and then In_Extended_Main_Code_Unit (N)
-         then
-            Check_Restriction (No_Enumeration_Maps, N);
-
-            --  Mark all enumeration literals as referenced, since the use of
-            --  the Value attribute can implicitly reference any of the
-            --  literals of the enumeration base type.
-
-            declare
-               Ent : Entity_Id := First_Literal (P_Base_Type);
-            begin
-               while Present (Ent) loop
-                  Set_Referenced (Ent);
-                  Next_Literal (Ent);
-               end loop;
-            end;
-         end if;
+         Check_Enum_Image (Check_Enumeration_Maps => True);
 
          --  Set Etype before resolving expression because expansion of
          --  expression may require enclosing type. Note that the type