procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[multiple changes]

Browse source 
2012-04-02  Emmanuel Briot  <briot@adacore.com>

	* g-expect.adb (Expect_Internal): Fix leak of the input file descriptor.

2012-04-02  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch4.adb (Expand_N_Quantified_Expression): Reimplemented.
	The expansion no longer uses the copy of the original QE created
	during analysis.
	* sem.adb (Analyze): Add processing for loop parameter specifications.
	* sem_ch4.adb (Analyze_Quantified_Expression): Reimplemented. The
	routine no longer creates a copy of the original QE. All
	constituents of a QE are now preanalyzed and resolved.
	* sem_ch5.adb (Analyze_Iteration_Scheme): Remove the guard which
	bypasses all processing when the iteration scheme is related to a
	QE. Relovate the code which analyzes loop parameter specifications
	to a separate routine.	(Analyze_Iterator_Specification):
	Preanalyze the iterator name. This action was originally
	done in Analyze_Iteration_Scheme. Update the check which
	detects an iterator specification in the context of a QE.
	(Analyze_Loop_Parameter_Specification): New routine. This
	procedure allows for a stand-alone analysis of a loop parameter
	specification without the need of a parent iteration scheme. Add
	code to update the type of the loop variable when the range
	generates an itype and the context is a QE.
	(Pre_Analyze_Range): Renamed to Preanalyze_Range. Update all references
	to the routine.
	* sem_ch5.ads: Code reformatting.
	(Analyze_Loop_Parameter_Specification): New routine.
	* sem_ch6.adb (Fully_Conformant_Expressions): Detect a case
	when establishing conformance between two QEs utilizing different
	specifications.
	* sem_res.adb (Proper_Current_Scope): New routine.
	(Resolve): Do not resolve a QE as there is nothing to be done now.
	Ignore any loop scopes generated for QEs when detecting an expression
	function as the scopes are cosmetic and do not appear in the tree.
	(Resolve_Quantified_Expression): Removed. All resolution of
	QE constituents is now performed during analysis. This ensures
	that loop variables appearing in array aggregates are properly
	resolved.

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

	* sem_util.adb (Build_Default_Subtype): If the base type is
	private and its full view is available, use the full view in
	the subtype declaration.

From-SVN: r186074
This commit is contained in:
Arnaud Charlet 2012-04-02 11:28:52 +02:00
parent a7942a0ee0
commit 804670f120
10 changed files with 792 additions and 793 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

47
gcc/ada/ChangeLog
View file

@ -1,3 +1,50 @@
2012-04-02 Emmanuel Briot <briot@adacore.com>
* g-expect.adb (Expect_Internal): Fix leak of the input file descriptor.
2012-04-02 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch4.adb (Expand_N_Quantified_Expression): Reimplemented.
The expansion no longer uses the copy of the original QE created
during analysis.
* sem.adb (Analyze): Add processing for loop parameter specifications.
* sem_ch4.adb (Analyze_Quantified_Expression): Reimplemented. The
routine no longer creates a copy of the original QE. All
constituents of a QE are now preanalyzed and resolved.
* sem_ch5.adb (Analyze_Iteration_Scheme): Remove the guard which
bypasses all processing when the iteration scheme is related to a
QE. Relovate the code which analyzes loop parameter specifications
to a separate routine. (Analyze_Iterator_Specification):
Preanalyze the iterator name. This action was originally
done in Analyze_Iteration_Scheme. Update the check which
detects an iterator specification in the context of a QE.
(Analyze_Loop_Parameter_Specification): New routine. This
procedure allows for a stand-alone analysis of a loop parameter
specification without the need of a parent iteration scheme. Add
code to update the type of the loop variable when the range
generates an itype and the context is a QE.
(Pre_Analyze_Range): Renamed to Preanalyze_Range. Update all references
to the routine.
* sem_ch5.ads: Code reformatting.
(Analyze_Loop_Parameter_Specification): New routine.
* sem_ch6.adb (Fully_Conformant_Expressions): Detect a case
when establishing conformance between two QEs utilizing different
specifications.
* sem_res.adb (Proper_Current_Scope): New routine.
(Resolve): Do not resolve a QE as there is nothing to be done now.
Ignore any loop scopes generated for QEs when detecting an expression
function as the scopes are cosmetic and do not appear in the tree.
(Resolve_Quantified_Expression): Removed. All resolution of
QE constituents is now performed during analysis. This ensures
that loop variables appearing in array aggregates are properly
resolved.
2012-04-02 Ed Schonberg <schonberg@adacore.com>
* sem_util.adb (Build_Default_Subtype): If the base type is
private and its full view is available, use the full view in
the subtype declaration.
2012-04-02 Jose Ruiz <ruiz@adacore.com>
* gnat_ugn.texi: Add some minimal documentation about how to

