[multiple changes]

2013-10-14  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_prag.adb (Analyze_Dependency_Clause): Add new local variable
	Non_Null_Output_Seen.  Update the call to Analyze_Input_Output.
	(Analyze_Input_Item): Streamline the detection mechanism of null and
	non-null items.
	(Analyze_Input_List): Add new local variable
	Non_Null_Input_Seen. Update all calls to Analyze_Input_Output.
	(Analyze_Input_Output): Add new formal parameter Non_Null_Seen
	and update the related comment on usage. Update the
	recursive call to itself. Attribute 'Result is now treated
	as a non-null item. Detect mixes of null and non-null items.
	(Analyze_Initialization_Item): Streamline the detection mechanism
	of null and non-null items.

2013-10-14  Vincent Celier  <celier@adacore.com>

	* projects.texi: Add documentation for the new project level
	attribute Library_Rpath_Options.

2013-10-14  Tristan Gingold  <gingold@adacore.com>

	* a-exexpr-gcc.adb (Set_Exception_Parameter): New procedure.
	(Set_Foreign_Occurrence): New procedure, extracted from
	Setup_Current_Excep.
	* exp_ch11.adb (Expand_Exception_Handlers): Do not expand choice
	parameter in case of zcx.
	* sem_ch11.adb (Analyze_Exception_Handlers): Need debug info
	for the choice parameter.
	* raise-gcc.c: Add comments.

From-SVN: r203552

gcc/ada/ChangeLog

@@ -1,3 +1,34 @@
+2013-10-14  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_prag.adb (Analyze_Dependency_Clause): Add new local variable
+	Non_Null_Output_Seen.  Update the call to Analyze_Input_Output.
+	(Analyze_Input_Item): Streamline the detection mechanism of null and
+	non-null items.
+	(Analyze_Input_List): Add new local variable
+	Non_Null_Input_Seen. Update all calls to Analyze_Input_Output.
+	(Analyze_Input_Output): Add new formal parameter Non_Null_Seen
+	and update the related comment on usage. Update the
+	recursive call to itself. Attribute 'Result is now treated
+	as a non-null item. Detect mixes of null and non-null items.
+	(Analyze_Initialization_Item): Streamline the detection mechanism
+	of null and non-null items.
+
+2013-10-14  Vincent Celier  <celier@adacore.com>
+
+	* projects.texi: Add documentation for the new project level
+	attribute Library_Rpath_Options.
+
+2013-10-14  Tristan Gingold  <gingold@adacore.com>
+
+	* a-exexpr-gcc.adb (Set_Exception_Parameter): New procedure.
+	(Set_Foreign_Occurrence): New procedure, extracted from
+	Setup_Current_Excep.
+	* exp_ch11.adb (Expand_Exception_Handlers): Do not expand choice
+	parameter in case of zcx.
+	* sem_ch11.adb (Analyze_Exception_Handlers): Need debug info
+	for the choice parameter.
+	* raise-gcc.c: Add comments.
+
 2013-10-14  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* aspects.adb: Add an entry in table Canonical_Aspect for

gcc/ada/a-exexpr-gcc.adb

@@ -199,13 +199,14 @@ package body Exception_Propagation is
      (GCC_Exception : not null GCC_Exception_Access);
    pragma No_Return (Reraise_GCC_Exception);
    pragma Export (C, Reraise_GCC_Exception, "__gnat_reraise_zcx");
-   --  Called to implement raise without exception, ie reraise.  Called
+   --  Called to implement raise without exception, ie reraise. Called
    --  directly from gigi.
 
    function Setup_Current_Excep
      (GCC_Exception : not null GCC_Exception_Access) return EOA;
    pragma Export (C, Setup_Current_Excep, "__gnat_setup_current_excep");
-   --  Write Get_Current_Excep.all from GCC_Exception
+   --  Write Get_Current_Excep.all from GCC_Exception. Called by the
+   --  personnality routine.
 
    procedure Unhandled_Except_Handler
      (GCC_Exception : not null GCC_Exception_Access);
@@ -243,6 +244,17 @@ package body Exception_Propagation is
       UW_Argument  : System.Address);
    pragma Import (C, Unwind_ForcedUnwind, "__gnat_Unwind_ForcedUnwind");
 
+   procedure Set_Exception_Parameter
+     (Excep : EOA;
+      GCC_Exception : not null GCC_Exception_Access);
+   pragma Export (C, Set_Exception_Parameter,
+                    "__gnat_set_exception_parameter");
+   --  Called inserted by gigi to initialize the exception parameter
+
+   procedure Set_Foreign_Occurrence (Excep : EOA; Mo : System.Address);
+   --  Utility routine to initialize occurrence Excep for a foreign exception
+   --  whose machine occurrence is Mo.
+
    --  Hooks called when entering/leaving an exception handler for a given
    --  occurrence, aimed at handling the stack of active occurrences. The
    --  calls are generated by gigi in tree_transform/N_Exception_Handler.
@@ -338,6 +350,20 @@ package body Exception_Propagation is
       Free (Copy);
    end GNAT_GCC_Exception_Cleanup;
 
+   ----------------------------
+   -- Set_Foreign_Occurrence --
+   ----------------------------
+
+   procedure Set_Foreign_Occurrence (Excep : EOA; Mo : System.Address) is
+   begin
+      Excep.Id := Foreign_Exception'Access;
+      Excep.Machine_Occurrence := Mo;
+      Excep.Msg_Length := 0;
+      Excep.Exception_Raised := True;
+      Excep.Pid := Local_Partition_ID;
+      Excep.Num_Tracebacks := 0;
+   end Set_Foreign_Occurrence;
+
    -------------------------
    -- Setup_Current_Excep --
    -------------------------
@@ -366,12 +392,7 @@ package body Exception_Propagation is
 
          --  A default one
 
