2012-10-01 Vincent Pucci <pucci@adacore.com>

	* s-gearop.adb (Vector_Matrix_Product): Dimensions check fixed. Index
	of Left in S evaluation fixed.

2012-10-01  Javier Miranda  <miranda@adacore.com>

	* sem_ch3.adb (Analyze_Declarations): Avoid
	premature freezing caused by the internally generated subprogram
	_postconditions.
	* checks.adb (Expr_Known_Valid): Float literals are assumed to be valid
	in VM targets.

2012-10-01  Thomas Quinot  <quinot@adacore.com>

	* sinput.ads, sinput.adb, sinput-l.adb sinput-c.adb (Sinput): New
	Instances table, tracking all generic instantiations. Source file
	attribute Instance replaces previous Instantiation attribute with an
	index into the Instances table.
	(Iterate_On_Instances): New generic procedure.
	(Create_Instantiation_Source): Record instantiations in Instances.
	(Tree_Read, Tree_Write): Read/write the instance table.
	* scils.ads, scos.adb (SCO_Instance_Table): New table, contains
	information copied from Sinput.Instance_Table, but self-contained
	within the SCO data structures.
	* par_sco.ads, par_sco.adb (To_Source_Location): Move to library level.
	(Record_Instance): New subprogram, used by...
	(Populate_SCO_Instance_Table): New subprogram to fill
	the SCO instance table from the Sinput one (called by SCO_Output).
	* opt.ads (Generate_SCO_Instance_Table): New option.
	* put_scos.adb (Write_Instance_Table): New subprogram, used by...
	(Put_SCOs): Dump the instance table at the end of SCO information
	if requested.
	* get_scos.adb (Get_SCOs): Read SCO_Instance_Table.
	* types.h: Add declaration for Instance_Id.
	* back_end.adb (Call_Back_End): Pass instance ids in source file
	information table.
	(Scan_Back_End_Switches): -fdebug-instances sets
	Opt.Generate_SCO_Instance_Table.
	* gcc-interface/gigi.h: File_Info_Type includes instance id.
	* gcc-interface/trans.c: Under -fdebug-instances, set instance
	id in line map from same in file info.

2012-10-01  Thomas Quinot  <quinot@adacore.com>

	* sem_elab.adb: Minor reformatting
	(Check_Elab_Call): Minor fix to debugging code
	(add special circuit for the valid case where a 'Access attribute
	reference is passed to Check_Elab_Call).

2012-10-01  Thomas Quinot  <quinot@adacore.com>

	* exp_ch3.adb: Minor reformatting.



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

1 files changed, 156 insertions, 89 deletions

diff --git a/gcc/ada/sinput-l.adb b/gcc/ada/sinput-l.adb
index 52f3a713bb1..59d2aed4f99 100644
--- a/gcc/ada/sinput-l.adb
+++ b/gcc/ada/sinput-l.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, 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- --
@@ -38,6 +38,8 @@ with Prep;     use Prep;
 with Prepcomp; use Prepcomp;
 with Scans;    use Scans;
 with Scn;      use Scn;
+with Sem_Aux;  use Sem_Aux;
+with Sem_Util; use Sem_Util;
 with Sinfo;    use Sinfo;
 with Snames;   use Snames;
 with System;   use System;
@@ -138,127 +140,191 @@ package body Sinput.L is
       Source_File.Append (Source_File.Table (Xold));
       Xnew := Source_File.Last;
 
-      Source_File.Table (Xnew).Inlined_Body  := Inlined_Body;
-      Source_File.Table (Xnew).Instantiation := Sloc (Inst_Node);
-      Source_File.Table (Xnew).Template      := Xold;
+      declare
+         Sold : Source_File_Record renames Source_File.Table (Xold);
+         Snew : Source_File_Record renames Source_File.Table (Xnew);
 
-      --  Now we need to compute the new values of Source_First, Source_Last
-      --  and adjust the source file pointer to have the correct virtual
-      --  origin for the new range of values.
+         Inst_Spec : Node_Id;
 
-      Source_File.Table (Xnew).Source_First :=
-        Source_File.Table (Xnew - 1).Source_Last + 1;
-      A.Adjust := Source_File.Table (Xnew).Source_First - A.Lo;
-      Source_File.Table (Xnew).Source_Last := A.Hi + A.Adjust;
+      begin
+         Snew.Inlined_Body  := Inlined_Body;
+         Snew.Template      := Xold;
 
-      Set_Source_File_Index_Table (Xnew);
+         --  For a genuine generic instantiation, assign new instance id.
+         --  For inlined bodies, we retain that of the template, but we
+         --  save the call location.
 
-      Source_File.Table (Xnew).Sloc_Adjust :=
-        Source_File.Table (Xold).Sloc_Adjust - A.Adjust;
+         if Inlined_Body then
+            Snew.Inlined_Call := Sloc (Inst_Node);
 
