OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

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

	* sem_dim.adb, errout.adb, errout.ads (Analyze_Dimension_Call): Add
	guard against abnormal tree resulting from a previously diagnosed
	illegality.

2012-10-05  Hristian Kirtchev  <kirtchev@adacore.com>

	* freeze.adb (Freeze_Expression): Rename local variable Cspc to Spec
	and update all refs to it. Do not freeze an entity outside a subprogram
	body when the original context is an expression function.

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

	* gnat1drv.adb (Adjust_Global_Switches): Default for overflow checking
	is suppressed, even if backend overflow/divide checks are enabled.

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

	* einfo.adb (Set_Invariant_Procedure, Set_Predicate_Function):
	chain properly subprograms on Subprograms_For_Type list.
	* sem_ch13.ads; (Build_Invariant_Procedure_Declaration): new
	procedure, to create declaration for invariant procedure
	independently of the construction of the body, so that it can
	be called within expression functions.
	* sem_ch13.adb (Build_Invariant_Procedure): code cleanup. The
	declaration may already have been generated at the point an
	explicit invariant aspect is encountered.
	* sem_prag.adb; (Analyze_Pragma, case Invariant): create declaration
	for invariant procedure.
	* sem_ch7.adb (Analyze_Package_Specification): clean up call to
	build invariant procedure.
	(Preserve_Full_Attributes): propagate information about invariants
	if they appear on a completion,

2012-10-05  Pascal Obry  <obry@adacore.com>

	* gnat_ugn.texi: Update documentation to lift Microsoft C
	restriction.

From-SVN: r192128
This commit is contained in:
Arnaud Charlet 2012-10-05 16:29:57 +02:00
parent 967fb65e80
commit 95081e99e2
12 changed files with 254 additions and 78 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
gcc/ada/ChangeLog
View File

@ -1,3 +1,43 @@
2012-10-05 Thomas Quinot <quinot@adacore.com>
* sem_dim.adb, errout.adb, errout.ads (Analyze_Dimension_Call): Add
guard against abnormal tree resulting from a previously diagnosed
illegality.
2012-10-05 Hristian Kirtchev <kirtchev@adacore.com>
* freeze.adb (Freeze_Expression): Rename local variable Cspc to Spec
and update all refs to it. Do not freeze an entity outside a subprogram
body when the original context is an expression function.
2012-10-05 Robert Dewar <dewar@adacore.com>
* gnat1drv.adb (Adjust_Global_Switches): Default for overflow checking
is suppressed, even if backend overflow/divide checks are enabled.
2012-10-05 Ed Schonberg <schonberg@adacore.com>
* einfo.adb (Set_Invariant_Procedure, Set_Predicate_Function):
chain properly subprograms on Subprograms_For_Type list.
* sem_ch13.ads; (Build_Invariant_Procedure_Declaration): new
procedure, to create declaration for invariant procedure
independently of the construction of the body, so that it can
be called within expression functions.
* sem_ch13.adb (Build_Invariant_Procedure): code cleanup. The
declaration may already have been generated at the point an
explicit invariant aspect is encountered.
* sem_prag.adb; (Analyze_Pragma, case Invariant): create declaration
for invariant procedure.
* sem_ch7.adb (Analyze_Package_Specification): clean up call to
build invariant procedure.
(Preserve_Full_Attributes): propagate information about invariants
if they appear on a completion,
2012-10-05 Pascal Obry <obry@adacore.com>
* gnat_ugn.texi: Update documentation to lift Microsoft C
restriction.
2012-10-05 Robert Dewar <dewar@adacore.com>
* sem_util.adb (Has_One_Matching_Field): Handle case of lone

6
gcc/ada/einfo.adb
View File

