git
/
gcc
mirror of git://gcc.gnu.org/git/gcc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

[multiple changes] 

2009-04-10  Sergey Rybin  <rybin@adacore.com>

	* vms_data.ads:
	Add qualifier for new gnatstub option '--no-exception'

	* gnat_ugn.texi:
	Add the description of the new gnatstub option '--no-exception'

2009-04-10  Robert Dewar  <dewar@adacore.com>

	* rtsfind.adb: Minor reformatting

2009-04-10  Thomas Quinot  <quinot@adacore.com>

	* sem_disp.adb: Minor reformatting.
	Add comment pointing to RM clause for the case of warning against a
	(failed) attempt at declaring a primitive operation elsewhere than in a
	package spec.

2009-04-10  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch12.adb (Denotes_Formal_Package): Check whether the package is
	an actual for a previous formal package of the current instance.

From-SVN: r145917
This commit is contained in:
Arnaud Charlet 2009-04-10 17:01:10 +02:00
parent e50e1c5ee1
commit f559e62f20
6 changed files with 101 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
gcc/ada/ChangeLog
View File

@ -1,3 +1,27 @@
2009-04-10 Sergey Rybin <rybin@adacore.com>
* vms_data.ads:
Add qualifier for new gnatstub option '--no-exception'
* gnat_ugn.texi:
Add the description of the new gnatstub option '--no-exception'
2009-04-10 Robert Dewar <dewar@adacore.com>
* rtsfind.adb: Minor reformatting
2009-04-10 Thomas Quinot <quinot@adacore.com>
* sem_disp.adb: Minor reformatting.
Add comment pointing to RM clause for the case of warning against a
(failed) attempt at declaring a primitive operation elsewhere than in a
package spec.
2009-04-10 Ed Schonberg <schonberg@adacore.com>
* sem_ch12.adb (Denotes_Formal_Package): Check whether the package is
an actual for a previous formal package of the current instance.
2009-04-10 Bob Duff <duff@adacore.com>
* rtsfind.adb (RTE): Put implicit with_clauses on whatever unit needs

12
gcc/ada/gnat_ugn.texi
View File

@ -22066,6 +22066,11 @@ units located outside the current directory, you have to provide
the source search path when calling @command{gnatstub}, see the description
of @command{gnatstub} switches below.
By default, all the program unit body stubs generated by @code{gnatstub}
raise the predefined @code{Program_Error} exception, which will catch
accidental calls of generated stubs. This behavior can be changed with
option @option{^--no-exception^/NO_EXCEPTION^} (see below).
@menu
* Running gnatstub::
* Switches for gnatstub::
@ -22191,7 +22196,12 @@ structures used by @command{gnatstub}) after creating the body stub.
@cindex @option{^-l^/LINE_LENGTH^} (@command{gnatstub})
Same as @option{^-gnatyM^/MAX_LINE_LENGTH=^@var{n}}
@item ^-o^/BODY=^@var{body-name}
@item ^--no-exception^/NO_EXCEPTION^
@cindex @option{^--no-exception^/NO_EXCEPTION^} (@command{gnatstub})
Avoind raising PROGRAM_ERROR in the generated bodies of program unit stubs.
This is not always possible for function stubs.
@item ^-o ^/BODY=^@var{body-name}
@cindex @option{^-o^/BODY^} (@command{gnatstub})
Body file name. This should be set if the argument file name does not
follow

2
gcc/ada/rtsfind.adb
View File

@ -1069,7 +1069,7 @@ package body Rtsfind is
-- for a call issued from RTE_Available.
<<Found>>
if (not U.Withed) and then not RTE_Available_Call then
if not U.Withed and then not RTE_Available_Call then
U.Withed := True;
declare

55
gcc/ada/sem_ch12.adb
View File

