+2013-10-10 Robert Dewar <dewar@adacore.com>
+
+ * lib-writ.adb (Write_Unit_Information): Fatal error if linker
+ options are detected in a predefined generic unit.
+
+2013-10-10 Thomas Quinot <quinot@adacore.com>
+
+ * s-oscons-tmplt.c (CLOCK_REALTIME): Always define, possibly using
+ a dummy placeholder value.
+ (NEED_PTHREAD_CONDATTR_SETCLOCK): Remove, not needed anymore.
+ * thread.c: Adjust #if test accordingly.
+
+2013-10-10 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * exp_ch6.adb (Consequence_Error): Generate an
+ implicit if statement.
+ (Expand_Contract_Cases): Generate an implicit if statement.
+ (Process_Contract_Cases): Do not expand Contract_Cases when no code
+ is being generated.
+
+2013-10-10 Robert Dewar <dewar@adacore.com>
+
+ * sem_attr.adb (Address_Checks): New procedure.
+
+2013-10-10 Ed Schonberg <schonberg@adacore.com>
+
+ * sinfo.ads, sinfo.adb: New Node Freeze_Generic_Entity, to trigger
+ semantic actions at the proper point for entities that previously
+ had no explicit freeze point.
+ * freeze.adb (Freeze_Generic_Entities): generate new nodes to
+ indicate the point at which semantic checks can be performed on
+ entities declared in generic packages.
+ * sem_ch13.ads, sem_ch13.adb: New procedure
+ Analyze_Freeze_Generic_Entity.
+ * exp_util.adb (Insert_Actions): Treat new node like Freeze_Entity.
+ * sem.adb (Analyze): Call Analyze_Freeze_Generic_Entity.
+ * sprint.adb (Sprint_Node): display Analyze_Freeze_Generic_Entity.
+ * gcc-interface/trans.c: Ignore Analyze_Freeze_Generic_Entity.
+ * gcc-interface/Make-lang.in: Update dependencies.
+
2013-10-10 Robert Dewar <dewar@adacore.com>
* sem_aggr.adb (Resolve_Array_Aggregate): Identify duplicated
if No (Checks) then
Checks :=
- Make_If_Statement (Loc,
+ Make_Implicit_If_Statement (CCs,
Condition => Cond,
Then_Statements => New_List (Error));
-- end if;
Append_To (Decls,
- Make_If_Statement (Loc,
+ Make_Implicit_If_Statement (CCs,
Condition => Relocate_Node (Case_Guard),
Then_Statements => New_List (
Set (Flag),
end if;
CG_Checks :=
- Make_If_Statement (Loc,
+ Make_Implicit_If_Statement (CCs,
Condition =>
Make_Op_Eq (Loc,
Left_Opnd => New_Reference_To (Count, Loc),
-- generated.
if not Expander_Active then
- null;
+ return;
end if;
Prag := Contract_Test_Cases (Contract (Subp_Id));
-- Freeze entity behaves like a declaration or statement
- N_Freeze_Entity
+ N_Freeze_Entity |
+ N_Freeze_Generic_Entity
=>
-- Do not insert here if the item is not a list member (this
-- happens for example with a triggering statement, and the
-- integer literal without an explicit corresponding size clause. The
-- caller has checked that Utype is a modular integer type.
+ function Freeze_Generic_Entities (Pack : Entity_Id) return List_Id;
+ -- Create Freeze_Generic_Entity nodes for types declared in a generic
+ -- package. Recurse on inner generic packages.
+
procedure Freeze_Record_Type (Rec : Entity_Id);
-- Freeze each component, handle some representation clauses, and freeze
-- primitive operations if this is a tagged type.
end if;
end Check_Suspicious_Modulus;
+ -----------------------------
+ -- Freeze_Generic_Entities --
+ -----------------------------
+
+ function Freeze_Generic_Entities (Pack : Entity_Id) return List_Id is
+ E : Entity_Id;
+ F : Node_Id;
+ Flist : List_Id;
+
+ begin
+ Flist := New_List;
+ E := First_Entity (Pack);
+ while Present (E) loop
+ if Is_Type (E) and then not Is_Generic_Type (E) then
+ F := Make_Freeze_Generic_Entity (Sloc (Pack));
+ Set_Entity (F, E);
+ Append_To (Flist, F);
+
+ elsif Ekind (E) = E_Generic_Package then
+ Append_List_To (Flist, Freeze_Generic_Entities (E));
+ end if;
+
+ Next_Entity (E);
+ end loop;
+
+ return Flist;
+ end Freeze_Generic_Entities;
+
------------------------
-- Freeze_Record_Type --
------------------------
return No_List;
end if;
end;
+
+ elsif Ekind (E) = E_Generic_Package then
+ return Freeze_Generic_Entities (E);
end if;
-- Add checks to detect proper initialization of scalars that may appear
if Present (Scope (E))
and then Is_Generic_Unit (Scope (E))
- and then not Has_Predicates (E)
+ and then
+ (not Has_Predicates (E)
+ and then not Has_Delayed_Freeze (E))
then
Check_Compile_Time_Size (E);
return No_List;
-- for the case of a private type with record extension (we will do
-- that later when the full type is frozen).
- elsif Ekind_In (E, E_Record_Type, E_Record_Subtype) then
+ elsif Ekind_In (E, E_Record_Type, E_Record_Subtype)
+ and then not Is_Generic_Unit (Scope (E))
+ then
Freeze_Record_Type (E);
-- For a concurrent type, freeze corresponding record type. This
if Is_Pure_Unit_Access_Type (E)
and then (Ada_Version < Ada_2005
or else not No_Pool_Assigned (E))
+ and then not Is_Generic_Unit (Scope (E))
then
Error_Msg_N ("named access type not allowed in pure unit", E);
ada/erroutc.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \
- ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads \
+ ada/atree.adb ada/casing.ads ada/csets.ads ada/debug.ads ada/einfo.ads \
ada/err_vars.ads ada/erroutc.ads ada/erroutc.adb ada/gnat.ads \
ada/g-byorma.ads ada/hostparm.ads ada/interfac.ads ada/namet.ads \
ada/namet.adb ada/nlists.ads ada/opt.ads ada/output.ads ada/output.adb \
ada/exp_util.ads ada/exp_util.adb ada/exp_vfpt.ads ada/expander.ads \
ada/fname.ads ada/fname-uf.ads ada/freeze.ads ada/get_targ.ads \
ada/gnat.ads ada/g-hesorg.ads ada/g-htable.ads ada/hostparm.ads \
- ada/inline.ads ada/itypes.ads ada/layout.ads ada/lib.ads ada/lib.adb \
- ada/lib-list.adb ada/lib-load.ads ada/lib-sort.adb ada/lib-util.ads \
- ada/lib-xref.ads ada/namet.ads ada/namet-sp.ads ada/nlists.ads \
- ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \
+ ada/inline.ads ada/interfac.ads ada/itypes.ads ada/layout.ads \
+ ada/lib.ads ada/lib.adb ada/lib-list.adb ada/lib-load.ads \
+ ada/lib-sort.adb ada/lib-util.ads ada/lib-xref.ads ada/namet.ads \
+ ada/namet.adb ada/namet-sp.ads ada/nlists.ads ada/nlists.adb \
+ ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \
ada/put_spark_xrefs.ads ada/restrict.ads ada/restrict.adb \
ada/rident.ads ada/rtsfind.ads ada/rtsfind.adb ada/scans.ads \
ada/scil_ll.ads ada/sem.ads ada/sem.adb ada/sem_attr.ads \
ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \
ada/put_spark_xrefs.ads ada/restrict.ads ada/rident.ads ada/rtsfind.ads \
ada/rtsfind.adb ada/scans.ads ada/sem.ads ada/sem_attr.ads \
- ada/sem_aux.ads ada/sem_aux.adb ada/sem_cat.ads ada/sem_ch13.ads \
- ada/sem_ch13.adb ada/sem_ch3.ads ada/sem_ch6.ads ada/sem_ch7.ads \
- ada/sem_ch8.ads ada/sem_ch9.ads ada/sem_dim.ads ada/sem_disp.ads \
- ada/sem_dist.ads ada/sem_eval.ads ada/sem_eval.adb ada/sem_prag.ads \
- ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb \
- ada/sem_warn.ads ada/set_targ.ads ada/sinfo.ads ada/sinfo.adb \
- ada/sinput.ads ada/snames.ads ada/stand.ads ada/stringt.ads \
- ada/style.ads ada/styleg.ads ada/styleg.adb ada/stylesw.ads \
- ada/system.ads ada/s-assert.ads ada/s-exctab.ads ada/s-exctab.adb \
- ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads \
- ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \
- ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
- ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
- ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
- ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads ada/types.ads \
- ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \
- ada/unchdeal.ads ada/urealp.ads ada/urealp.adb ada/validsw.ads \
- ada/warnsw.ads ada/widechar.ads
+ ada/sem_aux.ads ada/sem_aux.adb ada/sem_case.ads ada/sem_case.adb \
+ ada/sem_cat.ads ada/sem_ch13.ads ada/sem_ch13.adb ada/sem_ch3.ads \
+ ada/sem_ch6.ads ada/sem_ch7.ads ada/sem_ch8.ads ada/sem_ch9.ads \
+ ada/sem_dim.ads ada/sem_disp.ads ada/sem_dist.ads ada/sem_eval.ads \
+ ada/sem_eval.adb ada/sem_prag.ads ada/sem_res.ads ada/sem_type.ads \
+ ada/sem_util.ads ada/sem_util.adb ada/sem_warn.ads ada/set_targ.ads \
+ ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
+ ada/stringt.ads ada/style.ads ada/styleg.ads ada/styleg.adb \
+ ada/stylesw.ads ada/system.ads ada/s-assert.ads ada/s-exctab.ads \
+ ada/s-exctab.adb ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads \
+ ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads \
+ ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
+ ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads \
+ ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \
+ ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads \
+ ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
+ ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/urealp.adb \
+ ada/validsw.ads ada/warnsw.ads ada/widechar.ads
ada/sem_ch2.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \
ada/restrict.ads ada/restrict.adb ada/rident.ads ada/rtsfind.ads \
ada/scans.ads ada/scn.ads ada/scng.ads ada/scng.adb ada/sem.ads \
ada/sem.adb ada/sem_aggr.ads ada/sem_attr.ads ada/sem_aux.ads \
- ada/sem_aux.adb ada/sem_cat.ads ada/sem_ch10.ads ada/sem_ch11.ads \
- ada/sem_ch12.ads ada/sem_ch13.ads ada/sem_ch13.adb ada/sem_ch2.ads \
- ada/sem_ch3.ads ada/sem_ch4.ads ada/sem_ch5.ads ada/sem_ch6.ads \
- ada/sem_ch7.ads ada/sem_ch8.ads ada/sem_ch9.ads ada/sem_dim.ads \
- ada/sem_disp.ads ada/sem_dist.ads ada/sem_elab.ads ada/sem_elim.ads \
- ada/sem_eval.ads ada/sem_eval.adb ada/sem_intr.ads ada/sem_mech.ads \
- ada/sem_prag.ads ada/sem_prag.adb ada/sem_res.ads ada/sem_res.adb \
- ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb ada/sem_vfpt.ads \
- ada/sem_warn.ads ada/sem_warn.adb ada/set_targ.ads ada/sinfo.ads \
- ada/sinfo.adb ada/sinfo-cn.ads ada/sinput.ads ada/sinput.adb \
- ada/snames.ads ada/snames.adb ada/sprint.ads ada/stand.ads \
- ada/stringt.ads ada/stringt.adb ada/style.ads ada/styleg.ads \
- ada/styleg.adb ada/stylesw.ads ada/system.ads ada/s-assert.ads \
- ada/s-casuti.ads ada/s-carun8.ads ada/s-crc32.ads ada/s-exctab.ads \
- ada/s-exctab.adb ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads \
- ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads \
- ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
- ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads \
- ada/s-utf_32.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
- ada/targparm.ads ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads \
- ada/ttypes.ads ada/types.ads ada/types.adb ada/uintp.ads ada/uintp.adb \
- ada/uname.ads ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads \
- ada/urealp.adb ada/validsw.ads ada/warnsw.ads ada/widechar.ads
+ ada/sem_aux.adb ada/sem_case.ads ada/sem_cat.ads ada/sem_ch10.ads \
+ ada/sem_ch11.ads ada/sem_ch12.ads ada/sem_ch13.ads ada/sem_ch13.adb \
+ ada/sem_ch2.ads ada/sem_ch3.ads ada/sem_ch4.ads ada/sem_ch5.ads \
+ ada/sem_ch6.ads ada/sem_ch7.ads ada/sem_ch8.ads ada/sem_ch9.ads \
+ ada/sem_dim.ads ada/sem_disp.ads ada/sem_dist.ads ada/sem_elab.ads \
+ ada/sem_elim.ads ada/sem_eval.ads ada/sem_eval.adb ada/sem_intr.ads \
+ ada/sem_mech.ads ada/sem_prag.ads ada/sem_prag.adb ada/sem_res.ads \
+ ada/sem_res.adb ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb \
+ ada/sem_vfpt.ads ada/sem_warn.ads ada/sem_warn.adb ada/set_targ.ads \
+ ada/sinfo.ads ada/sinfo.adb ada/sinfo-cn.ads ada/sinput.ads \
+ ada/sinput.adb ada/snames.ads ada/snames.adb ada/sprint.ads \
+ ada/stand.ads ada/stringt.ads ada/stringt.adb ada/style.ads \
+ ada/styleg.ads ada/styleg.adb ada/stylesw.ads ada/system.ads \
+ ada/s-assert.ads ada/s-casuti.ads ada/s-carun8.ads ada/s-crc32.ads \
+ ada/s-exctab.ads ada/s-exctab.adb ada/s-htable.ads ada/s-imenne.ads \
+ ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads \
+ ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
+ ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads \
+ ada/s-unstyp.ads ada/s-utf_32.ads ada/s-wchcon.ads ada/table.ads \
+ ada/table.adb ada/targparm.ads ada/tbuild.ads ada/tbuild.adb \
+ ada/tree_io.ads ada/ttypes.ads ada/types.ads ada/types.adb \
+ ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \
+ ada/unchdeal.ads ada/urealp.ads ada/urealp.adb ada/validsw.ads \
+ ada/warnsw.ads ada/widechar.ads
ada/sem_res.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \
gnu_result = end_stmt_group ();
break;
+ case N_Freeze_Generic_Entity:
+ gnu_result = alloc_stmt_list ();
+ break;
+
case N_Itype_Reference:
if (!present_gnu_tree (Itype (gnat_node)))
process_type (Itype (gnat_node));
with Opt; use Opt;
with Osint; use Osint;
with Osint.C; use Osint.C;
+with Output; use Output;
with Par;
with Par_SCO; use Par_SCO;
with Restrict; use Restrict;
Write_With_Lines;
- -- Output linker option lines
+ -- Generate the linker option lines
for J in 1 .. Linker_Option_Lines.Last loop
+
+ -- Pragma Linker_Options is not allowed in predefined generic
+ -- units. This is because they won't be read, due to the fact that
+ -- with lines for generic units lack the file name and lib name
+ -- parameters (see Lib_Writ spec for an explanation).
+
+ if Is_Generic_Unit (Cunit_Entity (Main_Unit))
+ and then
+ Is_Predefined_File_Name (Unit_File_Name (Current_Sem_Unit))
+ then
+ Set_Standard_Error;
+ Write_Line
+ ("linker options not allowed in predefined generic unit");
+ raise Unrecoverable_Error;
+ end if;
+
+ -- Output one linker option line
+
declare
S : Linker_Option_Entry renames Linker_Option_Lines.Table (J);
begin
/* Note: On HP-UX, CLOCK_REALTIME is an enum, not a macro. */
-#if !(defined (__hpux__) || defined (CLOCK_REALTIME))
-# define CLOCK_REALTIME -1
+#if !(defined(CLOCK_REALTIME) || defined (__hpux__))
+# define CLOCK_REALTIME (-1)
#endif
CND(CLOCK_REALTIME, "System realtime clock")
#endif
CND(CLOCK_THREAD_CPUTIME_ID, "Thread CPU clock")
-#if defined(__APPLE__)
-/* There's no clock_gettime or clock_id's on Darwin, generate a dummy value */
-# define CLOCK_RT_Ada "-1"
-#elif defined(__FreeBSD__) || defined(_AIX)
+#if defined(__FreeBSD__) || defined(_AIX)
/** On these platforms use system provided monotonic clock instead of
- ** the default CLOCK_REALTIME. We then need to set up cond var attributes
- ** appropriately (see thread.c).
+ ** the default CLOCK_REALTIME. Note: We then need to set up cond var
+ ** attributes appropriately (see thread.c).
**/
# define CLOCK_RT_Ada "CLOCK_MONOTONIC"
-# define NEED_PTHREAD_CONDATTR_SETCLOCK 1
-#elif defined(HAVE_CLOCK_REALTIME)
+#else
/* By default use CLOCK_REALTIME */
# define CLOCK_RT_Ada "CLOCK_REALTIME"
#endif
#ifdef CLOCK_RT_Ada
CNS(CLOCK_RT_Ada, "")
#endif
-#ifdef NEED_PTHREAD_CONDATTR_SETCLOCK
-CND(NEED_PTHREAD_CONDATTR_SETCLOCK, "")
-#endif
#if defined (__APPLE__) || defined (__linux__) || defined (DUMMY)
/*
-- Sizes of pthread data types
-
*/
#if defined (__APPLE__) || defined (DUMMY)
/*
-- (on Darwin, these are just placeholders)
-
*/
#define PTHREAD_SIZE __PTHREAD_SIZE__
#define PTHREAD_ATTR_SIZE __PTHREAD_ATTR_SIZE__
#define PTHREAD_RWLOCK_SIZE (sizeof (pthread_rwlock_t))
#define PTHREAD_ONCE_SIZE (sizeof (pthread_once_t))
#endif
+/*
+*/
CND(PTHREAD_SIZE, "pthread_t")
CND(PTHREAD_ATTR_SIZE, "pthread_attr_t")
CND(PTHREAD_MUTEXATTR_SIZE, "pthread_mutexattr_t")
when N_Freeze_Entity =>
Analyze_Freeze_Entity (N);
+ when N_Freeze_Generic_Entity =>
+ Analyze_Freeze_Generic_Entity (N);
+
when N_Full_Type_Declaration =>
Analyze_Full_Type_Declaration (N);
-- Local Subprograms --
-----------------------
+ procedure Address_Checks;
+ -- Semantic checks for valid use of Address attribute. This was made
+ -- a separate routine with the idea of using it for unrestricted access
+ -- which seems like it should follow the same rules, but that turned
+ -- out to be impractical. So now this is only used for Address.
+
procedure Analyze_Access_Attribute;
-- Used for Access, Unchecked_Access, Unrestricted_Access attributes.
-- Internally, Id distinguishes which of the three cases is involved.
-- non-scalar arguments or returns a non-scalar result. Verifies that
-- such a call does not appear in a preelaborable context.
+ --------------------
+ -- Address_Checks --
+ --------------------
+
+ procedure Address_Checks is
+ begin
+ -- An Address attribute created by expansion is legal even when it
+ -- applies to other entity-denoting expressions.
+
+ if not Comes_From_Source (N) then
+ return;
+
+ -- Address attribute on a protected object self reference is legal
+
+ elsif Is_Protected_Self_Reference (P) then
+ return;
+
+ -- Address applied to an entity
+
+ elsif Is_Entity_Name (P) then
+ declare
+ Ent : constant Entity_Id := Entity (P);
+
+ begin
+ if Is_Subprogram (Ent) then
+ Set_Address_Taken (Ent);
+ Kill_Current_Values (Ent);
+
+ -- An Address attribute is accepted when generated by the
+ -- compiler for dispatching operation, and an error is
+ -- issued once the subprogram is frozen (to avoid confusing
+ -- errors about implicit uses of Address in the dispatch
+ -- table initialization).
+
+ if Has_Pragma_Inline_Always (Entity (P))
+ and then Comes_From_Source (P)
+ then
+ Error_Attr_P
+ ("prefix of % attribute cannot be Inline_Always "
+ & "subprogram");
+
+ -- It is illegal to apply 'Address to an intrinsic
+ -- subprogram. This is now formalized in AI05-0095.
+ -- In an instance, an attempt to obtain 'Address of an
+ -- intrinsic subprogram (e.g the renaming of a predefined
+ -- operator that is an actual) raises Program_Error.
+
+ elsif Convention (Ent) = Convention_Intrinsic then
+ if In_Instance then
+ Rewrite (N,
+ Make_Raise_Program_Error (Loc,
+ Reason => PE_Address_Of_Intrinsic));
+
+ else
+ Error_Msg_N
+ ("cannot take % of intrinsic subprogram", N);
+ end if;
+
+ -- Issue an error if prefix denotes an eliminated subprogram
+
+ else
+ Check_For_Eliminated_Subprogram (P, Ent);
+ end if;
+
+ -- Object or label reference
+
+ elsif Is_Object (Ent) or else Ekind (Ent) = E_Label then
+ Set_Address_Taken (Ent);
+
+ -- Deal with No_Implicit_Aliasing restriction
+
+ if Restriction_Check_Required (No_Implicit_Aliasing) then
+ if not Is_Aliased_View (P) then
+ Check_Restriction (No_Implicit_Aliasing, P);
+ else
+ Check_No_Implicit_Aliasing (P);
+ end if;
+ end if;
+
+ -- If we have an address of an object, and the attribute
+ -- comes from source, then set the object as potentially
+ -- source modified. We do this because the resulting address
+ -- can potentially be used to modify the variable and we
+ -- might not detect this, leading to some junk warnings.
+
+ Set_Never_Set_In_Source (Ent, False);
+
+ -- Allow Address to be applied to task or protected type,
+ -- returning null address (what is that about???)
+
+ elsif (Is_Concurrent_Type (Etype (Ent))
+ and then Etype (Ent) = Base_Type (Ent))
+ or else Ekind (Ent) = E_Package
+ or else Is_Generic_Unit (Ent)
+ then
+ Rewrite (N,
+ New_Occurrence_Of (RTE (RE_Null_Address), Sloc (N)));
+
+ -- Anything else is illegal
+
+ else
+ Error_Attr ("invalid prefix for % attribute", P);
+ end if;
+ end;
+
+ -- Allow Address if the prefix is a reference to the AST_Entry
+ -- attribute. If expansion is active, the attribute will be
+ -- replaced by a function call, and address will work fine and
+ -- get the proper value, but if expansion is not active, then
+ -- the check here allows proper semantic analysis of the reference.
+
+ elsif Nkind (P) = N_Attribute_Reference
+ and then Attribute_Name (P) = Name_AST_Entry
+ then
+ Rewrite (N,
+ New_Occurrence_Of (RTE (RE_Null_Address), Sloc (N)));
+
+ -- Object is OK
+
+ elsif Is_Object_Reference (P) then
+ return;
+
+ -- Subprogram called using dot notation
+
+ elsif Nkind (P) = N_Selected_Component
+ and then Is_Subprogram (Entity (Selector_Name (P)))
+ then
+ return;
+
+ -- What exactly are we allowing here ??? and is this properly
+ -- documented in the sinfo documentation for this node ???
+
+ elsif Relaxed_RM_Semantics
+ and then Nkind (P) = N_Attribute_Reference
+ then
+ return;
+
+ -- All other non-entity name cases are illegal
+
+ else
+ Error_Attr ("invalid prefix for % attribute", P);
+ end if;
+ end Address_Checks;
+
------------------------------
-- Analyze_Access_Attribute --
------------------------------
when Attribute_Address =>
Check_E0;
-
- -- Check for some junk cases, where we have to allow the address
- -- attribute but it does not make much sense, so at least for now
- -- just replace with Null_Address.
-
- -- We also do this if the prefix is a reference to the AST_Entry
- -- attribute. If expansion is active, the attribute will be
- -- replaced by a function call, and address will work fine and
- -- get the proper value, but if expansion is not active, then
- -- the check here allows proper semantic analysis of the reference.
-
- -- An Address attribute created by expansion is legal even when it
- -- applies to other entity-denoting expressions.
-
- if Is_Protected_Self_Reference (P) then
-
- -- Address attribute on a protected object self reference is legal
-
- null;
-
- elsif Is_Entity_Name (P) then
- declare
- Ent : constant Entity_Id := Entity (P);
-
- begin
- if Is_Subprogram (Ent) then
- Set_Address_Taken (Ent);
- Kill_Current_Values (Ent);
-
- -- An Address attribute is accepted when generated by the
- -- compiler for dispatching operation, and an error is
- -- issued once the subprogram is frozen (to avoid confusing
- -- errors about implicit uses of Address in the dispatch
- -- table initialization).
-
- if Has_Pragma_Inline_Always (Entity (P))
- and then Comes_From_Source (P)
- then
- Error_Attr_P
- ("prefix of % attribute cannot be Inline_Always" &
- " subprogram");
-
- -- It is illegal to apply 'Address to an intrinsic
- -- subprogram. This is now formalized in AI05-0095.
- -- In an instance, an attempt to obtain 'Address of an
- -- intrinsic subprogram (e.g the renaming of a predefined
- -- operator that is an actual) raises Program_Error.
-
- elsif Convention (Ent) = Convention_Intrinsic then
- if In_Instance then
- Rewrite (N,
- Make_Raise_Program_Error (Loc,
- Reason => PE_Address_Of_Intrinsic));
-
- else
- Error_Msg_N
- ("cannot take Address of intrinsic subprogram", N);
- end if;
-
- -- Issue an error if prefix denotes an eliminated subprogram
-
- else
- Check_For_Eliminated_Subprogram (P, Ent);
- end if;
-
- elsif Is_Object (Ent)
- or else Ekind (Ent) = E_Label
- then
- Set_Address_Taken (Ent);
-
- -- Deal with No_Implicit_Aliasing restriction
-
- if Restriction_Check_Required (No_Implicit_Aliasing) then
- if not Is_Aliased_View (P) then
- Check_Restriction (No_Implicit_Aliasing, P);
- else
- Check_No_Implicit_Aliasing (P);
- end if;
- end if;
-
- -- If we have an address of an object, and the attribute
- -- comes from source, then set the object as potentially
- -- source modified. We do this because the resulting address
- -- can potentially be used to modify the variable and we
- -- might not detect this, leading to some junk warnings.
-
- Set_Never_Set_In_Source (Ent, False);
-
- elsif (Is_Concurrent_Type (Etype (Ent))
- and then Etype (Ent) = Base_Type (Ent))
- or else Ekind (Ent) = E_Package
- or else Is_Generic_Unit (Ent)
- then
- Rewrite (N,
- New_Occurrence_Of (RTE (RE_Null_Address), Sloc (N)));
-
- else
- Error_Attr ("invalid prefix for % attribute", P);
- end if;
- end;
-
- elsif Nkind (P) = N_Attribute_Reference
- and then Attribute_Name (P) = Name_AST_Entry
- then
- Rewrite (N,
- New_Occurrence_Of (RTE (RE_Null_Address), Sloc (N)));
-
- elsif Is_Object_Reference (P) then
- null;
-
- elsif Nkind (P) = N_Selected_Component
- and then Is_Subprogram (Entity (Selector_Name (P)))
- then
- null;
-
- -- What exactly are we allowing here ??? and is this properly
- -- documented in the sinfo documentation for this node ???
-
- elsif not Comes_From_Source (N) then
- null;
-
- elsif Relaxed_RM_Semantics
- and then Nkind (P) = N_Attribute_Reference
- then
- null;
-
- else
- Error_Attr ("invalid prefix for % attribute", P);
- end if;
-
+ Address_Checks;
Set_Etype (N, RTE (RE_Address));
------------------
-------------------------
-- This is a GNAT specific attribute which is like Access except that
- -- all scope checks and checks for aliased views are omitted.
+ -- all scope checks and checks for aliased views are omitted. It is
+ -- documented as being equivalent to the use of the Address attribute
+ -- followed by an unchecked conversion to the target access type.
when Attribute_Unrestricted_Access =>
Set_Address_Taken (Entity (P));
end if;
+ -- It might seem reasonable to call Address_Checks here to apply the
+ -- same set of semantic checks that we enforce for 'Address (after
+ -- all we document Unrestricted_Access as being equivalent to the
+ -- use of Address followed by an Unchecked_Conversion). However, if
+ -- we do enable these checks, we get multiple failures in both the
+ -- compiler run-time and in our regression test suite, so we leave
+ -- out these checks for now. To be investigated further some time???
+
+ -- Address_Checks;
+
+ -- Now complete analysis using common access processing
+
Analyze_Access_Attribute;
------------
end if;
end Analyze_Freeze_Entity;
+ -----------------------------------
+ -- Analyze_Freeze_Generic_Entity --
+ -----------------------------------
+
+ procedure Analyze_Freeze_Generic_Entity (N : Node_Id) is
+ begin
+ -- Semantic checks here
+ null;
+ end Analyze_Freeze_Generic_Entity;
+
------------------------------------------
-- Analyze_Record_Representation_Clause --
------------------------------------------
procedure Analyze_Enumeration_Representation_Clause (N : Node_Id);
procedure Analyze_Free_Statement (N : Node_Id);
procedure Analyze_Freeze_Entity (N : Node_Id);
+ procedure Analyze_Freeze_Generic_Entity (N : Node_Id);
procedure Analyze_Record_Representation_Clause (N : Node_Id);
procedure Analyze_Code_Statement (N : Node_Id);
or else NT (N).Nkind in N_Has_Entity
or else NT (N).Nkind = N_Aspect_Specification
or else NT (N).Nkind = N_Attribute_Definition_Clause
- or else NT (N).Nkind = N_Freeze_Entity);
+ or else NT (N).Nkind = N_Freeze_Entity
+ or else NT (N).Nkind = N_Freeze_Generic_Entity);
return Node4 (N);
end Entity;
or else NT (N).Nkind in N_Has_Entity
or else NT (N).Nkind = N_Aspect_Specification
or else NT (N).Nkind = N_Attribute_Definition_Clause
- or else NT (N).Nkind = N_Freeze_Entity);
+ or else NT (N).Nkind = N_Freeze_Entity
+ or else NT (N).Nkind = N_Freeze_Generic_Entity);
Set_Node4 (N, Val); -- semantic field, no parent set
end Set_Entity;
-- Note: in the case where a debug source file is generated, the Sloc
-- for this node points to the FREEZE keyword in the Sprint file output.
+ ---------------------------
+ -- Freeze_Generic_Entity --
+ ---------------------------
+
+ -- The freeze point of an entity indicates the point at which the
+ -- information needed to generate code for the entity is complete.
+ -- The freeze node for an entity triggers expander activities, such as
+ -- build initialization procedures, and backend activities, such as
+ -- completing the elaboration of packages.
+
+ -- For entities declared within a generic unit, for which no code is
+ -- generated, the freeze point is not equally meaningful. However, in
+ -- Ada 2012 several semantic checks on declarations must be delayed to
+ -- the freeze point, and we need to include such a mark in the tree to
+ -- trigger these checks. The Freeze_Generic_Entity node plays no other
+ -- role, and is ignored by the expander and the back-end.
+
+ -- N_Freeze_Generic_Entity
+ -- Sloc points near freeze point
+ -- Entity (Node4-Sem)
+
--------------------------------
-- Implicit Label Declaration --
--------------------------------
N_Formal_Incomplete_Type_Definition,
N_Formal_Signed_Integer_Type_Definition,
N_Freeze_Entity,
+ N_Freeze_Generic_Entity,
N_Generic_Association,
N_Handled_Sequence_Of_Statements,
N_Index_Or_Discriminant_Constraint,
N_Expanded_Name ..
N_Attribute_Reference;
-- Nodes that have Entity fields
- -- Warning: DOES NOT INCLUDE N_Freeze_Entity, N_Aspect_Specification,
- -- or N_Attribute_Definition_Clause.
+ -- Warning: DOES NOT INCLUDE N_Freeze_Entity, N_Freeze_Generic_Entity,
+ -- N_Aspect_Specification, or N_Attribute_Definition_Clause.
subtype N_Has_Etype is Node_Kind range
N_Error ..
4 => False, -- Entity (Node4-Sem)
5 => False), -- First_Subtype_Link (Node5-Sem)
+ N_Freeze_Generic_Entity =>
+ (1 => False, -- unused
+ 2 => False, -- unused
+ 3 => False, -- unused
+ 4 => False, -- Entity (Node4-Sem)
+ 5 => False), -- unused
+
N_Implicit_Label_Declaration =>
(1 => True, -- Defining_Identifier (Node1)
2 => False, -- Label_Construct (Node2-Sem)
-- do not duplicate the output at this point.
if Nkind (Node) = N_Freeze_Entity
+ or else Nkind (Node) = N_Freeze_Generic_Entity
or else Nkind (Node) = N_Implicit_Label_Declaration
then
Sprint_Node_Actual (Node);
Write_Rewrite_Str (">>>");
end if;
+ when N_Freeze_Generic_Entity =>
+ if Dump_Original_Only then
+ null;
+
+ else
+ Write_Indent;
+ Write_Str_With_Col_Check_Sloc ("freeze_generic ");
+ Write_Id (Entity (Node));
+ end if;
+
when N_Full_Type_Declaration =>
Write_Indent_Str_Sloc ("type ");
Sprint_Node (Defining_Identifier (Node));
* *
* C Implementation File *
* *
- * Copyright (C) 2011, Free Software Foundation, Inc. *
+ * Copyright (C) 2011-2013, 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- *
#include "s-oscons.h"
-#ifdef NEED_PTHREAD_CONDATTR_SETCLOCK
+/* If the clock we used for tasking (CLOCK_RT_Ada) is not the default
+ * CLOCK_REALTIME, we need to set cond var attributes accordingly.
+ */
+#if CLOCK_RT_Ada != CLOCK_REALTIME
# include <pthread.h>
# include <time.h>
projects / thirdparty / gcc.git / commitdiff
