[multiple changes]

2015-11-12  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch8.adb (Find_Selected_Component): In a synchronized
	body, a reference to an operation of an object of the same
	synchronized type was always interpreted as a reference to the
	current instance. This is not always the case, as the prefix of
	the reference may designate an object of the same type declared
	in the enclosing context prior to the body.

2015-11-12  Arnaud Charlet  <charlet@adacore.com>

	* impunit.ads, impunit.adb (Get_Kind_Of_File): New. Cleaned up
	implementation from previous Get_Kind_Of_Unit.
	(Get_Kind_Of_Unit): Reimplemented using Get_Kind_Of_File.
	* debug.adb: Remove d.4 switch, no longer used.
	* opt.ads: Update doc on Debugger_Level.
	* gnat1drv.adb: Code clean ups.
	* sinput.ads: minor fix in comment

2015-11-12  Bob Duff  <duff@adacore.com>

	* sinfo.adb, sinfo.ads, sem_ch6.adb, atree.ads: Add
	Was_Expression_Function flag, which is set in sem_ch6.adb when
	converting an Expression_Function into a Subprogram_Body.

2015-11-12  Pascal Obry  <obry@adacore.com>

	* usage.adb: Update overflow checking documentation.

From-SVN: r230243

gcc/ada/ChangeLog

+2015-11-12  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch8.adb (Find_Selected_Component): In a synchronized
+	body, a reference to an operation of an object of the same
+	synchronized type was always interpreted as a reference to the
+	current instance. This is not always the case, as the prefix of
+	the reference may designate an object of the same type declared
+	in the enclosing context prior to the body.
+
+2015-11-12  Arnaud Charlet  <charlet@adacore.com>
+
+	* impunit.ads, impunit.adb (Get_Kind_Of_File): New. Cleaned up
+	implementation from previous Get_Kind_Of_Unit.
+	(Get_Kind_Of_Unit): Reimplemented using Get_Kind_Of_File.
+	* debug.adb: Remove d.4 switch, no longer used.
+	* opt.ads: Update doc on Debugger_Level.
+	* gnat1drv.adb: Code clean ups.
+	* sinput.ads: minor fix in comment
+
+2015-11-12  Bob Duff  <duff@adacore.com>
+
+	* sinfo.adb, sinfo.ads, sem_ch6.adb, atree.ads: Add
+	Was_Expression_Function flag, which is set in sem_ch6.adb when
+	converting an Expression_Function into a Subprogram_Body.
+
+2015-11-12  Pascal Obry  <obry@adacore.com>
+
+	* usage.adb: Update overflow checking documentation.
+
 2015-11-12  Tristan Gingold  <gingold@adacore.com>
 
 	* snames.ads-tmpl: Name_Gnat_Extended_Ravenscar: New identifier.

gcc/ada/atree.ads

@@ -181,7 +181,7 @@ package Atree is
    --   Flag10
    --   Flag11        Note that Flag0-3 are stored separately in the Flags
    --   Flag12        table, but that's a detail of the implementation which
-   --   Flag13        is entirely hidden by the funcitonal interface.
+   --   Flag13        is entirely hidden by the functional interface.
    --   Flag14
    --   Flag15
    --   Flag16

gcc/ada/gnat1drv.adb

@@ -148,12 +148,16 @@ procedure Gnat1drv is
          Generate_C_Code := True;
          Modify_Tree_For_C := True;
          Unnest_Subprogram_Mode := True;
-         Back_Annotate_Rep_Info := True;
 
          --  Set operating mode to Generate_Code to benefit from full front-end
          --  expansion (e.g. generics).
 
          Operating_Mode := Generate_Code;
+
+         --  Suppress alignment checks since we do not have access to alignment
+         --  info on the target
+
+         Suppress_Options.Suppress (Alignment_Check) := False;
       end if;
 
       --  -gnatd.E sets Error_To_Warning mode, causing selected error messages
@@ -1346,8 +1350,8 @@ begin
       Back_End.Call_Back_End (Back_End_Mode);
 
       --  Once the backend is complete, we unlock the names table. This call
-      --  allows a few extra entries, needed for example for the file name for
-      --  the library file output.
+      --  allows a few extra entries, needed for example for the file name
+      --  for the library file output.
 
       Namet.Unlock;
 

gcc/ada/impunit.adb

