sem_ch3.adb (Process_Discriminants): diagnose redundant or improper null exclusion in a discriminant declaration

2008-08-06  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Process_Discriminants): diagnose redundant or improper
	null exclusion in a discriminant declaration

	* sem_ch8.adb (Analyze_Object_Renaming): diagnose null exclusion
	indicators when type is not an access type.

	* sem_ch12.adb (Formal_Object_Declaration): diagnose null exclusion
	indicators when type is not an access type.

From-SVN: r138765

3 files changed, 47 insertions, 10 deletions

diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 82b47aa..30628b6 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -1812,12 +1812,16 @@ package body Sem_Ch12 is
 
          --  Verify that there is no redundant null exclusion.
 
-         if Null_Exclusion_Present (N)
-           and then Can_Never_Be_Null (T)
-         then
-            Error_Msg_NE
-              ("`NOT NULL` not allowed (& already excludes null)",
-                 N, T);
+         if Null_Exclusion_Present (N) then
+            if not Is_Access_Type (T) then
+               Error_Msg_N
+                 ("null exclusion can only apply to an access type", N);
+
+            elsif Can_Never_Be_Null (T) then
+               Error_Msg_NE
+                 ("`NOT NULL` not allowed (& already excludes null)",
+                    N, T);
+            end if;
          end if;
 
       --  Ada 2005 (AI-423): Formal object with an access definition
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 8a44655..8f02795 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -4624,11 +4624,21 @@ package body Sem_Ch3 is
                               Has_Private_Component (Derived_Type));
       Conditional_Delay      (Derived_Type, Subt);
 
-      --  Ada 2005 (AI-231). Set the null-exclusion attribute
+      --  Ada 2005 (AI-231). Set the null-exclusion attribute, and verify
+      --  that it is not redundant.
 
-      if Null_Exclusion_Present (Type_Definition (N))
-        or else Can_Never_Be_Null (Parent_Type)
-      then
+      if Null_Exclusion_Present (Type_Definition (N)) then
+         Set_Can_Never_Be_Null (Derived_Type);
+
+         if Can_Never_Be_Null (Parent_Type)
+           and then False
+         then
+            Error_Msg_NE
+              ("`NOT NULL` not allowed (& already excludes null)",
+                N, Parent_Type);
+         end if;
+
+      elsif Can_Never_Be_Null (Parent_Type) then
          Set_Can_Never_Be_Null (Derived_Type);
       end if;
 
@@ -12897,6 +12907,12 @@ package body Sem_Ch3 is
          end;
       end if;
 
+      if Null_Exclusion_Present (Def)
+        and then not Is_Access_Type (Parent_Type)
+      then
+         Error_Msg_N ("null exclusion can only apply to an access type", N);
+      end if;
+
       Build_Derived_Type (N, Parent_Type, T, Is_Completion);
 
       --  AI-419: The parent type of an explicitly limited derived type must
@@ -15352,6 +15368,15 @@ package body Sem_Ch3 is
                  Create_Null_Excluding_Itype
                    (T           => Discr_Type,
                     Related_Nod => Discr));
+
+            --  Check for improper null exclusion if the type is otherwise
+            --  legal for a discriminant.
+
+            elsif Null_Exclusion_Present (Discr)
+              and then Is_Discrete_Type (Discr_Type)
+            then
+               Error_Msg_N
+                 ("null exclusion can only apply to an access type", Discr);
             end if;
 
             --  Ada 2005 (AI-402): access discriminants of nonlimited types
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index 9a19b2a..f6acc6c 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -889,7 +889,15 @@ package body Sem_Ch8 is
                   Error_Msg_NE
                     ("`NOT NULL` not allowed (type of& already excludes null)",
                       N, Nam_Ent);
+
                end if;
+
+            elsif Has_Null_Exclusion (N)
+              and then No (Access_Definition (N))
+              and then Can_Never_Be_Null (T)
+            then
+               Error_Msg_NE
+                 ("`NOT NULL` not allowed (& already excludes null)", N, T);
             end if;
          end;
       end if;