-      if Debug_Flag_L then
-         Write_Eol;
-         Write_Str ("*** Create instantiation source for ");
+         else
 
-         if Nkind (Dnod) in N_Proper_Body
-           and then Was_Originally_Stub (Dnod)
-         then
-            Write_Str ("subunit ");
+            --  If the spec has been instantiated already, and we are now
+            --  creating the instance source for the corresponding body now,
+            --  retrieve the instance id that was assigned to the spec, which
+            --  corresponds to the same instantiation sloc.
+
+            Inst_Spec := Instance_Spec (Inst_Node);
+            if Present (Inst_Spec) then
+               declare
+                  Inst_Spec_Ent     : Entity_Id;
+                  --  Instance spec entity
+
+                  Inst_Spec_Sloc    : Source_Ptr;
+                  --  Virtual sloc of the spec instance source
+
+                  Inst_Spec_Inst_Id : Instance_Id;
+                  --  Instance id assigned to the instance spec
+
+               begin
+                  Inst_Spec_Ent := Defining_Entity (Inst_Spec);
+
+                  --  For a subprogram instantiation, we want the subprogram
+                  --  instance, not the wrapper package.
+
+                  if Present (Related_Instance (Inst_Spec_Ent)) then
+                     Inst_Spec_Ent := Related_Instance (Inst_Spec_Ent);
+                  end if;
+
+                  --  The specification of the instance entity has a virtual
+                  --  sloc within the instance sloc range.
+                  --  ??? But the Unit_Declaration_Node has the sloc of the
+                  --  instantiation, which is somewhat of an oddity.
+
+                  Inst_Spec_Sloc    :=
+                    Sloc (Specification (Unit_Declaration_Node
+                                           (Inst_Spec_Ent)));
+                  Inst_Spec_Inst_Id :=
+                    Source_File.Table
+                      (Get_Source_File_Index (Inst_Spec_Sloc)).Instance;
+
+                  pragma Assert
+                    (Sloc (Inst_Node) = Instances.Table (Inst_Spec_Inst_Id));
+                  Snew.Instance := Inst_Spec_Inst_Id;
+               end;
 
-         elsif Ekind (Template_Id) = E_Generic_Package then
-            if Nkind (Dnod) = N_Package_Body then
-               Write_Str ("body of package ");
             else
-               Write_Str ("spec of package ");
+               Instances.Append (Sloc (Inst_Node));
+               Snew.Instance := Instances.Last;
             end if;
+         end if;
 
-         elsif Ekind (Template_Id) = E_Function then
-            Write_Str ("body of function ");
+         --  Now we need to compute the new values of Source_First,
+         --  Source_Last and adjust the source file pointer to have the
+         --  correct virtual origin for the new range of values.
 
-         elsif Ekind (Template_Id) = E_Procedure then
-            Write_Str ("body of procedure ");
+         Snew.Source_First := Source_File.Table (Xnew - 1).Source_Last + 1;
+         A.Adjust := Snew.Source_First - A.Lo;
+         Snew.Source_Last := A.Hi + A.Adjust;
 
-         elsif Ekind (Template_Id) = E_Generic_Function then
-            Write_Str ("spec of function ");
+         Set_Source_File_Index_Table (Xnew);
 
-         elsif Ekind (Template_Id) = E_Generic_Procedure then
-            Write_Str ("spec of procedure ");
+         Snew.Sloc_Adjust := Sold.Sloc_Adjust - A.Adjust;
 
-         elsif Ekind (Template_Id) = E_Package_Body then
-            Write_Str ("body of package ");
+         if Debug_Flag_L then
+            Write_Eol;
+            Write_Str ("*** Create instantiation source for ");
 
-         else pragma Assert (Ekind (Template_Id) = E_Subprogram_Body);
+            if Nkind (Dnod) in N_Proper_Body
+              and then Was_Originally_Stub (Dnod)
+            then
+               Write_Str ("subunit ");
 
-            if Nkind (Dnod) = N_Procedure_Specification then
-               Write_Str ("body of procedure ");
-            else
+            elsif Ekind (Template_Id) = E_Generic_Package then
+               if Nkind (Dnod) = N_Package_Body then
+                  Write_Str ("body of package ");
+               else
+                  Write_Str ("spec of package ");
+               end if;
+
+            elsif Ekind (Template_Id) = E_Function then
                Write_Str ("body of function ");
+
+            elsif Ekind (Template_Id) = E_Procedure then
+               Write_Str ("body of procedure ");
+
+            elsif Ekind (Template_Id) = E_Generic_Function then
+               Write_Str ("spec of function ");
+
+            elsif Ekind (Template_Id) = E_Generic_Procedure then
+               Write_Str ("spec of procedure ");
+
+            elsif Ekind (Template_Id) = E_Package_Body then
+               Write_Str ("body of package ");
+
+            else pragma Assert (Ekind (Template_Id) = E_Subprogram_Body);
+
+               if Nkind (Dnod) = N_Procedure_Specification then
+                  Write_Str ("body of procedure ");
+               else
+                  Write_Str ("body of function ");
+               end if;
             end if;
