2012-10-04 Robert Dewar <dewar@adacore.com>

	* sem_eval.adb (Fold_Str, Fold_Uint, Fold_Ureal): Reset static
	expression state after Resolve call.

2012-10-04  Robert Dewar  <dewar@adacore.com>

	* sem_prag.adb (Analyze_Pragma. case Warnngs): Don't make entry
	in the table for Warnings Off pragmas if within an instance.

2012-10-04  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch9.adb (Analyze_Entry_Body): Transfer
	Has_Pragma_Unreferenced flag from entry formal to corresponding
	entity in body, to prevent spurious warnings when pragma is
	present.

2012-10-04  Robert Dewar  <dewar@adacore.com>

	* s-bignum.adb (Big_Exp): Raise Storage_Error for ludicrously
	large results.

2012-10-04  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Check_Duplicate_Aspects): Diagnose properly
	aspects that appear in the partial and the full view of a type.

2012-10-04  Robert Dewar  <dewar@adacore.com>

	* sinfo.ads (N_Return_Statement): Removed.

2012-10-04  Tristan Gingold  <gingold@adacore.com>

	* init.c (__gl_zero_cost_exceptions): Comment it as not used
	anymore.
	* bindgen.adb (Gen_Adainit): Do not emit Zero_Cost_Exceptions
	anymore.

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

	* prep.adb, prepcomp.adb, gprep.adb, opt.ads: New preprocessor switch
	-a (all source text preserved).



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

13 files changed, 173 insertions, 53 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index b976f9cba7e..ac7e2858667 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,46 @@
+2012-10-04  Robert Dewar  <dewar@adacore.com>
+
+	* sem_eval.adb (Fold_Str, Fold_Uint, Fold_Ureal): Reset static
+	expression state after Resolve call.
+
+2012-10-04  Robert Dewar  <dewar@adacore.com>
+
+	* sem_prag.adb (Analyze_Pragma. case Warnngs): Don't make entry
+	in the table for Warnings Off pragmas if within an instance.
+
+2012-10-04  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch9.adb (Analyze_Entry_Body): Transfer
+	Has_Pragma_Unreferenced flag from entry formal to corresponding
+	entity in body, to prevent spurious warnings when pragma is
+	present.
+
+2012-10-04  Robert Dewar  <dewar@adacore.com>
+
+	* s-bignum.adb (Big_Exp): Raise Storage_Error for ludicrously
+	large results.
+
+2012-10-04  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch3.adb (Check_Duplicate_Aspects): Diagnose properly
+	aspects that appear in the partial and the full view of a type.
+
+2012-10-04  Robert Dewar  <dewar@adacore.com>
+
+	* sinfo.ads (N_Return_Statement): Removed.
+
+2012-10-04  Tristan Gingold  <gingold@adacore.com>
+
+	* init.c (__gl_zero_cost_exceptions): Comment it as not used
+	anymore.
+	* bindgen.adb (Gen_Adainit): Do not emit Zero_Cost_Exceptions
+	anymore.
+
+2012-10-04  Thomas Quinot  <quinot@adacore.com>
+
+	* prep.adb, prepcomp.adb, gprep.adb, opt.ads: New preprocessor switch
+	-a (all source text preserved).
+
 2012-10-04  Vincent Celier  <celier@adacore.com>
 
 	* prj-proc.adb (Recursive_Process): Use project directory
diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb
index 094b25da42e..bb5a0aac906 100644
--- a/gcc/ada/bindgen.adb
+++ b/gcc/ada/bindgen.adb
@@ -137,7 +137,6 @@ package body Bindgen is
    --     Num_Interrupt_States          : Integer;
    --     Unreserve_All_Interrupts      : Integer;
    --     Exception_Tracebacks          : Integer;
-   --     Zero_Cost_Exceptions          : Integer;
    --     Detect_Blocking               : Integer;
    --     Default_Stack_Size            : Integer;
    --     Leap_Seconds_Support          : Integer;
@@ -216,9 +215,6 @@ package body Bindgen is
    --  tracebacks are provided by default, so a value of zero for this
    --  parameter does not necessarily mean no trace backs are available.
 