@ -7113,6 +7113,7 @@ package body Einfo is
S := Subprograms_For_Type (Id);
Set_Subprograms_For_Type (Id, V);
Set_Subprograms_For_Type (V, S);
while Present (S) loop
if Has_Invariants (S) then
@ -7121,8 +7122,6 @@ package body Einfo is
S := Subprograms_For_Type (S);
end if;
end loop;
Set_Subprograms_For_Type (Id, V);
end Set_Invariant_Procedure;
----------------------------
@ -7137,6 +7136,7 @@ package body Einfo is
S := Subprograms_For_Type (Id);
Set_Subprograms_For_Type (Id, V);
Set_Subprograms_For_Type (V, S);
while Present (S) loop
if Has_Predicates (S) then
@ -7145,8 +7145,6 @@ package body Einfo is
S := Subprograms_For_Type (S);
end if;
end loop;
Set_Subprograms_For_Type (Id, V);
end Set_Predicate_Function;
-----------------

15
gcc/ada/errout.adb
View File

@ -198,6 +198,21 @@ package body Errout is
-- spec for precise definition of the conversion that is performed by this
-- routine in OpenVMS mode.
--------------------
-- Cascaded_Error --
--------------------
procedure Cascaded_Error is
begin
-- An anomaly has been detected which is assumed to be a consequence of
-- a previous error. Raise an exception if no serious error has been
-- found so far.
if Serious_Errors_Detected = 0 then
raise Program_Error;
end if;
end Cascaded_Error;
-----------------------
-- Change_Error_Text --
-----------------------

7
gcc/ada/errout.ads
View File

@ -727,6 +727,13 @@ package Errout is
-- This routine can only be called during semantic analysis. It may not
-- be called during parsing.
procedure Cascaded_Error;
-- When an anomaly is detected, many semantic routines silently bail out,
-- assuming that the anomaly was caused by a previously detected error.
-- This routine should be called in these cases, and will raise an
-- exception if no serious error has been detected. This ensure that the
-- anomaly is never allowed to go unnoticed.
procedure Change_Error_Text (Error_Id : Error_Msg_Id; New_Msg : String);
-- The error message text of the message identified by Id is replaced by
-- the given text. This text may contain insertion characters in the

62
gcc/ada/freeze.adb
View File

@ -5156,44 +5156,64 @@ package body Freeze is
-- subprogram body that we are inside.
if In_Exp_Body (Parent_P) then
-- However, we *do* want to freeze at this point if we have
-- an entity to freeze, and that entity is declared *inside*
-- the body of the expander generated procedure. This case
-- is recognized by the scope of the type, which is either
-- the spec for some enclosing body, or (in the case of
-- init_procs, for which there are no separate specs) the
-- current scope.
declare
Subp : constant Node_Id := Parent (Parent_P);
Cspc : Entity_Id;
Spec : Entity_Id;
begin
if Nkind (Subp) = N_Subprogram_Body then
Cspc := Corresponding_Spec (Subp);
-- Freeze the entity only when it is declared inside the
-- body of the expander generated procedure. This case
-- is recognized by the scope of the entity or its type,
-- which is either the spec for some enclosing body, or
-- (in the case of init_procs, for which there are no
-- separate specs) the current scope.
if (Present (Typ) and then Scope (Typ) = Cspc)
if Nkind (Subp) = N_Subprogram_Body then
Spec := Corresponding_Spec (Subp);
if (Present (Typ) and then Scope (Typ) = Spec)
or else
(Present (Nam) and then Scope (Nam) = Cspc)
(Present (Nam) and then Scope (Nam) = Spec)
then
exit;
elsif Present (Typ)
and then Scope (Typ) = Current_Scope
and then Current_Scope = Defining_Entity (Subp)
and then Defining_Entity (Subp) = Current_Scope
then
exit;
end if;
end if;
-- An expression function may act as a completion of
-- a function declaration. As such, it can reference
-- entities declared between the two views:
-- Hidden []; -- 1
-- function F return ...;
-- private
-- function Hidden return ...;
-- function F return ... is (Hidden); -- 2
-- Refering to the example above, freezing the expression
-- of F (2) would place Hidden's freeze node (1) in the
-- wrong place. Avoid explicit freezing and let the usual
-- scenarios do the job - for example, reaching the end
-- of the private declarations.
if Nkind (Original_Node (Subp)) =
N_Expression_Function
then
null;
-- Freeze outside the body
else
Parent_P := Parent (Parent_P);
Freeze_Outside := True;
end if;
end;
-- If not that exception to the exception, then this is
-- where we delay the freeze till outside the body.
Parent_P := Parent (Parent_P);
Freeze_Outside := True;
-- Here if normal case where we are in handled statement
-- sequence and want to do the insertion right there.

