2004-03-29 Javier Miranda <miranda@gnat.com>

	* checks.adb (Null_Exclusion_Static_Checks): New subprogram
	(Install_Null_Excluding_Check): Local subprogram that determines whether
	an access node requires a runtime access check and if so inserts the
	appropriate run-time check.
	(Apply_Access_Check): Call Install_Null_Excluding check if required
	(Apply_Constraint_Check): Call Install_Null_Excluding check if required

	* checks.ads: (Null_Exclusion_Static_Checks): New subprogram

	* einfo.ads: Fix typo in comment

	* exp_ch3.adb (Build_Assignment): Generate conversion to the
	null-excluding type to force the corresponding run-time check.
	(Expand_N_Object_Declaration): Generate conversion to the null-excluding
	type to force the corresponding run-time check.

	* exp_ch5.adb (Expand_N_Assignment_Statement): Generate conversion to
	the null-excluding type to force the corresponding run-time check.

	* exp_ch6.adb (Expand_Call): Do not generate the run-time check in
	case of access types unless they have the null-excluding attribute.

	* sprint.adb (Sprint_Node_Actual): Give support to the null-exclusing
	part.

	* exp_util.ads: Fix typo in comment

	* par.adb (P_Null_Exclusion): New subprogram
	(P_Subtype_Indication): New formal that indicates if the null-excluding
	part has been scanned-out and it was present

	* par-ch3.adb, par-ch4.adb, par-ch6.adb: Give support to AI-231

	* sem_aggr.adb: (Check_Can_Never_Be_Null): New subprogram
	(Aggregate_Constraint_Checks): Generate conversion to the null-excluding
	type to force the corresponding run-time check
	(Resolve_Aggregate): Propagate the null-excluding attribute to the array
	components
	(Resolve_Array_Aggregate): Carry out some static checks
	(Resolve_Record_Aggregate.Get_Value): Carry out some static check

	* sem_ch3.adb (Access_Definition): In Ada 0Y the Can_Never_Be_Null
	attribute must be set only if specified by means of the null-excluding
	part. In addition, we must also propagate the access-constant attribute
	if present.
	(Access_Subprogram_Declaration, Access_Type_Declaration,
	Analyze_Component_Declaration, Analyze_Object_Declaration,
	Array_Type_Declaration, Process_Discriminants,
	Analyze_Subtype_Declaration): Propagate the null-excluding attribute
	and carry out some static checks.
	(Build_Derived_Access_Type): Set the null-excluding attribute
	(Derived_Type_Declaration, Process_Subtype): Carry out some static
	checks.

	* sem_ch4.adb (Analyze_Allocator): Carry out some static checks

	* sem_ch5.adb (Analyze_Assignment): Carry out some static checks

	* sem_ch6.adb (Process_Formals): Carry out some static checks.
	(Set_Actual_Subtypes): Generate null-excluding subtype if the
	null-excluding part was present; it is not required to be done here in
	case of anonymous access types.
	(Set_Formal_Mode): Ada 0Y allows anonymous access to have the null
	value.

	* sem_res.adb (Resolve_Actuals): Carry out some static check
	(Resolve_Null): Allow null in anonymous access

	* sinfo.adb: New subprogram Null_Exclusion_Present
	All_Present and Constant_Present available on access_definition nodes

	* sinfo.ads: New flag Null_Exclusion_Present on subtype_declaration,
	object_declaration, derived_type_definition, component_definition,
	discriminant_specification, access_to_object_definition,
	access_function_definition, allocator, access_procedure_definition,
	access_definition, parameter_specification, All_Present and
	Constant_Present flags available on access_definition nodes.

