Commit a56886e9 by Arnaud Charlet

[multiple changes]

2016-05-02  Tristan Gingold  <gingold@adacore.com>

	* fname.adb (Is_Predefined_File_Name): Also consider non-krunched
	i-* names.

2016-05-02  Ed Schonberg  <schonberg@adacore.com>

	* 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  <schonberg@adacore.com>

	* 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
parent fc3819c9
2016-05-02 Tristan Gingold <gingold@adacore.com>
* fname.adb (Is_Predefined_File_Name): Also consider non-krunched
i-* names.
2016-05-02 Ed Schonberg <schonberg@adacore.com>
* 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 <schonberg@adacore.com>
* 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 <schonberg@adacore.com> 2016-05-02 Ed Schonberg <schonberg@adacore.com>
* exp_ch6.adb (Expand_Call): When inlining a call to a function * exp_ch6.adb (Expand_Call): When inlining a call to a function
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -134,14 +134,9 @@ package body Fname is ...@@ -134,14 +134,9 @@ package body Fname is
Name_Len := Name_Len - 4; Name_Len := Name_Len - 4;
end if; 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 -- 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 (2) = '-'
and then (Name_Buffer (1) = 'a' and then (Name_Buffer (1) = 'a'
or else or else
...@@ -153,6 +148,11 @@ package body Fname is ...@@ -153,6 +148,11 @@ package body Fname is
Name_Buffer (3) in 'A' .. 'Z') Name_Buffer (3) in 'A' .. 'Z')
then then
return True; return True;
-- Definitely false if longer than 12 characters (8.3)
elsif Name_Len > 8 then
return False;
end if; end if;
-- Otherwise check against special list, first padding to 8 characters -- Otherwise check against special list, first padding to 8 characters
......
...@@ -18656,11 +18656,14 @@ package body Sem_Ch3 is ...@@ -18656,11 +18656,14 @@ package body Sem_Ch3 is
is is
begin begin
-- An object of a limited interface type can be initialized with any -- 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) if Is_Class_Wide_Type (Typ)
and then Is_Limited_Interface (Typ) and then Is_Limited_Interface (Typ)
and then not Is_Limited_Type (Etype (Exp)) and then not Is_Limited_Type (Etype (Exp))
and then Nkind (Exp) /= N_Type_Conversion
then then
return True; return True;
end if; end if;
......
...@@ -4767,13 +4767,21 @@ package body Sem_Res is ...@@ -4767,13 +4767,21 @@ package body Sem_Res is
and then not In_Instance_Body and then not In_Instance_Body
then then
if not OK_For_Limited_Init (Etype (E), Expression (E)) 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); Explain_Limited_Type (Etype (E), N);
end if; end if;
end if; end if;
-- A qualified expression requires an exact match of the type. -- A qualified expression requires an exact match of the type. Class-
-- Class-wide matching is not allowed. -- wide matching is not allowed.
if (Is_Class_Wide_Type (Etype (Expression (E))) if (Is_Class_Wide_Type (Etype (Expression (E)))
or else Is_Class_Wide_Type (Etype (E))) or else Is_Class_Wide_Type (Etype (E)))
......
...@@ -326,21 +326,19 @@ package body Sem_Util is ...@@ -326,21 +326,19 @@ package body Sem_Util is
-- Ada 2005 (AI-230): Generate a conversion to an anonymous access -- Ada 2005 (AI-230): Generate a conversion to an anonymous access
-- component's type to force the appropriate accessibility checks. -- component's type to force the appropriate accessibility checks.
-- Ada 2005 (AI-231): Generate conversion to the null-excluding -- Ada 2005 (AI-231): Generate conversion to the null-excluding type to
-- type to force the corresponding run-time check -- force the corresponding run-time check
if Is_Access_Type (Check_Typ) if Is_Access_Type (Check_Typ)
and then ((Is_Local_Anonymous_Access (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)))
then then
Rewrite (Exp, Convert_To (Check_Typ, Relocate_Node (Exp))); Rewrite (Exp, Convert_To (Check_Typ, Relocate_Node (Exp)));
Analyze_And_Resolve (Exp, Check_Typ); Analyze_And_Resolve (Exp, Check_Typ);
Check_Unset_Reference (Exp); Check_Unset_Reference (Exp);
end if; end if;
-- This is really expansion activity, so make sure that expansion is -- What follows is really expansion activity, so check that expansion
-- on and is allowed. In GNATprove mode, we also want check flags to -- 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 -- be added in the tree, so that the formal verification can rely on
-- those to be present. In GNATprove mode for formal verification, some -- those to be present. In GNATprove mode for formal verification, some
-- treatment typically only done during expansion needs to be performed -- treatment typically only done during expansion needs to be performed
...@@ -353,6 +351,13 @@ package body Sem_Util is ...@@ -353,6 +351,13 @@ package body Sem_Util is
return; return;
end if; 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 -- First check if we have to insert discriminant checks
if Has_Discriminants (Exp_Typ) then if Has_Discriminants (Exp_Typ) then
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment