[Ada] Correct various bad choices in Alfa mode

Arnaud Charlet charlet@adacore.com
Wed Aug 31 09:34:00 GMT 2011


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

2011-08-31  Yannick Moy  <moy@adacore.com>

	* exp_alfa.adb (Expand_Alfa_N_Package_Declaration,
	Expand_Alfa_N_Subprogram_Body): Remove useless procedures which simply
	call Qualify_Entity_Names.
	(Expand_Alfa): call Qualify_Entity_Names in more cases
	* lib-xref-alfa.adb: Take into account system package.
	* sem_prag.adb Take into account restrictions in Alfa mode, contrary to
	CodePeer mode in which we are interested in finding bugs even if
	compiler cannot compile source.
	* sem_util.adb, sem_util.ads (Unique_Entity): Take into account case of
	deferred constant.

-------------- next part --------------
Index: exp_alfa.adb
===================================================================
--- exp_alfa.adb	(revision 178360)
+++ exp_alfa.adb	(working copy)
@@ -51,15 +51,9 @@
    procedure Expand_Alfa_N_Attribute_Reference (N : Node_Id);
    --  Expand attributes 'Old and 'Result only
 
-   procedure Expand_Alfa_N_Package_Declaration (N : Node_Id);
-   --  Fully qualify names of enclosed entities
-
    procedure Expand_Alfa_N_Simple_Return_Statement (N : Node_Id);
    --  Insert conversion on function return if necessary
 
-   procedure Expand_Alfa_N_Subprogram_Body (N : Node_Id);
-   --  Fully qualify names of enclosed entities
-
    procedure Expand_Alfa_Simple_Function_Return (N : Node_Id);
    --  Expand simple return from function
 
@@ -71,15 +65,15 @@
    begin
       case Nkind (N) is
 
-         when N_Package_Declaration =>
-            Expand_Alfa_N_Package_Declaration (N);
+         when N_Package_Body        |
+              N_Package_Declaration |
+              N_Subprogram_Body     |
+              N_Block_Statement     =>
+            Qualify_Entity_Names (N);
 
          when N_Simple_Return_Statement =>
             Expand_Alfa_N_Simple_Return_Statement (N);
 
-         when N_Subprogram_Body =>
-            Expand_Alfa_N_Subprogram_Body (N);
-
          when N_Function_Call            |
               N_Procedure_Call_Statement =>
             Expand_Alfa_Call (N);
@@ -173,15 +167,6 @@
       end case;
    end Expand_Alfa_N_Attribute_Reference;
 
-   ---------------------------------------
-   -- Expand_Alfa_N_Package_Declaration --
-   ---------------------------------------
-
-   procedure Expand_Alfa_N_Package_Declaration (N : Node_Id) is
-   begin
-      Qualify_Entity_Names (N);
-   end Expand_Alfa_N_Package_Declaration;
-
    -------------------------------------------
    -- Expand_Alfa_N_Simple_Return_Statement --
    -------------------------------------------
@@ -222,15 +207,6 @@
          return;
    end Expand_Alfa_N_Simple_Return_Statement;
 
-   -----------------------------------
-   -- Expand_Alfa_N_Subprogram_Body --
-   -----------------------------------
-
-   procedure Expand_Alfa_N_Subprogram_Body (N : Node_Id) is
-   begin
-      Qualify_Entity_Names (N);
-   end Expand_Alfa_N_Subprogram_Body;
-
    ----------------------------------------
    -- Expand_Alfa_Simple_Function_Return --
    ----------------------------------------
Index: sem_prag.adb
===================================================================
--- sem_prag.adb	(revision 178358)
+++ sem_prag.adb	(working copy)
@@ -5090,9 +5090,9 @@
       --  Start of processing for Process_Restrictions_Or_Restriction_Warnings
 
       begin
-         --  Ignore all Restrictions pragma in CodePeer and Alfa modes
+         --  Ignore all Restrictions pragma in CodePeer mode
 
-         if CodePeer_Mode or Alfa_Mode then
+         if CodePeer_Mode then
             return;
          end if;
 
Index: sem_util.adb
===================================================================
--- sem_util.adb	(revision 178358)
+++ sem_util.adb	(working copy)
@@ -12656,6 +12656,11 @@
 
    begin
       case Ekind (E) is
+         when E_Constant =>
+            if Present (Full_View (E)) then
+               U := Full_View (E);
+            end if;
+
          when Type_Kind =>
             if Present (Full_View (E)) then
                U := Full_View (E);
Index: sem_util.ads
===================================================================
--- sem_util.ads	(revision 178358)
+++ sem_util.ads	(working copy)
@@ -1448,7 +1448,8 @@
    --  views of the same entity have the same unique defining entity:
    --  * package spec and body;
    --  * subprogram declaration, subprogram stub and subprogram body;
-   --  * private view and full view of a type.
+   --  * private view and full view of a type;
+   --  * private view and full view of a deferred constant.
    --  In other cases, return the defining entity for N.
 
    function Unique_Entity (E : Entity_Id) return Entity_Id;
Index: lib-xref-alfa.adb
===================================================================
--- lib-xref-alfa.adb	(revision 178363)
+++ lib-xref-alfa.adb	(working copy)
@@ -886,14 +886,7 @@
       --  Generate file and scope Alfa information
 
       for D in 1 .. Num_Sdep loop
-
-         --  Ignore file for System
-
-         if Units.Table (Sdep_Table (D)).Source_Index /=
-           System_Source_File_Index
-         then
-            Add_Alfa_File (U => Sdep_Table (D), D => D);
-         end if;
+         Add_Alfa_File (U => Sdep_Table (D), D => D);
       end loop;
 
       --  Fill in the spec information when relevant


More information about the Gcc-patches mailing list