-   --  Zero_Cost_Exceptions is set to one if zero cost exceptions are used for
-   --  this partition, and to zero if longjmp/setjmp exceptions are used.
-
    --  Detect_Blocking indicates whether pragma Detect_Blocking is active or
    --  not. A value of zero indicates that the pragma is not present, while a
    --  value of 1 signals its presence in the partition.
@@ -607,9 +603,6 @@ package body Bindgen is
                  """__gl_exception_tracebacks"");");
          end if;
 
-         WBI ("      Zero_Cost_Exceptions : Integer;");
-         WBI ("      pragma Import (C, Zero_Cost_Exceptions, " &
-              """__gl_zero_cost_exceptions"");");
          WBI ("      Detect_Blocking : Integer;");
          WBI ("      pragma Import (C, Detect_Blocking, " &
               """__gl_detect_blocking"");");
@@ -803,17 +796,6 @@ package body Bindgen is
             WBI ("      Exception_Tracebacks := 1;");
          end if;
 
-         Set_String ("      Zero_Cost_Exceptions := ");
-
-         if Zero_Cost_Exceptions_Specified then
-            Set_String ("1");
-         else
-            Set_String ("0");
-         end if;
-
-         Set_String (";");
-         Write_Statement_Buffer;
-
          Set_String ("      Detect_Blocking := ");
 
          if Detect_Blocking then
diff --git a/gcc/ada/gprep.adb b/gcc/ada/gprep.adb
index f6ce3acf02e..0fad22bf7a7 100644
--- a/gcc/ada/gprep.adb
+++ b/gcc/ada/gprep.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2002-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 2002-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- --
@@ -720,7 +720,7 @@ package body GPrep is
 
       loop
          begin
-            Switch := GNAT.Command_Line.Getopt ("D: b c C r s T u v");
+            Switch := GNAT.Command_Line.Getopt ("D: a b c C r s T u v");
 
             case Switch is
 
@@ -731,6 +731,10 @@ package body GPrep is
                   Process_Command_Line_Symbol_Definition
                     (S => GNAT.Command_Line.Parameter);
 
+               when 'a' =>
+                  Opt.No_Deletion := True;
+                  Opt.Undefined_Symbols_Are_False := True;
+
                when 'b' =>
                   Opt.Blank_Deleted_Lines := True;
 
diff --git a/gcc/ada/init.c b/gcc/ada/init.c
index 8a27a601617..ad00e148fcc 100644
--- a/gcc/ada/init.c
+++ b/gcc/ada/init.c
@@ -103,12 +103,14 @@ char *__gl_interrupt_states              = 0;
 int   __gl_num_interrupt_states          = 0;
 int   __gl_unreserve_all_interrupts      = 0;
 int   __gl_exception_tracebacks          = 0;
-int   __gl_zero_cost_exceptions          = 0;
 int   __gl_detect_blocking               = 0;
 int   __gl_default_stack_size            = -1;
 int   __gl_leap_seconds_support          = 0;
 int   __gl_canonical_streams             = 0;
 
+/* This value is not used anymore, but kept for bootstrapping purpose.  */
+int   __gl_zero_cost_exceptions          = 0;
+
 /* Indication of whether synchronous signal handler has already been
    installed by a previous call to adainit.  */
 int  __gnat_handler_installed      = 0;
diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads
index 184b09758a3..88194b3023b 100644
--- a/gcc/ada/opt.ads
+++ b/gcc/ada/opt.ads
@@ -968,6 +968,12 @@ package Opt is
    --  in this variable (e.g. 2 = select second unit in file). A value of
    --  zero indicates that we are in normal (one unit per file) mode.
 
+   No_Deletion : Boolean := False;
+   --  GNATPREP
+   --  Set by preprocessor switch -a. Do not eliminate any source text. Implies
+   --  Undefined_Symbols_Are_False. Useful to perform a syntax check on all
+   --  branches of #if constructs.
+
    No_Main_Subprogram : Boolean := False;
    --  GNATMAKE, GNATBIND
    --  Set to True if compilation/binding of a program without main
diff --git a/gcc/ada/prep.adb b/gcc/ada/prep.adb
index 2b0e1378bce..3ec2087926a 100644
--- a/gcc/ada/prep.adb
+++ b/gcc/ada/prep.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2002-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 2002-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- --
@@ -292,8 +292,8 @@ package body Prep is
          Result.Value := End_String;
       end if;
 
-      --  Now, check the syntax of the symbol (we don't allow accented and
-      --  wide characters)
+      --  Now, check the syntax of the symbol (we don't allow accented or
+      --  wide characters).
 
       if Name_Buffer (1) not in 'a' .. 'z'
         and then Name_Buffer (1) not in 'A' .. 'Z'
@@ -356,7 +356,7 @@ package body Prep is
    begin
       --  Always return False when not inside an #if statement
 
-      if Pp_States.Last = Ground then
+      if Opt.No_Deletion or else Pp_States.Last = Ground then
          return False;
       else
          return Pp_States.Table (Pp_States.Last).Deleting;
diff --git a/gcc/ada/prepcomp.adb b/gcc/ada/prepcomp.adb
index 2da21df3c42..dd64bcb714b 100644
--- a/gcc/ada/prepcomp.adb
+++ b/gcc/ada/prepcomp.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2003-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 2003-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- --
@@ -60,6 +60,7 @@ package body Prepcomp is
       Undef_False  : Boolean        := False;
       Always_Blank : Boolean        := False;
       Comments     : Boolean        := False;
+      No_Deletion  : Boolean        := False;
       List_Symbols : Boolean        := False;
       Processed    : Boolean        := False;
    end record;
@@ -73,6 +74,7 @@ package body Prepcomp is
       Undef_False  => False,
       Always_Blank => False,
       Comments     => False,
+      No_Deletion  => False,
       List_Symbols => False,
       Processed    => False);
 
@@ -330,6 +332,16 @@ package body Prepcomp is
                --  significant.
 
                case Sinput.Source (Token_Ptr) is
+                  when 'a' =>
+
+                     --  All source text preserved (also implies -u)
+
+                     if Name_Len = 1 then
+                        Current_Data.No_Deletion := True;
+                        Current_Data.Undef_False := True;
+                        OK := True;
+                     end if;
+
                   when 'u' =>
 
                      --  Undefined symbol are False
@@ -581,15 +593,15 @@ package body Prepcomp is
 
       --  Set the preprocessing flags according to the preprocessing data
 
-      if Current_Data.Comments and then not Current_Data.Always_Blank then
+      if Current_Data.Comments and not Current_Data.Always_Blank then
          Comment_Deleted_Lines := True;
          Blank_Deleted_Lines   := False;
-
       else
          Comment_Deleted_Lines := False;
          Blank_Deleted_Lines   := True;
       end if;
 
+      No_Deletion                 := Current_Data.No_Deletion;
       Undefined_Symbols_Are_False := Current_Data.Undef_False;
       List_Preprocessing_Symbols  := Current_Data.List_Symbols;
 
diff --git a/gcc/ada/s-bignum.adb b/gcc/ada/s-bignum.adb
index 69772772f55..b3af4796136 100644
--- a/gcc/ada/s-bignum.adb
+++ b/gcc/ada/s-bignum.adb
@@ -341,6 +341,17 @@ package body System.Bignums is
                begin
                   Free_Bignum (XY2);
 
+                  --  Raise storage error if intermediate value is getting too
+                  --  large, which we arbitrarily define as 200 words for now!
+
+                  if XY2S.Len > 200 then
+                     Free_Bignum (XY2S);
+                     raise Storage_Error with
+                       "exponentiation result is too large";
+                  end if;
+
+                  --  Otherwise take care of even/odd cases
+
                   if (Y and 1) = 0 then
                      return XY2S;
 
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index cb54be10215..7dd808c0d0d 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -23,6 +23,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with Aspects;  use Aspects;
 with Atree;    use Atree;
 with Checks;   use Checks;
 with Debug;    use Debug;
@@ -14805,6 +14806,11 @@ package body Sem_Ch3 is
       New_Id   : Entity_Id;
       Prev_Par : Node_Id;
 
+      procedure Check_Duplicate_Aspects;
+      --  Check that aspects specified in a completion have not been specified
+      --  already in the partial view. Type_Invariant and others can be
+      --  specified on either view but never on both.
+
       procedure Tag_Mismatch;
       --  Diagnose a tagged partial view whose full view is untagged.
       --  We post the message on the full view, with a reference to
@@ -14813,6 +14819,38 @@ package body Sem_Ch3 is
       --  so we determine the position of the error message from the
       --  respective slocs of both.
 
+      -----------------------------
+      -- Check_Duplicate_Aspects --
+      -----------------------------
+      procedure Check_Duplicate_Aspects is
+         Prev_Aspects   : constant List_Id := Aspect_Specifications (Prev_Par);
+         Full_Aspects   : constant List_Id := Aspect_Specifications (N);
+         F_Spec, P_Spec : Node_Id;
+
+      begin
+         if Present (Prev_Aspects) and then Present (Full_Aspects) then
+            F_Spec := First (Full_Aspects);
+            while Present (F_Spec) loop
+               P_Spec := First (Prev_Aspects);
+               while Present (P_Spec) loop
+                  if
+                    Chars (Identifier (P_Spec)) = Chars (Identifier (F_Spec))
+                  then
+                     Error_Msg_N
+                       ("aspect already specified in private declaration",
+                         F_Spec);
+                     Remove (F_Spec);
+                     return;
+                  end if;
+
+                  Next (P_Spec);
+               end loop;
+
+               Next (F_Spec);
+            end loop;
+         end if;
+      end Check_Duplicate_Aspects;
+
       ------------------
       -- Tag_Mismatch --
       ------------------
@@ -15022,6 +15060,10 @@ package body Sem_Ch3 is
                  ("declaration of full view must appear in private part", N);
             end if;
 
+            if Ada_Version >= Ada_2012 then
+               Check_Duplicate_Aspects;
+            end if;
+
             Copy_And_Swap (Prev, Id);
             Set_Has_Private_Declaration (Prev);
             Set_Has_Private_Declaration (Id);
diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb
index d40647ed7ad..a81ea5c6148 100644
--- a/gcc/ada/sem_ch9.adb
+++ b/gcc/ada/sem_ch9.adb
@@ -1345,9 +1345,10 @@ package body Sem_Ch9 is
       --  Check for unreferenced variables etc. Before the Check_References
       --  call, we transfer Never_Set_In_Source and Referenced flags from
       --  parameters in the spec to the corresponding entities in the body,
-      --  since we want the warnings on the body entities. Note that we do
-      --  not have to transfer Referenced_As_LHS, since that flag can only
-      --  be set for simple variables.
+      --  since we want the warnings on the body entities. Note that we do not
+      --  have to transfer Referenced_As_LHS, since that flag can only be set
+      --  for simple variables, but we include Has_Pragma_Unreferenced,
+      --  which may have been specified for a formal in the body.
 
       --  At the same time, we set the flags on the spec entities to suppress
       --  any warnings on the spec formals, since we also scan the spec.
@@ -1382,6 +1383,7 @@ package body Sem_Ch9 is
 
             Set_Referenced (E2, Referenced (E1));
             Set_Referenced (E1);
+            Set_Has_Pragma_Unreferenced (E2, Has_Pragma_Unreferenced (E1));
             Set_Entry_Component (E2, Entry_Component (E1));
 
          <<Continue>>
diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index 95a240eb0a7..f7e774308fb 100644
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -199,7 +199,7 @@ package body Sem_Eval is
    --  Tests to see if expression N whose single operand is Op1 is foldable,
    --  i.e. the operand value is known at compile time. If the operation is
    --  foldable, then Fold is True on return, and Stat indicates whether
-   --  the result is static (i.e. both operands were static). Note that it
+   --  the result is static (i.e. the operand was static). Note that it
    --  is quite possible for Fold to be True, and Stat to be False, since
    --  there are cases in which we know the value of an operand even though
    --  it is not technically static (e.g. the static lower bound of a range
@@ -233,7 +233,7 @@ package body Sem_Eval is
       Stat : out Boolean;
       Fold : out Boolean);
    --  Same processing, except applies to an expression N with two operands
-   --  Op1 and Op2.
+   --  Op1 and Op2. The result is static only if both operands are static.
 
    function Test_In_Range
      (N            : Node_Id;
@@ -241,11 +241,11 @@ package body Sem_Eval is
       Assume_Valid : Boolean;
       Fixed_Int    : Boolean;
       Int_Real     : Boolean) return Range_Membership;
-   --  Common processing for Is_In_Range and Is_Out_Of_Range:
-   --  Returns In_Range or Out_Of_Range if it can be guaranteed at compile time
-   --  that expression N is known to be in or out of range of the subtype Typ.
-   --  If not compile time known, Unknown is returned.
-   --  See documentation of Is_In_Range for complete description of parameters.
+   --  Common processing for Is_In_Range and Is_Out_Of_Range: Returns In_Range
+   --  or Out_Of_Range if it can be guaranteed at compile time that expression
+   --  N is known to be in or out of range of the subtype Typ. If not compile
+   --  time known, Unknown is returned. See documentation of Is_In_Range for
+   --  complete description of parameters.
 
    procedure To_Bits (U : Uint; B : out Bits);
    --  Converts a Uint value to a bit string of length B'Length
@@ -4046,12 +4046,18 @@ package body Sem_Eval is
 
       --  We now have the literal with the right value, both the actual type
       --  and the expected type of this literal are taken from the expression
-      --  that was evaluated.
+      --  that was evaluated. So now we do the Analyze and Resolve.
+
+      --  Note that we have to reset Is_Static_Expression both after the
+      --  analyze step (because Resolve will evaluate the literal, which
+      --  will cause semantic errors if it is marked as static), and after
+      --  the Resolve step (since Resolve in some cases sets this flag).
 
       Analyze (N);
       Set_Is_Static_Expression (N, Static);
       Set_Etype (N, Typ);
       Resolve (N);
+      Set_Is_Static_Expression (N, Static);
    end Fold_Str;
 
    ---------------
@@ -4100,12 +4106,18 @@ package body Sem_Eval is
 
       --  We now have the literal with the right value, both the actual type
       --  and the expected type of this literal are taken from the expression
-      --  that was evaluated.
+      --  that was evaluated. So now we do the Analyze and Resolve.
+
+      --  Note that we have to reset Is_Static_Expression both after the
+      --  analyze step (because Resolve will evaluate the literal, which
+      --  will cause semantic errors if it is marked as static), and after
+      --  the Resolve step (since Resolve in some cases sets this flag).
 
       Analyze (N);
       Set_Is_Static_Expression (N, Static);
       Set_Etype (N, Typ);
       Resolve (N);
+      Set_Is_Static_Expression (N, Static);
    end Fold_Uint;
 
    ----------------
@@ -4135,12 +4147,20 @@ package body Sem_Eval is
 
       Set_Original_Entity (N, Ent);
 
-      --  Both the actual and expected type comes from the original expression
+      --  We now have the literal with the right value, both the actual type
+      --  and the expected type of this literal are taken from the expression
+      --  that was evaluated. So now we do the Analyze and Resolve.
+
+      --  Note that we have to reset Is_Static_Expression both after the
+      --  analyze step (because Resolve will evaluate the literal, which
+      --  will cause semantic errors if it is marked as static), and after
+      --  the Resolve step (since Resolve in some cases sets this flag).
 
       Analyze (N);
       Set_Is_Static_Expression (N, Static);
       Set_Etype (N, Typ);
       Resolve (N);
+      Set_Is_Static_Expression (N, Static);
    end Fold_Ureal;
 
    ---------------
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 029b94b124d..258ec5b1685 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -14802,10 +14802,17 @@ package body Sem_Prag is
                            loop
                               Set_Warnings_Off
                                 (E, (Chars (Get_Pragma_Arg (Arg1)) =
-                                                              Name_Off));
+                                      Name_Off));
+
+                              --  For OFF case, make entry in warnings off
+                              --  pragma table for later processing. But we do
+                              --  not do that within an instance, since these
+                              --  warnings are about what is needed in the
+                              --  template, not an instance of it.
 
                               if Chars (Get_Pragma_Arg (Arg1)) = Name_Off
                                 and then Warn_On_Warnings_Off
+                                and then not In_Instance
                               then
                                  Warnings_Off_Pragmas.Append ((N, E));
                               end if;
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index 41998908b75..39e9acba824 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -12419,15 +12419,4 @@ package Sinfo is
    pragma Inline (Set_Was_Originally_Stub);
    pragma Inline (Set_Withed_Body);
 
-   --------------
-   -- Synonyms --
-   --------------
-
-   --  These synonyms are to aid in transition, they should eventually be
-   --  removed when all remaining references to the obsolete name are gone.
-
-   N_Return_Statement : constant Node_Kind := N_Simple_Return_Statement;
-   --  Rename N_Simple_Return_Statement to be N_Return_Statement. Clients
-   --  should refer to N_Simple_Return_Statement.
-
 end Sinfo;