+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,
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;
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
-- 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;
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
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
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
@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
/* 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;
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;
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
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
@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
-- 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
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;
-----------------
projects / gcc.git / commitdiff