[multiple changes]

2011-08-01  Geert Bosch  <bosch@adacore.com>

	* par-ch3.adb (P_Discrete_Choice_List): Improve error message for extra
	"," in choice list.

2011-08-01  Thomas Quinot  <quinot@adacore.com>

	* exp_ch11.adb (Expand_N_Raise_Statement): Mark N_Raise_xxx_Error for
	explicit raise of a predefined exception as Comes_From_Source if the
	original N_Raise_Statement comes from source.

2011-08-01  Robert Dewar  <dewar@adacore.com>

	* sinfo.ads: Add comment.
	* sem_ch6.adb: Minor reformatting.

2011-08-01  Robert Dewar  <dewar@adacore.com>

	* freeze.adb (Freeze_Entity): Refine check for bad component size
	clause to avoid rejecting confirming clause when atomic/aliased present.

2011-08-01  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch8.adb (Find_Direct_Name, Analyze_Expanded_Name): use Is_LHS to
	better determine whether an entity reference is a write.
	* sem_util.adb (Is_LHS): refine predicate to handle assignment to a
	subcomponent.
	* lib-xref.adb (Output_References): Do no suppress a read reference at
	the same location as an immediately preceeding modify-reference, to
	handle properly in-out actuals.

2011-08-01  Tristan Gingold  <gingold@adacore.com>

	* env.c (__gnat_setenv) [VMS]: Refine previous change.

2011-08-01  Quentin Ochem  <ochem@adacore.com>

	* i-cstrin.adb (New_String): Changed implementation, now uses only the
	heap to compute the result.

From-SVN: r177029

gcc/ada/ChangeLog

+2011-08-01  Geert Bosch  <bosch@adacore.com>
+
+	* par-ch3.adb (P_Discrete_Choice_List): Improve error message for extra
+	"," in choice list.
+
+2011-08-01  Thomas Quinot  <quinot@adacore.com>
+
+	* exp_ch11.adb (Expand_N_Raise_Statement): Mark N_Raise_xxx_Error for
+	explicit raise of a predefined exception as Comes_From_Source if the
+	original N_Raise_Statement comes from source.
+
+2011-08-01  Robert Dewar  <dewar@adacore.com>
+
+	* sinfo.ads: Add comment.
+	* sem_ch6.adb: Minor reformatting.
+
+2011-08-01  Robert Dewar  <dewar@adacore.com>
+
+	* freeze.adb (Freeze_Entity): Refine check for bad component size
+	clause to avoid rejecting confirming clause when atomic/aliased present.
+
+2011-08-01  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch8.adb (Find_Direct_Name, Analyze_Expanded_Name): use Is_LHS to
+	better determine whether an entity reference is a write.
+	* sem_util.adb (Is_LHS): refine predicate to handle assignment to a
+	subcomponent.
+	* lib-xref.adb (Output_References): Do no suppress a read reference at
+	the same location as an immediately preceeding modify-reference, to
+	handle properly in-out actuals.
+
+2011-08-01  Tristan Gingold  <gingold@adacore.com>
+
+	* env.c (__gnat_setenv) [VMS]: Refine previous change.
+
+2011-08-01  Quentin Ochem  <ochem@adacore.com>
+
+	* i-cstrin.adb (New_String): Changed implementation, now uses only the
+	heap to compute the result.
+
 2011-08-01  Robert Dewar  <dewar@adacore.com>
 
 	* atree.ads: Minor reformatting.

gcc/ada/env.c

@@ -50,7 +50,6 @@ extern "C" {
 #include <time.h>
 #ifdef VMS
 #include <unixio.h>
-#include <vms/descrip.h>
 #endif
 
 #if defined (__MINGW32__)
@@ -74,6 +73,10 @@ extern char** ppGlobalEnviron;
 #include <crt_externs.h>
 #endif
 
+#ifdef VMS
+#include <vms/descrip.h>
+#endif
+
 #include "env.h"
 
 void

gcc/ada/exp_ch11.adb

@@ -1439,6 +1439,7 @@ package body Exp_Ch11 is
       E     : Entity_Id;
       Str   : String_Id;
       H     : Node_Id;
+      Src   : Boolean;
 
    begin
       --  Processing for locally handled exception (exclude reraise case)
@@ -1510,12 +1511,12 @@ package body Exp_Ch11 is
          return;
       end if;
 
-      --  Remaining processing is for the case where no string expression
-      --  is present.
+      --  Remaining processing is for the case where no string expression is
+      --  present.
 
-      --  Don't expand a raise statement that does not come from source
-      --  if we have already had configurable run-time violations, since
-      --  most likely it will be junk cascaded nonsense.
+      --  Don't expand a raise statement that does not come from source if we
+      --  have already had configurable run-time violations, since most likely
+      --  it will be junk cascaded nonsense.
 
       if Configurable_Run_Time_Violations > 0
         and then not Comes_From_Source (N)
@@ -1526,27 +1527,29 @@ package body Exp_Ch11 is
       --  Convert explicit raise of Program_Error, Constraint_Error, and
       --  Storage_Error into the corresponding raise (in High_Integrity_Mode
       --  all other raises will get normal expansion and be disallowed,
-      --  but this is also faster in all modes).
+      --  but this is also faster in all modes). Propagate Comes_From_Source
+      --  flag to the new node.
 
       if Present (Name (N)) and then Nkind (Name (N)) = N_Identifier then
