From fa961f76ef7ce0b972797d55968d9f3ce04cee45 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Wed, 6 Aug 2008 09:56:04 +0200 Subject: [PATCH] sem_ch3.adb (Process_Discriminants): diagnose redundant or improper null exclusion in a discriminant declaration 2008-08-06 Ed Schonberg * 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 --- gcc/ada/sem_ch12.adb | 16 ++++++++++------ gcc/ada/sem_ch3.adb | 33 +++++++++++++++++++++++++++++---- gcc/ada/sem_ch8.adb | 8 ++++++++ 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; -- 2.7.4