Commit b0cd50fd by Arnaud Charlet

[multiple changes]

2017-04-25  Hristian Kirtchev  <kirtchev@adacore.com>

	* checks.adb (Insert_Valid_Check): Do not generate
	a validity check when inside a generic.

2017-04-25  Yannick Moy  <moy@adacore.com>

	* sem_res.adb (Resolve_Type_Conversion): Fix bad logic.

2017-04-25  Arnaud Charlet  <charlet@adacore.com>

	* snames.ads-tmpl (Snames): More names for detecting predefined
	potentially blocking subprograms.

2017-04-25  Ed Schonberg  <schonberg@adacore.com>

	* sem_prag.adb (Analyze_Pre_Post_Condition): The rules
	concerning inheritance of class-wide preconditions do not apply
	to postconditions.

2017-04-25  Bob Duff  <duff@adacore.com>

	* s-ficobl.ads: Minor comment fix.

From-SVN: r247174
parent d8ee014f
2017-04-25 Hristian Kirtchev <kirtchev@adacore.com>
* checks.adb (Insert_Valid_Check): Do not generate
a validity check when inside a generic.
2017-04-25 Yannick Moy <moy@adacore.com>
* sem_res.adb (Resolve_Type_Conversion): Fix bad logic.
2017-04-25 Arnaud Charlet <charlet@adacore.com>
* snames.ads-tmpl (Snames): More names for detecting predefined
potentially blocking subprograms.
2017-04-25 Ed Schonberg <schonberg@adacore.com>
* sem_prag.adb (Analyze_Pre_Post_Condition): The rules
concerning inheritance of class-wide preconditions do not apply
to postconditions.
2017-04-25 Bob Duff <duff@adacore.com>
* s-ficobl.ads: Minor comment fix.
2017-04-25 Yannick Moy <moy@adacore.com> 2017-04-25 Yannick Moy <moy@adacore.com>
* checks.adb (Apply_Scalar_Range_Check): Analyze precisely * checks.adb (Apply_Scalar_Range_Check): Analyze precisely
......
...@@ -7233,27 +7233,31 @@ package body Checks is ...@@ -7233,27 +7233,31 @@ package body Checks is
or else Expr_Known_Valid (Expr) or else Expr_Known_Valid (Expr)
then then
return; return;
end if;
-- Do not insert checks within a predicate function. This will arise -- Do not insert checks within a predicate function. This will arise
-- if the current unit and the predicate function are being compiled -- if the current unit and the predicate function are being compiled
-- with validity checks enabled. -- with validity checks enabled.
if Present (Predicate_Function (Typ)) elsif Present (Predicate_Function (Typ))
and then Current_Scope = Predicate_Function (Typ) and then Current_Scope = Predicate_Function (Typ)
then then
return; return;
end if;
-- If the expression is a packed component of a modular type of the -- If the expression is a packed component of a modular type of the
-- right size, the data is always valid. -- right size, the data is always valid.
if Nkind (Expr) = N_Selected_Component elsif Nkind (Expr) = N_Selected_Component
and then Present (Component_Clause (Entity (Selector_Name (Expr)))) and then Present (Component_Clause (Entity (Selector_Name (Expr))))
and then Is_Modular_Integer_Type (Typ) and then Is_Modular_Integer_Type (Typ)
and then Modulus (Typ) = 2 ** Esize (Entity (Selector_Name (Expr))) and then Modulus (Typ) = 2 ** Esize (Entity (Selector_Name (Expr)))
then then
return; return;
-- Do not generate a validity check when inside a generic unit as this
-- is an expansion activity.
elsif Inside_A_Generic then
return;
end if; end if;
-- If we have a checked conversion, then validity check applies to -- If we have a checked conversion, then validity check applies to
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- 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- --
...@@ -89,7 +89,7 @@ package System.File_Control_Block is ...@@ -89,7 +89,7 @@ package System.File_Control_Block is
Name : Pstring; Name : Pstring;
-- A pointer to the file name. The file name is null for temporary -- A pointer to the file name. The file name is null for temporary
-- files, and also for standard files (stdin, stdout, stderr). The -- files, and also for standard files (stdin, stdout, stderr). The
-- name is always null-terminated if it is non-null. -- name is always NUL-terminated if it is non-null.
Encoding : System.CRTL.Filename_Encoding; Encoding : System.CRTL.Filename_Encoding;
-- Encoding used to specified the filename -- Encoding used to specified the filename
......
...@@ -4417,6 +4417,7 @@ package body Sem_Prag is ...@@ -4417,6 +4417,7 @@ package body Sem_Prag is
begin begin
if Class_Present (N) if Class_Present (N)
and then Pragma_Name (N) = Name_Precondition
and then Present (Overridden_Operation (E)) and then Present (Overridden_Operation (E))
and then not Inherits_Class_Wide_Pre (E) and then not Inherits_Class_Wide_Pre (E)
then then
...@@ -11055,17 +11055,17 @@ package body Sem_Res is ...@@ -11055,17 +11055,17 @@ package body Sem_Res is
-- If at this stage we have a real to integer conversion, make sure that -- If at this stage we have a real to integer conversion, make sure that
-- the Do_Range_Check flag is set, because such conversions in general -- the Do_Range_Check flag is set, because such conversions in general
-- need a range check. We only need this if expansion is off, or we are -- need a range check. We only need this if expansion is off.
-- in GNATprove mode and the conversion if from fixed-point to integer -- In GNATprove mode, we only do that when converting from fixed-point
-- (as floating-point to integer conversions are now handled in -- (as floating-point to integer conversions are now handled in
-- GNATprove mode). -- GNATprove mode).
if Nkind (N) = N_Type_Conversion if Nkind (N) = N_Type_Conversion
and then not Expander_Active and then not Expander_Active
and then Is_Integer_Type (Target_Typ) and then Is_Integer_Type (Target_Typ)
and then (Is_Real_Type (Operand_Typ) and then (Is_Fixed_Point_Type (Operand_Typ)
or else (GNATprove_Mode or else (not GNATprove_Mode
and then Is_Fixed_Point_Type (Operand_Typ))) and then Is_Floating_Point_Type (Operand_Typ)))
then then
Set_Do_Range_Check (Operand); Set_Do_Range_Check (Operand);
end if; end if;
......
...@@ -275,14 +275,18 @@ package Snames is ...@@ -275,14 +275,18 @@ package Snames is
Name_EDF : constant Name_Id := N + $; Name_EDF : constant Name_Id := N + $;
Name_Reset_Standard_Files : constant Name_Id := N + $; Name_Reset_Standard_Files : constant Name_Id := N + $;
Name_Sequential_IO : constant Name_Id := N + $; Name_Sequential_IO : constant Name_Id := N + $;
Name_Strings : constant Name_Id := N + $;
Name_Streams : constant Name_Id := N + $; Name_Streams : constant Name_Id := N + $;
Name_Suspend_Until_True : constant Name_Id := N + $; Name_Suspend_Until_True : constant Name_Id := N + $;
Name_Suspend_Until_True_And_Set_Deadline : constant Name_Id := N + $; Name_Suspend_Until_True_And_Set_Deadline : constant Name_Id := N + $;
Name_Synchronous_Barriers : constant Name_Id := N + $; Name_Synchronous_Barriers : constant Name_Id := N + $;
Name_Task_Identification : constant Name_Id := N + $; Name_Task_Identification : constant Name_Id := N + $;
Name_Text_Streams : constant Name_Id := N + $; Name_Text_Streams : constant Name_Id := N + $;
Name_Unbounded : constant Name_Id := N + $;
Name_Unbounded_IO : constant Name_Id := N + $; Name_Unbounded_IO : constant Name_Id := N + $;
Name_Wait_For_Release : constant Name_Id := N + $; Name_Wait_For_Release : constant Name_Id := N + $;
Name_Wide_Unbounded : constant Name_Id := N + $;
Name_Wide_Wide_Unbounded : constant Name_Id := N + $;
Name_Yield : constant Name_Id := N + $; Name_Yield : constant Name_Id := N + $;
-- Names of implementations of the distributed systems annex -- Names of implementations of the distributed systems annex
......
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