mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-06 02:20:34 +08:00
Code Issues Packages Projects Releases Wiki Activity

[multiple changes]

Browse Source 
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.
	* sem_ch3.adb, lib-xref-spark_specific.adb, s-taprop-vxworks.adb,
	exp_ch7.adb, s-asthan-vms-alpha.adb, sem_ch10.adb, osint-c.adb,
	prj.adb, g-comlin.adb, makeutl.adb, s-tasdeb.adb, exp_intr.adb,
	s-asthan-vms-ia64.adb, prj-env.adb: 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.

From-SVN: r213264
This commit is contained in:
Arnaud Charlet 2014-07-30 15:40:41 +02:00
parent e687b3f535
commit 4bd4bb7f0c
36 changed files with 333 additions and 173 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

64
gcc/ada/ChangeLog
View File

@ -1,3 +1,67 @@
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.

6
gcc/ada/checks.adb
View File

@ -6554,7 +6554,8 @@ package body Checks is
-- 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
@ -6562,6 +6563,7 @@ package body Checks is
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);
@ -8053,8 +8055,10 @@ package body Checks is
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;

61
gcc/ada/einfo.adb
View File

@ -270,6 +270,7 @@ package body Einfo is
-- 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
@ -568,7 +569,6 @@ package body Einfo is
-- (SSO_Set_Low_By_Default) Flag272
-- (SSO_Set_Low_By_Default) Flag273
-- (unused) Flag1
-- (unused) Flag2
-- (unused) Flag3
@ -2107,6 +2107,12 @@ package body Einfo is
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);
@ -3518,6 +3524,13 @@ package body Einfo is
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);
@ -3559,6 +3572,22 @@ package body Einfo is
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
@ -3849,22 +3878,6 @@ package body Einfo is
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);
@ -3951,13 +3964,6 @@ package body Einfo is
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));
@ -4888,6 +4894,12 @@ package body Einfo is
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));
@ -8389,6 +8401,7 @@ package body Einfo is
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));

16
gcc/ada/einfo.ads
View File

@ -2476,10 +2476,12 @@ package Einfo is
-- 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
@ -5673,6 +5675,7 @@ package Einfo is
-- 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)
@ -5964,6 +5967,7 @@ package Einfo is
-- 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)
@ -6683,6 +6687,7 @@ package Einfo is
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;
@ -7320,6 +7325,7 @@ package Einfo is
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);
@ -8090,6 +8096,7 @@ package Einfo is
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);
@ -8545,6 +8552,7 @@ package Einfo is
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);

1
gcc/ada/exp_ch7.adb
View File

@ -3141,7 +3141,6 @@ package body Exp_Ch7 is
Decl : Node_Id;
Dummy : Entity_Id;
pragma Unreferenced (Dummy);
-- This variable captures an unused dummy internal entity, see the
-- comment associated with its use.

1
gcc/ada/exp_intr.adb
View File

@ -961,7 +961,6 @@ package body Exp_Intr is
-- 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.

1
gcc/ada/g-comlin.adb
View File

@ -584,7 +584,6 @@ package body GNAT.Command_Line is
Parser : Opt_Parser := Command_Line_Parser) return Character
is
Dummy : Boolean;
pragma Unreferenced (Dummy);
begin
<<Restart>>

5
gcc/ada/gcc-interface/Makefile.in
View File