19
gcc/ada/gnat1drv.adb
View File

@ -328,12 +328,17 @@ procedure Gnat1drv is
Exception_Mechanism := Back_End_Exceptions;
end if;
-- Set proper status for overflow checks. If already set (by -gnato or
-- -gnatp) then we have nothing to do.
-- Set proper status for overflow checks
-- If already set (by - gnato or -gnatp) then we have nothing to do
if Opt.Suppress_Options.Overflow_Checks_General /= Not_Set then
null;
-- Otherwise set appropriate default mode. Note: at present we set
-- SUPPRESSED in all three of the following cases. They are separated
-- because in the future we may make different choices.
-- By default suppress overflow checks in -gnatg mode
elsif GNAT_Mode then
@ -341,16 +346,18 @@ procedure Gnat1drv is
Suppress_Options.Overflow_Checks_Assertions := Suppressed;
-- If we have backend divide and overflow checks, then by default
-- overflow checks are minimized, which is a reasonable setting.
-- overflow checks are suppressed. Historically this code used to
-- activate overflow checks, although no target currently has these
-- flags set, so this was dead code anyway.
elsif Targparm.Backend_Divide_Checks_On_Target
and
Targparm.Backend_Overflow_Checks_On_Target
then
Suppress_Options.Overflow_Checks_General := Minimized;
Suppress_Options.Overflow_Checks_Assertions := Minimized;
Suppress_Options.Overflow_Checks_General := Suppressed;
Suppress_Options.Overflow_Checks_Assertions := Suppressed;
-- Otherwise for now, default is checks are suppressed. This is likely
-- Otherwise for now, default is checks are suppressed. This is subject
-- to change in the future, but for now this is the compatible behavior
-- with previous versions of GNAT.

18
gcc/ada/gnat_ugn.texi
View File

@ -28212,9 +28212,15 @@ success. It should be possible to use @code{GetLastError} and
features are not used, but it is not guaranteed to work.
@item
It is not possible to link against Microsoft libraries except for
It is not possible to link against Microsoft C++ libraries except for
import libraries. Interfacing must be done by the mean of DLLs.
@item
It is possible to link against Microsoft C libraries. Yet the preferred
solution is to use C/C++ compiler that comes with @value{EDITION}, since it
doesn't require having two different development environments and makes the
inter-language debugging experience smoother.
@item
When the compilation environment is located on FAT32 drives, users may
experience recompilations of the source files that have not changed if
@ -28302,14 +28308,14 @@ application that contains a mix of Ada and C/C++, the choice of your
Windows C/C++ development environment conditions your overall
interoperability strategy.
If you use @command{gcc} to compile the non-Ada part of your application,
there are no Windows-specific restrictions that affect the overall
interoperability with your Ada code. If you do want to use the
Microsoft tools for your non-Ada code, you have two choices:
If you use @command{gcc} or Microsoft C to compile the non-Ada part of
your application, there are no Windows-specific restrictions that
affect the overall interoperability with your Ada code. If you do want
to use the Microsoft tools for your C++ code, you have two choices:
@enumerate
@item
Encapsulate your non-Ada code in a DLL to be linked with your Ada
Encapsulate your C++ code in a DLL to be linked with your Ada
application. In this case, use the Microsoft or whatever environment to
build the DLL and use GNAT to build your executable
(@pxref{Using DLLs with GNAT}).

115
gcc/ada/sem_ch13.adb
View File