77
gcc/ada/exp_ch4.adb
View file

@ -7884,73 +7884,78 @@ package body Exp_Ch4 is
-- given by an iterator specification, not a loop parameter specification.
procedure Expand_N_Quantified_Expression (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N);
Is_Universal : constant Boolean := All_Present (N);
Actions : constant List_Id := New_List;
Tnn : constant Entity_Id := Make_Temporary (Loc, 'T', N);
Cond : Node_Id;
Decl : Node_Id;
I_Scheme : Node_Id;
Original_N : Node_Id;
Test : Node_Id;
Actions : constant List_Id := New_List;
For_All : constant Boolean := All_Present (N);
Iter_Spec : constant Node_Id := Iterator_Specification (N);
Loc : constant Source_Ptr := Sloc (N);
Loop_Spec : constant Node_Id := Loop_Parameter_Specification (N);
Cond : Node_Id;
Flag : Entity_Id;
Scheme : Node_Id;
Stmts : List_Id;
begin
-- Retrieve the original quantified expression (non analyzed)
-- Create the declaration of the flag which tracks the status of the
-- quantified expression. Generate:
if Present (Loop_Parameter_Specification (N)) then
Original_N := Parent (Parent (Loop_Parameter_Specification (N)));
else
Original_N := Parent (Parent (Iterator_Specification (N)));
end if;
-- Flag : Boolean := (True | False);
-- Rewrite N with the original quantified expression
Flag := Make_Temporary (Loc, 'T', N);
Rewrite (N, Original_N);
Decl :=
Append_To (Actions,
Make_Object_Declaration (Loc,
Defining_Identifier => Tnn,
Defining_Identifier => Flag,
Object_Definition => New_Occurrence_Of (Standard_Boolean, Loc),
Expression =>
New_Occurrence_Of (Boolean_Literals (Is_Universal), Loc));
Append_To (Actions, Decl);
New_Occurrence_Of (Boolean_Literals (For_All), Loc)));
-- Construct the circuitry which tracks the status of the quantified
-- expression. Generate:
-- if [not] Cond then
-- Flag := (False | True);
-- exit;
-- end if;
Cond := Relocate_Node (Condition (N));
if Is_Universal then
if For_All then
Cond := Make_Op_Not (Loc, Cond);
end if;
Test :=
Stmts := New_List (
Make_Implicit_If_Statement (N,
Condition => Cond,
Then_Statements => New_List (
Make_Assignment_Statement (Loc,
Name => New_Occurrence_Of (Tnn, Loc),
Name => New_Occurrence_Of (Flag, Loc),
Expression =>
New_Occurrence_Of (Boolean_Literals (not Is_Universal), Loc)),
Make_Exit_Statement (Loc)));
New_Occurrence_Of (Boolean_Literals (not For_All), Loc)),
Make_Exit_Statement (Loc))));
if Present (Loop_Parameter_Specification (N)) then
I_Scheme :=
-- Build the loop equivalent of the quantified expression
if Present (Iter_Spec) then
Scheme :=
Make_Iteration_Scheme (Loc,
Loop_Parameter_Specification =>
Loop_Parameter_Specification (N));
Iterator_Specification => Iter_Spec);
else
I_Scheme :=
Scheme :=
Make_Iteration_Scheme (Loc,
Iterator_Specification => Iterator_Specification (N));
Loop_Parameter_Specification => Loop_Spec);
end if;
Append_To (Actions,
Make_Loop_Statement (Loc,
Iteration_Scheme => I_Scheme,
Statements => New_List (Test),
Iteration_Scheme => Scheme,
Statements => Stmts,
End_Label => Empty));
-- Transform the quantified expression
Rewrite (N,
Make_Expression_With_Actions (Loc,
Expression => New_Occurrence_Of (Tnn, Loc),
Expression => New_Occurrence_Of (Flag, Loc),
Actions => Actions));
Analyze_And_Resolve (N, Standard_Boolean);

