From a56886e9df65ee26c605446e80470f2a6c2e2e82 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 2 May 2016 12:36:45 +0200 Subject: [PATCH] [multiple changes] 2016-05-02 Tristan Gingold * fname.adb (Is_Predefined_File_Name): Also consider non-krunched i-* names. 2016-05-02 Ed Schonberg * sem_util.adb (Aggregate_Constraint_Checks): Separate accessibility checks and non-null checks for aggregate components, to prevent spurious accessibility errors. 2016-05-02 Ed Schonberg * sem_ch3.adb (OK_For_Limited_Init): A type conversion is not always legal in the in-place initialization of a limited entity (e.g. an allocator). * sem_res.adb (Resolve_Allocator): Improve error message with RM reference when allocator expression is illegal. From-SVN: r235746 --- gcc/ada/ChangeLog | 19 +++++++++++++++++++ gcc/ada/fname.adb | 14 +++++++------- gcc/ada/sem_ch3.adb | 5 ++++- gcc/ada/sem_res.adb | 14 +++++++++++--- gcc/ada/sem_util.adb | 19 ++++++++++++------- 5 files changed, 53 insertions(+), 18 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 8764dbb..6f56c60 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,22 @@ +2016-05-02 Tristan Gingold + + * fname.adb (Is_Predefined_File_Name): Also consider non-krunched + i-* names. + +2016-05-02 Ed Schonberg + + * sem_util.adb (Aggregate_Constraint_Checks): Separate + accessibility checks and non-null checks for aggregate components, + to prevent spurious accessibility errors. + +2016-05-02 Ed Schonberg + + * sem_ch3.adb (OK_For_Limited_Init): A type conversion is not + always legal in the in-place initialization of a limited entity + (e.g. an allocator). + * sem_res.adb (Resolve_Allocator): Improve error message with RM + reference when allocator expression is illegal. + 2016-05-02 Ed Schonberg * exp_ch6.adb (Expand_Call): When inlining a call to a function diff --git a/gcc/ada/fname.adb b/gcc/ada/fname.adb index 0bea5a0..e17aa34 100644 --- a/gcc/ada/fname.adb +++ b/gcc/ada/fname.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -134,14 +134,9 @@ package body Fname is Name_Len := Name_Len - 4; end if; - -- Definitely false if longer than 12 characters (8.3) - - if Name_Len > 8 then - return False; - -- Definitely predefined if prefix is a- i- or s- followed by letter - elsif Name_Len >= 3 + if Name_Len >= 3 and then Name_Buffer (2) = '-' and then (Name_Buffer (1) = 'a' or else @@ -153,6 +148,11 @@ package body Fname is Name_Buffer (3) in 'A' .. 'Z') then return True; + + -- Definitely false if longer than 12 characters (8.3) + + elsif Name_Len > 8 then + return False; end if; -- Otherwise check against special list, first padding to 8 characters diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 18ebc25..f3c8584 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -18656,11 +18656,14 @@ package body Sem_Ch3 is is begin -- An object of a limited interface type can be initialized with any - -- expression of a nonlimited descendant type. + -- expression of a nonlimited descendant type. However this does not + -- apply if this is a view conversion of some other expression. This + -- is checked below. if Is_Class_Wide_Type (Typ) and then Is_Limited_Interface (Typ) and then not Is_Limited_Type (Etype (Exp)) + and then Nkind (Exp) /= N_Type_Conversion then return True; end if; diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index fb4c805..e1b22d1 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -4767,13 +4767,21 @@ package body Sem_Res is and then not In_Instance_Body then if not OK_For_Limited_Init (Etype (E), Expression (E)) then - Error_Msg_N ("initialization not allowed for limited types", N); + if Nkind (Parent (N)) = N_Assignment_Statement then + Error_Msg_N + ("illegal expression for initialized allocator of a " + & "limited type (RM 7.5 (2.7/2))", N); + else + Error_Msg_N + ("initialization not allowed for limited types", N); + end if; + Explain_Limited_Type (Etype (E), N); end if; end if; - -- A qualified expression requires an exact match of the type. - -- Class-wide matching is not allowed. + -- A qualified expression requires an exact match of the type. Class- + -- wide matching is not allowed. if (Is_Class_Wide_Type (Etype (Expression (E))) or else Is_Class_Wide_Type (Etype (E))) diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 371c147..3b241bd 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -326,21 +326,19 @@ package body Sem_Util is -- Ada 2005 (AI-230): Generate a conversion to an anonymous access -- component's type to force the appropriate accessibility checks. - -- Ada 2005 (AI-231): Generate conversion to the null-excluding - -- type to force the corresponding run-time check + -- Ada 2005 (AI-231): Generate conversion to the null-excluding type to + -- force the corresponding run-time check if Is_Access_Type (Check_Typ) - and then ((Is_Local_Anonymous_Access (Check_Typ)) - or else (Can_Never_Be_Null (Check_Typ) - and then not Can_Never_Be_Null (Exp_Typ))) + and then Is_Local_Anonymous_Access (Check_Typ) then Rewrite (Exp, Convert_To (Check_Typ, Relocate_Node (Exp))); Analyze_And_Resolve (Exp, Check_Typ); Check_Unset_Reference (Exp); end if; - -- This is really expansion activity, so make sure that expansion is - -- on and is allowed. In GNATprove mode, we also want check flags to + -- What follows is really expansion activity, so check that expansion + -- is on and is allowed. In GNATprove mode, we also want check flags to -- be added in the tree, so that the formal verification can rely on -- those to be present. In GNATprove mode for formal verification, some -- treatment typically only done during expansion needs to be performed @@ -353,6 +351,13 @@ package body Sem_Util is return; end if; + if Is_Access_Type (Check_Typ) + and then Can_Never_Be_Null (Check_Typ) + and then not Can_Never_Be_Null (Exp_Typ) + then + Install_Null_Excluding_Check (Exp); + end if; + -- First check if we have to insert discriminant checks if Has_Discriminants (Exp_Typ) then -- 2.7.4