@ -623,6 +623,9 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(target_cpu) $(target_vendor) $
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
@ -1024,6 +1027,8 @@ ifeq ($(strip $(filter-out arm% coff wrs vx%,$(target_cpu) $(target_vendor) $(ta
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

2
gcc/ada/gnat_rm.texi
View File

@ -10586,7 +10586,7 @@ statements (raise with no operand) are not permitted.
[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.

51
gcc/ada/inline.adb
View File

@ -1445,11 +1445,11 @@ package body Inline is
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
@ -1474,10 +1474,10 @@ package body Inline is
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
@ -1630,6 +1630,8 @@ package body Inline is
-- 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
@ -1663,7 +1665,8 @@ package body Inline is
-- 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;
@ -1671,7 +1674,8 @@ package body Inline is
-- 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;
@ -1684,8 +1688,10 @@ package body Inline is
-- 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;
@ -2781,8 +2787,16 @@ package body Inline is
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,
@ -3519,6 +3533,15 @@ package body Inline is
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
@ -3724,13 +3747,13 @@ package body Inline is
-- 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;

9
gcc/ada/inline.ads
View File

@ -238,8 +238,11 @@ package Inline is
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;

1
gcc/ada/lib-xref-spark_specific.adb
View File

@ -485,7 +485,6 @@ package body SPARK_Specific is
declare
Dummy : constant SPARK_Scope_Record :=
SPARK_Scope_Table.Table (Index);
pragma Unreferenced (Dummy);
begin
return True;
end;

8
gcc/ada/lib-xref.adb
View File

@ -955,6 +955,14 @@ package body Lib.Xref is
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.

3
gcc/ada/makeutl.adb
View File

@ -1434,8 +1434,6 @@ package body Makeutl is
In_Tree : Project_Tree_Ref;
Dummy : in out Boolean)
is
pragma Unreferenced (Dummy);
Linker_Package : Package_Id;
Options : Variable_Value;
@ -2621,7 +2619,6 @@ package body Makeutl is
Iter : Source_Iterator;
Dummy : Boolean;
pragma Unreferenced (Dummy);
begin
if not Insert_No_Roots (Source) then

4
gcc/ada/osint-c.adb
View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -197,8 +197,6 @@ package body Osint.C is
procedure Create_Output_Library_Info is
Dummy : Boolean;
pragma Unreferenced (Dummy);
begin
Set_Library_Info_Name;
Delete_File (Name_Buffer (1 .. Name_Len), Dummy);

11
gcc/ada/prj-env.adb
View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -131,7 +131,6 @@ package body Prj.Env is
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);
@ -201,7 +200,7 @@ package body Prj.Env is
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
@ -1259,7 +1258,7 @@ package body Prj.Env is
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
@ -1304,8 +1303,6 @@ package body Prj.Env is
In_Tree : Project_Tree_Ref;
Dummy : in out Integer)
is
pragma Unreferenced (Dummy);
Current : String_List_Id := Prj.Source_Dirs;
The_String : String_Element;
@ -1676,7 +1673,7 @@ package body Prj.Env is
In_Tree : Project_Tree_Ref;
Dummy : in out Boolean)
is
pragma Unreferenced (Dummy, In_Tree);
pragma Unreferenced (In_Tree);
Path : Path_Name_Type;

2
gcc/ada/prj.adb
View File

@ -1714,7 +1714,7 @@ package body Prj is
Context : Project_Context;
Dummy : in out Boolean)
is
pragma Unreferenced (Dummy, Tree);
pragma Unreferenced (Tree);
List : Project_List;
Prj2 : Project_Id;

1
gcc/ada/s-asthan-vms-alpha.adb
View File

@ -320,7 +320,6 @@ package body System.AST_Handling is
procedure Allocate_New_AST_Server is
Dummy : AST_Server_Task_Ptr;
pragma Unreferenced (Dummy);
begin
if Num_AST_Servers = Max_AST_Servers then

1
gcc/ada/s-asthan-vms-ia64.adb
View File

@ -325,7 +325,6 @@ package body System.AST_Handling is
procedure Allocate_New_AST_Server is
Dummy : AST_Server_Task_Ptr;
pragma Unreferenced (Dummy);
begin
if Num_AST_Servers = Max_AST_Servers then

3
gcc/ada/s-taprop-vxworks.adb
View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -1298,7 +1298,6 @@ package body System.Task_Primitives.Operations is
C : Task_Id;
Dummy : int;
pragma Unreferenced (Dummy);
begin
Dummy := Int_Lock;

10
gcc/ada/s-tasdeb.adb
View File

@ -77,10 +77,8 @@ package body System.Tasking.Debug is
------------------------
procedure Continue_All_Tasks is
C : Task_Id;
C : Task_Id;
Dummy : Boolean;
pragma Unreferenced (Dummy);
begin
STPO.Lock_RTS;
@ -218,7 +216,6 @@ package body System.Tasking.Debug is
procedure Resume_All_Tasks (Thread_Self : OS_Interface.Thread_Id) is
C : Task_Id;
Dummy : Boolean;
pragma Unreferenced (Dummy);
begin
STPO.Lock_RTS;
@ -267,10 +264,8 @@ package body System.Tasking.Debug is
--------------------
procedure Stop_All_Tasks is
C : Task_Id;
C : Task_Id;
Dummy : Boolean;
pragma Unreferenced (Dummy);
begin
STPO.Lock_RTS;
@ -300,7 +295,6 @@ package body System.Tasking.Debug is
procedure Suspend_All_Tasks (Thread_Self : OS_Interface.Thread_Id) is
C : Task_Id;
Dummy : Boolean;
pragma Unreferenced (Dummy);
begin
STPO.Lock_RTS;