@@ -635,23 +635,22 @@ package body Impunit is
                  ("utf_32", Sutf_32'Access));
 
    ----------------------
-   -- Get_Kind_Of_Unit --
+   -- Get_Kind_Of_File --
    ----------------------
 
-   function Get_Kind_Of_Unit (U : Unit_Number_Type) return Kind_Of_Unit is
-      Fname : constant File_Name_Type := Unit_File_Name (U);
+   function Get_Kind_Of_File (File : String) return Kind_Of_Unit is
+      pragma Assert (File'First = 1);
+
+      Buffer : String (1 .. 8);
 
    begin
       Error_Msg_Strlen := 0;
-      Get_Name_String (Fname);
 
       --  Ada/System/Interfaces are all Ada 95 units
 
-      if (Name_Len =  7 and then Name_Buffer (1 ..  7) = "ada.ads")
-           or else
-         (Name_Len = 10 and then Name_Buffer (1 .. 10) = "system.ads")
-           or else
-         (Name_Len = 12 and then Name_Buffer (1 .. 12) = "interfac.ads")
+      if File = "ada.ads"
+        or else File = "system.ads"
+        or else File = "interfac.ads"
       then
          return Ada_95_Unit;
       end if;
@@ -659,21 +658,19 @@ package body Impunit is
       --  If length of file name is greater than 12, not predefined. The value
       --  12 here is an 8 char name with extension .ads.
 
-      if Name_Len > 12 then
+      if File'Length > 12 then
          return Not_Predefined_Unit;
       end if;
 
       --  Not predefined if file name does not start with a- g- s- i-
 
-      if Name_Len < 3
-        or else Name_Buffer (2) /= '-'
-        or else (Name_Buffer (1) /= 'a'
-                   and then
-                 Name_Buffer (1) /= 'g'
-                   and then
-                 Name_Buffer (1) /= 'i'
-                   and then
-                 Name_Buffer (1) /= 's')
+      if File'Length < 3
+        or else File (2) /= '-'
+        or else
+          (File (1) /= 'a'
+            and then File (1) /= 'g'
+            and then File (1) /= 'i'
+            and then File (1) /= 's')
       then
          return Not_Predefined_Unit;
       end if;
@@ -687,25 +684,25 @@ package body Impunit is
       --  this routine to detect when a construct comes from an instance of
       --  a generic defined in a predefined unit.
 
-      if Name_Buffer (Name_Len - 3 .. Name_Len) /= ".ads"
+      if File (File'Last - 3 .. File'Last) /= ".ads"
            and then
-         Name_Buffer (Name_Len - 3 .. Name_Len) /= ".adb"
+         File (File'Last - 3 .. File'Last) /= ".adb"
       then
          return Not_Predefined_Unit;
       end if;
 
       --  Otherwise normalize file name to 8 characters
 
-      Name_Len := Name_Len - 4;
-      while Name_Len < 8 loop
-         Name_Len := Name_Len + 1;
-         Name_Buffer (Name_Len) := ' ';
+      Buffer (1 .. File'Length - 4) := File (1 .. File'Length - 4);
+
+      for J in File'Length - 3 .. 8 loop
+         Buffer (J) := ' ';
       end loop;
 
       --  See if name is in 95 list
 
       for J in Non_Imp_File_Names_95'Range loop
-         if Name_Buffer (1 .. 8) = Non_Imp_File_Names_95 (J).Fname then
+         if Buffer = Non_Imp_File_Names_95 (J).Fname then
             return Ada_95_Unit;
          end if;
       end loop;
@@ -713,7 +710,7 @@ package body Impunit is
       --  See if name is in 2005 list
 
       for J in Non_Imp_File_Names_05'Range loop
-         if Name_Buffer (1 .. 8) = Non_Imp_File_Names_05 (J).Fname then
+         if Buffer = Non_Imp_File_Names_05 (J).Fname then
             return Ada_2005_Unit;
          end if;
       end loop;
@@ -721,7 +718,7 @@ package body Impunit is
       --  See if name is in 2012 list
 
       for J in Non_Imp_File_Names_12'Range loop
-         if Name_Buffer (1 .. 8) = Non_Imp_File_Names_12 (J).Fname then
+         if Buffer = Non_Imp_File_Names_12 (J).Fname then
             return Ada_2012_Unit;
          end if;
       end loop;
@@ -729,22 +726,9 @@ package body Impunit is
       --  Only remaining special possibilities are children of System.RPC and
       --  System.Garlic and special files of the form System.Aux...
 
-      Get_Name_String (Unit_Name (U));
-
-      if Name_Len > 12
-        and then Name_Buffer (1 .. 11) = "system.rpc."
-      then
-         return Ada_95_Unit;
-      end if;
-
-      if Name_Len > 15
-        and then Name_Buffer (1 .. 14) = "system.garlic."
-      then
-         return Ada_95_Unit;
-      end if;
-
-      if Name_Len > 11
-        and then Name_Buffer (1 .. 10) = "system.aux"
+      if File (1 .. 5) = "s-rpc"
+        or else File (1 .. 5) = "s-gar"
+        or else File (1 .. 5) = "s-aux"
       then
          return Ada_95_Unit;
       end if;
@@ -752,18 +736,16 @@ package body Impunit is
       --  All tests failed, this is definitely an implementation unit. See if
       --  we have an alternative name.
 
-      Get_Name_String (Fname);
-
-      if Name_Len in 11 .. 12
-        and then Name_Buffer (1 .. 2) = "s-"
-        and then Name_Buffer (Name_Len - 3 .. Name_Len) = ".ads"
+      if File'Length in 11 .. 12
+        and then File (1 .. 2) = "s-"
+        and then File (File'Last - 3 .. File'Last) = ".ads"
       then
          for J in Map_Array'Range loop
-            if (Name_Len = 12 and then
-                 Name_Buffer (3 .. 8) = Map_Array (J).Fname)
+            if (File'Length = 12 and then
+                 File (3 .. 8) = Map_Array (J).Fname)
               or else
-               (Name_Len = 11 and then
-                 Name_Buffer (3 .. 7) = Map_Array (J).Fname (1 .. 5))
+               (File'Length = 11 and then
+                 File (3 .. 7) = Map_Array (J).Fname (1 .. 5))
             then
                Error_Msg_Strlen := Map_Array (J).Aname'Length;
                Error_Msg_String (1 .. Error_Msg_Strlen) :=
@@ -773,6 +755,16 @@ package body Impunit is
       end if;
 
       return Implementation_Unit;
+   end Get_Kind_Of_File;
+
+   ----------------------
+   -- Get_Kind_Of_Unit --
+   ----------------------
+
+   function Get_Kind_Of_Unit (U : Unit_Number_Type) return Kind_Of_Unit is
+   begin
+      Get_Name_String (Unit_File_Name (U));
+      return Get_Kind_Of_File (Name_Buffer (1 .. Name_Len));
    end Get_Kind_Of_Unit;
 
    -------------------

gcc/ada/impunit.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2000-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 2000-2015, 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- --
@@ -62,11 +62,14 @@ package Impunit is
    function Get_Kind_Of_Unit (U : Unit_Number_Type) return Kind_Of_Unit;
    --  Given the unit number of a unit, this function determines the type
    --  of the unit, as defined above. If the result is Implementation_Unit,
-   --  then the name of a possible atlernative equivalent unit is placed in
+   --  then the name of a possible alternative equivalent unit is placed in
    --  Error_Msg_String/Slen on return. If there is no alternative name, or if
    --  the result is not Implementation_Unit, then Error_Msg_Slen is zero on
    --  return, indicating that no alternative name was found.
 
+   function Get_Kind_Of_File (File : String) return Kind_Of_Unit;
+   --  Same as Get_Kind_Of_Unit, for a given filename
+
    function Is_Known_Unit (Nam : Node_Id) return Boolean;
    --  Nam is the possible name of a child unit, represented as a selected
    --  component node. This function determines whether the name matches one of

gcc/ada/opt.ads

@@ -422,8 +422,9 @@ package Opt is
    subtype Debug_Level_Value is Nat range 0 .. 3;
    Debugger_Level : Debug_Level_Value := 0;
    --  The value given to the -g parameter. The default value for -g with
-   --  no value is 2. This is not currently used but is retained for possible
-   --  future use.
+   --  no value is 2. If no -g is specified, defaults to 0.
+   --  Note that the generated code should never depend on this variable,
+   --  since we want debug info to be non intrusive on the generate code.
 
    Default_Exit_Status : Int := 0;
    --  GNATBIND

gcc/ada/sem_ch6.adb

@@ -334,6 +334,7 @@ package body Sem_Ch6 is
           Handled_Statement_Sequence =>
             Make_Handled_Sequence_Of_Statements (LocX,
               Statements => New_List (Ret)));
+      Set_Was_Expression_Function (New_Body);
 
       --  If the expression completes a generic subprogram, we must create a
       --  separate node for the body, because at instantiation the original

gcc/ada/sem_ch8.adb

@@ -6774,7 +6774,26 @@ package body Sem_Ch8 is
             --  Prefix denotes an enclosing loop, block, or task, i.e. an
             --  enclosing construct that is not a subprogram or accept.
 
-            Find_Expanded_Name (N);
+            --  A special case: a protected body may call an operation
+            --  on an external object of the same type, in which case it
+            --  is not an expanded name. If the prefix is the type itself,
+            --  or the context is a single synchronized object it can only
+            --  be interpreted as an expanded name.
+
+            if Is_Concurrent_Type (Etype (P_Name)) then
+               if Is_Type (P_Name)
+                  or else Present (Anonymous_Object (Etype (P_Name)))
+               then
+                  Find_Expanded_Name (N);
+
+               else
+                  Analyze_Selected_Component (N);
+                  return;
+               end if;
+
+            else
+               Find_Expanded_Name (N);
+            end if;
 
          elsif Ekind (P_Name) = E_Package then
             Find_Expanded_Name (N);

gcc/ada/sinfo.adb

@@ -3286,6 +3286,14 @@ package body Sinfo is
       return Elist5 (N);
    end Used_Operations;
 
+   function Was_Expression_Function
+      (N : Node_Id) return Boolean is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Subprogram_Body);
+      return Flag18 (N);
+   end Was_Expression_Function;
+
    function Was_Originally_Stub
       (N : Node_Id) return Boolean is
    begin
