+2014-07-30 Olivier Hainque <hainque@adacore.com>
+
+ * vxworks-ppc-link.spec: New file. Extra link
+ instructions for ppc-vxworks.
+ * vxworks-crtbe-link.spec: Likewise, for ZCX related support.
+ * system-vxworks-ppc.ads: Adjust linker options to use spec files.
+ * system-vxworks-arm.ads: Likewise.
+ * gcc-interface/Makefile.in: Enable .spec files.
+
+2014-07-30 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_aggr.adb: Minor comment reformatting.
+
+2014-07-30 Robert Dewar <dewar@adacore.com>
+
+ * sem_util.ads, sem_util.adb (Is_Junk_Name): Removed.
+ * sem_warn.adb (Has_Junk_Name): New function
+ (Check_References): Use Has_Junk_Name to delete junk warnings
+ (Check_Unset_Reference): ditto.
+ (Warn_On_Unreferenced_Entity): ditto.
+ (Warn_On_Useless_Assignment): ditto.
+
+2014-07-30 Ed Schonberg <schonberg@adacore.com>
+
+ * checks.adb (Insert_Valid_Check): Do not check for the packed
+ array type of a prefix that is an access type.
+
+2014-07-30 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_attr.adb (Eval_Attribute): Evaluate the GNAT attribute
+ Unconstrained_Array even if prefix is not frozen yet, as can
+ occur with a private subtype used as a generic actual.
+
+2014-07-30 Gary Dismukes <dismukes@adacore.com>
+
+ * sem_attr.adb: Minor reformatting.
+
+2014-07-30 Pat Rogers <rogers@adacore.com>
+
+ * gnat_rm.texi: Corrected minor wording error in description
+ of No_Exception_Registration.
+
+2014-07-30 Yannick Moy <moy@adacore.com>
+
+ * einfo.ads, einfo.adb: New flag Is_Inlined_Always for use in GNATprove
+ mode. Realphabetize two subprograms.
+ * inline.adb (Cannot_Inline): Use Is_Inlined_Always in GNATprove mode.
+ (Can_Be_Inlined_In_GNATprove_Mode): Adapt to possible Empty Body_Id.
+ (Check_And_Build_Body_To_Inline): Use Is_Inlined_Always in GNATprove
+ mode.
+ (Expand_Inline_Call): Use Is_Inlined_Always in GNATprove mode.
+ * sem_ch6.adb (Analyze_Subprogram_Body_Helper): Do not use
+ Is_Inline in GNATprove mode.
+ (Analyze_Subprogram_Specification):
+ Set Is_Inlined_Always at subprogram entity creation.
+ * sem_res.adb (Resolve_Call): Do not deal with inlining during
+ pre-analysis. Issue warning on call to possibly inlined
+ subprogram when body not seen.
+
+2014-07-30 Yannick Moy <moy@adacore.com>
+
+ * lib-xref.adb (Generate_Reference): Add special
+ case for compiler-generated formals in GNATprove mode.
+
2014-07-30 Yannick Moy <moy@adacore.com>
* sem_ch6.adb: Add comments.
-- A rather specialized test. If PV is an analyzed expression which
-- is an indexed component of a packed array that has not been
-- properly expanded, turn off its Analyzed flag to make sure it
- -- gets properly reexpanded.
+ -- gets properly reexpanded. If the prefix is an access value,
+ -- the dereference will be added later.
-- The reason this arises is that Duplicate_Subexpr_No_Checks did
-- an analyze with the old parent pointer. This may point e.g. to
if Analyzed (PV)
and then Nkind (PV) = N_Indexed_Component
+ and then Is_Array_Type (Etype (Prefix (PV)))
and then Present (Packed_Array_Impl_Type (Etype (Prefix (PV))))
then
Set_Analyzed (PV, False);
if Vax_Float (E) then
return True;
+
elsif Kill_Range_Checks (E) then
return True;
+
elsif Checks_May_Be_Suppressed (E) then
return Is_Check_Suppressed (E, Range_Check);
end if;
-- sense for them to be set true for certain subsets of entity kinds. See
-- the spec of Einfo for further details.
+ -- Is_Inlined_Always Flag1
-- Is_Frozen Flag4
-- Has_Discriminants Flag5
-- Is_Dispatching_Operation Flag6
-- (SSO_Set_Low_By_Default) Flag272
-- (SSO_Set_Low_By_Default) Flag273
- -- (unused) Flag1
-- (unused) Flag2
-- (unused) Flag3
return Flag11 (Id);
end Is_Inlined;
+ function Is_Inlined_Always (Id : E) return B is
+ begin
+ pragma Assert (Ekind (Id) = E_Function or else Ekind (Id) = E_Procedure);
+ return Flag1 (Id);
+ end Is_Inlined_Always;
+
function Is_Interface (Id : E) return B is
begin
return Flag186 (Id);
Set_Flag38 (Id, V);
end Set_Can_Never_Be_Null;
+ procedure Set_Can_Use_Internal_Rep (Id : E; V : B := True) is
+ begin
+ pragma Assert
+ (Is_Access_Subprogram_Type (Id) and then Is_Base_Type (Id));
+ Set_Flag229 (Id, V);
+ end Set_Can_Use_Internal_Rep;
+
procedure Set_Checks_May_Be_Suppressed (Id : E; V : B := True) is
begin
Set_Flag31 (Id, V);
Set_Node20 (Id, V);
end Set_Component_Type;
+ procedure Set_Contract (Id : E; V : N) is
+ begin
+ pragma Assert
+ (Ekind_In (Id, E_Entry,
+ E_Entry_Family,
+ E_Generic_Package,
+ E_Package,
+ E_Package_Body,
+ E_Subprogram_Body,
+ E_Variable,
+ E_Void)
+ or else Is_Generic_Subprogram (Id)
+ or else Is_Subprogram (Id));
+ Set_Node34 (Id, V);
+ end Set_Contract;
+
procedure Set_Corresponding_Concurrent_Type (Id : E; V : E) is
begin
pragma Assert
Set_Node18 (Id, V);
end Set_Entry_Index_Constant;
- procedure Set_Contract (Id : E; V : N) is
- begin
- pragma Assert
- (Ekind_In (Id, E_Entry,
- E_Entry_Family,
- E_Generic_Package,
- E_Package,
- E_Package_Body,
- E_Subprogram_Body,
- E_Variable,
- E_Void)
- or else Is_Generic_Subprogram (Id)
- or else Is_Subprogram (Id));
- Set_Node34 (Id, V);
- end Set_Contract;
-
procedure Set_Entry_Parameters_Type (Id : E; V : E) is
begin
Set_Node15 (Id, V);
Set_Node28 (Id, V);
end Set_Extra_Formals;
- procedure Set_Can_Use_Internal_Rep (Id : E; V : B := True) is
- begin
- pragma Assert
- (Is_Access_Subprogram_Type (Id) and then Is_Base_Type (Id));
- Set_Flag229 (Id, V);
- end Set_Can_Use_Internal_Rep;
-
procedure Set_Finalization_Master (Id : E; V : E) is
begin
pragma Assert (Is_Access_Type (Id) and then Is_Base_Type (Id));
Set_Flag11 (Id, V);
end Set_Is_Inlined;
+ procedure Set_Is_Inlined_Always (Id : E; V : B := True) is
+ begin
+ pragma Assert (Ekind (Id) = E_Function or else Ekind (Id) = E_Procedure);
+ Set_Flag1 (Id, V);
+ end Set_Is_Inlined_Always;
+
procedure Set_Is_Interface (Id : E; V : B := True) is
begin
pragma Assert (Is_Record_Type (Id));
W ("Is_Imported", Flag24 (Id));
W ("Is_Independent", Flag268 (Id));
W ("Is_Inlined", Flag11 (Id));
+ W ("Is_Inlined_Always", Flag1 (Id));
W ("Is_Instantiated", Flag126 (Id));
W ("Is_Interface", Flag186 (Id));
W ("Is_Internal", Flag17 (Id));
-- be compiled. Is_Inlined is also set on generic subprograms and is
-- inherited by their instances. It is also set on the body entities
-- of inlined subprograms. See also Has_Pragma_Inline.
---
--- Is_Inlined is also set for subprograms that are always inlined in
--- GNATprove mode. GNATprove uses this flag to know when a body does not
--- need to be analyzed.
+
+-- Is_Inlined_Always (Flag1)
+-- Defined in subprograms. Set for functions and procedures which are
+-- always inlined in GNATprove mode. GNATprove uses this flag to know
+-- when a body does not need to be analyzed. The value of this flag is
+-- only meaningful if Body_To_Inline is not Empty for the subprogram.
-- Is_Instantiated (Flag126)
-- Defined in generic packages and generic subprograms. Set if the unit
-- Is_Discrim_SO_Function (Flag176)
-- Is_Discriminant_Check_Function (Flag264)
-- Is_Eliminated (Flag124)
+ -- Is_Inlined_Always (Flag1) (non-generic case only)
-- Is_Instantiated (Flag126) (generic case only)
-- Is_Intrinsic_Subprogram (Flag64)
-- Is_Invariant_Procedure (Flag257) (non-generic case only)
-- Is_Called (Flag102) (non-generic case only)
-- Is_Constructor (Flag76)
-- Is_Eliminated (Flag124)
+ -- Is_Inlined_Always (Flag1) (non-generic case only)
-- Is_Instantiated (Flag126) (generic case only)
-- Is_Interrupt_Handler (Flag89)
-- Is_Intrinsic_Subprogram (Flag64)
function Is_Imported (Id : E) return B;
function Is_Independent (Id : E) return B;
function Is_Inlined (Id : E) return B;
+ function Is_Inlined_Always (Id : E) return B;
function Is_Instantiated (Id : E) return B;
function Is_Interface (Id : E) return B;
function Is_Internal (Id : E) return B;
procedure Set_Is_Imported (Id : E; V : B := True);
procedure Set_Is_Independent (Id : E; V : B := True);
procedure Set_Is_Inlined (Id : E; V : B := True);
+ procedure Set_Is_Inlined_Always (Id : E; V : B := True);
procedure Set_Is_Instantiated (Id : E; V : B := True);
procedure Set_Is_Interface (Id : E; V : B := True);
procedure Set_Is_Internal (Id : E; V : B := True);
pragma Inline (Is_Incomplete_Type);
pragma Inline (Is_Independent);
pragma Inline (Is_Inlined);
+ pragma Inline (Is_Inlined_Always);
pragma Inline (Is_Instantiated);
pragma Inline (Is_Integer_Type);
pragma Inline (Is_Interface);
pragma Inline (Set_Is_Imported);
pragma Inline (Set_Is_Independent);
pragma Inline (Set_Is_Inlined);
+ pragma Inline (Set_Is_Inlined_Always);
pragma Inline (Set_Is_Instantiated);
pragma Inline (Set_Is_Interface);
pragma Inline (Set_Is_Internal);
Decl : Node_Id;
Dummy : Entity_Id;
- pragma Unreferenced (Dummy);
-- This variable captures an unused dummy internal entity, see the
-- comment associated with its use.
-- them to the tree, and that can disturb current value settings.
Dummy : Entity_Id;
- pragma Unreferenced (Dummy);
-- This variable captures an unused dummy internal entity, see the
-- comment associated with its use.
Parser : Opt_Parser := Command_Line_Parser) return Character
is
Dummy : Boolean;
- pragma Unreferenced (Dummy);
begin
<<Restart>>
EXTRA_GNATRTL_TASKING_OBJS += s-vxwork.o s-vxwext.o
EXTRA_LIBGNAT_OBJS+=vx_stack_info.o
+
+ GCC_SPEC_FILES+=vxworks-$(ARCH_STR)-link.spec
+ GCC_SPEC_FILES+=vxworks-crtbe-link.spec
endif
# PowerPC and e500v2 VxWorks 653
EXTRA_GNATRTL_TASKING_OBJS=s-vxwork.o s-vxwext.o
EXTRA_LIBGNAT_OBJS+=vx_stack_info.o
+
+ GCC_SPEC_FILES+=vxworks-crtbe-link.spec
endif
# MIPS VxWorks
[GNAT] This restriction ensures at compile time that no stream operations for
types Exception_Id or Exception_Occurrence are used. This also makes it
impossible to pass exceptions to or from a partition with this restriction
-in a distributed environment. If this exception is active, then the generated
+in a distributed environment. If this restriction is active, the generated
code is simplified by omitting the otherwise-required global registration
of exceptions when they are declared.
null;
-- In GNATprove mode, issue a warning, and indicate that the
- -- subprogram is not always inlined by setting flag Is_Inlined
+ -- subprogram is not always inlined by setting flag Is_Inlined_Always
-- to False.
elsif GNATprove_Mode then
- Set_Is_Inlined (Subp, False);
+ Set_Is_Inlined_Always (Subp, False);
Error_Msg_NE (Msg & "p?", N, Subp);
elsif Has_Pragma_Inline_Always (Subp) then
Error_Msg_NE (Msg (Msg'First .. Msg'Last - 1), N, Subp);
-- In GNATprove mode, issue a warning, and indicate that the subprogram
- -- is not always inlined by setting flag Is_Inlined to False.
+ -- is not always inlined by setting flag Is_Inlined_Always to False.
elsif GNATprove_Mode then
- Set_Is_Inlined (Subp, False);
+ Set_Is_Inlined_Always (Subp, False);
Error_Msg_NE (Msg & "p?", N, Subp);
-- Do not issue errors/warnings when compiling with optimizations
-- Start of Can_Be_Inlined_In_GNATprove_Mode
begin
+ pragma Assert (Present (Spec_Id) or else Present (Body_Id));
+
if Present (Spec_Id) then
Id := Spec_Id;
else
-- body. Use the contract(s) instead in GNATprove.
elsif (Present (Spec_Id) and then Has_Some_Contract (Spec_Id))
- or else Has_Some_Contract (Body_Id)
+ or else
+ (Present (Body_Id) and then Has_Some_Contract (Body_Id))
then
return False;
-- prover level.
elsif (Present (Spec_Id) and then Is_Expression_Function (Spec_Id))
- or else Is_Expression_Function (Body_Id)
+ or else
+ (Present (Body_Id) and then Is_Expression_Function (Body_Id))
then
return False;
-- Only inline subprograms whose body is marked SPARK_Mode On. Other
-- subprogram bodies should not be analyzed.
- elsif No (SPARK_Pragma (Body_Id))
- or else Get_SPARK_Mode_From_Pragma (SPARK_Pragma (Body_Id)) /= On
+ elsif Present (Body_Id)
+ and then (No (SPARK_Pragma (Body_Id))
+ or else
+ Get_SPARK_Mode_From_Pragma (SPARK_Pragma (Body_Id)) /= On)
then
return False;
if Is_Subprogram (P_Ent) then
Set_Is_Inlined (P_Ent, False);
+ -- In GNATprove mode, issue a warning, and indicate that
+ -- the subprogram is not always inlined by setting flag
+ -- Is_Inlined_Always to False.
+
+ if GNATprove_Mode then
+ Set_Is_Inlined_Always (P_Ent, False);
+ end if;
+
if Comes_From_Source (P_Ent)
- and then Has_Pragma_Inline (P_Ent)
+ and then (Has_Pragma_Inline (P_Ent) or else GNATprove_Mode)
then
Cannot_Inline
("cannot inline& (nested subprogram)?", N, P_Ent,
if In_Open_Scopes (Subp) then
Error_Msg_N ("call to recursive subprogram cannot be inlined??", N);
Set_Is_Inlined (Subp, False);
+
+ -- In GNATprove mode, issue a warning, and indicate that the
+ -- subprogram is not always inlined by setting flag Is_Inlined_Always
+ -- to False.
+
+ if GNATprove_Mode then
+ Set_Is_Inlined_Always (Subp, False);
+ end if;
+
return;
-- Skip inlining if this is not a true inlining since the attribute
-- inlining will not happen, and mark the subprogram as not always
-- inlined.
- if Expander_Active then
- Error_Msg_N
- ("cannot inline call to recursive subprogram", N);
- else
+ if GNATprove_Mode then
Cannot_Inline
("cannot inline call to recursive subprogram?", N, Subp);
- Set_Is_Inlined (Subp, False);
+ Set_Is_Inlined_Always (Subp, False);
+ else
+ Error_Msg_N
+ ("cannot inline call to recursive subprogram", N);
end if;
return;
function Can_Be_Inlined_In_GNATprove_Mode
(Spec_Id : Entity_Id;
Body_Id : Entity_Id) return Boolean;
- -- Returns True if the subprogram identified by Spec_Id (possibly Empty)
- -- and Body_Id (not Empty) can be inlined in GNATprove mode. GNATprove
- -- relies on this to adapt its treatment of the subprogram.
+ -- Returns True if the subprogram identified by Spec_Id and Body_Id can
+ -- be inlined in GNATprove mode. One but not both of Spec_Id and Body_Id
+ -- can be Empty. Body_Id is Empty when doing a partial check on a call
+ -- to a subprogram whose body has not been seen yet, to know whether this
+ -- subprogram could possibly be inlined. GNATprove relies on this to adapt
+ -- its treatment of the subprogram.
end Inline;
declare
Dummy : constant SPARK_Scope_Record :=
SPARK_Scope_Table.Table (Index);
- pragma Unreferenced (Dummy);
begin
return True;
end;
if Comes_From_Source (E) then
Ent := E;
+ -- Because a declaration may be generated for a subprogram body
+ -- without declaration in GNATprove mode, for inlining, some
+ -- parameters may end up being marked as not coming from source
+ -- although they are. Take these into account specially.
+
+ elsif GNATprove_Mode and then Ekind (E) in Formal_Kind then
+ Ent := E;
+
-- Entity does not come from source, but is a derived subprogram and
-- the derived subprogram comes from source (after one or more
-- derivations) in which case the reference is to parent subprogram.
In_Tree : Project_Tree_Ref;
Dummy : in out Boolean)
is
- pragma Unreferenced (Dummy);
-
Linker_Package : Package_Id;
Options : Variable_Value;
Iter : Source_Iterator;
Dummy : Boolean;
- pragma Unreferenced (Dummy);
begin
if not Insert_No_Roots (Source) then
-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2014, 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- --
procedure Create_Output_Library_Info is
Dummy : Boolean;
- pragma Unreferenced (Dummy);
-
begin
Set_Library_Info_Name;
Delete_File (Name_Buffer (1 .. Name_Len), Dummy);
-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2014, 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- --
In_Tree : Project_Tree_Ref;
Dummy : in out Boolean)
is
- pragma Unreferenced (Dummy);
begin
Add_To_Path
(Project.Source_Dirs, In_Tree.Shared, Buffer, Buffer_Last);
In_Tree : Project_Tree_Ref;
Dummy : in out Boolean)
is
- pragma Unreferenced (Dummy, In_Tree);
+ pragma Unreferenced (In_Tree);
Path : constant Path_Name_Type :=
Get_Object_Directory
Tree : Project_Tree_Ref;
Dummy : in out Integer)
is
- pragma Unreferenced (Dummy, Tree);
+ pragma Unreferenced (Tree);
begin
-- ??? Set_Ada_Paths has a different behavior for library project
In_Tree : Project_Tree_Ref;
Dummy : in out Integer)
is
- pragma Unreferenced (Dummy);
-
Current : String_List_Id := Prj.Source_Dirs;
The_String : String_Element;
In_Tree : Project_Tree_Ref;
Dummy : in out Boolean)
is
- pragma Unreferenced (Dummy, In_Tree);
+ pragma Unreferenced (In_Tree);
Path : Path_Name_Type;
Context : Project_Context;
Dummy : in out Boolean)
is
- pragma Unreferenced (Dummy, Tree);
+ pragma Unreferenced (Tree);
List : Project_List;
Prj2 : Project_Id;
procedure Allocate_New_AST_Server is
Dummy : AST_Server_Task_Ptr;
- pragma Unreferenced (Dummy);
begin
if Num_AST_Servers = Max_AST_Servers then
procedure Allocate_New_AST_Server is
Dummy : AST_Server_Task_Ptr;
- pragma Unreferenced (Dummy);
begin
if Num_AST_Servers = Max_AST_Servers then
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
C : Task_Id;
Dummy : int;
- pragma Unreferenced (Dummy);
begin
Dummy := Int_Lock;
------------------------
procedure Continue_All_Tasks is
- C : Task_Id;
-
+ C : Task_Id;
Dummy : Boolean;
- pragma Unreferenced (Dummy);
begin
STPO.Lock_RTS;
procedure Resume_All_Tasks (Thread_Self : OS_Interface.Thread_Id) is
C : Task_Id;
Dummy : Boolean;
- pragma Unreferenced (Dummy);
begin
STPO.Lock_RTS;
--------------------
procedure Stop_All_Tasks is
- C : Task_Id;
-
+ C : Task_Id;
Dummy : Boolean;
- pragma Unreferenced (Dummy);
begin
STPO.Lock_RTS;
procedure Suspend_All_Tasks (Thread_Self : OS_Interface.Thread_Id) is
C : Task_Id;
Dummy : Boolean;
- pragma Unreferenced (Dummy);
begin
STPO.Lock_RTS;
-- expressions allowed for a limited component association (namely, an
-- aggregate, function call, or <> notation). Report error for violations.
-- Expression is also OK in an instance or inlining context, because we
- -- have already analyzed and checked it.
+ -- have already pre-analyzed and it is known to be type correct.
procedure Check_Qualified_Aggregate (Level : Nat; Expr : Node_Id);
-- Given aggregate Expr, check that sub-aggregates of Expr that are nested
-- If we are asked to evaluate an attribute where the prefix is a
-- non-frozen generic actual type whose RM_Size is still set to zero,
- -- then abandon the effort. It seems wrong that this can ever happen,
- -- but we see it happen, so this is a defense! ???
+ -- then abandon the effort.
if Is_Type (P_Entity)
and then (not Is_Frozen (P_Entity)
and then Is_Generic_Actual_Type (P_Entity)
and then RM_Size (P_Entity) = 0)
+
+ -- However, the attribute Unconstrained_Array must be evaluated,
+ -- since it is documented to be a static attribute (and can for
+ -- example appear in a Compile_Time_Warning pragma). The frozen
+ -- status of the type does not affect its evaluation.
+
+ and then Id /= Attribute_Unconstrained_Array
then
return;
end if;
-------------------
procedure Process_State (State : Node_Id) is
- Loc : constant Source_Ptr := Sloc (State);
- Elmt : Node_Id;
- Id : Entity_Id;
- Name : Name_Id;
-
+ Loc : constant Source_Ptr := Sloc (State);
+ Elmt : Node_Id;
+ Id : Entity_Id;
+ Name : Name_Id;
Dummy : Entity_Id;
- pragma Unreferenced (Dummy);
begin
-- Multiple abstract states appear as an aggregate
Elmt := First (Expressions (State));
while Present (Elmt) loop
Process_State (Elmt);
-
Next (Elmt);
end loop;
+
return;
-- A null state has no abstract view
Spec_Id : Entity_Id;
Dummy : Entity_Id;
- pragma Unreferenced (Dummy);
-- A dummy variable used to capture the unused result of subprogram
-- spec analysis.
and then Can_Be_Inlined_In_GNATprove_Mode (Spec_Id, Body_Id)
and then not Body_Has_Contract
then
- Set_Is_Inlined (Spec_Id, True);
Build_Body_To_Inline (N, Spec_Id);
end if;
and then Can_Be_Inlined_In_GNATprove_Mode (Spec_Id, Body_Id)
and then not Body_Has_Contract
then
- Set_Is_Inlined (Spec_Id, True);
Check_And_Build_Body_To_Inline (N, Spec_Id, Body_Id);
end if;
and then Nkind (Parent (Parent (Spec_Id))) = N_Subprogram_Declaration
then
Set_Body_To_Inline (Parent (Parent (Spec_Id)), Empty);
- Set_Is_Inlined (Spec_Id, False);
+ Set_Is_Inlined_Always (Spec_Id, False);
end if;
-- Check completion, and analyze the statements
Set_Etype (Designator, Standard_Void_Type);
end if;
+ -- Flag Is_Inlined_Always is True by default, and reversed to False for
+ -- those subprograms which could be inlined in GNATprove mode (because
+ -- Body_To_Inline is non-Empty) but cannot be inlined.
+
+ if GNATprove_Mode then
+ Set_Is_Inlined_Always (Designator);
+ end if;
+
-- Introduce new scope for analysis of the formals and the return type
Set_Scope (Designator, Current_Scope);
Alt := First (Alternatives (N));
Search : loop
- -- We must find a match among the alternatives, If not this must
+ -- We must find a match among the alternatives. If not, this must
-- be due to other errors, so just ignore, leaving as non-static.
if No (Alt) then
return;
end if;
- -- If condition raises constraint error then we have already signalled
+ -- If condition raises constraint error then we have already signaled
-- an error, and we just propagate to the result and do not fold.
if Raises_Constraint_Error (Condition) then
-- non-static or raise Constraint_Error, return Non_Static.
--
-- Otherwise check if the selecting expression matches any of the given
- -- discrete choices. If so the alternative is executed and we return
- -- Open, otherwise, the alternative can never be executed, and so we
- -- return Closed.
+ -- discrete choices. If so, the alternative is executed and we return
+ -- Match, otherwise, the alternative can never be executed, and so we
+ -- return No_Match.
---------------------------------
-- Check_Case_Expr_Alternative --
begin
pragma Assert (Nkind (Case_Exp) = N_Case_Expression);
- -- Check selecting expression is static
+ -- Check that selecting expression is static
if not Is_OK_Static_Expression (Expression (Case_Exp)) then
return Non_Static;
Choice := First (Discrete_Choices (CEA));
while Present (Choice) loop
- -- Check various possibilities for choice, returning Closed if we
+ -- Check various possibilities for choice, returning Match if we
-- find the selecting value matches any of the choices. Note that
-- we know we are the last choice, so we don't have to keep going.
Next (Choice);
end loop;
- -- If we get through that loop then all choices were static, and
- -- none of them matched the selecting expression. So return Closed.
+ -- If we get through that loop then all choices were static, and none
+ -- of them matched the selecting expression. So return No_Match.
return No_Match;
end Check_Case_Expr_Alternative;
-- This refers to cases like
- -- (if 1 then 1 elsif 1/0=2 then 2 else 3)
+ -- (if True then 1 elsif 1/0=2 then 2 else 3)
-- But we expand elsif's out anyway, so the above looks like:
- -- (if 1 then 1 else (if 1/0=2 then 2 else 3))
+ -- (if True then 1 else (if 1/0=2 then 2 else 3))
-- So for us this is caught by the above check for the 32.3 case.
and then not In_Inlined_Body
and then Ada_Version >= Ada_95
then
- -- No message if we are staticallly unevaluated
+ -- No message if we are statically unevaluated
if Is_Statically_Unevaluated (N) then
null;
-- definition, they are sometimes folded anyway, but of course in this case
-- Is_Static_Expression is not set.
- -- When we are analyzing and evaluating static expressions, we proopagate
+ -- When we are analyzing and evaluating static expressions, we propagate
-- both flags accurately. Usually if a subexpression raises a constraint
-- error, then so will its parent expression, and Raise_Constraint_Error
-- will be propagated to this parent. The exception is conditional cases
if GNATprove_Mode
and then Is_Overloadable (Nam)
and then SPARK_Mode = On
+ and then Full_Analysis
then
-- Retrieve the body to inline from the ultimate alias of Nam, if
-- there is one, otherwise calls that should be inlined end up not
Decl : constant Node_Id := Unit_Declaration_Node (Nam_Alias);
begin
if Nkind (Decl) = N_Subprogram_Declaration
+ and then Can_Be_Inlined_In_GNATprove_Mode (Nam_Alias, Empty)
+ and then No (Corresponding_Body (Decl))
+ then
+ Error_Msg_NE
+ ("?cannot inline call to & (body not seen yet)", N, Nam);
+ Set_Is_Inlined_Always (Nam_Alias, False);
+
+ elsif Nkind (Decl) = N_Subprogram_Declaration
and then Present (Body_To_Inline (Decl))
+ and then Is_Inlined (Nam_Alias)
then
if Is_Potentially_Unevaluated (N) then
Error_Msg_NE ("?cannot inline call to &", N, Nam);
Error_Msg_N
("\call appears in potentially unevaluated context", N);
- Set_Is_Inlined (Nam, False);
+ Set_Is_Inlined_Always (Nam_Alias, False);
else
Expand_Inlined_Call (N, Nam_Alias, Nam);
end if;
end if;
end Is_Iterator;
- ------------------
- -- Is_Junk_Name --
- ------------------
-
- function Is_Junk_Name (N : Name_Id) return Boolean is
- function Match (S : String) return Boolean;
- -- Return true if substring S is found in Name_Buffer (1 .. Name_Len)
-
- -----------
- -- Match --
- -----------
-
- function Match (S : String) return Boolean is
- Slen1 : constant Integer := S'Length - 1;
-
- begin
- for J in 1 .. Name_Len - S'Length + 1 loop
- if Name_Buffer (J .. J + Slen1) = S then
- return True;
- end if;
- end loop;
-
- return False;
- end Match;
-
- -- Start of processing for Is_Junk_Name
-
- begin
- Get_Unqualified_Decoded_Name_String (N);
- Set_All_Upper_Case;
-
- return
- Match ("DISCARD") or else
- Match ("DUMMY") or else
- Match ("IGNORE") or else
- Match ("JUNK") or else
- Match ("UNUSED");
- end Is_Junk_Name;
-
------------
-- Is_LHS --
------------
-- AI05-0139-2: Check whether Typ is one of the predefined interfaces in
-- Ada.Iterator_Interfaces, or it is derived from one.
- function Is_Junk_Name (N : Name_Id) return Boolean;
- -- Returns True if the given name contains any of the following substrings
- -- discard
- -- dummy
- -- ignore
- -- junk
- -- unused
- -- Used to suppress warnings on names matching these patterns. The contents
- -- of Name_Buffer and Name_Len are destroyed by this call.
-
type Is_LHS_Result is (Yes, No, Unknown);
function Is_LHS (N : Node_Id) return Is_LHS_Result;
-- Returns Yes if N is definitely used as Name in an assignment statement.
-- If E is a parameter entity for a subprogram body, then this function
-- returns the corresponding spec entity, if not, E is returned unchanged.
+ function Has_Junk_Name (E : Entity_Id) return Boolean;
+ -- Return True if the entity name contains any of the following substrings:
+ -- discard
+ -- dummy
+ -- ignore
+ -- junk
+ -- unused
+ -- Used to suppress warnings on names matching these patterns. The contents
+ -- of Name_Buffer and Name_Len are destroyed by this call.
+
function Has_Pragma_Unmodified_Check_Spec (E : Entity_Id) return Boolean;
-- Tests Has_Pragma_Unmodified flag for entity E. If E is not a formal,
-- this is simply the setting of the flag Has_Pragma_Unmodified. If E is
-- We are only interested in source entities. We also don't issue
-- warnings within instances, since the proper place for such
- -- warnings is on the template when it is compiled.
+ -- warnings is on the template when it is compiled, and we don't
+ -- issue warnings for variables with names like Junk, Discard etc.
if Comes_From_Source (E1)
and then Instantiation_Location (Sloc (E1)) = No_Location
and then not Has_Pragma_Unreferenced_Check_Spec (E1)
and then not Has_Pragma_Unmodified_Check_Spec (E1)
then
- if not Warnings_Off_E1 then
+ if not Warnings_Off_E1
+ and then not Has_Junk_Name (E1)
+ then
Error_Msg_N -- CODEFIX
("?k?& is not modified, "
& "could be declared constant!",
-- the formal is not modified.
else
- In_Out_Warnings.Append (E1);
+ -- Suppress the warnings for a junk name
+
+ if not Has_Junk_Name (E1) then
+ In_Out_Warnings.Append (E1);
+ end if;
end if;
-- Other cases of formals
if Referenced_Check_Spec (E1) then
if not Has_Pragma_Unmodified_Check_Spec (E1)
and then not Warnings_Off_E1
+ and then not Has_Junk_Name (E1)
then
Output_Reference_Error
("?f?formal parameter& is read but "
elsif not Has_Pragma_Unreferenced_Check_Spec (E1)
and then not Warnings_Off_E1
+ and then not Has_Junk_Name (E1)
then
Output_Reference_Error
("?f?formal parameter& is not referenced!");
if Referenced (E1) then
if not Has_Unmodified (E1)
and then not Warnings_Off_E1
- and then not Is_Junk_Name (Chars (E1))
+ and then not Has_Junk_Name (E1)
then
Output_Reference_Error
("?v?variable& is read but never assigned!");
elsif not Has_Unreferenced (E1)
and then not Warnings_Off_E1
- and then not Is_Junk_Name (Chars (E1))
+ and then not Has_Junk_Name (E1)
then
Output_Reference_Error -- CODEFIX
("?v?variable& is never read and never assigned!");
if Nkind (UR) = N_Simple_Return_Statement
and then not Has_Pragma_Unmodified_Check_Spec (E1)
then
- if not Warnings_Off_E1 then
+ if not Warnings_Off_E1
+ and then not Has_Junk_Name (E1)
+ then
Error_Msg_NE
("?v?OUT parameter& not set before return",
UR, E1);
(E1, Body_Formal (E1, Accept_Statement => Anod));
end if;
- elsif not Warnings_Off_E1 then
+ elsif not Warnings_Off_E1
+ and then not Has_Junk_Name (E1)
+ then
Unreferenced_Entities.Append (E1);
end if;
end if;
and then Instantiation_Depth (Sloc (E1)) = 0
and then Warn_On_Redundant_Constructs
then
- if not Warnings_Off_E1 then
+ if not Warnings_Off_E1 and then not Has_Junk_Name (E1) then
Unreferenced_Entities.Append (E1);
-- Force warning on entity
(Sloc (N), Sloc (Unset_Reference (E))))
and then not Has_Pragma_Unmodified_Check_Spec (E)
and then not Warnings_Off_Check_Spec (E)
+ and then not Has_Junk_Name (E)
then
-- We may have an unset reference. The first test is whether
-- this is an access to a discriminant of a record or a
end if;
end Goto_Spec_Entity;
+ -------------------
+ -- Has_Junk_Name --
+ -------------------
+
+ function Has_Junk_Name (E : Entity_Id) return Boolean is
+ function Match (S : String) return Boolean;
+ -- Return true if substring S is found in Name_Buffer (1 .. Name_Len)
+
+ -----------
+ -- Match --
+ -----------
+
+ function Match (S : String) return Boolean is
+ Slen1 : constant Integer := S'Length - 1;
+
+ begin
+ for J in 1 .. Name_Len - S'Length + 1 loop
+ if Name_Buffer (J .. J + Slen1) = S then
+ return True;
+ end if;
+ end loop;
+
+ return False;
+ end Match;
+
+ -- Start of processing for Has_Junk_Name
+
+ begin
+ Get_Unqualified_Decoded_Name_String (Chars (E));
+
+ return
+ Match ("discard") or else
+ Match ("dummy") or else
+ Match ("ignore") or else
+ Match ("junk") or else
+ Match ("unused");
+ end Has_Junk_Name;
+
--------------------------------------
-- Has_Pragma_Unmodified_Check_Spec --
--------------------------------------
if not Referenced_Check_Spec (E)
and then not Has_Pragma_Unreferenced_Check_Spec (E)
and then not Warnings_Off_Check_Spec (E)
- and then not Is_Junk_Name (Chars (Spec_E))
+ and then not Has_Junk_Name (Spec_E)
then
case Ekind (E) is
when E_Variable =>
and then not Is_Exported (Ent)
and then Safe_To_Capture_Value (N, Ent)
and then not Has_Pragma_Unreferenced_Check_Spec (Ent)
- and then not Is_Junk_Name (Chars (Ent))
+ and then not Has_Junk_Name (Ent)
then
-- Before we issue the message, check covering exception handlers.
-- Search up tree for enclosing statement sequences and handlers.
private
+ pragma Linker_Options ("--specs=vxworks-crtbe-link.spec");
+ -- Pull in crtbegin/crtend objects and register exceptions for ZCX.
+ -- This is commented out by our Makefile for SJLJ runtimes.
+
type Address is mod Memory_Size;
Null_Address : constant Address := 0;
Always_Compatible_Rep : constant Boolean := False;
Suppress_Standard_Library : constant Boolean := False;
Use_Ada_Main_Program_Name : constant Boolean := True;
- ZCX_By_Default : constant Boolean := False;
+ ZCX_By_Default : constant Boolean := True;
end System;
-- S p e c --
-- (VxWorks 5 Version PPC) --
-- --
--- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
private
- -- Note: we now more closely rely on the VxWorks mechanisms to register
- -- exception tables for ZCX support in kernel mode, thanks to crt objects
- -- featuring dedicated constructors triggered by linker options below.
+ pragma Linker_Options ("--specs=vxworks-crtbe-link.spec");
+ -- Pull in crtbegin/crtend objects and register exceptions for ZCX.
+ -- This is commented out by our Makefile for SJLJ runtimes.
- -- Commenting the pragma for the sjlj runtimes is performed automatically
- -- by our Makefiles, so this line needs to be manipulated with care.
-
- pragma Linker_Options ("-crtbe" & ASCII.NUL & "-auto-register");
+ pragma Linker_Options ("--specs=vxworks-ppc-link.spec");
+ -- Setup proper set of -L's for this configuration
type Address is mod Memory_Size;
Null_Address : constant Address := 0;
--- /dev/null
+*self_spec:
++ %{!auto-register:%{!noauto-register:-auto-register}} \
+ %{!crtbe:%{!nocrtbe:-crtbe}}
+
+*startfile:
++ %{crtbe:%{!nocrtbe: \
+ %{!noauto-register:crtbegin.o%s} \
+ %{noauto-register:crtbeginT.o%s} \
+ }}
+
+*endfile:
++ %{crtbe:%{!nocrtbe:crtend.o%s}}
+
--- /dev/null
+*lib:
++ %{mrtp:%{!shared: \
+ -L%:if-exists-else( \
+ %:getenv(WIND_BASE /target/lib/usr/lib/ppc/PPC32/common) \
+ %:getenv(WIND_BASE /target/usr/lib/ppc/PPC32/common)) \
+ }}
projects / thirdparty / gcc.git / commitdiff