-         Excep.Id := Foreign_Exception'Access;
+         Set_Foreign_Occurrence (Excep, GCC_Exception.all'Address);
-         Excep.Machine_Occurrence := GCC_Exception.all'Address;
-         Excep.Msg_Length := 0;
-         Excep.Exception_Raised := True;
-         Excep.Pid := Local_Partition_ID;
-         Excep.Num_Tracebacks := 0;
 
          return Excep;
       end if;
@@ -465,6 +486,34 @@ package body Exception_Propagation is
       Propagate_GCC_Exception (To_GCC_Exception (Excep.Machine_Occurrence));
    end Propagate_Exception;
 
+   -----------------------------
+   -- Set_Exception_Parameter --
+   -----------------------------
+
+   procedure Set_Exception_Parameter
+     (Excep : EOA;
+      GCC_Exception : not null GCC_Exception_Access) is
+   begin
+      --  Setup the exception occurrence
+
+      if GCC_Exception.Class = GNAT_Exception_Class then
+
+         --  From the GCC exception
+
+         declare
+            GNAT_Occurrence : constant GNAT_GCC_Exception_Access :=
+              To_GNAT_GCC_Exception (GCC_Exception);
+         begin
+            Save_Occurrence (Excep.all, GNAT_Occurrence.Occurrence);
+         end;
+      else
+
+         --  A default one
+
+         Set_Foreign_Occurrence (Excep, GCC_Exception.all'Address);
+      end if;
+   end Set_Exception_Parameter;
+
    ------------------------------
    -- Unhandled_Except_Handler --
    ------------------------------

gcc/ada/exp_ch11.adb

@@ -1025,7 +1025,12 @@ package body Exp_Ch11 is
                --        ...
                --     end;
 
-               if Present (Choice_Parameter (Handler)) then
+               --  This expansion is not performed when using GCC ZCX. Gigi
+               --  will insert a call to intialize the choice parameter.
+
+               if Present (Choice_Parameter (Handler))
+                 and then Exception_Mechanism /= Back_End_Exceptions
+               then
                   declare
                      Cparm : constant Entity_Id  := Choice_Parameter (Handler);
                      Cloc  : constant Source_Ptr := Sloc (Cparm);

gcc/ada/projects.texi

@@ -3962,6 +3962,14 @@ the command line when linking a shared library.
 
 Value is a list of options that are to be used when linking a shared library.
 
+@item @b{Library_Rpath_Options}: list, indexed, case-insensitive index
+
+Index is a language name. Value is a list of options for an invocation of the
+compiler of the language. This invocation is done for a shared library project
+with sources of the language. The output of the invocation is the path name
+of a shared library file. The directory name is to be put in the run path
+option switch when linking the shared library for the project.
+
 @item @b{Library_Src_Dir}: single
 
 Value is the name of the directory where copies of the sources of the

gcc/ada/raise-gcc.c

@@ -1217,7 +1217,9 @@ PERSONALITY_FUNCTION (version_arg_t version_arg,
   setup_to_install
     (uw_context, uw_exception, action.landing_pad, action.ttype_filter);
 
-  /* Write current exception, so that it can be retrieved from Ada.  */
+  /* Write current exception, so that it can be retrieved from Ada.  It was
+     already done during phase 1 (just above), but in between, one or several
+     exceptions may have been raised (in cleanup handlers).  */
   __gnat_setup_current_excep (uw_exception);
 
   return _URC_INSTALL_CONTEXT;

gcc/ada/sem_ch11.adb

@@ -199,6 +199,7 @@ package body Sem_Ch11 is
 
                if Comes_From_Source (Choice) then
                   Check_Restriction (No_Exception_Propagation, Choice);
+                  Set_Debug_Info_Needed (Choice);
                end if;
 
                if No (H_Scope) then

gcc/ada/sem_prag.adb

@@ -555,12 +555,13 @@ package body Sem_Prag is
          --  Verify the legality of a single input list
 
          procedure Analyze_Input_Output
-           (Item      : Node_Id;
+           (Item          : Node_Id;
-            Is_Input  : Boolean;
+            Is_Input      : Boolean;
-            Self_Ref  : Boolean;
+            Self_Ref      : Boolean;
-            Top_Level : Boolean;
+            Top_Level     : Boolean;
-            Seen      : in out Elist_Id;
+            Seen          : in out Elist_Id;
-            Null_Seen : in out Boolean);
+            Null_Seen     : in out Boolean;
+            Non_Null_Seen : in out Boolean);
          --  Verify the legality of a single input or output item. Flag
          --  Is_Input should be set whenever Item is an input, False when it
          --  denotes an output. Flag Self_Ref should be set when the item is an
@@ -568,7 +569,8 @@ package body Sem_Prag is
          --  be set whenever Item appears immediately within an input or output
          --  list. Seen is a collection of all abstract states, variables and
          --  formals processed so far. Flag Null_Seen denotes whether a null
-         --  input or output has been encountered.
+         --  input or output has been encountered. Flag Non_Null_Seen denotes
+         --  whether a non-null input or output has been encountered.
 
          ------------------------
          -- Analyze_Input_List --
@@ -579,8 +581,9 @@ package body Sem_Prag is
             --  A list containing the entities of all inputs that appear in the
             --  current input list.
 
-            Null_Input_Seen : Boolean := False;
+            Non_Null_Input_Seen : Boolean := False;
-            --  A flag used to track the legality of a null input
+            Null_Input_Seen     : Boolean := False;
+            --  Flags used to check the legality of an input list
 
             Input : Node_Id;
 
@@ -596,12 +599,13 @@ package body Sem_Prag is
                   Input := First (Expressions (Inputs));
                   while Present (Input) loop
                      Analyze_Input_Output
-                       (Item      => Input,
+                       (Item          => Input,
-                        Is_Input  => True,
+                        Is_Input      => True,
-                        Self_Ref  => False,
+                        Self_Ref      => False,
-                        Top_Level => False,
+                        Top_Level     => False,
-                        Seen      => Inputs_Seen,
+                        Seen          => Inputs_Seen,
-                        Null_Seen => Null_Input_Seen);
+                        Null_Seen     => Null_Input_Seen,
+                        Non_Null_Seen => Non_Null_Input_Seen);
 
                      Next (Input);
                   end loop;
@@ -614,12 +618,13 @@ package body Sem_Prag is
 
             else
                Analyze_Input_Output
-                 (Item      => Inputs,
+                 (Item          => Inputs,
-                  Is_Input  => True,
+                  Is_Input      => True,
-                  Self_Ref  => False,
+                  Self_Ref      => False,
-                  Top_Level => False,
+                  Top_Level     => False,
-                  Seen      => Inputs_Seen,
+                  Seen          => Inputs_Seen,
-                  Null_Seen => Null_Input_Seen);
+                  Null_Seen     => Null_Input_Seen,
+                  Non_Null_Seen => Non_Null_Input_Seen);
             end if;
 
             --  Detect an illegal dependency clause of the form
@@ -638,12 +643,13 @@ package body Sem_Prag is
          --------------------------
 
          procedure Analyze_Input_Output
-           (Item      : Node_Id;
+           (Item          : Node_Id;
-            Is_Input  : Boolean;
+            Is_Input      : Boolean;
-            Self_Ref  : Boolean;
+            Self_Ref      : Boolean;
-            Top_Level : Boolean;
+            Top_Level     : Boolean;
-            Seen      : in out Elist_Id;
+            Seen          : in out Elist_Id;
-            Null_Seen : in out Boolean)
+            Null_Seen     : in out Boolean;
+            Non_Null_Seen : in out Boolean)
          is
             Is_Output : constant Boolean := not Is_Input;
             Grouped   : Node_Id;
@@ -666,12 +672,13 @@ package body Sem_Prag is
                   Grouped := First (Expressions (Item));
                   while Present (Grouped) loop
                      Analyze_Input_Output
-                       (Item      => Grouped,
+                       (Item          => Grouped,
-                        Is_Input  => Is_Input,
+                        Is_Input      => Is_Input,
-                        Self_Ref  => Self_Ref,
+                        Self_Ref      => Self_Ref,
-                        Top_Level => False,
+                        Top_Level     => False,
-                        Seen      => Seen,
+                        Seen          => Seen,
-                        Null_Seen => Null_Seen);
+                        Null_Seen     => Null_Seen,
+                        Non_Null_Seen => Non_Null_Seen);
 
                      Next (Grouped);
                   end loop;
@@ -683,6 +690,7 @@ package body Sem_Prag is
             --  Process Function'Result in the context of a dependency clause
 
             elsif Is_Attribute_Result (Item) then
+               Non_Null_Seen := True;
 
                --  It is sufficent to analyze the prefix of 'Result in order to
                --  establish legality of the attribute.
@@ -707,6 +715,10 @@ package body Sem_Prag is
                elsif Is_Input then
                   Error_Msg_N ("function result cannot act as input", Item);
 
+               elsif Null_Seen then
+                  Error_Msg_N
+                    ("cannot mix null and non-null dependency items", Item);
+
                else
                   Result_Seen := True;
                end if;
@@ -719,19 +731,39 @@ package body Sem_Prag is
                if Null_Seen then
                   Error_Msg_N
                     ("multiple null dependency relations not allowed", Item);
+
+               elsif Non_Null_Seen then
+                  Error_Msg_N
+                    ("cannot mix null and non-null dependency items", Item);
+
                else
                   Null_Seen := True;
 
-                  if Is_Output and then not Is_Last then
+                  if Is_Output then
-                     Error_Msg_N
+                     if not Is_Last then
-                       ("null output list must be the last clause in a "
+                        Error_Msg_N
-                        & "dependency relation", Item);
+                          ("null output list must be the last clause in a "
+                           & "dependency relation", Item);
+
+                     --  Catch a useless dependence of the form:
+                     --    null =>+ ...
+
+                     elsif Self_Ref then
+                        Error_Msg_N
+                          ("useless dependence, null depends on itself", Item);
+                     end if;
                   end if;
                end if;
 
             --  Default case
 
             else
+               Non_Null_Seen := True;
+
+               if Null_Seen then
+                  Error_Msg_N ("cannot mix null and non-null items", Item);
+               end if;
+
                Analyze (Item);
 
                --  Find the entity of the item. If this is a renaming, climb
@@ -845,6 +877,9 @@ package body Sem_Prag is
          Output   : Node_Id;
          Self_Ref : Boolean;
 
+         Non_Null_Output_Seen : Boolean := False;
+         --  Flag used to check the legality of an output list
+
       --  Start of processing for Analyze_Dependency_Clause
 
       begin
@@ -864,12 +899,13 @@ package body Sem_Prag is
          Output := First (Choices (Clause));
          while Present (Output) loop
             Analyze_Input_Output
-              (Item      => Output,
+              (Item          => Output,
-               Is_Input  => False,
+               Is_Input      => False,
-               Self_Ref  => Self_Ref,
+               Self_Ref      => Self_Ref,
-               Top_Level => True,
+               Top_Level     => True,
-               Seen      => All_Outputs_Seen,
+               Seen          => All_Outputs_Seen,
-               Null_Seen => Null_Output_Seen);
+               Null_Seen     => Null_Output_Seen,
+               Non_Null_Seen => Non_Null_Output_Seen);
 
             Next (Output);
          end loop;
@@ -2192,22 +2228,15 @@ package body Sem_Prag is
          Item_Id : Entity_Id;
 
       begin
-         --  A package with null initialization list is not allowed to have
-         --  additional initializations.
-
-         if Null_Seen then
-            Error_Msg_NE ("package & has null initialization", Item, Pack_Id);
-
          --  Null initialization list
 
-         elsif Nkind (Item) = N_Null then
+         if Nkind (Item) = N_Null then
+            if Null_Seen then
+               Error_Msg_N ("multiple null initializations not allowed", Item);
 
-            --  Catch a case where a null initialization item appears in a list
+            elsif Non_Null_Seen then
-            --  of non-null items.
+               Error_Msg_N
-
+                 ("cannot mix null and non-null initialization items", Item);
-            if Non_Null_Seen then
-               Error_Msg_NE
-                 ("package & has non-null initialization", Item, Pack_Id);
             else
                Null_Seen := True;
             end if;
@@ -2217,6 +2246,11 @@ package body Sem_Prag is
          else
             Non_Null_Seen := True;
 
+            if Null_Seen then
+               Error_Msg_N
+                 ("cannot mix null and non-null initialization items", Item);
+            end if;
+
             Analyze (Item);
 
             if Is_Entity_Name (Item) then
@@ -2287,21 +2321,16 @@ package body Sem_Prag is
             Input_Id : Entity_Id;
 
          begin
-            --  An initialization item with null inputs is not allowed to have
-            --  assitional inputs.
-
-            if Null_Seen then
-               Error_Msg_N ("item has null input list", Item);
-
             --  Null input list
 
-            elsif Nkind (Input) = N_Null then
+            if Nkind (Input) = N_Null then
+               if Null_Seen then
+                  Error_Msg_N
+                    ("multiple null initializations not allowed", Item);
 
-               --  Catch a case where a null input appears in a list of non-
+               elsif Non_Null_Seen then
-               --  null inpits.
+                  Error_Msg_N
-
+                    ("cannot mix null and non-null initialization item", Item);
-               if Non_Null_Seen then
-                  Error_Msg_N ("item has non-null input list", Item);
                else
                   Null_Seen := True;
                end if;
@@ -2311,6 +2340,11 @@ package body Sem_Prag is
             else
                Non_Null_Seen := True;
 
+               if Null_Seen then
+                  Error_Msg_N
+                    ("cannot mix null and non-null initialization item", Item);
+               end if;
+
                Analyze (Input);
 
                if Is_Entity_Name (Input) then
@@ -9299,7 +9333,7 @@ package body Sem_Prag is
 
                elsif Nkind (State) = N_Null then
                   Name := New_Internal_Name ('S');
-                  Is_Null := True;
+                  Is_Null   := True;
                   Null_Seen := True;
 
                   --  Catch a case where a null state appears in a list of
@@ -19946,7 +19980,7 @@ package body Sem_Prag is
                   Dep_Id := Entity_Of (Dep_Input);
 
                   --  Inspect all inputs of the refinement clause and attempt
-                  --  to match against the inputs of the dependance clause.
+                  --  to match against the inputs of the dependence clause.
 
                   Ref_Input := First (Ref_Inputs);
                   while Present (Ref_Input) loop
@@ -20256,7 +20290,7 @@ package body Sem_Prag is
       begin
          --  The analysis of pragma Depends should produce normalized clauses
          --  with exactly one output. This is important because output items
-         --  are unique in the whole dependance relation and can be used as
+         --  are unique in the whole dependence relation and can be used as
          --  keys.
 
          pragma Assert (No (Next (Dep_Output)));