23
gcc/ada/g-expect.adb
View file

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2000-2011, AdaCore --
-- Copyright (C) 2000-2012, AdaCore --
-- --
-- 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- --
@ -33,7 +33,7 @@ with System; use System;
with System.OS_Constants; use System.OS_Constants;
with Ada.Calendar; use Ada.Calendar;
with GNAT.IO;
with GNAT.IO; use GNAT.IO;
with GNAT.OS_Lib; use GNAT.OS_Lib;
with GNAT.Regpat; use GNAT.Regpat;
@ -678,6 +678,7 @@ package body GNAT.Expect is
-- ??? Note that ddd tries again up to three times
-- in that case. See LiterateA.C:174
Close (Descriptors (D).Input_Fd);
Descriptors (D).Input_Fd := Invalid_FD;
Result := Expect_Process_Died;
return;
@ -893,7 +894,8 @@ package body GNAT.Expect is
begin
Non_Blocking_Spawn
(Process, Command, Arguments, Err_To_Out => Err_To_Out);
(Process, Command, Arguments, Err_To_Out => Err_To_Out,
Buffer_Size => 0);
if Input'Length > 0 then
Send (Process, Input);
@ -1055,17 +1057,18 @@ package body GNAT.Expect is
Command_With_Path : String_Access;
begin
-- Create the rest of the pipes
Set_Up_Communications
(Descriptor, Err_To_Out, Pipe1'Access, Pipe2'Access, Pipe3'Access);
Command_With_Path := Locate_Exec_On_Path (Command);
if Command_With_Path = null then
raise Invalid_Process;
end if;
-- Create the rest of the pipes once we know we will be able to
-- execute the process.
Set_Up_Communications
(Descriptor, Err_To_Out, Pipe1'Access, Pipe2'Access, Pipe3'Access);
-- Fork a new process
Descriptor.Pid := Fork;
@ -1365,6 +1368,8 @@ package body GNAT.Expect is
end if;
if Create_Pipe (Pipe2) /= 0 then
Close (Pipe1.Input);
Close (Pipe1.Output);
return;
end if;
@ -1389,7 +1394,7 @@ package body GNAT.Expect is
-- Create a separate pipe for standard error
if Create_Pipe (Pipe3) /= 0 then
return;
Pipe3.all := Pipe2.all;
end if;
end if;

4
gcc/ada/sem.adb
View file

@ -314,6 +314,9 @@ package body Sem is
when N_Label =>
Analyze_Label (N);
when N_Loop_Parameter_Specification =>
Analyze_Loop_Parameter_Specification (N);
when N_Loop_Statement =>
Analyze_Loop_Statement (N);
@ -681,7 +684,6 @@ package body Sem is
N_Generic_Association |
N_Index_Or_Discriminant_Constraint |
N_Iteration_Scheme |
N_Loop_Parameter_Specification |
N_Mod_Clause |
N_Modular_Type_Definition |
N_Ordinary_Fixed_Point_Definition |

104
gcc/ada/sem_ch4.adb
View file

@ -47,7 +47,6 @@ with Sem_Aux; use Sem_Aux;
with Sem_Case; use Sem_Case;
with Sem_Cat; use Sem_Cat;
with Sem_Ch3; use Sem_Ch3;
with Sem_Ch5; use Sem_Ch5;
with Sem_Ch6; use Sem_Ch6;
with Sem_Ch8; use Sem_Ch8;
with Sem_Dim; use Sem_Dim;
@ -3403,101 +3402,38 @@ package body Sem_Ch4 is
-----------------------------------
procedure Analyze_Quantified_Expression (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N);
Ent : constant Entity_Id :=
New_Internal_Entity (E_Loop, Current_Scope, Sloc (N), 'L');
Need_Preanalysis : constant Boolean :=
Operating_Mode /= Check_Semantics
and then not Alfa_Mode;
Iterator : Node_Id;
Original_N : Node_Id;
QE_Scop : Entity_Id;
begin
-- The approach in this procedure is very non-standard and at the
-- very least, extensive comments are required saying why this very
-- non-standard approach is needed???
-- Also general comments are needed in any case saying what is going
-- on here, since tree rewriting of this kind should normally be done
-- by the expander and not by the analyzer ??? Probably Ent, Iterator,
-- and Original_N, and Needs_Preanalysis, all need comments above ???
-- Preserve the original node used for the expansion of the quantified
-- expression.
-- This is a very unusual use of Copy_Separate_Tree, needs looking at???
if Need_Preanalysis then
Original_N := Copy_Separate_Tree (N);
end if;
Set_Etype (Ent, Standard_Void_Type);
Set_Scope (Ent, Current_Scope);
Set_Parent (Ent, N);
Check_SPARK_Restriction ("quantified expression is not allowed", N);
-- The following seems like expansion activity done at analysis
-- time, which seems weird ???
-- Create a scope to emulate the loop-like behavior of the quantified
-- expression. The scope is needed to provide proper visibility of the
-- loop variable.
if Present (Loop_Parameter_Specification (N)) then
Iterator :=
Make_Iteration_Scheme (Loc,
Loop_Parameter_Specification =>
Loop_Parameter_Specification (N));
QE_Scop := New_Internal_Entity (E_Loop, Current_Scope, Sloc (N), 'L');
Set_Etype (QE_Scop, Standard_Void_Type);
Set_Scope (QE_Scop, Current_Scope);
Set_Parent (QE_Scop, N);
Push_Scope (QE_Scop);
-- All constituents are preanalyzed and resolved to avoid untimely
-- generation of various temporaries and types. Full analysis and
-- expansion is carried out when the quantified expression is
-- transformed into an expression with actions.
if Present (Iterator_Specification (N)) then
Preanalyze (Iterator_Specification (N));
else
Iterator :=
Make_Iteration_Scheme (Loc,
Iterator_Specification =>
Iterator_Specification (N));
Preanalyze (Loop_Parameter_Specification (N));
end if;
Push_Scope (Ent);
Set_Parent (Iterator, N);
Analyze_Iteration_Scheme (Iterator);
-- The loop specification may have been converted into an iterator
-- specification during its analysis. Update the quantified node
-- accordingly.
if Present (Iterator_Specification (Iterator)) then
Set_Iterator_Specification
(N, Iterator_Specification (Iterator));
Set_Loop_Parameter_Specification (N, Empty);
Set_Parent (Iterator_Specification (Iterator), Iterator);
end if;
if Need_Preanalysis then
-- The full analysis will be performed during the expansion of the
-- quantified expression, only a preanalysis of the condition needs
-- to be done.
-- This is strange for two reasons
-- First, there is almost no situation in which Preanalyze vs
-- Analyze should be conditioned on -gnatc mode (since error msgs
-- must be 100% unaffected by -gnatc). Seconed doing a Preanalyze
-- with no resolution almost certainly means that some messages are
-- either missed, or flagged differently in the two cases.
Preanalyze (Condition (N));
else
Analyze (Condition (N));
end if;
Preanalyze_And_Resolve (Condition (N), Standard_Boolean);
End_Scope;
Set_Etype (N, Standard_Boolean);
-- Attach the original node to the iteration scheme created above
if Need_Preanalysis then
Set_Etype (Original_N, Standard_Boolean);
Set_Parent (Iterator, Original_N);
end if;
end Analyze_Quantified_Expression;
-------------------

1209
gcc/ada/sem_ch5.adb
View file

File diff suppressed because it is too large Load diff

29
gcc/ada/sem_ch5.ads
View file

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -27,19 +27,20 @@ with Types; use Types;
package Sem_Ch5 is
procedure Analyze_Assignment (N : Node_Id);
procedure Analyze_Block_Statement (N : Node_Id);
procedure Analyze_Case_Statement (N : Node_Id);
procedure Analyze_Exit_Statement (N : Node_Id);
procedure Analyze_Goto_Statement (N : Node_Id);
procedure Analyze_If_Statement (N : Node_Id);
procedure Analyze_Implicit_Label_Declaration (N : Node_Id);
procedure Analyze_Iterator_Specification (N : Node_Id);
procedure Analyze_Iteration_Scheme (N : Node_Id);
procedure Analyze_Label (N : Node_Id);
procedure Analyze_Loop_Statement (N : Node_Id);
procedure Analyze_Null_Statement (N : Node_Id);
procedure Analyze_Statements (L : List_Id);
procedure Analyze_Assignment (N : Node_Id);
procedure Analyze_Block_Statement (N : Node_Id);
procedure Analyze_Case_Statement (N : Node_Id);
procedure Analyze_Exit_Statement (N : Node_Id);
procedure Analyze_Goto_Statement (N : Node_Id);
procedure Analyze_If_Statement (N : Node_Id);
procedure Analyze_Implicit_Label_Declaration (N : Node_Id);
procedure Analyze_Iterator_Specification (N : Node_Id);
procedure Analyze_Iteration_Scheme (N : Node_Id);
procedure Analyze_Label (N : Node_Id);
procedure Analyze_Loop_Parameter_Specification (N : Node_Id);
procedure Analyze_Loop_Statement (N : Node_Id);
procedure Analyze_Null_Statement (N : Node_Id);
procedure Analyze_Statements (L : List_Id);
procedure Analyze_Label_Entity (E : Entity_Id);
-- This procedure performs direct analysis of the label entity E. It

10
gcc/ada/sem_ch6.adb
View file

@ -8702,7 +8702,9 @@ package body Sem_Ch6 is
Discrete_Subtype_Definition (L2));
end;
else -- quantified expression with an iterator
elsif Present (Iterator_Specification (E1))
and then Present (Iterator_Specification (E2))
then
declare
I1 : constant Node_Id := Iterator_Specification (E1);
I2 : constant Node_Id := Iterator_Specification (E2);
@ -8719,6 +8721,12 @@ package body Sem_Ch6 is
and then FCE (Subtype_Indication (I1),
Subtype_Indication (I2));
end;
-- The quantified expressions used different specifications to
-- walk their respective ranges.
else
return False;
end if;
when N_Range =>

64
gcc/ada/sem_res.adb
View file

@ -193,7 +193,6 @@ package body Sem_Res is
procedure Resolve_Op_Expon (N : Node_Id; Typ : Entity_Id);
procedure Resolve_Op_Not (N : Node_Id; Typ : Entity_Id);
procedure Resolve_Qualified_Expression (N : Node_Id; Typ : Entity_Id);
procedure Resolve_Quantified_Expression (N : Node_Id; Typ : Entity_Id);
procedure Resolve_Range (N : Node_Id; Typ : Entity_Id);
procedure Resolve_Real_Literal (N : Node_Id; Typ : Entity_Id);
procedure Resolve_Reference (N : Node_Id; Typ : Entity_Id);
@ -1770,6 +1769,10 @@ package body Sem_Res is
-- Try and fix up a literal so that it matches its expected type. New
-- literals are manufactured if necessary to avoid cascaded errors.
function Proper_Current_Scope return Entity_Id;
-- Return the current scope. Skip loop scopes created for the purpose of
-- quantified expression analysis since those do not appear in the tree.
procedure Report_Ambiguous_Argument;
-- Additional diagnostics when an ambiguous call has an ambiguous
-- argument (typically a controlling actual).
@ -1832,6 +1835,30 @@ package body Sem_Res is
end if;
end Patch_Up_Value;
--------------------------
-- Proper_Current_Scope --
--------------------------
function Proper_Current_Scope return Entity_Id is
S : Entity_Id := Current_Scope;
begin
while Present (S) loop
-- Skip a loop scope created for quantified expression analysis
if Ekind (S) = E_Loop
and then Nkind (Parent (S)) = N_Quantified_Expression
then
S := Scope (S);
else
exit;
end if;
end loop;
return S;
end Proper_Current_Scope;
-------------------------------
-- Report_Ambiguous_Argument --
-------------------------------
@ -2761,8 +2788,7 @@ package body Sem_Res is
when N_Qualified_Expression
=> Resolve_Qualified_Expression (N, Ctx_Type);
when N_Quantified_Expression
=> Resolve_Quantified_Expression (N, Ctx_Type);
when N_Quantified_Expression => null;
when N_Raise_xxx_Error
=> Set_Etype (N, Ctx_Type);
@ -2857,10 +2883,9 @@ package body Sem_Res is
-- Ada 2012 (AI05-177): Expression functions do not freeze. Only
-- their use (in an expanded call) freezes.
if Ekind (Current_Scope) /= E_Function
or else
Nkind (Original_Node (Unit_Declaration_Node (Current_Scope))) /=
N_Expression_Function
if Ekind (Proper_Current_Scope) /= E_Function
or else Nkind (Original_Node (Unit_Declaration_Node
(Proper_Current_Scope))) /= N_Expression_Function
then
Freeze_Expression (N);
end if;
@ -8290,31 +8315,6 @@ package body Sem_Res is
Eval_Qualified_Expression (N);
end Resolve_Qualified_Expression;
-----------------------------------
-- Resolve_Quantified_Expression --
-----------------------------------
procedure Resolve_Quantified_Expression (N : Node_Id; Typ : Entity_Id) is
begin
if not Alfa_Mode then
-- The loop structure is already resolved during its analysis, only
-- the resolution of the condition needs to be done. Expansion is
-- disabled so that checks and other generated code are inserted in
-- the tree after expression has been rewritten as a loop.
Expander_Mode_Save_And_Set (False);
Resolve (Condition (N), Typ);
Expander_Mode_Restore;
-- In Alfa mode, we need normal expansion in order to properly introduce
-- the necessary transient scopes.
else
Resolve (Condition (N), Typ);
end if;
end Resolve_Quantified_Expression;
-------------------
-- Resolve_Range --
-------------------

18
gcc/ada/sem_util.adb
View file

@ -740,12 +740,28 @@ package body Sem_Util is
N : Node_Id) return Entity_Id
is
Loc : constant Source_Ptr := Sloc (N);
Bas : Entity_Id;
-- The base type that is to be constrained by the defaults.
Disc : Entity_Id;
begin
if not Has_Discriminants (T) or else Is_Constrained (T) then
return T;
end if;
Bas := Base_Type (T);
-- If T is non-private but its base type is private, this is
-- the completion of a subtype declaration whose parent type
-- is private (see Complete_Private_Subtype in sem_ch3). The
-- proper discriminants are to be found in the full view of
-- the base.
if Is_Private_Type (Bas)
and then Present (Full_View (Bas))
then
Bas := Full_View (Bas);
end if;
Disc := First_Discriminant (T);
@ -770,7 +786,7 @@ package body Sem_Util is
Defining_Identifier => Act,
Subtype_Indication =>
Make_Subtype_Indication (Loc,
Subtype_Mark => New_Occurrence_Of (T, Loc),
Subtype_Mark => New_Occurrence_Of (Bas, Loc),
Constraint =>
Make_Index_Or_Discriminant_Constraint (Loc,
Constraints => Constraints)));