@@ -6525,6 +6533,14 @@ package body Sinfo is
       Set_Elist5 (N, Val);
    end Set_Used_Operations;
 
+   procedure Set_Was_Expression_Function
+      (N : Node_Id; Val : Boolean := True) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Subprogram_Body);
+      Set_Flag18 (N, Val);
+   end Set_Was_Expression_Function;
+
    procedure Set_Was_Originally_Stub
       (N : Node_Id; Val : Boolean := True) is
    begin

gcc/ada/sinfo.ads

@@ -2220,6 +2220,14 @@ package Sinfo is
    --    on exit from the scope of the use_type_clause, in particular in the
    --    case of Use_All_Type, when those operations several scopes.
 
+   --  Was_Expression_Function (Flag18-Sem)
+   --    Present in N_Subprogram_Body. True if the original source had an
+   --    N_Expression_Function, which was converted to the N_Subprogram_Body
+   --    by Analyze_Expression_Function. This is needed by ASIS to correctly
+   --    recreate the expression function (for the instance body) when the
+   --    completion of a generic function declaration is an expression
+   --    function.
+
    --  Was_Originally_Stub (Flag13-Sem)
    --    This flag is set in the node for a proper body that replaces stub.
    --    During the analysis procedure, stubs in some situations get rewritten
