+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
-- 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;
-- 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.
"""__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"");");
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
-- --
-- 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- --
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
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;
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;
-- 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
-- --
-- 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- --
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'
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;
-- --
-- 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- --
Undef_False : Boolean := False;
Always_Blank : Boolean := False;
Comments : Boolean := False;
+ No_Deletion : Boolean := False;
List_Symbols : Boolean := False;
Processed : Boolean := False;
end record;
Undef_False => False,
Always_Blank => False,
Comments => False,
+ No_Deletion => False,
List_Symbols => False,
Processed => False);
-- 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
-- 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;
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;
-- --
------------------------------------------------------------------------------
+with Aspects; use Aspects;
with Atree; use Atree;
with Checks; use Checks;
with Debug; use Debug;
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
-- 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 --
------------------
("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);
-- 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.
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>>
-- 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
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;
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
-- 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;
---------------
-- 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;
----------------
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;
---------------
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;
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;
projects / platform / upstream / gcc.git / commitdiff