diff mbox

[Ada] Fixes to No_Implementation_Units restriction

Message ID 20110906133128.GA12115@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet Sept. 6, 2011, 1:31 p.m. UTC
This patch fixes some errors in the previous initial checkin of this
new feature.

     1. package noimpunit4 is end;

     1. pragma Restrictions (No_Implementation_Units);
     2. with noimpunit4;
     3. with GNAT.IO;
                 |
        >>> violation of restriction
            "no_implementation_units" at line 1

     4. package noimpunit3 is end;

Prior to this fix, the line with'ing noimpunit4 was flagged (along
with all user defined units), and the with of the gnat unit was not
flagged and it should be (even if perhaps this is not 100% legally
conforming).

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

2011-09-06  Robert Dewar  <dewar@adacore.com>

	* sem_ch10.adb, impunit.ads, impunit.adb (Not_Impl_Defined_Unit): New
	name for Is_RM_Defined_Unit. Also several fixes to this unit.
diff mbox

Patch

Index: impunit.adb
===================================================================
--- impunit.adb	(revision 178594)
+++ impunit.adb	(working copy)
@@ -826,11 +826,11 @@ 
          return False;
    end Is_Known_Unit;
 
-   ------------------------
-   -- Is_RM_Defined_Unit --
-   ------------------------
+   ---------------------------
+   -- Not_Impl_Defined_Unit --
+   ---------------------------
 
-   function Is_RM_Defined_Unit (U : Unit_Number_Type) return Boolean is
+   function Not_Impl_Defined_Unit (U : Unit_Number_Type) return Boolean is
       Fname : constant File_Name_Type := Unit_File_Name (U);
 
    begin
@@ -848,21 +848,22 @@ 
          return True;
       end if;
 
-      --  If length of file name is greater than 12, not RM-defined. The value
-      --  12 here is an 8 char name with extension .ads.
+      --  If length of file name is greater than 12, then it's a user unit
+      --  and not a GNAT implementation defined unit.
 
       if Name_Len > 12 then
-         return False;
+         return True;
       end if;
 
-      --  Not RM-defined if length of name greater than 12 (12 is 8 characters
-      --  plus 4 for ".ads" appended at the end).
+      --  Implementation defined if unit in the gnat hierarchy
 
-      if Length_Of_Name (Fname) > 12 then
+      if (Name_Len = 8 and then Name_Buffer (1 .. 8) = "gnat.ads")
+        or else (Name_Len > 2 and then Name_Buffer (1 .. 2) = "g-")
+      then
          return False;
       end if;
 
-      --  Not RM defined if file name does not start with a- s- i-
+      --  Not implementation defined if file name does not start with a- s- i-
 
       if Name_Len < 3
         or else Name_Buffer (2) /= '-'
@@ -872,14 +873,14 @@ 
                    and then
                  Name_Buffer (1) /= 's')
       then
-         return False;
+         return True;
       end if;
 
-      --  Not RM defined if file name does not end in .ads. This can happen
+      --  Not impl-defined if file name does not end in .ads. This can happen
       --  when non-standard file names are being used.
 
       if Name_Buffer (Name_Len - 3 .. Name_Len) /= ".ads" then
-         return False;
+         return True;
       end if;
 
       --  Otherwise normalize file name to 8 characters
@@ -891,7 +892,8 @@ 
       end loop;
 
       --  Check our lists of names, if we find a match, return corresponding
-      --  indication of whether the file is RM defined.
+      --  indication of whether the file is RM defined, respecting the RM
+      --  version in which it is defined.
 
       for J in Non_Imp_File_Names_95'Range loop
          if Name_Buffer (1 .. 8) = Non_Imp_File_Names_95 (J).Fname then
@@ -913,9 +915,11 @@ 
          end if;
       end loop;
 
-      --  If no match in any of the lists, not RM defined
+      --  If unit is in System, Ada or Interfaces hierarchies and did not match
+      --  any entry in the list, means it is an internal implementation defined
+      --  unit which the restriction should definition forbid.
 
-      return False;
-   end Is_RM_Defined_Unit;
+      return True;
+   end Not_Impl_Defined_Unit;
 
 end Impunit;
Index: impunit.ads
===================================================================
--- impunit.ads	(revision 178594)
+++ impunit.ads	(working copy)
@@ -72,10 +72,14 @@ 
    --  the known library units, and if so, returns True. If the name does not
    --  match any known library unit, False is returned.
 
-   function Is_RM_Defined_Unit (U : Unit_Number_Type) return Boolean;
-   --  This function returns True if U represents a unit that is defined in
-   --  the RM, as defined by the No_Implementation_Units restriction rules.
-   --  It is used to implement this restriction, so if False is returned, it
-   --  means that with'ing the unit violates the restriction.
+   function Not_Impl_Defined_Unit (U : Unit_Number_Type) return Boolean;
+   --  This function returns True if U represents a unit that is permitted by
+   --  the restriction No_Implementation_Units (i.e. a unit in the Ada, System,
+   --  and Interfaces hierarchies that is defined in the RM, or a user defined
+   --  unit. It returns False if U represents a unit that is not permitted by
+   --  this restriction, which includes units in these three hierarchies that
+   --  are GNAT implementation defined. It also returns False for any units in
+   --  the GNAT hierarchy, which is not strictly conforming, but so obviously
+   --  useful that it is a reasonable deviation from the standard.
 
 end Impunit;
Index: sem_ch10.adb
===================================================================
--- sem_ch10.adb	(revision 178594)
+++ sem_ch10.adb	(working copy)
@@ -2380,7 +2380,9 @@ 
       --  Check No_Implementation_Units violation
 
       if Restriction_Check_Required (No_Implementation_Units) then
-         if not Is_RM_Defined_Unit (Get_Source_Unit (U)) then
+         if Not_Impl_Defined_Unit (Get_Source_Unit (U)) then
+            null;
+         else
             Check_Restriction (No_Implementation_Units, Nam);
             Restriction_Violation := True;
          end if;