[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
This commit is contained in:
parent
443dd772d6
commit
cca7f1076a
@ -1,3 +1,21 @@
|
||||
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>
|
||||
|
||||
* exp_ch9.adb, inline.ads: Minor reformatting.
|
||||
|
@ -6672,7 +6672,7 @@ package body Checks is
|
||||
begin
|
||||
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
|
||||
return;
|
||||
@ -6690,11 +6690,20 @@ package body Checks is
|
||||
|
||||
-- Avoid generating warning message inside init procs. In SPARK mode
|
||||
-- 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
|
||||
(N, "null value not allowed here??", CE_Access_Check_Failed);
|
||||
|
||||
-- Remaining cases, where we silently insert the raise
|
||||
|
||||
else
|
||||
Insert_Action (N,
|
||||
Make_Raise_Constraint_Error (Loc,
|
||||
|
@ -3847,9 +3847,10 @@ package body Exp_Ch9 is
|
||||
Build_Protected_Entry_Specification (Loc, Edef, Empty);
|
||||
|
||||
-- Add the following declarations:
|
||||
|
||||
-- type poVP is access poV;
|
||||
-- _object : poVP := poVP (_O);
|
||||
--
|
||||
|
||||
-- where _O is the formal parameter associated with the concurrent
|
||||
-- object. These declarations are needed for Complete_Entry_Body.
|
||||
|
||||
@ -3861,35 +3862,42 @@ package body Exp_Ch9 is
|
||||
Add_Formal_Renamings (Espec, Op_Decls, Ent, Loc);
|
||||
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
|
||||
when System_Tasking_Protected_Objects_Entries =>
|
||||
Complete :=
|
||||
New_Reference_To (RTE (RE_Complete_Entry_Body), Loc);
|
||||
Append_To (Op_Stats,
|
||||
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 =>
|
||||
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 =>
|
||||
raise Program_Error;
|
||||
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
|
||||
-- Exception_Complete_Entry_Body
|
||||
|
||||
|
@ -1747,7 +1747,6 @@ package Rtsfind is
|
||||
RE_Unlock_Entry, -- Protected_Objects.Single_Entry
|
||||
RE_Protected_Single_Entry_Call, -- 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_Protected_Count_Entry, -- Protected_Objects.Single_Entry
|
||||
RE_Protected_Single_Entry_Caller, -- Protected_Objects.Single_Entry
|
||||
@ -3057,8 +3056,6 @@ package Rtsfind is
|
||||
System_Tasking_Protected_Objects_Single_Entry,
|
||||
RE_Service_Entry =>
|
||||
System_Tasking_Protected_Objects_Single_Entry,
|
||||
RE_Complete_Single_Entry_Body =>
|
||||
System_Tasking_Protected_Objects_Single_Entry,
|
||||
RE_Exceptional_Complete_Single_Entry_Body =>
|
||||
System_Tasking_Protected_Objects_Single_Entry,
|
||||
RE_Protected_Count_Entry =>
|
||||
|
@ -1927,9 +1927,10 @@ package body System.OS_Lib is
|
||||
-- Start of processing for Normalize_Pathname
|
||||
|
||||
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 "";
|
||||
end if;
|
||||
|
||||
|
@ -445,9 +445,10 @@ package System.OS_Lib is
|
||||
-- directory pointed to. This is slightly less efficient, since it
|
||||
-- requires system calls.
|
||||
--
|
||||
-- If Name cannot be resolved or is null on entry (for example if there is
|
||||
-- symbolic link circularity, e.g. A is a symbolic link for B, and B is a
|
||||
-- symbolic link for A), then Normalize_Pathname returns an empty string.
|
||||
-- If Name cannot be resolved, is invalid (for example if it is too big) or
|
||||
-- is null on entry (for example if there is symbolic link circularity,
|
||||
-- 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
|
||||
-- converted into Unix syntax. If the conversion fails, Normalize_Pathname
|
||||
|
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- 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 --
|
||||
-- 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
|
||||
-- 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 --
|
||||
--------------------------------------------
|
||||
|
@ -250,12 +250,6 @@ package System.Tasking.Protected_Objects.Single_Entry is
|
||||
-- Same as the Protected_Entry_Call but with time-out specified.
|
||||
-- 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
|
||||
(Object : Protection_Entry_Access;
|
||||
Ex : Ada.Exceptions.Exception_Id);
|
||||
|
Loading…
Reference in New Issue
Block a user