[multiple changes]
authorArnaud Charlet <charlet@gcc.gnu.org>
Wed, 29 Jan 2014 15:25:11 +0000 (16:25 +0100)
committerArnaud Charlet <charlet@gcc.gnu.org>
Wed, 29 Jan 2014 15:25:11 +0000 (16:25 +0100)
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

gcc/ada/ChangeLog
gcc/ada/checks.adb
gcc/ada/exp_ch9.adb
gcc/ada/rtsfind.ads
gcc/ada/s-os_lib.adb
gcc/ada/s-os_lib.ads
gcc/ada/s-tposen.adb
gcc/ada/s-tposen.ads

index 8641cd2b7e1cc36e1cc9dfe2fe72b2f830efae42..c6e15738146fbc7b7f8bfb2877ef098d83280be4 100644 (file)
@@ -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.
index 51acd293a91779816b3859c4de173e5e8f3d1d88..826c09bf11f42e92dd5d63fbdf2df01fc9ddcc4a 100644 (file)
@@ -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,
index c9ee46cf8631ea3c57757e600ab6069574639324..7c570a84a02c492cc837ac0e7aca09e8b3b28771 100644 (file)
@@ -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
 
index 5ae85f32b966a73817f083dbb340032c777e783c..8325bcf1fb35e0339c136cc4c8136a58cac7dec7 100644 (file)
@@ -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            =>
index 268e541865685c2fb3bddab1dc709ba2f89602c9..8b4db7b5f0391197b2d184c3010608615f88cba0 100644 (file)
@@ -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;
 
index 4e11fb1c2115ef280c438a1930d55c73ef6b0472..cd644964f1fbe067a4d3c4db476d7a3f450d2647 100644 (file)
@@ -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
index 10cfca21016aa75c4a1e2b868eba1795ff872c15..356da5aa4616b2fd5972bb2bffa2bc7d470afd5d 100644 (file)
@@ -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 --
    --------------------------------------------
index c5b832ce214bf8f4b157afa2d921a7d96a764eea..6cfd3de537da3a2921e0015f0c23e9c31fd23261 100644 (file)
@@ -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);