Patchwork [Ada] Fix missed cases for No_Wide_Characters restriction

login
register
mail settings
Submitter Arnaud Charlet
Date Sept. 9, 2010, 9:35 a.m.
Message ID <20100909093525.GA23732@adacore.com>
Download mbox | patch
Permalink /patch/64265/
State New
Headers show

Comments

Arnaud Charlet - Sept. 9, 2010, 9:35 a.m.
This patch fixes a number of missed checks for the No_Wide_Characters
restriction. The following comprehensive test case now gets properly
flagged on every expected line:


Compiling: no_wide_characters.adb

     1. pragma Restrictions (No_Wide_Characters);
     2. procedure No_Wide_Characters is
     3.    W_Char_1   : Wide_Character := 'a';             --  FLAG
                        |
        >>> violation of restriction "No_Wide_Characters" at line 1

     4.    W_String_1 : Wide_String := "a";                --  FLAG
                        |
        >>> violation of restriction "No_Wide_Characters" at line 1

     5.
     6.    subtype My_Wide_Character is Wide_Character;    --  FLAG
                                        |
        >>> violation of restriction "No_Wide_Characters" at line 1

     7.    subtype My_Wide_String is Wide_String (1 .. 5); --  FLAG
                                     |
        >>> violation of restriction "No_Wide_Characters" at line 1

     8.
     9.    W_Char_2   : My_Wide_Character := 'a';          --  FLAG
                        |
        >>> violation of restriction "No_Wide_Characters" at line 1

    10.    W_String_2 : My_Wide_String := "12345";         --  FLAG
                        |
        >>> violation of restriction "No_Wide_Characters" at line 1

    11.
    12.    type My_Array_1
    13.      is array (Wide_Character'First ..             --  FLAG
                       |
        >>> violation of restriction "No_Wide_Characters" at line 1

    14.                Wide_Character'Last) of Integer;    --  FLAG
                       |
        >>> violation of restriction "No_Wide_Characters" at line 1

    15.
    16.    procedure Proc
    17.      (W_Ch  : Standard.Wide_Character;             --  FLAG
                              |
        >>> violation of restriction "No_Wide_Characters" at line 1

    18.       W_Str : Wide_String)                         --  FLAG
                      |
        >>> violation of restriction "No_Wide_Characters" at line 1

    19.    is
    20.    begin
    21.       null;
    22.    end;
    23.
    24.    function Fun_W_Ch
    25.      (Ch   : Character)
    26.       return Standard.Wide_Character               --  FLAG
                             |
        >>> violation of restriction "No_Wide_Characters" at line 1

    27.    is
    28.    begin
    29.       return '["1234"]';                           --  FLAG
                     |
        >>> violation of restriction "No_Wide_Characters" at line 1

    30.    end;
    31.
    32.    function Fun_W_Str
    33.      (Str  : String)
    34.       return Wide_String                           --  FLAG
                     |
        >>> violation of restriction "No_Wide_Characters" at line 1

    35.    is
    36.    begin
    37.       return "["1234"]";                           --  FLAG
                     |
        >>> violation of restriction "No_Wide_Characters" at line 1

    38.    end;
    39.
    40.    type R is ('a', '["1234"]');                    --  FLAG
                           |
        >>> violation of restriction "No_Wide_Characters" at line 1

    41.
    42. begin
    43.       null;
    44. end No_Wide_Characters;

 44 lines: 15 errors

As a side effect the list of possible restrictions now accurately
includes No_Wide_Characters if and only if this is correct.

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

2010-09-09  Robert Dewar  <dewar@adacore.com>

	* restrict.ads, restrict.adb (Check_Wide_Character_Restriction): New
	procedure.
	* sem_ch3.adb: Use Check_Wide_Character_Restriction
	(Enumeration_Type_Declaration): Check violation of No_Wide_Characters
	* sem_ch8.adb (Find_Direct_Name): Check violation of No_Wide_Characters
	(Find_Expanded_Name): Check violation of No_Wide_Characters

Patch

Index: sem_ch3.adb
===================================================================
--- sem_ch3.adb	(revision 164000)
+++ sem_ch3.adb	(working copy)
@@ -2960,13 +2960,7 @@  package body Sem_Ch3 is
 
       --  Check No_Wide_Characters restriction
 
-      if T = Standard_Wide_Character
-        or else T = Standard_Wide_Wide_Character
-        or else Root_Type (T) = Standard_Wide_String
-        or else Root_Type (T) = Standard_Wide_Wide_String
-      then
-         Check_Restriction (No_Wide_Characters, Object_Definition (N));
-      end if;
+      Check_Wide_Character_Restriction (T, Object_Definition (N));
 
       --  Indicate this is not set in source. Certainly true for constants,
       --  and true for variables so far (will be reset for a variable if and
@@ -13677,8 +13671,20 @@  package body Sem_Ch3 is
          Generate_Definition (L);
          Set_Convention (L, Convention_Intrinsic);
 
+         --  Case of character literal
+
          if Nkind (L) = N_Defining_Character_Literal then
             Set_Is_Character_Type (T, True);
+
+            --  Check violation of No_Wide_Characters
+
+            if Restriction_Active (No_Wide_Characters) then
+               Get_Name_String (Chars (L));
+
+               if Name_Len >= 3 and then Name_Buffer (1 .. 2) = "QW" then
+                  Check_Restriction (No_Wide_Characters, L);
+               end if;
+            end if;
          end if;
 
          Ev := Ev + 1;
@@ -14211,13 +14217,7 @@  package body Sem_Ch3 is
 
       --  Check No_Wide_Characters restriction
 
-      if Typ = Standard_Wide_Character
-        or else Typ = Standard_Wide_Wide_Character
-        or else Typ = Standard_Wide_String
-        or else Typ = Standard_Wide_Wide_String
-      then
-         Check_Restriction (No_Wide_Characters, S);
-      end if;
+      Check_Wide_Character_Restriction (Typ, S);
 
       return Typ;
    end Find_Type_Of_Subtype_Indic;
Index: restrict.adb
===================================================================
--- restrict.adb	(revision 164000)
+++ restrict.adb	(working copy)
@@ -25,6 +25,7 @@ 
 
 with Atree;    use Atree;
 with Casing;   use Casing;
+with Einfo;    use Einfo;
 with Errout;   use Errout;
 with Debug;    use Debug;
 with Fname;    use Fname;
@@ -396,6 +397,29 @@  package body Restrict is
       end loop;
    end Check_Restriction_No_Dependence;
 
+   --------------------------------------
+   -- Check_Wide_Character_Restriction --
+   --------------------------------------
+
+   procedure Check_Wide_Character_Restriction (E : Entity_Id; N : Node_Id) is
+   begin
+      if Restriction_Active (No_Wide_Characters)
+        and then Comes_From_Source (N)
+      then
+         declare
+            T : constant Entity_Id := Root_Type (E);
+         begin
+            if T = Standard_Wide_Character      or else
+               T = Standard_Wide_String         or else
+               T = Standard_Wide_Wide_Character or else
+               T = Standard_Wide_Wide_String
+            then
+               Check_Restriction (No_Wide_Characters, N);
+            end if;
+         end;
+      end if;
+   end Check_Wide_Character_Restriction;
+
    ----------------------------------------
    -- Cunit_Boolean_Restrictions_Restore --
    ----------------------------------------
Index: restrict.ads
===================================================================
--- restrict.ads	(revision 164000)
+++ restrict.ads	(working copy)
@@ -239,6 +239,12 @@  package Restrict is
    --  mechanism (e.g. a special pragma) to handle this case, but there are
    --  only six cases, and it is not worth the effort to do something general.
 
+   procedure Check_Wide_Character_Restriction (E : Entity_Id; N : Node_Id);
+   --  This procedure checks if the No_Wide_Character restriction is active,
+   --  and if so, if N Comes_From_Source, and the root type of E is one of
+   --  [Wide_]Wide_Character or [Wide_]Wide_String, then the restriction
+   --  violation is recorded, and an appropriate message given.
+
    function Cunit_Boolean_Restrictions_Save
      return Save_Cunit_Boolean_Restrictions;
    --  This function saves the compilation unit restriction settings, and
Index: sem_ch8.adb
===================================================================
--- sem_ch8.adb	(revision 164000)
+++ sem_ch8.adb	(working copy)
@@ -454,8 +454,9 @@  package body Sem_Ch8 is
    --  private with on E.
 
    procedure Find_Expanded_Name (N : Node_Id);
-   --  Selected component is known to be expanded name. Verify legality of
-   --  selector given the scope denoted by prefix.
+   --  The input is a selected component is known to be expanded name. Verify
+   --  legality of selector given the scope denoted by prefix, and change node
+   --  N into a expanded name with a properly set Entity field.
 
    function Find_Renamed_Entity
      (N         : Node_Id;
@@ -4411,6 +4412,10 @@  package body Sem_Ch8 is
 
       <<Found>> begin
 
+         --  Check violation of No_Wide_Characters restriction
+
+         Check_Wide_Character_Restriction (E, N);
+
          --  When distribution features are available (Get_PCS_Name /=
          --  Name_No_DSA), a remote access-to-subprogram type is converted
          --  into a record type holding whatever information is needed to
@@ -4960,6 +4965,10 @@  package body Sem_Ch8 is
          Set_Etype (N, Get_Full_View (Etype (Id)));
       end if;
 
+      --  Check for violation of No_Wide_Characters
+
+      Check_Wide_Character_Restriction (Id, N);
+
       --  If the Ekind of the entity is Void, it means that all homonyms are
       --  hidden from all visibility (RM 8.3(5,14-20)).
 
@@ -7330,8 +7339,8 @@  package body Sem_Ch8 is
               and then Scope (Id) /= Scope (Prev)
               and then Used_As_Generic_Actual (Scope (Prev))
               and then Used_As_Generic_Actual (Scope (Id))
-              and then List_Containing (Current_Use_Clause (Scope (Prev))) /=
-                       List_Containing (Current_Use_Clause (Scope (Id)))
+              and then not In_Same_List (Current_Use_Clause (Scope (Prev)),
+                                         Current_Use_Clause (Scope (Id)))
             then
                Set_Is_Potentially_Use_Visible (Prev, False);
                Append_Elmt (Prev, Hidden_By_Use_Clause (N));