2004-03-29  Robert Dewar  <dewar@gnat.com>

	* fname.adb, fname.ads, fname-sf.adb, fname-uf.adb, fname-uf.ads,
	gnat1drv.adb, lib.adb, lib.ads, lib-load.adb, lib-writ.adb,
	opt.ads, osint.adb, osint.ads, osint-c.adb, par.adb,
	par-ch10.adb, par-load.adb, par-prag.adb, sfn_scan.adb,
	sfn_scan.ads, sinput-l.adb, sinput-l.ads, switch-c.adb,
	sem_prag.adb: Updates to handle multiple units/file

	* par.adb: Change test for s-rpc to s-rp for detecting rpc and children

	* par.adb, memtrack.adb, prj-makr.adb, prj-part.adb,
	sem_util.adb: Minor reformatting

	* sem_ch12.adb: Add comment for previous change

2004-03-29  Laurent Pautet  <pautet@act-europe.fr>

	* osint.adb (Executable_Prefix): Set Exec_Name to the current
	executable name when not initialized. Otherwise, use its current value.

	* osint.ads (Exec_Name): Move Exec_Name from body to spec in order to
	initialize it to another executable name than the current one. This
	allows to configure paths for an executable name (gnatmake) different
	from the current one (gnatdist).

2004-03-29  Ed Schonberg  <schonberg@gnat.com>

	* exp_ch6.adb (Expand_Call): A call to a function declared in the
	current unit cannot be inlined if it appears in the body of a withed
	unit, to avoid order of elaboration problems in gigi.

	* exp_ch9.adb (Build_Protected_Sub_Specification): Generate debugging
	information for protected (wrapper) operation as well, to simplify gdb
	use.

	* sem_ch6.adb (Analyze_Subprogram_Body): For a private operation in a
	protected body, indicate that the entity for the generated spec comes
	from source, to ensure that references are properly generated for it.
	(Build_Body_To_Inline): Do not inline a function that returns a
	controlled type.

	* sem_prag.adb (Process_Convention): If subprogram is overloaded, only
	apply convention to homonyms that are declared explicitly.

	* sem_res.adb (Make_Call_Into_Operator): If the operation is a function
	that renames an equality operator and the operands are overloaded,
	resolve them with the declared formal types, before rewriting as an
	operator.

2004-03-29  GNAT Script  <nobody@gnat.com>

	* Make-lang.in: Makefile automatically updated


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@80055 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 92 insertions, 12 deletions

diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index 897e9b500af..4d8a67d9a17 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2003 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
 --                                                                          --
 -- 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- --
@@ -78,6 +78,9 @@ package body Sem_Aggr is
    --  statement of variant part will usually be small and probably in near
    --  sorted order.
 
+   procedure Check_Can_Never_Be_Null (N : Node_Id; Expr : Node_Id);
+   --  Ada 0Y (AI-231): Check bad usage of the null-exclusion issue
+
    ------------------------------------------------------
    -- Subprograms used for RECORD AGGREGATE Processing --
    ------------------------------------------------------
@@ -465,6 +468,17 @@ package body Sem_Aggr is
             Analyze_And_Resolve (Exp, Check_Typ);
             Check_Unset_Reference (Exp);
          end if;
+
+      --  Ada 0Y (AI-231): Generate conversion to the null-excluding
+      --  type to force the corresponding run-time check
+
+      elsif Is_Access_Type (Check_Typ)
+        and then Can_Never_Be_Null (Check_Typ)
+        and then not Can_Never_Be_Null (Exp_Typ)
+      then
+         Rewrite (Exp, Convert_To (Check_Typ, Relocate_Node (Exp)));
+         Analyze_And_Resolve (Exp, Check_Typ);
+         Check_Unset_Reference (Exp);
       end if;
    end Aggregate_Constraint_Checks;
 
@@ -867,7 +881,7 @@ package body Sem_Aggr is
          Error_Msg_N ("aggregate type cannot have limited component", N);
          Explain_Limited_Type (Typ, N);
 
-      --  Ada0Y (AI-287): Limited aggregates allowed
+      --  Ada 0Y (AI-287): Limited aggregates allowed
 
       elsif Is_Limited_Type (Typ)
         and not Extensions_Allowed
