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

[multiple changes] 

2013-04-22  Pascal Obry  <obry@adacore.com>

	* gnat_ugn.texi, prj-nmsc.adb, projects.texi: Add check for
	Library_Standalone and Library_Kind.

2013-04-22  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch6.adb (Expand_Actuals): If the call is to an
	inherited operation and the actual is a by-reference type with
	predicates, add predicate call to post-call actions.
	* sem_util.adb (Is_Inherited_Operation_For_Type): Fix coding
	error: a type declaration has a defining identifier, not an Etype.
	* sem_res.adb: Restore code removed because of above error.

2013-04-22  Doug Rupp  <rupp@adacore.com>

	* init.c (__gnat_handle_vms_condition): Also match C$_SIGINT.

From-SVN: r198130
This commit is contained in:
Arnaud Charlet 2013-04-22 12:44:46 +02:00
parent 16d3a85360
commit f6820c2d0e
8 changed files with 94 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
gcc/ada/ChangeLog
View File

@ -1,3 +1,21 @@
2013-04-22 Pascal Obry <obry@adacore.com>
* gnat_ugn.texi, prj-nmsc.adb, projects.texi: Add check for
Library_Standalone and Library_Kind.
2013-04-22 Ed Schonberg <schonberg@adacore.com>
* exp_ch6.adb (Expand_Actuals): If the call is to an
inherited operation and the actual is a by-reference type with
predicates, add predicate call to post-call actions.
* sem_util.adb (Is_Inherited_Operation_For_Type): Fix coding
error: a type declaration has a defining identifier, not an Etype.
* sem_res.adb: Restore code removed because of above error.
2013-04-22 Doug Rupp <rupp@adacore.com>
* init.c (__gnat_handle_vms_condition): Also match C$_SIGINT.
2013-04-22 Yannick Moy <moy@adacore.com>
* gnat_rm.texi, exp_util.adb, sem_prag.adb, sem_prag.ads, par-ch2.adb,

32
gcc/ada/exp_ch6.adb
View File

@ -942,6 +942,7 @@ package body Exp_Ch6 is
Formal : Entity_Id;
N_Node : Node_Id;
Post_Call : List_Id;
E_Actual : Entity_Id;
E_Formal : Entity_Id;
procedure Add_Call_By_Copy_Code;
@ -1508,6 +1509,7 @@ package body Exp_Ch6 is
Actual := First_Actual (N);
while Present (Formal) loop
E_Formal := Etype (Formal);
E_Actual := Etype (Actual);
if Is_Scalar_Type (E_Formal)
or else Nkind (Actual) = N_Slice
@ -1645,7 +1647,7 @@ package body Exp_Ch6 is
-- conversion" errors.
elsif Is_Access_Type (E_Formal)
and then not Same_Type (E_Formal, Etype (Actual))
and then not Same_Type (E_Formal, E_Actual)
and then not Is_Tagged_Type (Designated_Type (E_Formal))
then
Add_Call_By_Copy_Code;
@ -1661,7 +1663,7 @@ package body Exp_Ch6 is
elsif Is_Entity_Name (Actual)
and then Is_Volatile (Entity (Actual))
and then not Is_By_Reference_Type (Etype (Actual))
and then not Is_By_Reference_Type (E_Actual)
and then not Is_Scalar_Type (Etype (Entity (Actual)))
and then not Is_Volatile (E_Formal)
then
@ -1682,10 +1684,10 @@ package body Exp_Ch6 is
elsif Is_Scalar_Type (E_Formal)
and then
(not In_Subrange_Of (E_Formal, Etype (Actual))
(not In_Subrange_Of (E_Formal, E_Actual)
or else
(Ekind (Formal) = E_In_Out_Parameter
and then not In_Subrange_Of (Etype (Actual), E_Formal)))
and then not In_Subrange_Of (E_Actual, E_Formal)))
then
-- Perhaps the setting back to False should be done within
-- Add_Call_By_Copy_Code, since it could get set on other
@ -1698,6 +1700,28 @@ package body Exp_Ch6 is
Add_Call_By_Copy_Code;
end if;
-- RM 3.2.4 (23/3) : A predicate is checked on in-out and out
-- by-reference parameters on exit from the call. If the actual
-- is a derived type and the operation is inherited, the body
-- of the operation will not contain a call to the predicate
-- function, so it must be done explicitly after the call. Ditto
-- if the actual is an entity of a predicated subtype.
if Is_By_Reference_Type (E_Formal)
and then Has_Predicates (E_Actual)
then
if Is_Derived_Type (E_Actual)
and then Is_Inherited_Operation_For_Type (Subp, E_Actual)
then
Append_To
(Post_Call, Make_Predicate_Check (E_Actual, Actual));
elsif Is_Entity_Name (Actual) then
Append_To
(Post_Call, Make_Predicate_Check (E_Actual, Actual));
end if;
end if;
-- Processing for IN parameters
else

1
gcc/ada/gnat_ugn.texi
View File

@ -17083,6 +17083,7 @@ build an encapsulated library the attribute
@group
for Library_Dir use "lib_dir";
for Library_Name use "dummy";
for Library_Kind use "dynamic";
for Library_Interface use ("int1", "int1.child");
for Library_Standalone use "encapsulated";
@end group