+         Src := Comes_From_Source (N);
          if Entity (Name (N)) = Standard_Constraint_Error then
             Rewrite (N,
-              Make_Raise_Constraint_Error (Loc,
-                Reason => CE_Explicit_Raise));
+              Make_Raise_Constraint_Error (Loc, Reason => CE_Explicit_Raise));
+            Set_Comes_From_Source (N, Src);
             Analyze (N);
             return;
 
          elsif Entity (Name (N)) = Standard_Program_Error then
             Rewrite (N,
-              Make_Raise_Program_Error (Loc,
-                Reason => PE_Explicit_Raise));
+              Make_Raise_Program_Error (Loc, Reason => PE_Explicit_Raise));
+            Set_Comes_From_Source (N, Src);
             Analyze (N);
             return;
 
          elsif Entity (Name (N)) = Standard_Storage_Error then
             Rewrite (N,
-              Make_Raise_Storage_Error (Loc,
-                Reason => SE_Explicit_Raise));
+              Make_Raise_Storage_Error (Loc, Reason => SE_Explicit_Raise));
+            Set_Comes_From_Source (N, Src);
             Analyze (N);
             return;
          end if;

gcc/ada/freeze.adb

@@ -3447,12 +3447,28 @@ package body Freeze is
                      --  Start of processing for Alias_Atomic_Check
 
                      begin
-                        --  Case where component size has no effect
+                        --  Case where component size has no effect. First
+                        --  check for object size of component type known
+                        --  and a multiple of the storage unit size.
 
                         if Known_Static_Esize (Ctyp)
-                          and then Known_Static_RM_Size (Ctyp)
-                          and then Esize (Ctyp) = RM_Size (Ctyp)
-                          and then Esize (Ctyp) mod 8 = 0
+                          and then Esize (Ctyp) mod System_Storage_Unit = 0
+
+                          --  OK in both packing case and component size case
+                          --  if RM size is known and static and the same as
+                          --  the object size.
+
+                          and then
+                            ((Known_Static_RM_Size (Ctyp)
+                               and then Esize (Ctyp) = RM_Size (Ctyp))
+
+                             --  Or if we have an explicit component size
+                             --  clause and the component size and object size
+                             --  are equal.
+
+                             or else
+                                 (Has_Component_Size_Clause (E)
+                                 and then Component_Size (E) = Esize (Ctyp)))
                         then
                            null;
 

gcc/ada/i-cstrin.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2010, 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- --
@@ -139,8 +139,24 @@ package body Interfaces.C.Strings is
    ----------------
 
    function New_String (Str : String) return chars_ptr is