@ -424,15 +424,19 @@ package body Sem_Ch12 is
-- illegal circular instantiation.
function Denotes_Formal_Package
(Pack : Entity_Id;
On_Exit : Boolean := False) return Boolean;
(Pack : Entity_Id;
On_Exit : Boolean := False;
Instance : Entity_Id := Empty) return Boolean;
-- Returns True if E is a formal package of an enclosing generic, or
-- the actual for such a formal in an enclosing instantiation. If such
-- a package is used as a formal in an nested generic, or as an actual
-- in a nested instantiation, the visibility of ITS formals should not
-- be modified. When called from within Restore_Private_Views, the flag
-- On_Exit is true, to indicate that the search for a possible enclosing
-- instance should ignore the current one.
-- instance should ignore the current one. In that case Instance denotes
-- the declaration for which this is an actual. This declaration may be
-- an instantiation in the source, or the internal instantiation that
-- corresponds to the actual for a formal package.
function Find_Actual_Type
(Typ : Entity_Id;
@ -6130,13 +6134,46 @@ package body Sem_Ch12 is
----------------------------
function Denotes_Formal_Package
(Pack : Entity_Id;
On_Exit : Boolean := False) return Boolean
(Pack : Entity_Id;
On_Exit : Boolean := False;
Instance : Entity_Id := Empty) return Boolean
is
Par : Entity_Id;
Scop : constant Entity_Id := Scope (Pack);
E : Entity_Id;
function Is_Actual_Of_Previous_Formal (P : Entity_Id) return Boolean;
-- The package in question may be an actual for a previous formal
-- package P of the current instance, so examine its actuals as well.
----------------------------------
-- Is_Actual_Of_Previous_Formal --
----------------------------------
function Is_Actual_Of_Previous_Formal (P : Entity_Id) return Boolean is
E1 : Entity_Id;
begin
E1 := First_Entity (E);
while Present (E1) and then E1 /= Instance loop
if Ekind (E1) = E_Package
and then Nkind (Parent (E1)) = N_Package_Renaming_Declaration
and then Renamed_Object (E1) = Pack
then
return True;
elsif Renamed_Object (E1) = P then
return False;
end if;
Next_Entity (E1);
end loop;
return False;
end Is_Actual_Of_Previous_Formal;
-- Start processing of Denotes_Formal_Package
begin
if On_Exit then
Par :=
@ -6176,6 +6213,10 @@ package body Sem_Ch12 is
elsif Renamed_Object (E) = Pack then
return True;
elsif Is_Actual_Of_Previous_Formal (E) then
return True;
end if;
Next_Entity (E);
@ -11142,7 +11183,9 @@ package body Sem_Ch12 is
elsif Nkind (Parent (E)) /= N_Package_Renaming_Declaration then
null;
elsif Denotes_Formal_Package (Renamed_Object (E), True) then
elsif
Denotes_Formal_Package (Renamed_Object (E), True, Pack_Id)
then
Set_Is_Hidden (E, False);
else

17
gcc/ada/sem_disp.adb
View File

@ -764,11 +764,10 @@ package body Sem_Disp is
-- be delayed until after the spec is seen, but that's
-- a tricky change to the delicate freezing code.
-- Look at each declaration following the type up
-- until the new subprogram body. If any of the
-- declarations is a body then the type has been
-- frozen already so the overriding primitive is
-- illegal.
-- Look at each declaration following the type up until the
-- new subprogram body. If any of the declarations is a body
-- then the type has been frozen already so the overriding
-- primitive is illegal.
while Present (Decl_Item)
and then (Decl_Item /= Subp_Body)
@ -788,9 +787,8 @@ package body Sem_Disp is
end loop;
-- If the subprogram doesn't follow in the list of
-- declarations including the type then the type
-- has definitely been frozen already and the body
-- is illegal.
-- declarations including the type then the type has
-- definitely been frozen already and the body is illegal.
if No (Decl_Item) then
Error_Msg_N ("overriding of& is too late!", Subp);
@ -852,7 +850,8 @@ package body Sem_Disp is
-- If the type is not frozen yet and we are not in the overriding
-- case it looks suspiciously like an attempt to define a primitive
-- operation.
-- operation, which requires the declaration to be in a package spec
-- (3.2.3(6)).
elsif not Is_Frozen (Tagged_Type) then
Error_Msg_N

8
gcc/ada/vms_data.ads
View File

@ -6511,6 +6511,13 @@ package VMS_Data is
-- HIGH A great number of messages are output, most of them not
-- being useful for the user.
S_Stub_No_Exc : aliased constant S := "/NO_EXCEPTION " &
"--no-exception";
-- /NONO_EXCEPTION (D)
-- /NO_EXCEPTION
--
-- Avoid raising PROGRAM_ERROR in the generated program unit stubs.
S_Stub_Output : aliased constant S := "/OUTPUT=@" &
"-o@";
-- /OUTPUT=filespec
@ -6607,6 +6614,7 @@ package VMS_Data is
S_Stub_Mess 'Access,
S_Stub_Output 'Access,
S_Stub_Project 'Access,
S_Stub_No_Exc 'Access,
S_Stub_Quiet 'Access,
S_Stub_Search 'Access,
S_Stub_Subdirs 'Access,