2
gcc/ada/sem_aggr.adb
View File

@ -112,7 +112,7 @@ package body Sem_Aggr is
-- 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

10
gcc/ada/sem_attr.adb
View File

@ -7386,13 +7386,19 @@ package body Sem_Attr is
-- 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;

12
gcc/ada/sem_ch10.adb
View File

@ -5694,13 +5694,11 @@ package body Sem_Ch10 is
-------------------
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
@ -5709,9 +5707,9 @@ package body Sem_Ch10 is
Elmt := First (Expressions (State));
while Present (Elmt) loop
Process_State (Elmt);
Next (Elmt);
end loop;
return;
-- A null state has no abstract view

1
gcc/ada/sem_ch3.adb
View File

@ -2140,7 +2140,6 @@ package body Sem_Ch3 is
Spec_Id : Entity_Id;
Dummy : Entity_Id;
pragma Unreferenced (Dummy);
-- A dummy variable used to capture the unused result of subprogram
-- spec analysis.

12
gcc/ada/sem_ch6.adb
View File

@ -3512,7 +3512,6 @@ package body Sem_Ch6 is
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;
@ -3540,7 +3539,6 @@ package body Sem_Ch6 is
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;
@ -3675,7 +3673,7 @@ package body Sem_Ch6 is
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
@ -4268,6 +4266,14 @@ package body Sem_Ch6 is
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);

24
gcc/ada/sem_eval.adb
View File

@ -2128,7 +2128,7 @@ package body Sem_Eval is
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
@ -2381,7 +2381,7 @@ package body Sem_Eval is
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
@ -4980,9 +4980,9 @@ package body Sem_Eval is
-- 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 --
@ -4998,7 +4998,7 @@ package body Sem_Eval is
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;
@ -5014,7 +5014,7 @@ package body Sem_Eval is
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.
@ -5048,8 +5048,8 @@ package body Sem_Eval is
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;
@ -5125,11 +5125,11 @@ package body Sem_Eval is
-- 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.
@ -5287,7 +5287,7 @@ package body Sem_Eval is
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;

2
gcc/ada/sem_eval.ads
View File

@ -74,7 +74,7 @@ package Sem_Eval is
-- 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

12
gcc/ada/sem_res.adb
View File

@ -6210,6 +6210,7 @@ package body Sem_Res is
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
@ -6220,13 +6221,22 @@ package body Sem_Res is
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;

39
gcc/ada/sem_util.adb
View File

@ -10493,45 +10493,6 @@ package body Sem_Util is
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 --
------------

10
gcc/ada/sem_util.ads
View File

@ -1203,16 +1203,6 @@ package Sem_Util is
-- 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.

82
gcc/ada/sem_warn.adb
View File

@ -128,6 +128,16 @@ package body Sem_Warn is
-- 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
@ -1060,7 +1070,8 @@ package body Sem_Warn 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
@ -1145,7 +1156,9 @@ package body Sem_Warn is
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!",
@ -1267,7 +1280,11 @@ package body Sem_Warn is
-- 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
@ -1277,6 +1294,7 @@ package body Sem_Warn is
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 "
@ -1285,6 +1303,7 @@ package body Sem_Warn is
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!");
@ -1297,7 +1316,7 @@ package body Sem_Warn is
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!");
@ -1306,7 +1325,7 @@ package body Sem_Warn is
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!");
@ -1373,7 +1392,9 @@ package body Sem_Warn is
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);
@ -1593,7 +1614,9 @@ package body Sem_Warn is
(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;
@ -1609,7 +1632,7 @@ package body Sem_Warn is
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
@ -1755,6 +1778,7 @@ package body Sem_Warn is
(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
@ -2660,6 +2684,44 @@ package body Sem_Warn is
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 --
--------------------------------------
@ -3910,7 +3972,7 @@ package body Sem_Warn is
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 =>
@ -4115,7 +4177,7 @@ package body Sem_Warn is
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.

6
gcc/ada/system-vxworks-arm.ads
View File

@ -115,6 +115,10 @@ package System is
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;
@ -151,6 +155,6 @@ private
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;

14
gcc/ada/system-vxworks-ppc.ads
View File

@ -7,7 +7,7 @@
-- 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 --
@ -115,14 +115,12 @@ package System is
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;

13
gcc/ada/vxworks-crtbe-link.spec Normal file
View File

@ -0,0 +1,13 @@
*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}}

6
gcc/ada/vxworks-ppc-link.spec Normal file
View File

@ -0,0 +1,6 @@
*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)) \
}}