@ -4902,6 +4902,48 @@ package body Sem_Ch13 is
end if;
end Analyze_Record_Representation_Clause;
-------------------------------------------
-- Build_Invariant_Procedure_Declaration --
-------------------------------------------
function Build_Invariant_Procedure_Declaration
(Typ : Entity_Id) return Node_Id
is
Loc : constant Source_Ptr := Sloc (Typ);
Object_Entity : constant Entity_Id :=
Make_Defining_Identifier (Loc, New_Internal_Name ('I'));
Spec : Node_Id;
SId : Entity_Id;
begin
Set_Etype (Object_Entity, Typ);
-- Check for duplicate definiations.
if Has_Invariants (Typ)
and then Present (Invariant_Procedure (Typ))
then
return Empty;
end if;
SId := Make_Defining_Identifier (Loc,
Chars => New_External_Name (Chars (Typ), "Invariant"));
Set_Has_Invariants (SId);
Set_Has_Invariants (Typ);
Set_Ekind (SId, E_Procedure);
Set_Invariant_Procedure (Typ, SId);
Spec :=
Make_Procedure_Specification (Loc,
Defining_Unit_Name => SId,
Parameter_Specifications => New_List (
Make_Parameter_Specification (Loc,
Defining_Identifier => Object_Entity,
Parameter_Type => New_Occurrence_Of (Typ, Loc))));
return Make_Subprogram_Declaration (Loc, Specification => Spec);
end Build_Invariant_Procedure_Declaration;
-------------------------------
-- Build_Invariant_Procedure --
-------------------------------
@ -4936,12 +4978,11 @@ package body Sem_Ch13 is
-- "inherited" to the exception message and generating an informational
-- message about the inheritance of an invariant.
Object_Name : constant Name_Id := New_Internal_Name ('I');
Object_Name : Name_Id;
-- Name for argument of invariant procedure
Object_Entity : constant Node_Id :=
Make_Defining_Identifier (Loc, Object_Name);
-- The procedure declaration entity for the argument
Object_Entity : Node_Id;
-- The entity of the formal for the procedure
--------------------
-- Add_Invariants --
@ -5140,7 +5181,29 @@ package body Sem_Ch13 is
Stmts := No_List;
PDecl := Empty;
PBody := Empty;
Set_Etype (Object_Entity, Typ);
SId := Empty;
-- If the aspect specification exists for some view of the type, the
-- declaration for the procedure has been created.
if Has_Invariants (Typ) then
SId := Invariant_Procedure (Typ);
end if;
if Present (SId) then
PDecl := Unit_Declaration_Node (SId);
else
PDecl := Build_Invariant_Procedure_Declaration (Typ);
end if;
-- Recover formal of procedure, for use in the calls to invariant
-- functions (including inherited ones).
Object_Entity :=
Defining_Identifier
(First (Parameter_Specifications (Specification (PDecl))));
Object_Name := Chars (Object_Entity);
-- Add invariants for the current type
@ -5174,38 +5237,7 @@ package body Sem_Ch13 is
if Stmts /= No_List then
-- Build procedure declaration
SId :=
Make_Defining_Identifier (Loc,
Chars => New_External_Name (Chars (Typ), "Invariant"));
Set_Has_Invariants (SId);
Set_Invariant_Procedure (Typ, SId);
Spec :=
Make_Procedure_Specification (Loc,
Defining_Unit_Name => SId,
Parameter_Specifications => New_List (
Make_Parameter_Specification (Loc,
Defining_Identifier => Object_Entity,
Parameter_Type => New_Occurrence_Of (Typ, Loc))));
PDecl := Make_Subprogram_Declaration (Loc, Specification => Spec);
-- Build procedure body
SId :=
Make_Defining_Identifier (Loc,
Chars => New_External_Name (Chars (Typ), "Invariant"));
Spec :=
Make_Procedure_Specification (Loc,
Defining_Unit_Name => SId,
Parameter_Specifications => New_List (
Make_Parameter_Specification (Loc,
Defining_Identifier =>
Make_Defining_Identifier (Loc, Object_Name),
Parameter_Type => New_Occurrence_Of (Typ, Loc))));
Spec := Copy_Separate_Tree (Specification (PDecl));
PBody :=
Make_Subprogram_Body (Loc,
@ -5216,14 +5248,18 @@ package body Sem_Ch13 is
Statements => Stmts));
-- Insert procedure declaration and spec at the appropriate points.
-- If declaration is already analyzed, it was processed by the
-- generated pragma.
if Present (Private_Decls) then
-- The spec goes at the end of visible declarations, but they have
-- already been analyzed, so we need to explicitly do the analyze.
Append_To (Visible_Decls, PDecl);
Analyze (PDecl);
if not Analyzed (PDecl) then
Append_To (Visible_Decls, PDecl);
Analyze (PDecl);
end if;
-- The body goes at the end of the private declarations, which we
-- have not analyzed yet, so we do not need to perform an explicit
@ -5523,6 +5559,7 @@ package body Sem_Ch13 is
Make_Defining_Identifier (Loc,
Chars => New_External_Name (Chars (Typ), "Predicate"));
Set_Has_Predicates (SId);
Set_Ekind (SId, E_Function);
Set_Predicate_Function (Typ, SId);
-- The predicate function is shared between views of a type.