@@ -5212,6 +5220,7 @@ package Sinfo is
       --  Is_Task_Master (Flag5-Sem)
       --  Was_Originally_Stub (Flag13-Sem)
       --  Has_Relative_Deadline_Pragma (Flag9-Sem)
+      --  Was_Expression_Function (Flag18-Sem)
 
       -------------------------
       -- Expression Function --
@@ -9795,6 +9804,9 @@ package Sinfo is
    function Used_Operations
      (N : Node_Id) return Elist_Id;   -- Elist5
 
+   function Was_Expression_Function
+     (N : Node_Id) return Boolean;    -- Flag18
+
    function Was_Originally_Stub
      (N : Node_Id) return Boolean;    -- Flag13
 
@@ -10830,6 +10842,9 @@ package Sinfo is
    procedure Set_Used_Operations
      (N : Node_Id; Val : Elist_Id);           -- Elist5
 
+   procedure Set_Was_Expression_Function
+     (N : Node_Id; Val : Boolean := True);    -- Flag18
+
    procedure Set_Was_Originally_Stub
      (N : Node_Id; Val : Boolean := True);    -- Flag13
 
@@ -12938,6 +12953,7 @@ package Sinfo is
    pragma Inline (Variants);
    pragma Inline (Visible_Declarations);
    pragma Inline (Used_Operations);
+   pragma Inline (Was_Expression_Function);
    pragma Inline (Was_Originally_Stub);
    pragma Inline (Withed_Body);
 
@@ -13277,6 +13293,7 @@ package Sinfo is
    pragma Inline (Set_Variant_Part);
    pragma Inline (Set_Variants);
    pragma Inline (Set_Visible_Declarations);
+   pragma Inline (Set_Was_Expression_Function);
    pragma Inline (Set_Was_Originally_Stub);
    pragma Inline (Set_Withed_Body);
 

gcc/ada/sinput.ads

@@ -608,7 +608,7 @@ package Sinput is
    function Num_Source_Lines (S : Source_File_Index) return Nat;
    --  Returns the number of source lines (this is equivalent to reading
    --  the value of Last_Source_Line, but returns Nat rather than a
-   --  physical line number.
+   --  physical line number).
 
    procedure Register_Source_Ref_Pragma
      (File_Name          : File_Name_Type;

gcc/ada/usage.adb

@@ -360,8 +360,11 @@ begin
 
    --  Line for -gnato switch
 
+   Write_Switch_Char ("o0");
+   Write_Line ("Disable overflow checking (on by default)");
+
    Write_Switch_Char ("o");
-   Write_Line ("Enable overflow checking mode to CHECKED (off by default)");
+   Write_Line ("Enable overflow checking in STRICT (-gnato1) mode (default)");
 
    --  Lines for -gnato? switches