9
gcc/ada/init.c
View File

@ -833,6 +833,7 @@ void (*__gnat_ctrl_c_handler) (void) = 0;
/* These codes are in standard message libraries. */
extern int C$_SIGKILL;
extern int C$_SIGINT;
extern int SS$_DEBUG;
extern int LIB$_KEYNOTFOU;
extern int LIB$_ACTIMAGE;
@ -1221,14 +1222,18 @@ __gnat_handle_vms_condition (int *sigargs, void *mechargs)
system_cond_except_table,
0};
unsigned int ctrlc = SS$_CONTROLC;
unsigned int *sigint = &C$_SIGINT;
int ctrlc_match = LIB$MATCH_COND (&sigargs [1], &ctrlc);
int sigint_match = LIB$MATCH_COND (&sigargs [1], &sigint);
extern int SYS$DCLAST (void (*astadr)(), unsigned long long astprm,
unsigned int acmode);
/* If SS$_CONTROLC has been imported as an exception, it will take
priority over a a Ctrl/C handler. See above. */
if (ctrlc_match && __gnat_ctrl_c_handler)
priority over a a Ctrl/C handler. See above. SIGINT has a
different condition value due to it's DECCCRTL roots and it's
the condition that gets raised for a "kill -INT". */
if ((ctrlc_match || sigint_match) && __gnat_ctrl_c_handler)
{
SYS$DCLAST (__gnat_ctrl_c_handler, 0, 0);
return SS$_CONTINUE;

15
gcc/ada/prj-nmsc.adb
View File

@ -3659,6 +3659,21 @@ package body Prj.Nmsc is
end loop;
end if;
if not Lib_Standalone.Default
and then Project.Library_Kind = Static
then
-- An standalone library must be a shared library
Error_Msg_Name_1 := Project.Name;
Error_Msg
(Data.Flags,
Continuation.all &
"standalone library project %% must be a shared library",
Project.Location, Project);
Continuation := Continuation_String'Access;
end if;
if Project.Library and not Data.In_Aggregate_Lib then
-- Record the library name

16
gcc/ada/projects.texi
View File

@ -1890,12 +1890,15 @@ language and takes a list of sources as parameter.
library can furthermore only depends on static libraries (including
the GNAT runtime). This attribute can be set to @code{no} to make it clear
that the library should not be standalone in which case the
@code{Library_Interface} should not defined.
@code{Library_Interface} should not defined. Note that this attribute
only applies to shared libraries, so @code{Library_Kind} must be set
to @code{dynamic}.
@smallexample @c projectfile
@group
for Library_Dir use "lib";
for Library_Name use "loggin";
for Library_Kind use "dynamic";
for Library_Interface use ("lib1", "lib2"); -- unit names
for Library_Standalone use "encapsulated";
@end group
@ -3772,8 +3775,15 @@ The list of languages of the sources of the project.
@item @b{Roots}: list, indexed, file name index
The index is the file name of an executable source. Indicates the list of
units that need to be bound and linked with their closures with the executable.
The index is the file name of an executable source. Indicates the list of units
from the main project that need to be bound and linked with their closures
with the executable. The index is either a file name, a language name or "*".
The roots for an executable source are those in @b{Roots} with an index that
is the executable source file name, if declared. Otherwise, they are those in
@b{Roots} with an index that is the language name of the executable source,
if present. Otherwise, they are those in @b{Roots ("*")}, if declared. If none
of these three possibilities are declared, then there are no roots for the
executable source.
@item @b{Externally_Built}: single

21
gcc/ada/sem_res.adb
View File

@ -5896,19 +5896,14 @@ package body Sem_Res is
-- In formal mode, the primitive operations of a tagged type or type
-- extension do not include functions that return the tagged type.
-- Commented out as the call to Is_Inherited_Operation_For_Type may
-- cause an error because the type entity of the parent node of
-- Entity (Name (N) may not be set. ???
-- So why not just add a guard ???
-- if Nkind (N) = N_Function_Call
-- and then Is_Tagged_Type (Etype (N))
-- and then Is_Entity_Name (Name (N))
-- and then Is_Inherited_Operation_For_Type
-- (Entity (Name (N)), Etype (N))
-- then
-- Check_SPARK_Restriction ("function not inherited", N);
-- end if;
if Nkind (N) = N_Function_Call
and then Is_Tagged_Type (Etype (N))
and then Is_Entity_Name (Name (N))
and then Is_Inherited_Operation_For_Type
(Entity (Name (N)), Etype (N))
then
Check_SPARK_Restriction ("function not inherited", N);
end if;
-- Implement rule in 12.5.1 (23.3/2): In an instance, if the actual is
-- class-wide and the call dispatches on result in a context that does

5
gcc/ada/sem_util.adb
View File

@ -8462,8 +8462,11 @@ package body Sem_Util is
Typ : Entity_Id) return Boolean
is
begin
-- Check that the operation has been created by the declaration for
-- the type.
return Is_Inherited_Operation (E)
and then Etype (Parent (E)) = Typ;
and then Defining_Identifier (Parent (E)) = Typ;
end Is_Inherited_Operation_For_Type;
-----------------