8
gcc/ada/sem_ch13.ads
View File

@ -46,6 +46,14 @@ package Sem_Ch13 is
-- order is specified and there is at least one component clause. Adjusts
-- component positions according to either Ada 95 or Ada 2005 (AI-133).
function Build_Invariant_Procedure_Declaration
(Typ : Entity_Id) return Node_Id;
-- If a type declaration has a specified invariant aspect, build the
-- declaration for the procedure at once, so that calls to it can be
-- generated before the body of the invariant procedure is built. This
-- is needed in the presence of public expression functions that return
-- the type in question.
procedure Build_Invariant_Procedure (Typ : Entity_Id; N : Node_Id);
-- Typ is a private type with invariants (indicated by Has_Invariants being
-- set for Typ, indicating the presence of pragma Invariant entries on the

25
gcc/ada/sem_ch7.adb
View File

@ -28,6 +28,7 @@
-- handling of private and full declarations, and the construction of dispatch
-- tables for tagged types.
with Aspects; use Aspects;
with Atree; use Atree;
with Debug; use Debug;
with Einfo; use Einfo;
@ -1387,7 +1388,21 @@ package body Sem_Ch7 is
and then Nkind (Parent (E)) = N_Full_Type_Declaration
and then Has_Aspects (Parent (E))
then
Build_Invariant_Procedure (E, N);
declare
ASN : Node_Id;
begin
ASN := First (Aspect_Specifications (Parent (E)));
while Present (ASN) loop
if Chars (Identifier (ASN)) = Name_Invariant
or else Chars (Identifier (ASN)) = Name_Type_Invariant
then
Build_Invariant_Procedure (E, N);
exit;
end if;
Next (ASN);
end loop;
end;
end if;
Next_Entity (E);
@ -2143,6 +2158,14 @@ package body Sem_Ch7 is
Set_Freeze_Node (Priv, Freeze_Node (Full));
-- Propagate information of type invariants, which may be specified
-- for the full view.
if Has_Invariants (Full) and not Has_Invariants (Priv) then
Set_Has_Invariants (Priv);
Set_Subprograms_For_Type (Priv, Subprograms_For_Type (Full));
end if;
if Is_Tagged_Type (Priv)
and then Is_Tagged_Type (Full)
and then not Error_Posted (Full)

9
gcc/ada/sem_dim.adb
View File

@ -1629,6 +1629,15 @@ package body Sem_Dim is
Formal := First_Formal (Nam);
while Present (Formal) loop
-- A missing corresponding actual indicates that the analysis of
-- the call was aborted due to a previous error.
if No (Actual) then
Cascaded_Error;
return;
end if;
Formal_Typ := Etype (Formal);
Dims_Of_Formal := Dimensions_Of (Formal_Typ);

8
gcc/ada/sem_prag.adb
View File

@ -10329,6 +10329,7 @@ package body Sem_Prag is
when Pragma_Invariant => Invariant : declare
Type_Id : Node_Id;
Typ : Entity_Id;
PDecl : Node_Id;
Discard : Boolean;
pragma Unreferenced (Discard);
@ -10380,8 +10381,13 @@ package body Sem_Prag is
-- Note that the type has at least one invariant, and also that
-- it has inheritable invariants if we have Invariant'Class.
-- Build the corresponding invariant procedure declaration, so
-- that calls to it can be generated before the body is built
-- (for example wihin an expression function).
Set_Has_Invariants (Typ);
PDecl := Build_Invariant_Procedure_Declaration (Typ);
Insert_After (N, PDecl);
Analyze (PDecl);
if Class_Present (N) then
Set_Has_Inheritable_Invariants (Typ);