From: Arnaud Charlet Date: Tue, 2 Aug 2011 10:14:09 +0000 (+0200) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=d8b962d80e8388a84aec13593b8b169446c547cb;p=gcc.git [multiple changes] 2011-08-02 Robert Dewar * einfo.adb (Is_Base_Type): Improve efficiency by using a flag table (Base_Type): Now uses improved Is_Base_Type function * einfo.ads (Base_Type): Inline this function 2011-08-02 Robert Dewar * sem_prag.adb (Analyze_Pragma): Defend against infinite recursion (Analyze_Aspect_Specifications): Fix Sloc values for constructed pragmas 2011-08-02 Arnaud Charlet * gcc-interface/Make-lang.in: Update dependencies. * gcc-interface/Makefile.in: Use s-inmapop-vxworks.adb for all VxWorks targets. 2011-08-02 Yannick Moy * par-ch3.adb (P_Delta_Constraint): issue an error in formal mode on non-simple expression used in delta constraint (P_Index_Or_Discriminant_Constraint): issue an error in formal mode on index constraint which is not a subtype mark * par.adb: With and use Restrict * sem_ch3.adb (Analyze_Component_Declaration): issue an error in formal mode on component type which is not a subtype mark and default expression on component (Analyze_Subtype_Declaration): issue an error in formal mode on subtype of string which does not have a lower index bound equal to 1 (Array_Type_Declaration): issue an error in formal mode on index or component type which is not a subtype mark, and on aliased keyword on component (Derived_Type_Declaration): issue an error in formal mode on interface, limited or abstract type (Record_Type_Declaration): issue an error in formal mode on interface (Record_Type_Definition): issue an error in formal mode on tagged types and type extensions not declared in the specification of a library unit package; on null non-tagged record; on variant part 2011-08-02 Vincent Celier * prj-nmsc.adb (Check_Library_Attributes): Do not report Library_Dir not declared for qualified library project when Library_Name is not declared, but Library_Dir is. 2011-08-02 Robert Dewar * sem_ch13.adb (Analyze_Aspect_Specification): Fix slocs on generated pragmas (affects aspects [Component_]Default_Value (Check_Aspect_At_Freeze_Point): For Component_Default_Value, use component type for the resolution From-SVN: r177123 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a78d1b98fc0..ffee3e4e579 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,55 @@ +2011-08-02 Robert Dewar + + * einfo.adb (Is_Base_Type): Improve efficiency by using a flag table + (Base_Type): Now uses improved Is_Base_Type function + * einfo.ads (Base_Type): Inline this function + +2011-08-02 Robert Dewar + + * sem_prag.adb (Analyze_Pragma): Defend against infinite recursion + (Analyze_Aspect_Specifications): Fix Sloc values for constructed pragmas + +2011-08-02 Arnaud Charlet + + * gcc-interface/Make-lang.in: Update dependencies. + * gcc-interface/Makefile.in: Use s-inmapop-vxworks.adb for all VxWorks + targets. + +2011-08-02 Yannick Moy + + * par-ch3.adb (P_Delta_Constraint): issue an error in formal mode on + non-simple expression used in delta constraint + (P_Index_Or_Discriminant_Constraint): issue an error in formal mode on + index constraint which is not a subtype mark + * par.adb: With and use Restrict + * sem_ch3.adb (Analyze_Component_Declaration): issue an error in formal + mode on component type which is not a subtype mark and default + expression on component + (Analyze_Subtype_Declaration): issue an error in formal mode on subtype + of string which does not have a lower index bound equal to 1 + (Array_Type_Declaration): issue an error in formal mode on index or + component type which is not a subtype mark, and on aliased keyword on + component + (Derived_Type_Declaration): issue an error in formal mode on interface, + limited or abstract type + (Record_Type_Declaration): issue an error in formal mode on interface + (Record_Type_Definition): issue an error in formal mode on tagged types + and type extensions not declared in the specification of a library unit + package; on null non-tagged record; on variant part + +2011-08-02 Vincent Celier + + * prj-nmsc.adb (Check_Library_Attributes): Do not report Library_Dir + not declared for qualified library project when Library_Name is not + declared, but Library_Dir is. + +2011-08-02 Robert Dewar + + * sem_ch13.adb (Analyze_Aspect_Specification): Fix slocs on generated + pragmas (affects aspects [Component_]Default_Value + (Check_Aspect_At_Freeze_Point): For Component_Default_Value, use + component type for the resolution + 2011-08-02 Eric Botcazou * einfo.adb (Base_Type): Tune implementation for speed. diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 662af6735a6..c66b35a5764 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -5608,43 +5608,13 @@ package body Einfo is --------------- function Base_Type (Id : E) return E is - Is_Base_Type : Boolean; begin - -- Implementation note: this function shows up high in the profile. - -- We use a fully static case construct so as to make it easier for - -- the compiler to build a static table out of it, instead of using - -- a less efficient jump table. - - case Ekind (Id) is - when E_Enumeration_Subtype | - E_Incomplete_Type | - E_Signed_Integer_Subtype | - E_Modular_Integer_Subtype | - E_Floating_Point_Subtype | - E_Ordinary_Fixed_Point_Subtype | - E_Decimal_Fixed_Point_Subtype | - E_Array_Subtype | - E_String_Subtype | - E_Record_Subtype | - E_Private_Subtype | - E_Record_Subtype_With_Private | - E_Limited_Private_Subtype | - E_Access_Subtype | - E_Protected_Subtype | - E_Task_Subtype | - E_String_Literal_Subtype | - E_Class_Wide_Subtype => - Is_Base_Type := False; - - when others => - Is_Base_Type := True; - end case; - - if Is_Base_Type then + if Is_Base_Type (Id) then return Id; + else + pragma Assert (Is_Type (Id)); + return Etype (Id); end if; - - return Etype (Id); end Base_Type; ------------------------- @@ -6206,9 +6176,32 @@ package body Einfo is -- Is_Base_Type -- ------------------ + -- Global flag table allowing rapid computation of this function + + Entity_Is_Base_Type : constant array (Entity_Kind) of Boolean := + (E_Enumeration_Subtype | + E_Incomplete_Type | + E_Signed_Integer_Subtype | + E_Modular_Integer_Subtype | + E_Floating_Point_Subtype | + E_Ordinary_Fixed_Point_Subtype | + E_Decimal_Fixed_Point_Subtype | + E_Array_Subtype | + E_String_Subtype | + E_Record_Subtype | + E_Private_Subtype | + E_Record_Subtype_With_Private | + E_Limited_Private_Subtype | + E_Access_Subtype | + E_Protected_Subtype | + E_Task_Subtype | + E_String_Literal_Subtype | + E_Class_Wide_Subtype => False, + others => True); + function Is_Base_Type (Id : E) return Boolean is begin - return Id = Base_Type (Id); + return Entity_Is_Base_Type (Ekind (Id)); end Is_Base_Type; --------------------- diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 6f44fd788df..a69ba1ac1ce 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -8010,6 +8010,7 @@ package Einfo is -- things here which are small, but not of the canonical attribute -- access/set format that can be handled by xeinfo. + pragma Inline (Base_Type); pragma Inline (Is_Base_Type); pragma Inline (Is_Package_Or_Generic_Package); pragma Inline (Is_Volatile); diff --git a/gcc/ada/gcc-interface/Make-lang.in b/gcc/ada/gcc-interface/Make-lang.in index c925db01cca..7e43d966f98 100644 --- a/gcc/ada/gcc-interface/Make-lang.in +++ b/gcc/ada/gcc-interface/Make-lang.in @@ -1514,22 +1514,22 @@ ada/cstand.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ada/g-htable.ads ada/hostparm.ads ada/interfac.ads ada/layout.ads \ ada/lib.ads ada/lib-xref.ads ada/namet.ads ada/namet.adb ada/nlists.ads \ ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \ - ada/rident.ads ada/rtsfind.ads ada/scans.ads ada/scn.ads ada/scng.ads \ - ada/scng.adb ada/sem.ads ada/sem_attr.ads ada/sem_aux.ads \ - ada/sem_ch8.ads ada/sem_disp.ads ada/sem_eval.ads ada/sem_mech.ads \ - ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb \ - ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/sinput.adb \ - 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-crc32.ads ada/s-crc32.adb ada/s-exctab.ads 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/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/widechar.ads + ada/restrict.ads ada/rident.ads ada/rtsfind.ads ada/scans.ads \ + ada/scn.ads ada/scng.ads ada/scng.adb ada/sem.ads ada/sem_attr.ads \ + ada/sem_aux.ads ada/sem_ch8.ads ada/sem_disp.ads ada/sem_eval.ads \ + ada/sem_mech.ads ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads \ + ada/sem_util.adb ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \ + ada/sinput.adb 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-crc32.ads ada/s-crc32.adb ada/s-exctab.ads \ + 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/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/widechar.ads ada/debug.o : ada/debug.ads ada/debug.adb ada/system.ads @@ -1638,22 +1638,23 @@ ada/exp_aggr.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads \ ada/output.ads ada/restrict.ads ada/restrict.adb 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_cat.ads ada/sem_ch3.ads \ - ada/sem_ch6.ads ada/sem_ch7.ads ada/sem_ch8.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/sinfo.ads ada/sinfo.adb ada/sinput.ads \ - ada/snames.ads 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-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/validsw.ads ada/widechar.ads + ada/sem_aggr.ads ada/sem_attr.ads ada/sem_aux.ads ada/sem_cat.ads \ + ada/sem_ch3.ads ada/sem_ch6.ads ada/sem_ch7.ads ada/sem_ch8.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/sinfo.ads ada/sinfo.adb \ + ada/sinput.ads ada/snames.ads 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-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/validsw.ads \ + ada/widechar.ads ada/exp_atag.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 \ @@ -2023,22 +2024,22 @@ ada/exp_code.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ada/interfac.ads ada/lib.ads ada/lib.adb ada/lib-list.adb \ ada/lib-sort.adb ada/lib-xref.ads ada/namet.ads ada/namet.adb \ ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads \ - ada/output.ads ada/rident.ads ada/rtsfind.ads ada/scans.ads ada/sem.ads \ - ada/sem_attr.ads ada/sem_aux.ads ada/sem_cat.ads ada/sem_ch6.ads \ - ada/sem_ch8.ads ada/sem_disp.ads ada/sem_eval.ads ada/sem_eval.adb \ - ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb \ - ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \ - ada/snames.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-carun8.ads ada/s-exctab.ads 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/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/widechar.ads + ada/output.ads ada/restrict.ads ada/rident.ads ada/rtsfind.ads \ + ada/scans.ads ada/sem.ads ada/sem_attr.ads ada/sem_aux.ads \ + ada/sem_cat.ads ada/sem_ch6.ads ada/sem_ch8.ads ada/sem_disp.ads \ + ada/sem_eval.ads ada/sem_eval.adb ada/sem_res.ads ada/sem_type.ads \ + ada/sem_util.ads ada/sem_util.adb ada/sem_warn.ads ada/sinfo.ads \ + ada/sinfo.adb ada/sinput.ads ada/snames.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-carun8.ads \ + ada/s-exctab.ads 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/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/widechar.ads ada/exp_dbug.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 \ @@ -2123,20 +2124,20 @@ ada/exp_fixd.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ada/gnat.ads ada/g-htable.ads ada/hostparm.ads ada/interfac.ads \ ada/lib.ads ada/lib-xref.ads ada/namet.ads ada/namet.adb ada/nlists.ads \ ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \ - ada/rident.ads ada/rtsfind.ads ada/scans.ads ada/sem.ads \ - ada/sem_attr.ads ada/sem_aux.ads ada/sem_cat.ads ada/sem_ch6.ads \ - ada/sem_ch8.ads ada/sem_disp.ads ada/sem_eval.ads ada/sem_eval.adb \ - ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb \ - ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \ - ada/snames.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-exctab.ads 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/tree_io.ads ada/ttypes.ads \ - ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \ + ada/restrict.ads ada/rident.ads ada/rtsfind.ads ada/scans.ads \ + ada/sem.ads ada/sem_attr.ads ada/sem_aux.ads ada/sem_cat.ads \ + ada/sem_ch6.ads ada/sem_ch8.ads ada/sem_disp.ads ada/sem_eval.ads \ + ada/sem_eval.adb ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads \ + ada/sem_util.adb ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb \ + ada/sinput.ads ada/snames.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-exctab.ads 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/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/widechar.ads @@ -2409,25 +2410,24 @@ ada/freeze.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ada/atree.adb ada/casing.ads ada/checks.ads ada/csets.ads ada/debug.ads \ ada/debug_a.ads ada/einfo.ads ada/einfo.adb ada/elists.ads \ ada/elists.adb ada/err_vars.ads ada/errout.ads ada/erroutc.ads \ - ada/eval_fat.ads ada/exp_aggr.ads ada/exp_ch11.ads ada/exp_ch3.ads \ - ada/exp_ch6.ads ada/exp_ch7.ads ada/exp_disp.ads ada/exp_pakd.ads \ - ada/exp_tss.ads ada/exp_util.ads ada/exp_util.adb ada/expander.ads \ - ada/fname.ads ada/freeze.ads ada/freeze.adb ada/get_targ.ads \ - ada/gnat.ads ada/g-hesorg.ads ada/g-htable.ads ada/hostparm.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-sort.adb \ - ada/lib-xref.ads ada/namet.ads ada/namet.adb ada/nlists.ads \ - ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \ - ada/restrict.ads ada/rident.ads ada/rtsfind.ads ada/scans.ads \ - ada/sem.ads ada/sem_aggr.ads ada/sem_attr.ads ada/sem_aux.ads \ - ada/sem_cat.ads ada/sem_ch13.ads ada/sem_ch4.ads ada/sem_ch6.ads \ - ada/sem_ch7.ads ada/sem_ch8.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_res.ads \ - ada/sem_res.adb ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb \ - ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb ada/sinfo-cn.ads \ - ada/sinput.ads ada/snames.ads ada/stand.ads ada/stringt.ads \ - ada/stringt.adb ada/style.ads ada/styleg.ads ada/styleg.adb \ + ada/exp_aggr.ads ada/exp_ch11.ads ada/exp_ch3.ads ada/exp_ch6.ads \ + ada/exp_ch7.ads ada/exp_disp.ads ada/exp_pakd.ads ada/exp_tss.ads \ + ada/exp_util.ads ada/exp_util.adb ada/expander.ads ada/fname.ads \ + ada/freeze.ads ada/freeze.adb ada/get_targ.ads ada/gnat.ads \ + ada/g-hesorg.ads ada/g-htable.ads ada/hostparm.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-sort.adb ada/lib-xref.ads ada/namet.ads \ + ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb \ + ada/opt.ads ada/output.ads ada/restrict.ads ada/rident.ads \ + ada/rtsfind.ads ada/scans.ads ada/sem.ads ada/sem_aggr.ads \ + ada/sem_attr.ads ada/sem_aux.ads ada/sem_cat.ads ada/sem_ch13.ads \ + ada/sem_ch4.ads ada/sem_ch6.ads ada/sem_ch7.ads ada/sem_ch8.ads \ + ada/sem_disp.ads ada/sem_dist.ads ada/sem_elab.ads ada/sem_elim.ads \ + ada/sem_eval.ads ada/sem_intr.ads ada/sem_mech.ads ada/sem_prag.ads \ + ada/sem_res.ads ada/sem_res.adb ada/sem_type.ads ada/sem_util.ads \ + ada/sem_util.adb ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb \ + ada/sinfo-cn.ads 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-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 \ @@ -2817,12 +2817,12 @@ ada/nmake.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ada/urealp.ads ada/opt.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads ada/a-uncdea.ads \ - ada/debug.ads ada/gnatvsn.ads ada/hostparm.ads ada/opt.ads ada/opt.adb \ - ada/system.ads ada/s-exctab.ads ada/s-os_lib.ads ada/s-parame.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/tree_io.ads ada/types.ads \ - ada/unchconv.ads ada/unchdeal.ads + ada/gnatvsn.ads ada/hostparm.ads ada/opt.ads ada/opt.adb ada/system.ads \ + ada/s-exctab.ads ada/s-os_lib.ads ada/s-parame.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/tree_io.ads ada/types.ads ada/unchconv.ads \ + ada/unchdeal.ads ada/osint-b.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ada/a-uncdea.ads ada/alloc.ads ada/debug.ads ada/hostparm.ads \ @@ -3356,19 +3356,20 @@ ada/sem_cat.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ada/g-htable.ads ada/hostparm.ads ada/interfac.ads ada/lib.ads \ ada/lib.adb ada/lib-list.adb ada/lib-sort.adb ada/lib-xref.ads \ ada/namet.ads ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads \ - ada/opt.ads ada/output.ads ada/rident.ads ada/rtsfind.ads ada/scans.ads \ - ada/sem.ads ada/sem_attr.ads ada/sem_aux.ads ada/sem_cat.ads \ - ada/sem_cat.adb ada/sem_ch8.ads ada/sem_disp.ads ada/sem_eval.ads \ - ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb \ - 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-exctab.ads 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/tree_io.ads \ - ada/ttypes.ads ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \ + ada/opt.ads ada/output.ads ada/restrict.ads ada/rident.ads \ + ada/rtsfind.ads ada/scans.ads ada/sem.ads ada/sem_attr.ads \ + ada/sem_aux.ads ada/sem_cat.ads ada/sem_cat.adb ada/sem_ch8.ads \ + ada/sem_disp.ads ada/sem_eval.ads ada/sem_res.ads ada/sem_type.ads \ + ada/sem_util.ads ada/sem_util.adb 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-exctab.ads 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/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/widechar.ads ada/sem_ch10.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ @@ -3646,23 +3647,23 @@ ada/sem_ch7.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ada/inline.ads ada/interfac.ads ada/lib.ads ada/lib.adb \ ada/lib-list.adb ada/lib-sort.adb ada/lib-xref.ads ada/namet.ads \ ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb \ - ada/opt.ads ada/output.ads ada/rident.ads ada/rtsfind.ads ada/scans.ads \ - ada/sem.ads ada/sem_attr.ads ada/sem_aux.ads ada/sem_cat.ads \ - ada/sem_ch10.ads ada/sem_ch12.ads ada/sem_ch13.ads ada/sem_ch3.ads \ - ada/sem_ch6.ads ada/sem_ch7.ads ada/sem_ch7.adb ada/sem_ch8.ads \ - ada/sem_disp.ads ada/sem_eval.ads ada/sem_res.ads ada/sem_type.ads \ - ada/sem_util.ads ada/sem_util.adb ada/sem_warn.ads ada/sinfo.ads \ - ada/sinfo.adb ada/sinput.ads ada/sinput.adb ada/snames.ads \ - ada/snames.adb ada/stand.ads ada/stringt.ads ada/style.ads \ - ada/styleg.ads ada/styleg.adb ada/stylesw.ads ada/system.ads \ - ada/s-exctab.ads 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/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/widechar.ads + ada/opt.ads ada/output.ads ada/restrict.ads ada/rident.ads \ + ada/rtsfind.ads ada/scans.ads ada/sem.ads ada/sem_attr.ads \ + ada/sem_aux.ads ada/sem_cat.ads ada/sem_ch10.ads ada/sem_ch12.ads \ + ada/sem_ch13.ads ada/sem_ch3.ads ada/sem_ch6.ads ada/sem_ch7.ads \ + ada/sem_ch7.adb ada/sem_ch8.ads ada/sem_disp.ads ada/sem_eval.ads \ + ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb \ + ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \ + ada/sinput.adb ada/snames.ads ada/snames.adb ada/stand.ads \ + ada/stringt.ads ada/style.ads ada/styleg.ads ada/styleg.adb \ + ada/stylesw.ads ada/system.ads ada/s-exctab.ads 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/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/widechar.ads ada/sem_ch8.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 \ @@ -4002,20 +4003,21 @@ ada/sem_type.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ada/g-htable.ads ada/hostparm.ads ada/inline.ads ada/interfac.ads \ ada/lib.ads ada/lib.adb ada/lib-list.adb ada/lib-sort.adb \ ada/lib-xref.ads ada/namet.ads ada/namet.adb ada/nlists.ads \ - ada/nlists.adb ada/nmake.ads ada/opt.ads ada/output.ads ada/rident.ads \ - ada/rtsfind.ads ada/scans.ads ada/sem.ads ada/sem_attr.ads \ - ada/sem_aux.ads ada/sem_ch12.ads ada/sem_ch6.ads ada/sem_ch8.ads \ - ada/sem_disp.ads ada/sem_dist.ads ada/sem_eval.ads ada/sem_res.ads \ - ada/sem_type.ads ada/sem_type.adb ada/sem_util.ads ada/sem_util.adb \ - 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-exctab.ads 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/tree_io.ads \ - ada/ttypes.ads ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \ + ada/nlists.adb ada/nmake.ads ada/opt.ads ada/output.ads \ + ada/restrict.ads ada/rident.ads ada/rtsfind.ads ada/scans.ads \ + ada/sem.ads ada/sem_attr.ads ada/sem_aux.ads ada/sem_ch12.ads \ + ada/sem_ch6.ads ada/sem_ch8.ads ada/sem_disp.ads ada/sem_dist.ads \ + ada/sem_eval.ads ada/sem_res.ads ada/sem_type.ads ada/sem_type.adb \ + ada/sem_util.ads ada/sem_util.adb 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-exctab.ads 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/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/widechar.ads ada/sem_util.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ @@ -4072,21 +4074,22 @@ ada/sem_warn.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ada/g-htable.ads ada/hostparm.ads ada/interfac.ads ada/lib.ads \ ada/lib.adb ada/lib-list.adb ada/lib-sort.adb ada/lib-xref.ads \ ada/namet.ads ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads \ - ada/opt.ads ada/output.ads ada/par_sco.ads ada/rident.ads \ - ada/rtsfind.ads ada/scans.ads ada/sem.ads ada/sem_attr.ads \ - ada/sem_aux.ads ada/sem_ch8.ads ada/sem_disp.ads ada/sem_eval.ads \ - ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb \ - ada/sem_warn.ads ada/sem_warn.adb ada/sinfo.ads ada/sinfo.adb \ - ada/sinput.ads ada/sinput.adb 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-exctab.ads 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/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/widechar.ads + ada/opt.ads ada/output.ads ada/par_sco.ads ada/restrict.ads \ + ada/rident.ads ada/rtsfind.ads ada/scans.ads ada/sem.ads \ + ada/sem_attr.ads ada/sem_aux.ads ada/sem_ch8.ads ada/sem_disp.ads \ + ada/sem_eval.ads ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads \ + ada/sem_util.adb ada/sem_warn.ads ada/sem_warn.adb ada/sinfo.ads \ + ada/sinfo.adb ada/sinput.ads ada/sinput.adb 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-exctab.ads \ + 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/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/widechar.ads ada/sinfo-cn.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 \ diff --git a/gcc/ada/gcc-interface/Makefile.in b/gcc/ada/gcc-interface/Makefile.in index 580bbcdb460..ffe3f126d38 100644 --- a/gcc/ada/gcc-interface/Makefile.in +++ b/gcc/ada/gcc-interface/Makefile.in @@ -423,7 +423,7 @@ ifeq ($(strip $(filter-out m68k% wrs vx%,$(targ))),) LIBGNAT_TARGET_PAIRS = \ a-intnam.ads if not Project.Library then - if Project.Library_Dir = No_Path_Information then + if Project.Library_Name = No_Name then Error_Msg (Data.Flags, - "\attribute Library_Dir not declared", + "attribute Library_Name not declared", Project.Location, Project); - end if; - if Project.Library_Name = No_Name then + if not Library_Directory_Present then + Error_Msg + (Data.Flags, + "\attribute Library_Dir not declared", + Project.Location, Project); + end if; + + elsif Project.Library_Dir = No_Path_Information then Error_Msg (Data.Flags, - "\attribute Library_Name not declared", + "attribute Library_Dir not declared", Project.Location, Project); end if; end if; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 70625112cfc..06ed3480729 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -993,7 +993,7 @@ package body Sem_Ch13 is Aitem := Make_Pragma (Loc, Pragma_Argument_Associations => New_List ( - New_Occurrence_Of (E, Eloc), + New_Occurrence_Of (E, Loc), Relocate_Node (Expr)), Pragma_Identifier => Make_Identifier (Sloc (Id), Chars (Id))); @@ -1016,7 +1016,7 @@ package body Sem_Ch13 is Aitem := Make_Pragma (Loc, Pragma_Argument_Associations => New_List ( - New_Occurrence_Of (E, Eloc), + New_Occurrence_Of (E, Loc), Relocate_Node (Expr)), Pragma_Identifier => Make_Identifier (Sloc (Id), Chars (Id))); @@ -1038,7 +1038,7 @@ package body Sem_Ch13 is Make_Pragma (Loc, Pragma_Argument_Associations => New_List ( Relocate_Node (Expr), - New_Occurrence_Of (E, Eloc)), + New_Occurrence_Of (E, Loc)), Pragma_Identifier => Make_Identifier (Sloc (Id), Chars (Id)), Class_Present => Class_Present (Aspect)); @@ -5239,13 +5239,16 @@ package body Sem_Ch13 is when Boolean_Aspects => raise Program_Error; - -- Default_Value and Default_Component_Value are resolved with - -- the entity, which is the type in question. + -- Default_Value is resolved with the type entity in question - when Aspect_Default_Component_Value | - Aspect_Default_Value => + when Aspect_Default_Value => T := Entity (ASN); + -- Default_Component_Value is resolved with the component type + + when Aspect_Default_Component_Value => + T := Component_Type (Entity (ASN)); + -- Aspects corresponding to attribute definition clauses when Aspect_Address => diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index fffe351b3ae..82bd372e8e6 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -1773,13 +1773,19 @@ package body Sem_Ch3 is end if; end Is_Known_Limited; + Typ : constant Node_Id := Subtype_Indication (Component_Definition (N)); + -- Start of processing for Analyze_Component_Declaration begin Generate_Definition (Id); Enter_Name (Id); - if Present (Subtype_Indication (Component_Definition (N))) then + if Present (Typ) then + if Nkind (Typ) /= N_Identifier then + Check_Formal_Restriction ("subtype mark required", Typ); + end if; + T := Find_Type_Of_Object (Subtype_Indication (Component_Definition (N)), N); @@ -1833,6 +1839,7 @@ package body Sem_Ch3 is -- package Sem). if Present (E) then + Check_Formal_Restriction ("default expression is not allowed", E); Preanalyze_Spec_Expression (E, T); Check_Initialization (T, E); @@ -3998,6 +4005,36 @@ package body Sem_Ch3 is ("subtype of Boolean cannot have constraint", N); end if; + -- Subtype of String shall have a lower index bound equal to 1 in SPARK + -- or ALFA. + + if Base_Type (T) = Standard_String + and then Nkind (Subtype_Indication (N)) = N_Subtype_Indication + then + declare + Cstr : constant Node_Id := Constraint (Subtype_Indication (N)); + Drange : Node_Id; + Low : Node_Id; + begin + if Nkind (Cstr) = N_Index_Or_Discriminant_Constraint + and then List_Length (Constraints (Cstr)) = 1 + then + Drange := First (Constraints (Cstr)); + + if Nkind (Drange) = N_Range then + Low := Low_Bound (Drange); + + if Is_OK_Static_Expression (Low) + and then Expr_Value (Low) /= 1 + then + Check_Formal_Restriction + ("subtype of String must have 1 as lower bound", N); + end if; + end if; + end if; + end; + end if; + -- In the case where there is no constraint given in the subtype -- indication, Process_Subtype just returns the Subtype_Mark, so its -- semantic attributes must be established here. @@ -4503,6 +4540,7 @@ package body Sem_Ch3 is procedure Array_Type_Declaration (T : in out Entity_Id; Def : Node_Id) is Component_Def : constant Node_Id := Component_Definition (Def); + Component_Typ : constant Node_Id := Subtype_Indication (Component_Def); Element_Type : Entity_Id; Implicit_Base : Entity_Id; Index : Node_Id; @@ -4530,6 +4568,10 @@ package body Sem_Ch3 is Nb_Index := 1; while Present (Index) loop + if Nkind (Index) /= N_Identifier then + Check_Formal_Restriction ("subtype mark required", Index); + end if; + Analyze (Index); -- Add a subtype declaration for each index of private array type @@ -4600,10 +4642,12 @@ package body Sem_Ch3 is -- Process subtype indication if one is present - if Present (Subtype_Indication (Component_Def)) then - Element_Type := - Process_Subtype - (Subtype_Indication (Component_Def), P, Related_Id, 'C'); + if Present (Component_Typ) then + if Nkind (Component_Typ) /= N_Identifier then + Check_Formal_Restriction ("subtype mark required", Component_Typ); + end if; + + Element_Type := Process_Subtype (Component_Typ, P, Related_Id, 'C'); -- Ada 2005 (AI-230): Access Definition case @@ -4711,6 +4755,8 @@ package body Sem_Ch3 is Set_Packed_Array_Type (T, Empty); if Aliased_Present (Component_Definition (Def)) then + Check_Formal_Restriction + ("aliased is not allowed", Component_Definition (Def)); Set_Has_Aliased_Components (Etype (T)); end if; @@ -13832,6 +13878,8 @@ package body Sem_Ch3 is -- parent is also an interface. if Interface_Present (Def) then + Check_Formal_Restriction ("interface is not allowed", Def); + if not Is_Interface (Parent_Type) then Diagnose_Interface (Indic, Parent_Type); @@ -18789,6 +18837,14 @@ package body Sem_Ch3 is if Ada_Version < Ada_2005 or else not Interface_Present (Def) then + if Limited_Present (Def) then + Check_Formal_Restriction ("limited is not allowed", N); + end if; + + if Abstract_Present (Def) then + Check_Formal_Restriction ("abstract is not allowed", N); + end if; + -- The flag Is_Tagged_Type might have already been set by -- Find_Type_Name if it detected an error for declaration T. This -- arises in the case of private tagged types where the full view @@ -18808,6 +18864,8 @@ package body Sem_Ch3 is or else Abstract_Present (Def)); else + Check_Formal_Restriction ("interface is not allowed", N); + Is_Tagged := True; Analyze_Interface_Declaration (T, Def); @@ -18946,6 +19004,41 @@ package body Sem_Ch3 is T := Prev_T; end if; + -- In SPARK or ALFA, tagged types and type extensions may only be + -- declared in the specification of library unit packages. + + if Present (Def) and then Is_Tagged_Type (T) then + declare + Typ : Node_Id; + Ctxt : Node_Id; + begin + if Nkind (Parent (Def)) = N_Full_Type_Declaration then + Typ := Parent (Def); + else + pragma Assert + (Nkind (Parent (Def)) = N_Derived_Type_Definition); + Typ := Parent (Parent (Def)); + end if; + + Ctxt := Parent (Typ); + + if Nkind (Ctxt) = N_Package_Body + and then Nkind (Parent (Ctxt)) = N_Compilation_Unit + then + Check_Formal_Restriction + ("type should be defined in package specification", Typ); + elsif Nkind (Ctxt) /= N_Package_Specification + or else + Nkind (Parent (Parent (Ctxt))) /= N_Compilation_Unit + then + Check_Formal_Restriction + ("type should be defined in library unit package", Typ); + else + null; + end if; + end; + end if; + Final_Storage_Only := not Is_Controlled (T); -- Ada 2005: check whether an explicit Limited is present in a derived @@ -18968,12 +19061,15 @@ package body Sem_Ch3 is or else No (Component_List (Def)) or else Null_Present (Component_List (Def)) then - null; + if not Is_Tagged_Type (T) then + Check_Formal_Restriction ("non-tagged record cannot be null", Def); + end if; else Analyze_Declarations (Component_Items (Component_List (Def))); if Present (Variant_Part (Component_List (Def))) then + Check_Formal_Restriction ("variant part is not allowed", Def); Analyze (Variant_Part (Component_List (Def))); end if; end if; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index d416bd93264..51e7f5fbda2 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -5656,6 +5656,16 @@ package body Sem_Prag is -- Start of processing for Analyze_Pragma begin + -- The following code is a defense against recursion. Not clear that + -- this can happen legitimately, but perhaps some error situations + -- can cause it, and we did see this recursion during testing. + + if Analyzed (N) then + return; + else + Set_Analyzed (N, True); + end if; + -- Deal with unrecognized pragma if not Is_Pragma_Name (Pname) then