@@ -965,6 +979,13 @@ package body Sem_Aggr is
 
             Set_Etype (N, Aggr_Typ);  --  may be overridden later on.
 
+            --  Ada 0Y (AI-231): Propagate the null_exclusion attribute to the
+            --  components of the array aggregate
+
+            if Extensions_Allowed then
+               Set_Can_Never_Be_Null (Aggr_Typ, Can_Never_Be_Null (Typ));
+            end if;
+
             if Is_Constrained (Typ) and then
               (Pkind = N_Assignment_Statement      or else
                Pkind = N_Parameter_Association     or else
@@ -1644,12 +1665,16 @@ package body Sem_Aggr is
                   end if;
                end loop;
 
-               --  Ada0Y (AI-287): In case of default initialized component
+               --  Ada 0Y (AI-231)
+
+               Check_Can_Never_Be_Null (N, Expression (Assoc));
+
+               --  Ada 0Y (AI-287): In case of default initialized component
                --  we delay the resolution to the expansion phase
 
                if Box_Present (Assoc) then
 
-                  --  Ada0Y (AI-287): In case of default initialization of a
+                  --  Ada 0Y (AI-287): In case of default initialization of a
                   --  component the expander will generate calls to the
                   --  corresponding initialization subprogram.
 
@@ -1776,6 +1801,8 @@ package body Sem_Aggr is
          while Present (Expr) loop
             Nb_Elements := Nb_Elements + 1;
 
+            Check_Can_Never_Be_Null (N, Expr); --  Ada 0Y (AI-231)
+
             if not Resolve_Aggr_Expr (Expr, Single_Elmt => True) then
                return Failure;
             end if;
@@ -1786,12 +1813,14 @@ package body Sem_Aggr is
          if Others_Present then
             Assoc := Last (Component_Associations (N));
 
-            --  Ada0Y (AI-287): In case of default initialized component
+            Check_Can_Never_Be_Null (N, Expression (Assoc)); -- Ada 0Y (AI-231)
+
+            --  Ada 0Y (AI-287): In case of default initialized component
             --  we delay the resolution to the expansion phase.
 
             if Box_Present (Assoc) then
 
-               --  Ada0Y (AI-287): In case of default initialization of a
+               --  Ada 0Y (AI-287): In case of default initialization of a
                --  component the expander will generate calls to the
                --  corresponding initialization subprogram.
 
@@ -1958,7 +1987,7 @@ package body Sem_Aggr is
 
       elsif Is_Limited_Type (Typ) then
 
-         --  Ada0Y (AI-287): Limited aggregates are allowed
+         --  Ada 0Y (AI-287): Limited aggregates are allowed
 
          if Extensions_Allowed then
             null;
@@ -2069,7 +2098,7 @@ package body Sem_Aggr is
 
       Mbox_Present : Boolean := False;
       Others_Mbox  : Boolean := False;
-      --  Ada0Y (AI-287): Variables used in case of default initialization to
+      --  Ada 0Y (AI-287): Variables used in case of default initialization to
       --  provide a functionality similar to Others_Etype. Mbox_Present
       --  indicates that the component takes its default initialization;
       --  Others_Mbox indicates that at least one component takes its default
@@ -2258,7 +2287,7 @@ package body Sem_Aggr is
                and then Comes_From_Source (Compon)
                and then not In_Instance_Body
             then
-               --  Ada0Y (AI-287): Limited aggregates are allowed
+               --  Ada 0Y (AI-287): Limited aggregates are allowed
 
                if Extensions_Allowed
                  and then Present (Expression (Assoc))
@@ -2298,7 +2327,7 @@ package body Sem_Aggr is
                      --  indispensable otherwise, because each one must be
                      --  expanded individually to preserve side-effects.
 
-                     --  Ada0Y (AI-287): In case of default initialization of
+                     --  Ada 0Y (AI-287): In case of default initialization of
                      --  components, we duplicate the corresponding default
                      --  expression (from the record type declaration).
 
@@ -2336,10 +2365,24 @@ package body Sem_Aggr is
                elsif Chars (Compon) = Chars (Selector_Name) then
                   if No (Expr) then
 
+                     --  Ada 0Y (AI-231)
+
+                     if Extensions_Allowed
+                       and then Present (Expression (Assoc))
+                       and then Nkind (Expression (Assoc)) = N_Null
+                       and then Can_Never_Be_Null (Compon)
+                     then
+                        Error_Msg_N
+                          ("(Ada 0Y) NULL not allowed in null-excluding " &
+                           "components", Expression (Assoc));
+                     end if;
+
                      --  We need to duplicate the expression when several
                      --  components are grouped together with a "|" choice.
                      --  For instance "filed1 | filed2 => Expr"
 
+                     --  Ada 0Y (AI-287)
+
                      if Box_Present (Assoc) then
                         Mbox_Present := True;
 
@@ -2643,6 +2686,18 @@ package body Sem_Aggr is
          while Present (Discrim) and then Present (Positional_Expr) loop
             if Discr_Present (Discrim) then
                Resolve_Aggr_Expr (Positional_Expr, Discrim);
+
+               --  Ada 0Y (AI-231)
+
+               if Extensions_Allowed
+                 and then Nkind (Positional_Expr) = N_Null
+                 and then Can_Never_Be_Null (Discrim)
+               then
+                  Error_Msg_N
+                    ("(Ada 0Y) NULL not allowed in null-excluding components",
+                     Positional_Expr);
+               end if;
+
                Next (Positional_Expr);
             end if;
 
@@ -2874,6 +2929,16 @@ package body Sem_Aggr is
          Component := Node (Component_Elmt);
          Resolve_Aggr_Expr (Positional_Expr, Component);
 
+         --  Ada 0Y (AI-231)
+         if Extensions_Allowed
+           and then Nkind (Positional_Expr) = N_Null
+           and then Can_Never_Be_Null (Component)
+         then
+            Error_Msg_N
+              ("(Ada 0Y) NULL not allowed in null-excluding components",
+               Positional_Expr);
+         end if;
+
          if Present (Get_Value (Component, Component_Associations (N))) then
             Error_Msg_NE
               ("more than one value supplied for Component &", N, Component);
@@ -2896,7 +2961,7 @@ package body Sem_Aggr is
 
          if Mbox_Present and then Is_Limited_Type (Etype (Component)) then
 
-            --  Ada0Y (AI-287): In case of default initialization of a limited
+            --  Ada 0Y (AI-287): In case of default initialization of a limited
             --  component we pass the limited component to the expander. The
             --  expander will generate calls to the corresponding initiali-
             --  zation subprograms.
@@ -2937,7 +3002,7 @@ package body Sem_Aggr is
 
             if Nkind (Selectr) = N_Others_Choice then
 
-               --  Ada0Y (AI-287):  others choice may have expression or mbox
+               --  Ada 0Y (AI-287):  others choice may have expression or mbox
 
                if No (Others_Etype)
                   and then not Others_Mbox
@@ -3015,6 +3080,21 @@ package body Sem_Aggr is
       end Step_8;
    end Resolve_Record_Aggregate;
 
+   -----------------------------
+   -- Check_Can_Never_Be_Null --
+   -----------------------------
+
+   procedure Check_Can_Never_Be_Null (N : Node_Id; Expr : Node_Id) is
+   begin
+      if Extensions_Allowed
+        and then Nkind (Expr) = N_Null
+        and then Can_Never_Be_Null (Etype (N))
+      then
+         Error_Msg_N
+           ("(Ada 0Y) NULL not allowed in null-excluding components", Expr);
+      end if;
+   end Check_Can_Never_Be_Null;
+
    ---------------------
    -- Sort_Case_Table --
    ---------------------