Commit cca7f107 by Arnaud Charlet

[multiple changes]

2014-01-29  Tristan Gingold  <gingold@adacore.com>

	* exp_ch9.adb (Build_Protected_Entry): Do not call
	Complete_Entry_Body anymore.
	* rtsfind.ads (RE_Complete_Single_Entry_Body): Remove.
	* s-tposen.ads, s-tposen.adb (Complete_Single_Entry_Body): Remove.

2014-01-29  Pierre-Marie Derodat  <derodat@adacore.com>

	* s-os_lib.adb, s-os_lib.ads (Normalize_Pathname): Return an empty
	string when the Name input bigger than allowed. Adapt the function
	specification.

2014-01-29  Ed Schonberg  <schonberg@adacore.com>

	* checks.adb (Install_Null_Excluding_Check): Do not emit warning
	if expression is within a case_expression of if_expression.

From-SVN: r207247
parent 443dd772
2014-01-29 Tristan Gingold <gingold@adacore.com>
* exp_ch9.adb (Build_Protected_Entry): Do not call
Complete_Entry_Body anymore.
* rtsfind.ads (RE_Complete_Single_Entry_Body): Remove.
* s-tposen.ads, s-tposen.adb (Complete_Single_Entry_Body): Remove.
2014-01-29 Pierre-Marie Derodat <derodat@adacore.com>
* s-os_lib.adb, s-os_lib.ads (Normalize_Pathname): Return an empty
string when the Name input bigger than allowed. Adapt the function
specification.
2014-01-29 Ed Schonberg <schonberg@adacore.com>
* checks.adb (Install_Null_Excluding_Check): Do not emit warning
if expression is within a case_expression of if_expression.
2014-01-29 Robert Dewar <dewar@adacore.com> 2014-01-29 Robert Dewar <dewar@adacore.com>
* exp_ch9.adb, inline.ads: Minor reformatting. * exp_ch9.adb, inline.ads: Minor reformatting.
......
...@@ -6672,7 +6672,7 @@ package body Checks is ...@@ -6672,7 +6672,7 @@ package body Checks is
begin begin
pragma Assert (Is_Access_Type (Typ)); pragma Assert (Is_Access_Type (Typ));
-- No check inside a generic (why not???) -- No check inside a generic, check will be emitted in instance
if Inside_A_Generic then if Inside_A_Generic then
return; return;
...@@ -6690,11 +6690,20 @@ package body Checks is ...@@ -6690,11 +6690,20 @@ package body Checks is
-- Avoid generating warning message inside init procs. In SPARK mode -- Avoid generating warning message inside init procs. In SPARK mode
-- we can go ahead and call Apply_Compile_Time_Constraint_Error -- we can go ahead and call Apply_Compile_Time_Constraint_Error
-- since it will be truned into an error in any case. -- since it will be turned into an error in any case.
if not Inside_Init_Proc or else SPARK_Mode = On then if (not Inside_Init_Proc or else SPARK_Mode = On)
-- Do not emit the warning within a conditional expression
-- Why not ???
and then not Within_Case_Or_If_Expression (N)
then
Apply_Compile_Time_Constraint_Error Apply_Compile_Time_Constraint_Error
(N, "null value not allowed here??", CE_Access_Check_Failed); (N, "null value not allowed here??", CE_Access_Check_Failed);
-- Remaining cases, where we silently insert the raise
else else
Insert_Action (N, Insert_Action (N,
Make_Raise_Constraint_Error (Loc, Make_Raise_Constraint_Error (Loc,
......
...@@ -3847,9 +3847,10 @@ package body Exp_Ch9 is ...@@ -3847,9 +3847,10 @@ package body Exp_Ch9 is
Build_Protected_Entry_Specification (Loc, Edef, Empty); Build_Protected_Entry_Specification (Loc, Edef, Empty);
-- Add the following declarations: -- Add the following declarations:
-- type poVP is access poV; -- type poVP is access poV;
-- _object : poVP := poVP (_O); -- _object : poVP := poVP (_O);
--
-- where _O is the formal parameter associated with the concurrent -- where _O is the formal parameter associated with the concurrent
-- object. These declarations are needed for Complete_Entry_Body. -- object. These declarations are needed for Complete_Entry_Body.
...@@ -3861,35 +3862,42 @@ package body Exp_Ch9 is ...@@ -3861,35 +3862,42 @@ package body Exp_Ch9 is
Add_Formal_Renamings (Espec, Op_Decls, Ent, Loc); Add_Formal_Renamings (Espec, Op_Decls, Ent, Loc);
Debug_Private_Data_Declarations (Decls); Debug_Private_Data_Declarations (Decls);
-- Put the declarations and the statements from the entry
Op_Stats :=
New_List (
Make_Block_Statement (Loc,
Declarations => Decls,
Handled_Statement_Sequence =>
Handled_Statement_Sequence (N)));
case Corresponding_Runtime_Package (Pid) is case Corresponding_Runtime_Package (Pid) is
when System_Tasking_Protected_Objects_Entries => when System_Tasking_Protected_Objects_Entries =>
Complete := Append_To (Op_Stats,
New_Reference_To (RTE (RE_Complete_Entry_Body), Loc); Make_Procedure_Call_Statement (End_Loc,
Name =>
New_Reference_To (RTE (RE_Complete_Entry_Body), Loc),
Parameter_Associations => New_List (
Make_Attribute_Reference (End_Loc,
Prefix =>
Make_Selected_Component (End_Loc,
Prefix =>
Make_Identifier (End_Loc, Name_uObject),
Selector_Name =>
Make_Identifier (End_Loc, Name_uObject)),
Attribute_Name => Name_Unchecked_Access))));
when System_Tasking_Protected_Objects_Single_Entry => when System_Tasking_Protected_Objects_Single_Entry =>
Complete :=
New_Reference_To (RTE (RE_Complete_Single_Entry_Body), Loc); -- Historically, a call to Complete_Single_Entry_Body was
-- inserted, but it was a null procedure.
null;
when others => when others =>
raise Program_Error; raise Program_Error;
end case; end case;
Op_Stats := New_List (
Make_Block_Statement (Loc,
Declarations => Decls,
Handled_Statement_Sequence =>
Handled_Statement_Sequence (N)),
Make_Procedure_Call_Statement (End_Loc,
Name => Complete,
Parameter_Associations => New_List (
Make_Attribute_Reference (End_Loc,
Prefix =>
Make_Selected_Component (End_Loc,
Prefix => Make_Identifier (End_Loc, Name_uObject),
Selector_Name => Make_Identifier (End_Loc, Name_uObject)),
Attribute_Name => Name_Unchecked_Access))));
-- When exceptions can not be propagated, we never need to call -- When exceptions can not be propagated, we never need to call
-- Exception_Complete_Entry_Body -- Exception_Complete_Entry_Body
......
...@@ -1747,7 +1747,6 @@ package Rtsfind is ...@@ -1747,7 +1747,6 @@ package Rtsfind is
RE_Unlock_Entry, -- Protected_Objects.Single_Entry RE_Unlock_Entry, -- Protected_Objects.Single_Entry
RE_Protected_Single_Entry_Call, -- Protected_Objects.Single_Entry RE_Protected_Single_Entry_Call, -- Protected_Objects.Single_Entry
RE_Service_Entry, -- Protected_Objects.Single_Entry RE_Service_Entry, -- Protected_Objects.Single_Entry
RE_Complete_Single_Entry_Body, -- Protected_Objects.Single_Entry
RE_Exceptional_Complete_Single_Entry_Body, RE_Exceptional_Complete_Single_Entry_Body,
RE_Protected_Count_Entry, -- Protected_Objects.Single_Entry RE_Protected_Count_Entry, -- Protected_Objects.Single_Entry
RE_Protected_Single_Entry_Caller, -- Protected_Objects.Single_Entry RE_Protected_Single_Entry_Caller, -- Protected_Objects.Single_Entry
...@@ -3057,8 +3056,6 @@ package Rtsfind is ...@@ -3057,8 +3056,6 @@ package Rtsfind is
System_Tasking_Protected_Objects_Single_Entry, System_Tasking_Protected_Objects_Single_Entry,
RE_Service_Entry => RE_Service_Entry =>
System_Tasking_Protected_Objects_Single_Entry, System_Tasking_Protected_Objects_Single_Entry,
RE_Complete_Single_Entry_Body =>
System_Tasking_Protected_Objects_Single_Entry,
RE_Exceptional_Complete_Single_Entry_Body => RE_Exceptional_Complete_Single_Entry_Body =>
System_Tasking_Protected_Objects_Single_Entry, System_Tasking_Protected_Objects_Single_Entry,
RE_Protected_Count_Entry => RE_Protected_Count_Entry =>
......
...@@ -1927,9 +1927,10 @@ package body System.OS_Lib is ...@@ -1927,9 +1927,10 @@ package body System.OS_Lib is
-- Start of processing for Normalize_Pathname -- Start of processing for Normalize_Pathname
begin begin
-- Special case, if name is null, then return null -- Special case, return null if name is null, or if it is bigger than
-- the biggest name allowed.
if Name'Length = 0 then if Name'Length = 0 or else Name'Length > Max_Path then
return ""; return "";
end if; end if;
......
...@@ -445,9 +445,10 @@ package System.OS_Lib is ...@@ -445,9 +445,10 @@ package System.OS_Lib is
-- directory pointed to. This is slightly less efficient, since it -- directory pointed to. This is slightly less efficient, since it
-- requires system calls. -- requires system calls.
-- --
-- If Name cannot be resolved or is null on entry (for example if there is -- If Name cannot be resolved, is invalid (for example if it is too big) or
-- symbolic link circularity, e.g. A is a symbolic link for B, and B is a -- is null on entry (for example if there is symbolic link circularity,
-- symbolic link for A), then Normalize_Pathname returns an empty string. -- e.g. A is a symbolic link for B, and B is a symbolic link for A), then
-- Normalize_Pathname returns an empty string.
-- --
-- In VMS, if Name follows the VMS syntax file specification, it is first -- In VMS, if Name follows the VMS syntax file specification, it is first
-- converted into Unix syntax. If the conversion fails, Normalize_Pathname -- converted into Unix syntax. If the conversion fails, Normalize_Pathname
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1998-2009, Free Software Foundation, Inc. -- -- Copyright (C) 1998-2013, Free Software Foundation, Inc. --
-- -- -- --
-- GNARL is free software; you can redistribute it and/or modify it under -- -- GNARL 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- --
...@@ -278,20 +278,6 @@ package body System.Tasking.Protected_Objects.Single_Entry is ...@@ -278,20 +278,6 @@ package body System.Tasking.Protected_Objects.Single_Entry is
-- Restricted GNARLI -- -- Restricted GNARLI --
----------------------- -----------------------
--------------------------------
-- Complete_Single_Entry_Body --
--------------------------------
procedure Complete_Single_Entry_Body (Object : Protection_Entry_Access) is
pragma Warnings (Off, Object);
begin
-- Nothing needs to do (Object.Call_In_Progress.Exception_To_Raise
-- has already been set to Null_Id).
null;
end Complete_Single_Entry_Body;
-------------------------------------------- --------------------------------------------
-- Exceptional_Complete_Single_Entry_Body -- -- Exceptional_Complete_Single_Entry_Body --
-------------------------------------------- --------------------------------------------
......
...@@ -250,12 +250,6 @@ package System.Tasking.Protected_Objects.Single_Entry is ...@@ -250,12 +250,6 @@ package System.Tasking.Protected_Objects.Single_Entry is
-- Same as the Protected_Entry_Call but with time-out specified. -- Same as the Protected_Entry_Call but with time-out specified.
-- This routine is used to implement timed entry calls. -- This routine is used to implement timed entry calls.
procedure Complete_Single_Entry_Body
(Object : Protection_Entry_Access);
pragma Inline (Complete_Single_Entry_Body);
-- Called from within an entry body procedure, indicates that the
-- corresponding entry call has been serviced.
procedure Exceptional_Complete_Single_Entry_Body procedure Exceptional_Complete_Single_Entry_Body
(Object : Protection_Entry_Access; (Object : Protection_Entry_Access;
Ex : Ada.Exceptions.Exception_Id); Ex : Ada.Exceptions.Exception_Id);
......
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