+      --  It's important that this subprogram uses directly the heap to compute
+      --  the result, and doesn't copy the string on the stack, otherwise its
+      --  use is limited when used from tasks on large strings.
+
+      Result       : constant chars_ptr := Memory_Alloc (Str'Length + 1);
+      Result_Array : char_array  (1 .. Str'Length + 1);
+      for Result_Array'Address use To_Address (Result);
+      pragma Import (Ada, Result_Array);
+
+      Count : size_t;
    begin
-      return New_Char_Array (To_C (Str));
+      To_C
+        (Item       => Str,
+         Target     => Result_Array,
+         Count      => Count,
+         Append_Nul => True);
+
+      return Result;
    end New_String;
 
    ----------

gcc/ada/lib-xref.adb

@@ -1377,6 +1377,9 @@ package body Lib.Xref is
          Ctyp : Character;
          --  Entity type character
 
+         Prevt : Character;
+         --  reference kind of previous reference
+
          Tref : Entity_Id;
          --  Type reference
 
@@ -1519,6 +1522,7 @@ package body Lib.Xref is
          Curdef := No_Location;
          Curru  := No_Unit;
          Crloc  := No_Location;
+         Prevt  := 'm';
 
          --  Loop to output references
 
@@ -2193,12 +2197,17 @@ package body Lib.Xref is
                      Crloc := No_Location;
                   end if;
 
-                  --  Output the reference
+                  --  Output the reference if it is not as the same location
+                  --  as the previous one, or it is a read-reference that
+                  --  indicates that the entity is an in-out actual in a call.
 
                   if XE.Loc /= No_Location
-                     and then XE.Loc /= Crloc
+                    and then
+                      (XE.Loc /= Crloc
+                         or else (Prevt = 'm' and then  XE.Typ = 'r'))
                   then
                      Crloc := XE.Loc;
+                     Prevt := XE.Typ;
 
                      --  Start continuation if line full, else blank
 

gcc/ada/par-ch3.adb

@@ -3714,13 +3714,23 @@ package body Ch3 is
          end if;
 
          if Token = Tok_Comma then
-            Error_Msg_SC -- CODEFIX
-              (""","" should be ""'|""");
+            Scan; -- past comma
+
+            if Token = Tok_Vertical_Bar then
+               Error_Msg_SP -- CODEFIX
+                 ("|extra "","" ignored");
+               Scan; -- past |
+
+            else
+               Error_Msg_SP -- CODEFIX
+                 (""","" should be ""'|""");
+            end if;
+
          else
             exit when Token /= Tok_Vertical_Bar;
+            Scan; -- past |
          end if;
 
-         Scan; -- past | or comma
       end loop;
 
       return Choices;

gcc/ada/sem_ch6.adb

@@ -1072,12 +1072,13 @@ package body Sem_Ch6 is
    procedure Analyze_Parameterized_Expression (N : Node_Id) is
       Loc      : constant Source_Ptr := Sloc (N);
       LocX     : constant Source_Ptr := Sloc (Expression (N));
-      Def_Id   : constant Entity_Id := Defining_Entity (Specification (N));
-      Prev     : constant Entity_Id := Current_Entity_In_Scope (Def_Id);
+      Def_Id   : constant Entity_Id  := Defining_Entity (Specification (N));
+      New_Body : Node_Id;
+
+      Prev : constant Entity_Id := Current_Entity_In_Scope (Def_Id);
       --  If the expression is a completion, Prev is the entity whose
       --  declaration is completed.
 
-      New_Body : Node_Id;
    begin
       --  This is one of the occasions on which we transform the tree during
       --  semantic analysis. Transform the parameterized expression into an
@@ -1096,7 +1097,6 @@ package body Sem_Ch6 is
       if Present (Prev)
         and then Ekind (Prev) = E_Generic_Function
       then
-
          --  If the expression completes a generic subprogram, we must create
          --  a separate node for the body, because at instantiation the
          --  original node of the generic copy must be a generic subprogram

gcc/ada/sem_ch8.adb

@@ -4574,10 +4574,21 @@ package body Sem_Ch8 is
             --
             --    The Is_Actual_Parameter routine takes care of one of these
             --    cases but there are others probably ???
+            --
+            --    If the entity is the LHS of an assignment, and is a variable
+            --    (rather than a package prefix),  we can mark it as a
+            --    modification right away, to avoid duplicate references.
 
             else
                if not Is_Actual_Parameter then
-                  Generate_Reference (E, N);
+                  if Is_LHS (N)
+                    and then Ekind (E) /= E_Package
+                    and then Ekind (E) /= E_Generic_Package
+                  then
+                     Generate_Reference (E, N, 'm');
+                  else
+                     Generate_Reference (E, N);
+                  end if;
                end if;
 
                Check_Nested_Access (E);
@@ -4980,7 +4991,12 @@ package body Sem_Ch8 is
          Set_Entity (N, Id);
       else
          Set_Entity_Or_Discriminal (N, Id);
-         Generate_Reference (Id, N);
+
+         if Is_LHS (N) then
+            Generate_Reference (Id, N, 'm');
+         else
+            Generate_Reference (Id, N);
+         end if;
       end if;
 
       if Is_Type (Id) then

gcc/ada/sem_util.adb

@@ -6663,8 +6663,17 @@ package body Sem_Util is
    function Is_LHS (N : Node_Id) return Boolean is
       P : constant Node_Id := Parent (N);
    begin
-      return Nkind (P) = N_Assignment_Statement
-        and then Name (P) = N;
+      if Nkind (P) = N_Assignment_Statement then
+         return Name (P) = N;
+
+      elsif
+        Nkind_In (P, N_Indexed_Component, N_Selected_Component, N_Slice)
+      then
+         return N = Prefix (P) and then Is_LHS (P);
+
+      else
+         return False;
+      end if;
    end Is_LHS;
 
    ----------------------------

gcc/ada/sinfo.ads

@@ -7449,6 +7449,13 @@ package Sinfo is
 
       --  N_Has_Etype, N_Has_Chars
 
+      --  Note: of course N_Error does not really have Etype or Chars fields,
+      --  and any attempt to access these fields in N_Error will cause an
+      --  error, but historically this always has been positioned so that an
+      --  "in N_Has_Chars" or "in N_Has_Etype" test yields true for N_Error.
+      --  Most likely this makes coding easier somewhere but still seems
+      --  undesirable. To be investigated some time ???
+
       N_Error,
 
       --  N_Entity, N_Has_Etype, N_Has_Chars