-         end if;
 
-         Write_Name (Chars (Template_Id));
-         Write_Eol;
+            Write_Name (Chars (Template_Id));
+            Write_Eol;
 
-         Write_Str ("  new source index = ");
-         Write_Int (Int (Xnew));
-         Write_Eol;
+            Write_Str ("  new source index = ");
+            Write_Int (Int (Xnew));
+            Write_Eol;
 
-         Write_Str ("  copying from file name = ");
-         Write_Name (File_Name (Xold));
-         Write_Eol;
+            Write_Str ("  copying from file name = ");
+            Write_Name (File_Name (Xold));
+            Write_Eol;
 
-         Write_Str ("  old source index = ");
-         Write_Int (Int (Xold));
-         Write_Eol;
+            Write_Str ("  old source index = ");
+            Write_Int (Int (Xold));
+            Write_Eol;
 
-         Write_Str ("  old lo = ");
-         Write_Int (Int (A.Lo));
-         Write_Eol;
+            Write_Str ("  old lo = ");
+            Write_Int (Int (A.Lo));
+            Write_Eol;
 
-         Write_Str ("  old hi = ");
-         Write_Int (Int (A.Hi));
-         Write_Eol;
+            Write_Str ("  old hi = ");
+            Write_Int (Int (A.Hi));
+            Write_Eol;
 
-         Write_Str ("  new lo = ");
-         Write_Int (Int (Source_File.Table (Xnew).Source_First));
-         Write_Eol;
+            Write_Str ("  new lo = ");
+            Write_Int (Int (Snew.Source_First));
+            Write_Eol;
 
-         Write_Str ("  new hi = ");
-         Write_Int (Int (Source_File.Table (Xnew).Source_Last));
-         Write_Eol;
+            Write_Str ("  new hi = ");
+            Write_Int (Int (Snew.Source_Last));
+            Write_Eol;
 
-         Write_Str ("  adjustment factor = ");
-         Write_Int (Int (A.Adjust));
-         Write_Eol;
+            Write_Str ("  adjustment factor = ");
+            Write_Int (Int (A.Adjust));
+            Write_Eol;
 
-         Write_Str ("  instantiation location: ");
-         Write_Location (Sloc (Inst_Node));
-         Write_Eol;
-      end if;
+            Write_Str ("  instantiation location: ");
+            Write_Location (Sloc (Inst_Node));
+            Write_Eol;
+         end if;
 
-      --  For a given character in the source, a higher subscript will be used
-      --  to access the instantiation, which means that the virtual origin must
-      --  have a corresponding lower value. We compute this new origin by
-      --  taking the address of the appropriate adjusted element in the old
-      --  array. Since this adjusted element will be at a negative subscript,
-      --  we must suppress checks.
+         --  For a given character in the source, a higher subscript will be
+         --  used to access the instantiation, which means that the virtual
+         --  origin must have a corresponding lower value. We compute this new
+         --  origin by taking the address of the appropriate adjusted element
+         --  in the old array. Since this adjusted element will be at a
+         --  negative subscript, we must suppress checks.
 
-      declare
-         pragma Suppress (All_Checks);
+         declare
+            pragma Suppress (All_Checks);
 
-         pragma Warnings (Off);
-         --  This unchecked conversion is aliasing safe, since it is never used
-         --  to create improperly aliased pointer values.
+            pragma Warnings (Off);
+            --  This unchecked conversion is aliasing safe, since it is never
+            --  used to create improperly aliased pointer values.
 
-         function To_Source_Buffer_Ptr is new
-           Unchecked_Conversion (Address, Source_Buffer_Ptr);
+            function To_Source_Buffer_Ptr is new
+              Unchecked_Conversion (Address, Source_Buffer_Ptr);
 
-         pragma Warnings (On);
+            pragma Warnings (On);
 
-      begin
-         Source_File.Table (Xnew).Source_Text :=
-           To_Source_Buffer_Ptr
-             (Source_File.Table (Xold).Source_Text (-A.Adjust)'Address);
+         begin
+            Snew.Source_Text :=
+              To_Source_Buffer_Ptr
+                (Sold.Source_Text (-A.Adjust)'Address);
+         end;
       end;
    end Create_Instantiation_Source;
 
@@ -433,9 +499,10 @@ package body Sinput.L is
                   Full_Debug_Name     => Osint.Full_Source_Name,
                   Full_File_Name      => Osint.Full_Source_Name,
                   Full_Ref_Name       => Osint.Full_Source_Name,
+                  Instance            => No_Instance_Id,
                   Identifier_Casing   => Unknown,
+                  Inlined_Call        => No_Location,
                   Inlined_Body        => False,
-                  Instantiation       => No_Location,
                   Keyword_Casing      => Unknown,
                   Last_Source_Line    => 1,
                   License             => Unknown,