Skip to content

R
riscv-gcc-1
Commit 19fb051c by Arnaud Charlet
Options

[multiple changes] 

2011-08-02  Robert Dewar  <dewar@adacore.com>

	* mlib-prj.adb, restrict.ads, sem_aggr.adb, sem_ch12.adb: Minor
	reformatting.

2011-08-02  Robert Dewar  <dewar@adacore.com>

	* aspects.adb: New aspects Default_Value and Default_Component_Value
	New format of Aspect_Names table checks for omitted entries
	* aspects.ads: Remove mention of Aspect_Cancel and add documentation on
	handling of boolean aspects for derived types.
	New aspects Default_Value and Default_Component_Value
	New format of Aspect_Names table checks for omitted entries
	* einfo.ads, einfo.adb (Has_Default_Component_Value): New flag
	(Has_Default_Value): New flag
	(Has_Default_Component_Value): New flag
	(Has_Default_Value): New flag
	* par-ch13.adb (P_Aspect_Specifications): New format of Aspect_Names
	table.
	* par-prag.adb: New pragmas Default_Value and Default_Component_Value
	* sem_ch13.adb (Analyze_Aspect_Specifications): New aspects
	Default_Value and Default_Component_Value
	* sem_prag.adb: New pragmas Default_Value and Default_Component_Value
	New aspects Default_Value and Default_Component_Value
	* snames.ads-tmpl: New pragmas Default_Value and Default_Component_Value
	* sprint.adb: Print N_Aspect_Specification node when called from gdb

2011-08-02  Ed Schonberg  <schonberg@adacore.com>

	* sem_res.adb: Add guards in calls to Matching_Static_Array_Bounds.
	Minor reformatting.

2011-08-02  Robert Dewar  <dewar@adacore.com>

	* i-cstrin.ads: Updates to make Interfaces.C.Strings match RM

From-SVN: r177110
parent e443b7f9
Showing with 396 additions and 122 deletions
gcc/ada/ChangeLog
2011-08-02 Robert Dewar <dewar@adacore.com>
* mlib-prj.adb, restrict.ads, sem_aggr.adb, sem_ch12.adb: Minor
reformatting.
2011-08-02 Robert Dewar <dewar@adacore.com>
* aspects.adb: New aspects Default_Value and Default_Component_Value
New format of Aspect_Names table checks for omitted entries
* aspects.ads: Remove mention of Aspect_Cancel and add documentation on
handling of boolean aspects for derived types.
New aspects Default_Value and Default_Component_Value
New format of Aspect_Names table checks for omitted entries
* einfo.ads, einfo.adb (Has_Default_Component_Value): New flag
(Has_Default_Value): New flag
(Has_Default_Component_Value): New flag
(Has_Default_Value): New flag
* par-ch13.adb (P_Aspect_Specifications): New format of Aspect_Names
table.
* par-prag.adb: New pragmas Default_Value and Default_Component_Value
* sem_ch13.adb (Analyze_Aspect_Specifications): New aspects
Default_Value and Default_Component_Value
* sem_prag.adb: New pragmas Default_Value and Default_Component_Value
New aspects Default_Value and Default_Component_Value
* snames.ads-tmpl: New pragmas Default_Value and Default_Component_Value
* sprint.adb: Print N_Aspect_Specification node when called from gdb
2011-08-02 Vincent Celier <celier@adacore.com>
* prj-nmsc.adb (Check_Library_Attributes): For virtual library project,
inherit library kind.
2011-08-02 Ed Schonberg <schonberg@adacore.com>
* sem_res.adb: Add guards in calls to Matching_Static_Array_Bounds.
Minor reformatting.
2011-08-02 Robert Dewar <dewar@adacore.com>
* i-cstrin.ads: Updates to make Interfaces.C.Strings match RM
2011-08-02 Yannick Moy <moy@adacore.com> 2011-08-02 Yannick Moy <moy@adacore.com>
* sem_aggr.adb (Resolve_Aggregate): Fix thinko. * sem_aggr.adb (Resolve_Aggregate): Fix thinko.
......
gcc/ada/aspects.adb
...@@ -179,6 +179,8 @@ package body Aspects is ...@@ -179,6 +179,8 @@ package body Aspects is
Aspect_Atomic_Components => Aspect_Atomic_Components, Aspect_Atomic_Components => Aspect_Atomic_Components,
Aspect_Bit_Order => Aspect_Bit_Order, Aspect_Bit_Order => Aspect_Bit_Order,
Aspect_Component_Size => Aspect_Component_Size, Aspect_Component_Size => Aspect_Component_Size,
Aspect_Default_Component_Value => Aspect_Default_Component_Value,
Aspect_Default_Value => Aspect_Default_Value,
Aspect_Discard_Names => Aspect_Discard_Names, Aspect_Discard_Names => Aspect_Discard_Names,
Aspect_Dynamic_Predicate => Aspect_Predicate, Aspect_Dynamic_Predicate => Aspect_Predicate,
Aspect_External_Tag => Aspect_External_Tag, Aspect_External_Tag => Aspect_External_Tag,
...@@ -289,7 +291,7 @@ package body Aspects is ...@@ -289,7 +291,7 @@ package body Aspects is
-- Package initialization sets up Aspect Id hash table -- Package initialization sets up Aspect Id hash table
begin begin
for J in Aspect_Names'Range loop for J in Aspect_Id loop
Aspect_Id_Hash_Table.Set (Aspect_Names (J).Nam, Aspect_Names (J).Asp); Aspect_Id_Hash_Table.Set (Aspect_Names (J), J);
end loop; end loop;
end Aspects; end Aspects;
gcc/ada/aspects.ads
...@@ -48,6 +48,8 @@ package Aspects is ...@@ -48,6 +48,8 @@ package Aspects is
Aspect_Alignment, Aspect_Alignment,
Aspect_Bit_Order, Aspect_Bit_Order,
Aspect_Component_Size, Aspect_Component_Size,
Aspect_Default_Component_Value,
Aspect_Default_Value,
Aspect_Dynamic_Predicate, Aspect_Dynamic_Predicate,
Aspect_External_Tag, Aspect_External_Tag,
Aspect_Input, Aspect_Input,
...@@ -162,6 +164,8 @@ package Aspects is ...@@ -162,6 +164,8 @@ package Aspects is
Aspect_Alignment => Expression, Aspect_Alignment => Expression,
Aspect_Bit_Order => Expression, Aspect_Bit_Order => Expression,
Aspect_Component_Size => Expression, Aspect_Component_Size => Expression,
Aspect_Default_Component_Value => Expression,
Aspect_Default_Value => Expression,
Aspect_Dynamic_Predicate => Expression, Aspect_Dynamic_Predicate => Expression,
Aspect_External_Tag => Expression, Aspect_External_Tag => Expression,
Aspect_Input => Name, Aspect_Input => Name,
...@@ -194,74 +198,73 @@ package Aspects is ...@@ -194,74 +198,73 @@ package Aspects is
-- Table Linking Names and Aspect_Id's -- -- Table Linking Names and Aspect_Id's --
----------------------------------------- -----------------------------------------
type Aspect_Entry is record
Nam : Name_Id;
Asp : Aspect_Id;
end record;
-- Table linking aspect names and id's -- Table linking aspect names and id's
Aspect_Names : constant array (Integer range <>) of Aspect_Entry := Aspect_Names : constant array (Aspect_Id) of Name_Id := (
((Name_Ada_2005, Aspect_Ada_2005), No_Aspect => No_Name,
(Name_Ada_2012, Aspect_Ada_2012), Aspect_Ada_2005 => Name_Ada_2005,
(Name_Address, Aspect_Address), Aspect_Ada_2012 => Name_Ada_2012,
(Name_Alignment, Aspect_Alignment), Aspect_Address => Name_Address,
(Name_All_Calls_Remote, Aspect_All_Calls_Remote), Aspect_Alignment => Name_Alignment,
(Name_Atomic, Aspect_Atomic), Aspect_All_Calls_Remote => Name_All_Calls_Remote,
(Name_Atomic_Components, Aspect_Atomic_Components), Aspect_Atomic => Name_Atomic,
(Name_Bit_Order, Aspect_Bit_Order), Aspect_Atomic_Components => Name_Atomic_Components,
(Name_Compiler_Unit, Aspect_Compiler_Unit), Aspect_Bit_Order => Name_Bit_Order,
(Name_Component_Size, Aspect_Component_Size), Aspect_Compiler_Unit => Name_Compiler_Unit,
(Name_Discard_Names, Aspect_Discard_Names), Aspect_Component_Size => Name_Component_Size,
(Name_Dynamic_Predicate, Aspect_Dynamic_Predicate), Aspect_Default_Value => Name_Default_Value,
(Name_Elaborate_Body, Aspect_Elaborate_Body), Aspect_Default_Component_Value => Name_Default_Component_Value,
(Name_External_Tag, Aspect_External_Tag), Aspect_Discard_Names => Name_Discard_Names,
(Name_Favor_Top_Level, Aspect_Favor_Top_Level), Aspect_Dynamic_Predicate => Name_Dynamic_Predicate,
(Name_Inline, Aspect_Inline), Aspect_Elaborate_Body => Name_Elaborate_Body,
(Name_Inline_Always, Aspect_Inline_Always), Aspect_External_Tag => Name_External_Tag,
(Name_Input, Aspect_Input), Aspect_Favor_Top_Level => Name_Favor_Top_Level,
(Name_Invariant, Aspect_Invariant), Aspect_Inline => Name_Inline,
(Name_Machine_Radix, Aspect_Machine_Radix), Aspect_Inline_Always => Name_Inline_Always,
(Name_Object_Size, Aspect_Object_Size), Aspect_Input => Name_Input,
(Name_Output, Aspect_Output), Aspect_Invariant => Name_Invariant,
(Name_Pack, Aspect_Pack), Aspect_Machine_Radix => Name_Machine_Radix,
(Name_Persistent_BSS, Aspect_Persistent_BSS), Aspect_No_Return => Name_No_Return,
(Name_Post, Aspect_Post), Aspect_Object_Size => Name_Object_Size,
(Name_Postcondition, Aspect_Postcondition), Aspect_Output => Name_Output,
(Name_Pre, Aspect_Pre), Aspect_Pack => Name_Pack,
(Name_Precondition, Aspect_Precondition), Aspect_Persistent_BSS => Name_Persistent_BSS,
(Name_Predicate, Aspect_Predicate), Aspect_Post => Name_Post,
(Name_Preelaborable_Initialization, Aspect_Preelaborable_Initialization), Aspect_Postcondition => Name_Postcondition,
(Name_Preelaborate, Aspect_Preelaborate), Aspect_Pre => Name_Pre,
(Name_Preelaborate_05, Aspect_Preelaborate_05), Aspect_Precondition => Name_Precondition,
(Name_Pure, Aspect_Pure), Aspect_Predicate => Name_Predicate,
(Name_Pure_05, Aspect_Pure_05), Aspect_Preelaborable_Initialization => Name_Preelaborable_Initialization,
(Name_Pure_Function, Aspect_Pure_Function), Aspect_Preelaborate => Name_Preelaborate,
(Name_Read, Aspect_Read), Aspect_Preelaborate_05 => Name_Preelaborate_05,
(Name_Remote_Call_Interface, Aspect_Remote_Call_Interface), Aspect_Pure => Name_Pure,
(Name_Remote_Types, Aspect_Remote_Types), Aspect_Pure_05 => Name_Pure_05,
(Name_Shared, Aspect_Shared), Aspect_Pure_Function => Name_Pure_Function,
(Name_Shared_Passive, Aspect_Shared_Passive), Aspect_Read => Name_Read,
(Name_Size, Aspect_Size), Aspect_Remote_Call_Interface => Name_Remote_Call_Interface,
(Name_Static_Predicate, Aspect_Static_Predicate), Aspect_Remote_Types => Name_Remote_Types,
(Name_Storage_Pool, Aspect_Storage_Pool), Aspect_Shared => Name_Shared,
(Name_Storage_Size, Aspect_Storage_Size), Aspect_Shared_Passive => Name_Shared_Passive,
(Name_Stream_Size, Aspect_Stream_Size), Aspect_Size => Name_Size,
(Name_Suppress, Aspect_Suppress), Aspect_Static_Predicate => Name_Static_Predicate,
(Name_Suppress_Debug_Info, Aspect_Suppress_Debug_Info), Aspect_Storage_Pool => Name_Storage_Pool,
(Name_Type_Invariant, Aspect_Type_Invariant), Aspect_Storage_Size => Name_Storage_Size,
(Name_Unchecked_Union, Aspect_Unchecked_Union), Aspect_Stream_Size => Name_Stream_Size,
(Name_Universal_Aliasing, Aspect_Universal_Aliasing), Aspect_Suppress => Name_Suppress,
(Name_Universal_Data, Aspect_Universal_Data), Aspect_Suppress_Debug_Info => Name_Suppress_Debug_Info,
(Name_Unmodified, Aspect_Unmodified), Aspect_Type_Invariant => Name_Type_Invariant,
(Name_Unreferenced, Aspect_Unreferenced), Aspect_Unchecked_Union => Name_Unchecked_Union,
(Name_Unreferenced_Objects, Aspect_Unreferenced_Objects), Aspect_Universal_Aliasing => Name_Universal_Aliasing,
(Name_Unsuppress, Aspect_Unsuppress), Aspect_Universal_Data => Name_Universal_Data,
(Name_Value_Size, Aspect_Value_Size), Aspect_Unmodified => Name_Unmodified,
(Name_Volatile, Aspect_Volatile), Aspect_Unreferenced => Name_Unreferenced,
(Name_Volatile_Components, Aspect_Volatile_Components), Aspect_Unreferenced_Objects => Name_Unreferenced_Objects,
(Name_Warnings, Aspect_Warnings), Aspect_Unsuppress => Name_Unsuppress,
(Name_Write, Aspect_Write)); Aspect_Value_Size => Name_Value_Size,
Aspect_Volatile => Name_Volatile,
Aspect_Volatile_Components => Name_Volatile_Components,
Aspect_Warnings => Name_Warnings,
Aspect_Write => Name_Write);
function Get_Aspect_Id (Name : Name_Id) return Aspect_Id; function Get_Aspect_Id (Name : Name_Id) return Aspect_Id;
pragma Inline (Get_Aspect_Id); pragma Inline (Get_Aspect_Id);
......
gcc/ada/einfo.adb
...@@ -283,6 +283,7 @@ package body Einfo is ...@@ -283,6 +283,7 @@ package body Einfo is
-- Referenced_As_LHS Flag36 -- Referenced_As_LHS Flag36
-- Is_Known_Non_Null Flag37 -- Is_Known_Non_Null Flag37
-- Can_Never_Be_Null Flag38 -- Can_Never_Be_Null Flag38
-- Has_Default_Value Flag39
-- Body_Needed_For_SAL Flag40 -- Body_Needed_For_SAL Flag40
-- Treat_As_Volatile Flag41 -- Treat_As_Volatile Flag41
...@@ -406,6 +407,7 @@ package body Einfo is ...@@ -406,6 +407,7 @@ package body Einfo is
-- Is_Compilation_Unit Flag149 -- Is_Compilation_Unit Flag149
-- Has_Pragma_Elaborate_Body Flag150 -- Has_Pragma_Elaborate_Body Flag150
-- Has_Default_Component_Value Flag151
-- Entry_Accepted Flag152 -- Entry_Accepted Flag152
-- Is_Obsolescent Flag153 -- Is_Obsolescent Flag153
-- Has_Per_Object_Constraint Flag154 -- Has_Per_Object_Constraint Flag154
...@@ -514,8 +516,6 @@ package body Einfo is ...@@ -514,8 +516,6 @@ package body Einfo is
-- Has_Inheritable_Invariants Flag248 -- Has_Inheritable_Invariants Flag248
-- Has_Predicates Flag250 -- Has_Predicates Flag250
-- (unused) Flag39
-- (unused) Flag151
-- (unused) Flag249 -- (unused) Flag249
-- (unused) Flag251 -- (unused) Flag251
-- (unused) Flag252 -- (unused) Flag252
...@@ -1226,6 +1226,18 @@ package body Einfo is ...@@ -1226,6 +1226,18 @@ package body Einfo is
return Flag119 (Id); return Flag119 (Id);
end Has_Convention_Pragma; end Has_Convention_Pragma;
function Has_Default_Component_Value (Id : E) return B is
begin
pragma Assert (Is_Array_Type (Id));
return Flag151 (Base_Type (Id));
end Has_Default_Component_Value;
function Has_Default_Value (Id : E) return B is
begin
pragma Assert (Is_Scalar_Type (Id));
return Flag39 (Base_Type (Id));
end Has_Default_Value;
function Has_Delayed_Aspects (Id : E) return B is function Has_Delayed_Aspects (Id : E) return B is
begin begin
pragma Assert (Nkind (Id) in N_Entity); pragma Assert (Nkind (Id) in N_Entity);
...@@ -3663,6 +3675,18 @@ package body Einfo is ...@@ -3663,6 +3675,18 @@ package body Einfo is
Set_Flag119 (Id, V); Set_Flag119 (Id, V);
end Set_Has_Convention_Pragma; end Set_Has_Convention_Pragma;
procedure Set_Has_Default_Component_Value (Id : E; V : B := True) is
begin
pragma Assert (Is_Array_Type (Id) and then Is_Base_Type (Id));
Set_Flag151 (Id, V);
end Set_Has_Default_Component_Value;
procedure Set_Has_Default_Value (Id : E; V : B := True) is
begin
pragma Assert (Is_Scalar_Type (Id) and then Is_Base_Type (Id));
Set_Flag39 (Id, V);
end Set_Has_Default_Value;
procedure Set_Has_Delayed_Aspects (Id : E; V : B := True) is procedure Set_Has_Delayed_Aspects (Id : E; V : B := True) is
begin begin
pragma Assert (Nkind (Id) in N_Entity); pragma Assert (Nkind (Id) in N_Entity);
...@@ -7326,6 +7350,8 @@ package body Einfo is ...@@ -7326,6 +7350,8 @@ package body Einfo is
W ("Has_Controlled_Component", Flag43 (Id)); W ("Has_Controlled_Component", Flag43 (Id));
W ("Has_Controlling_Result", Flag98 (Id)); W ("Has_Controlling_Result", Flag98 (Id));
W ("Has_Convention_Pragma", Flag119 (Id)); W ("Has_Convention_Pragma", Flag119 (Id));
W ("Has_Default_Component_Value", Flag151 (Id));
W ("Has_Default_Value", Flag39 (Id));
W ("Has_Delayed_Aspects", Flag200 (Id)); W ("Has_Delayed_Aspects", Flag200 (Id));
W ("Has_Delayed_Freeze", Flag18 (Id)); W ("Has_Delayed_Freeze", Flag18 (Id));
W ("Has_Discriminants", Flag5 (Id)); W ("Has_Discriminants", Flag5 (Id));
......
gcc/ada/einfo.ads
...@@ -1428,6 +1428,18 @@ package Einfo is ...@@ -1428,6 +1428,18 @@ package Einfo is
-- node must be generated for the entity at its freezing point. See -- node must be generated for the entity at its freezing point. See
-- separate section ("Delayed Freezing and Elaboration") for details. -- separate section ("Delayed Freezing and Elaboration") for details.
-- Has_Default_Component_Value (Flag151) [root type only]
-- Present in array types. Set on a base type to indicate that the base
-- type and all its subtypes have a Default_Component_Value aspect. If
-- this flag is True, then there will be a pragma Default_Component_Value
-- chained to the Rep_Item list for the base type.
-- Has_Default_Value (Flag39) [base type only]
-- Present in scalar types. Set on a base type to indicate that the base
-- type and all its subtypes have a Default_Value aspect. If this flag is
-- True, then there will always be a pragma Default_Value chained to the
-- Rep_Item list for the base type.
-- Has_Discriminants (Flag5) -- Has_Discriminants (Flag5)
-- Present in all types and subtypes. For types that are allowed to have -- Present in all types and subtypes. For types that are allowed to have
-- discriminants (record types and subtypes, task types and subtypes, -- discriminants (record types and subtypes, task types and subtypes,
...@@ -3099,12 +3111,12 @@ package Einfo is ...@@ -3099,12 +3111,12 @@ package Einfo is
-- interpreted as true. Currently this is set true for derived Boolean -- interpreted as true. Currently this is set true for derived Boolean
-- types which have a convention of C, C++ or Fortran. -- types which have a convention of C, C++ or Fortran.
-- No_Pool_Assigned (Flag131) [root type only] Present in access types. -- No_Pool_Assigned (Flag131) [root type only]
-- Set if a storage size clause applies to the variable with a static -- Present in access types. Set if a storage size clause applies to the
-- expression value of zero. This flag is used to generate errors if any -- variable with a static expression value of zero. This flag is used to
-- attempt is made to allocate or free an instance of such an access -- generate errors if any attempt is made to allocate or free an instance
-- type. This is set only in the root type, since derived types must -- of such an access type. This is set only in the root type, since
-- have the same pool. -- derived types must have the same pool.
-- No_Return (Flag113) -- No_Return (Flag113)
-- Present in all entities. Always false except in the case of procedures -- Present in all entities. Always false except in the case of procedures
...@@ -4902,6 +4914,7 @@ package Einfo is ...@@ -4902,6 +4914,7 @@ package Einfo is
-- Packed_Array_Type (Node23) -- Packed_Array_Type (Node23)
-- Component_Alignment (special) (base type only) -- Component_Alignment (special) (base type only)
-- Has_Component_Size_Clause (Flag68) (base type only) -- Has_Component_Size_Clause (Flag68) (base type only)
-- Has_Default_Component_Value (Flag151) (base type only)
-- Is_Aliased (Flag15) -- Is_Aliased (Flag15)
-- Is_Constrained (Flag12) -- Is_Constrained (Flag12)
-- Next_Index (synth) -- Next_Index (synth)
...@@ -5001,6 +5014,7 @@ package Einfo is ...@@ -5001,6 +5014,7 @@ package Einfo is
-- Scalar_Range (Node20) -- Scalar_Range (Node20)
-- Delta_Value (Ureal18) -- Delta_Value (Ureal18)
-- Small_Value (Ureal21) -- Small_Value (Ureal21)
-- Has_Default_Value (Flag39) (base type only)
-- Has_Machine_Radix_Clause (Flag83) -- Has_Machine_Radix_Clause (Flag83)
-- Machine_Radix_10 (Flag84) -- Machine_Radix_10 (Flag84)
-- Aft_Value (synth) -- Aft_Value (synth)
...@@ -5077,6 +5091,7 @@ package Einfo is ...@@ -5077,6 +5091,7 @@ package Einfo is
-- Static_Predicate (List25) -- Static_Predicate (List25)
-- Has_Biased_Representation (Flag139) -- Has_Biased_Representation (Flag139)
-- Has_Contiguous_Rep (Flag181) -- Has_Contiguous_Rep (Flag181)
-- Has_Default_Value (Flag39) (base type only)
-- Has_Enumeration_Rep_Clause (Flag66) -- Has_Enumeration_Rep_Clause (Flag66)
-- Has_Pragma_Ordered (Flag198) (base type only) -- Has_Pragma_Ordered (Flag198) (base type only)
-- Nonzero_Is_True (Flag162) (base type only) -- Nonzero_Is_True (Flag162) (base type only)
...@@ -5103,6 +5118,8 @@ package Einfo is ...@@ -5103,6 +5118,8 @@ package Einfo is
-- E_Floating_Point_Subtype -- E_Floating_Point_Subtype
-- Digits_Value (Uint17) -- Digits_Value (Uint17)
-- Float_Rep (Uint10) (Float_Rep_Kind) -- Float_Rep (Uint10) (Float_Rep_Kind)
-- Scalar_Range (Node20)
-- Has_Default_Value (Flag39) (base type only)
-- Machine_Emax_Value (synth) -- Machine_Emax_Value (synth)
-- Machine_Emin_Value (synth) -- Machine_Emin_Value (synth)
-- Machine_Mantissa_Value (synth) -- Machine_Mantissa_Value (synth)
...@@ -5114,7 +5131,6 @@ package Einfo is ...@@ -5114,7 +5131,6 @@ package Einfo is
-- Safe_Emax_Value (synth) -- Safe_Emax_Value (synth)
-- Safe_First_Value (synth) -- Safe_First_Value (synth)
-- Safe_Last_Value (synth) -- Safe_Last_Value (synth)
-- Scalar_Range (Node20)
-- Type_Low_Bound (synth) -- Type_Low_Bound (synth)
-- Type_High_Bound (synth) -- Type_High_Bound (synth)
-- Vax_Float (synth) -- Vax_Float (synth)
...@@ -5278,6 +5294,7 @@ package Einfo is ...@@ -5278,6 +5294,7 @@ package Einfo is
-- Static_Predicate (List25) -- Static_Predicate (List25)
-- Non_Binary_Modulus (Flag58) (base type only) -- Non_Binary_Modulus (Flag58) (base type only)
-- Has_Biased_Representation (Flag139) -- Has_Biased_Representation (Flag139)
-- Has_Default_Value (Flag39) (base type only)
-- Type_Low_Bound (synth) -- Type_Low_Bound (synth)
-- Type_High_Bound (synth) -- Type_High_Bound (synth)
-- (plus type attributes) -- (plus type attributes)
...@@ -5308,6 +5325,7 @@ package Einfo is ...@@ -5308,6 +5325,7 @@ package Einfo is
-- Delta_Value (Ureal18) -- Delta_Value (Ureal18)
-- Scalar_Range (Node20) -- Scalar_Range (Node20)
-- Small_Value (Ureal21) -- Small_Value (Ureal21)
-- Has_Default_Value (Flag39) (base type only)
-- Has_Small_Clause (Flag67) -- Has_Small_Clause (Flag67)
-- Aft_Value (synth) -- Aft_Value (synth)
-- Type_Low_Bound (synth) -- Type_Low_Bound (synth)
...@@ -5544,6 +5562,7 @@ package Einfo is ...@@ -5544,6 +5562,7 @@ package Einfo is
-- Scalar_Range (Node20) -- Scalar_Range (Node20)
-- Static_Predicate (List25) -- Static_Predicate (List25)
-- Has_Biased_Representation (Flag139) -- Has_Biased_Representation (Flag139)
-- Has_Default_Value (Flag39) (base type only)
-- Type_Low_Bound (synth) -- Type_Low_Bound (synth)
-- Type_High_Bound (synth) -- Type_High_Bound (synth)
-- (plus type attributes) -- (plus type attributes)
...@@ -5993,6 +6012,8 @@ package Einfo is ...@@ -5993,6 +6012,8 @@ package Einfo is
function Has_Controlled_Component (Id : E) return B; function Has_Controlled_Component (Id : E) return B;
function Has_Controlling_Result (Id : E) return B; function Has_Controlling_Result (Id : E) return B;
function Has_Convention_Pragma (Id : E) return B; function Has_Convention_Pragma (Id : E) return B;
function Has_Default_Component_Value (Id : E) return B;
function Has_Default_Value (Id : E) return B;
function Has_Delayed_Aspects (Id : E) return B; function Has_Delayed_Aspects (Id : E) return B;
function Has_Delayed_Freeze (Id : E) return B; function Has_Delayed_Freeze (Id : E) return B;
function Has_Discriminants (Id : E) return B; function Has_Discriminants (Id : E) return B;
...@@ -6573,6 +6594,8 @@ package Einfo is ...@@ -6573,6 +6594,8 @@ package Einfo is
procedure Set_Has_Controlled_Component (Id : E; V : B := True); procedure Set_Has_Controlled_Component (Id : E; V : B := True);
procedure Set_Has_Controlling_Result (Id : E; V : B := True); procedure Set_Has_Controlling_Result (Id : E; V : B := True);
procedure Set_Has_Convention_Pragma (Id : E; V : B := True); procedure Set_Has_Convention_Pragma (Id : E; V : B := True);
procedure Set_Has_Default_Component_Value (Id : E; V : B := True);
procedure Set_Has_Default_Value (Id : E; V : B := True);
procedure Set_Has_Delayed_Aspects (Id : E; V : B := True); procedure Set_Has_Delayed_Aspects (Id : E; V : B := True);
procedure Set_Has_Delayed_Freeze (Id : E; V : B := True); procedure Set_Has_Delayed_Freeze (Id : E; V : B := True);
procedure Set_Has_Discriminants (Id : E; V : B := True); procedure Set_Has_Discriminants (Id : E; V : B := True);
...@@ -7262,6 +7285,8 @@ package Einfo is ...@@ -7262,6 +7285,8 @@ package Einfo is
pragma Inline (Has_Controlled_Component); pragma Inline (Has_Controlled_Component);
pragma Inline (Has_Controlling_Result); pragma Inline (Has_Controlling_Result);
pragma Inline (Has_Convention_Pragma); pragma Inline (Has_Convention_Pragma);
pragma Inline (Has_Default_Component_Value);
pragma Inline (Has_Default_Value);
pragma Inline (Has_Delayed_Aspects); pragma Inline (Has_Delayed_Aspects);
pragma Inline (Has_Delayed_Freeze); pragma Inline (Has_Delayed_Freeze);
pragma Inline (Has_Discriminants); pragma Inline (Has_Discriminants);
...@@ -7698,6 +7723,8 @@ package Einfo is ...@@ -7698,6 +7723,8 @@ package Einfo is
pragma Inline (Set_Has_Controlled_Component); pragma Inline (Set_Has_Controlled_Component);
pragma Inline (Set_Has_Controlling_Result); pragma Inline (Set_Has_Controlling_Result);
pragma Inline (Set_Has_Convention_Pragma); pragma Inline (Set_Has_Convention_Pragma);
pragma Inline (Set_Has_Default_Component_Value);
pragma Inline (Set_Has_Default_Value);
pragma Inline (Set_Has_Delayed_Aspects); pragma Inline (Set_Has_Delayed_Aspects);
pragma Inline (Set_Has_Delayed_Freeze); pragma Inline (Set_Has_Delayed_Freeze);
pragma Inline (Set_Has_Discriminants); pragma Inline (Set_Has_Discriminants);
......
gcc/ada/i-cstrin.ads
...@@ -45,8 +45,9 @@ package Interfaces.C.Strings is ...@@ -45,8 +45,9 @@ package Interfaces.C.Strings is
-- strict aliasing assumptions for this type. -- strict aliasing assumptions for this type.
type chars_ptr is private; type chars_ptr is private;
pragma Preelaborable_Initialization (chars_ptr);
type chars_ptr_array is array (size_t range <>) of chars_ptr; type chars_ptr_array is array (size_t range <>) of aliased chars_ptr;
Null_Ptr : constant chars_ptr; Null_Ptr : constant chars_ptr;
......
gcc/ada/mlib-prj.adb
...@@ -73,23 +73,26 @@ package body MLib.Prj is ...@@ -73,23 +73,26 @@ package body MLib.Prj is
-- Name_Id for "g-trasym.ads" -- Name_Id for "g-trasym.ads"
Arguments : String_List_Access := No_Argument; Arguments : String_List_Access := No_Argument;
-- Used to accumulate arguments for the invocation of gnatbind and of -- Used to accumulate arguments for the invocation of gnatbind and of the
-- the compiler. Also used to collect the interface ALI when copying -- compiler. Also used to collect the interface ALI when copying the ALI
-- the ALI files to the library directory. -- files to the library directory.
Argument_Number : Natural := 0; Argument_Number : Natural := 0;
-- Index of the last argument in Arguments -- Index of the last argument in Arguments
Initial_Argument_Max : constant := 10; Initial_Argument_Max : constant := 10;
-- Where does the magic constant 10 come from???
No_Main_String : aliased String := "-n"; No_Main_String : aliased String := "-n";
No_Main : constant String_Access := No_Main_String'Access; No_Main : constant String_Access := No_Main_String'Access;
Output_Switch_String : aliased String := "-o"; Output_Switch_String : aliased String := "-o";
Output_Switch : constant String_Access := Output_Switch_String'Access; Output_Switch : constant String_Access :=
Output_Switch_String'Access;
Compile_Switch_String : aliased String := "-c"; Compile_Switch_String : aliased String := "-c";
Compile_Switch : constant String_Access := Compile_Switch_String'Access; Compile_Switch : constant String_Access :=
Compile_Switch_String'Access;
No_Warning_String : aliased String := "-gnatws"; No_Warning_String : aliased String := "-gnatws";
No_Warning : constant String_Access := No_Warning_String'Access; No_Warning : constant String_Access := No_Warning_String'Access;
...@@ -296,27 +299,24 @@ package body MLib.Prj is ...@@ -296,27 +299,24 @@ package body MLib.Prj is
is is
Maximum_Size : Integer; Maximum_Size : Integer;
pragma Import (C, Maximum_Size, "__gnat_link_max"); pragma Import (C, Maximum_Size, "__gnat_link_max");
-- Maximum number of bytes to put in an invocation of the -- Maximum number of bytes to put in an invocation of gnatbind
-- gnatbind.
Size : Integer; Size : Integer;
-- The number of bytes for the invocation of the gnatbind -- The number of bytes for the invocation of gnatbind
Warning_For_Library : Boolean := False; Warning_For_Library : Boolean := False;
-- Set to True for the first warning about a unit missing from the -- Set True for first warning for a unit missing from the interface set
-- interface set.
Current_Proj : Project_Id; Current_Proj : Project_Id;
Libgnarl_Needed : Yes_No_Unknown := For_Project.Libgnarl_Needed; Libgnarl_Needed : Yes_No_Unknown := For_Project.Libgnarl_Needed;
-- Set to True if library needs to be linked with libgnarl -- Set True if library needs to be linked with libgnarl
Libdecgnat_Needed : Boolean := False; Libdecgnat_Needed : Boolean := False;
-- On OpenVMS, set to True if library needs to be linked with libdecgnat -- On OpenVMS, set True if library needs to be linked with libdecgnat
Gtrasymobj_Needed : Boolean := False; Gtrasymobj_Needed : Boolean := False;
-- On OpenVMS, set to True if library needs to be linked with -- On OpenVMS, set rue if library needs to be linked with g-trasym.obj
-- g-trasym.obj.
Object_Directory_Path : constant String := Object_Directory_Path : constant String :=
Get_Name_String Get_Name_String
...@@ -354,15 +354,14 @@ package body MLib.Prj is ...@@ -354,15 +354,14 @@ package body MLib.Prj is
-- Initial size of Rpath, when first allocated -- Initial size of Rpath, when first allocated
Path_Option : String_Access := Linker_Library_Path_Option; Path_Option : String_Access := Linker_Library_Path_Option;
-- If null, Path Option is not supported. -- If null, Path Option is not supported. Not a constant so that it can
-- Not a constant so that it can be deallocated. -- be deallocated.
First_ALI : File_Name_Type := No_File; First_ALI : File_Name_Type := No_File;
-- Store the ALI file name of a source of the library (the first found) -- Store the ALI file name of a source of the library (the first found)
procedure Add_ALI_For (Source : File_Name_Type); procedure Add_ALI_For (Source : File_Name_Type);
-- Add the name of the ALI file corresponding to Source to the -- Add name of the ALI file corresponding to Source to the Arguments
-- Arguments.
procedure Add_Rpath (Path : String); procedure Add_Rpath (Path : String);
-- Add a path name to Rpath -- Add a path name to Rpath
...@@ -375,8 +374,8 @@ package body MLib.Prj is ...@@ -375,8 +374,8 @@ package body MLib.Prj is
-- to link with -lgnarl (this is the case when there is a dependency -- to link with -lgnarl (this is the case when there is a dependency
-- on s-osinte.ads). On OpenVMS, set Libdecgnat_Needed if the ALI file -- on s-osinte.ads). On OpenVMS, set Libdecgnat_Needed if the ALI file
-- indicates that there is a need to link with -ldecgnat (this is the -- indicates that there is a need to link with -ldecgnat (this is the
-- case when there is a dependency on dec.ads), and set -- case when there is a dependency on dec.ads). Set Gtrasymobj_Needed
-- Gtrasymobj_Needed if there is a dependency on g-trasym.ads. -- if there is a dependency on g-trasym.ads.
procedure Process (The_ALI : File_Name_Type); procedure Process (The_ALI : File_Name_Type);
-- Check if the closure of a library unit which is or should be in the -- Check if the closure of a library unit which is or should be in the
...@@ -914,8 +913,8 @@ package body MLib.Prj is ...@@ -914,8 +913,8 @@ package body MLib.Prj is
In_Tree.Packages.Table In_Tree.Packages.Table
(Binder_Package).Decl.Arrays, (Binder_Package).Decl.Arrays,
In_Tree => In_Tree); In_Tree => In_Tree);
Switches : Variable_Value := Nil_Variable_Value;
Switches : Variable_Value := Nil_Variable_Value;
Switch : String_List_Id := Nil_String; Switch : String_List_Id := Nil_String;
begin begin
...@@ -1180,8 +1179,7 @@ package body MLib.Prj is ...@@ -1180,8 +1179,7 @@ package body MLib.Prj is
-- Invoke <gcc> -c b__<lib>.adb -- Invoke <gcc> -c b__<lib>.adb
-- Allocate Arguments, if it is the first time we see a standalone -- Allocate Arguments, if first time we see a standalone library
-- library.
if Arguments = No_Argument then if Arguments = No_Argument then
Arguments := new String_List (1 .. Initial_Argument_Max); Arguments := new String_List (1 .. Initial_Argument_Max);
...@@ -1247,8 +1245,7 @@ package body MLib.Prj is ...@@ -1247,8 +1245,7 @@ package body MLib.Prj is
end; end;
end if; end if;
-- Now that all the arguments are set, compile the binder -- Now all the arguments are set, compile binder generated file
-- generated file.
Display (Gcc); Display (Gcc);
Spawn Spawn
...@@ -1277,8 +1274,7 @@ package body MLib.Prj is ...@@ -1277,8 +1274,7 @@ package body MLib.Prj is
Driver_Name := Name_Id (For_Project.Config.Shared_Lib_Driver); Driver_Name := Name_Id (For_Project.Config.Shared_Lib_Driver);
end if; end if;
-- If attribute Library_Options was specified, add these additional -- If attribute Library_Options was specified, add these options
-- options.
Library_Options := Value_Of Library_Options := Value_Of
(Name_Library_Options, For_Project.Decl.Attributes, In_Tree); (Name_Library_Options, For_Project.Decl.Attributes, In_Tree);
...@@ -1353,7 +1349,7 @@ package body MLib.Prj is ...@@ -1353,7 +1349,7 @@ package body MLib.Prj is
loop loop
if Current_Proj.Object_Directory /= No_Path_Information then if Current_Proj.Object_Directory /= No_Path_Information then
-- The following code gets far too indented, I suggest some -- The following code gets far too indented ... suggest some
-- procedural abstraction here. How about making this declare -- procedural abstraction here. How about making this declare
-- block a named procedure??? -- block a named procedure???
...@@ -1557,8 +1553,7 @@ package body MLib.Prj is ...@@ -1557,8 +1553,7 @@ package body MLib.Prj is
Opts.Increment_Last; Opts.Increment_Last;
Opts.Table (Opts.Last) := new String'("-L" & Lib_Directory); Opts.Table (Opts.Last) := new String'("-L" & Lib_Directory);
-- If Path Option is supported, add libgnat directory path name to -- If Path Option supported, add libgnat directory path name to Rpath
-- Rpath.
if Path_Option /= null then if Path_Option /= null then
declare declare
......
gcc/ada/par-ch13.adb
...@@ -427,9 +427,9 @@ package body Ch13 is ...@@ -427,9 +427,9 @@ package body Ch13 is
-- Check bad spelling -- Check bad spelling
for J in Aspect_Names'Range loop for J in Aspect_Id loop
if Is_Bad_Spelling_Of (Token_Name, Aspect_Names (J).Nam) then if Is_Bad_Spelling_Of (Token_Name, Aspect_Names (J)) then
Error_Msg_Name_1 := Aspect_Names (J).Nam; Error_Msg_Name_1 := Aspect_Names (J);
Error_Msg_SC -- CODEFIX Error_Msg_SC -- CODEFIX
("\possible misspelling of%"); ("\possible misspelling of%");
exit; exit;
......
gcc/ada/par-prag.adb
...@@ -1142,6 +1142,8 @@ begin ...@@ -1142,6 +1142,8 @@ begin
Pragma_Controlled | Pragma_Controlled |
Pragma_Convention | Pragma_Convention |
Pragma_Debug_Policy | Pragma_Debug_Policy |
Pragma_Default_Value |
Pragma_Default_Component_Value |
Pragma_Detect_Blocking | Pragma_Detect_Blocking |
Pragma_Default_Storage_Pool | Pragma_Default_Storage_Pool |
Pragma_Dimension | Pragma_Dimension |
......
gcc/ada/restrict.ads
...@@ -220,10 +220,10 @@ package Restrict is ...@@ -220,10 +220,10 @@ package Restrict is
-- message is posted on the node given as argument. -- message is posted on the node given as argument.
procedure Check_Formal_Restriction (Msg : String; N : Node_Id); procedure Check_Formal_Restriction (Msg : String; N : Node_Id);
-- Provides a wrappper on Error_Msg_F which prepends the special characters -- Node N represents a construct not allowed in formal mode. If this is a
-- "|~~" (error not serious, language prepended) provided the current mode -- source node, then an error is issued on N (using Err_Msg_F), prepending
-- is formal verification and the node N comes originally from source. -- "|~~" (error not serious, language prepended). Call has no effect if
-- Otherwise, does nothing. -- not in formal mode, or if N does not come originally from source.
procedure Check_Implicit_Dynamic_Code_Allowed (N : Node_Id); procedure Check_Implicit_Dynamic_Code_Allowed (N : Node_Id);
-- Tests to see if dynamic code generation (dynamically generated -- Tests to see if dynamic code generation (dynamically generated
......
gcc/ada/sem_aggr.adb
...@@ -805,11 +805,13 @@ package body Sem_Aggr is ...@@ -805,11 +805,13 @@ package body Sem_Aggr is
procedure Check_Qualified_Aggregate (Level : Nat; Expr : Node_Id) is procedure Check_Qualified_Aggregate (Level : Nat; Expr : Node_Id) is
Comp_Expr : Node_Id; Comp_Expr : Node_Id;
Comp_Assn : Node_Id; Comp_Assn : Node_Id;
begin begin
if Level = 0 then if Level = 0 then
if Nkind (Parent (Expr)) /= N_Qualified_Expression then if Nkind (Parent (Expr)) /= N_Qualified_Expression then
Check_Formal_Restriction ("aggregate should be qualified", Expr); Check_Formal_Restriction ("aggregate should be qualified", Expr);
end if; end if;
else else
Comp_Expr := First (Expressions (Expr)); Comp_Expr := First (Expressions (Expr));
while Present (Comp_Expr) loop while Present (Comp_Expr) loop
......
gcc/ada/sem_ch13.adb
...@@ -982,7 +982,31 @@ package body Sem_Ch13 is ...@@ -982,7 +982,31 @@ package body Sem_Ch13 is
-- Aspects corresponding to pragmas with two arguments, where -- Aspects corresponding to pragmas with two arguments, where
-- the first argument is a local name referring to the entity, -- the first argument is a local name referring to the entity,
-- and the second argument is the aspect definition expression. -- and the second argument is the aspect definition expression
-- which is an expression which must be delayed and analyzed.
when Aspect_Default_Component_Value |
Aspect_Default_Value =>
-- Construct the pragma
Aitem :=
Make_Pragma (Loc,
Pragma_Argument_Associations => New_List (
New_Occurrence_Of (E, Eloc),
Relocate_Node (Expr)),
Pragma_Identifier =>
Make_Identifier (Sloc (Id), Chars (Id)));
-- These aspects do require delaying
Delay_Required := True;
Set_Is_Delayed_Aspect (Aspect);
-- Aspects corresponding to pragmas with two arguments, where
-- the first argument is a local name referring to the entity,
-- and the second argument is the aspect definition expression
-- which is an expression that does not get analyzed.
when Aspect_Suppress | when Aspect_Suppress |
Aspect_Unsuppress => Aspect_Unsuppress =>
...@@ -5209,13 +5233,18 @@ package body Sem_Ch13 is ...@@ -5209,13 +5233,18 @@ package body Sem_Ch13 is
when Library_Unit_Aspects => when Library_Unit_Aspects =>
raise Program_Error; raise Program_Error;
-- Aspects taking an optional boolean argument. Note that we will -- Aspects taking an optional boolean argument. Should be impossible
-- never be called with an empty expression, because such aspects -- since these are never delayed.
-- never need to be delayed anyway.
when Boolean_Aspects => when Boolean_Aspects =>
pragma Assert (Present (Expression (ASN))); raise Program_Error;
T := Standard_Boolean;
-- Default_Value and Default_Component_Value are resolved with
-- the entity, which is the type in question.
when Aspect_Default_Component_Value |
Aspect_Default_Value =>
T := Entity (ASN);
-- Aspects corresponding to attribute definition clauses -- Aspects corresponding to attribute definition clauses
......
gcc/ada/sem_prag.adb
...@@ -7266,6 +7266,139 @@ package body Sem_Prag is ...@@ -7266,6 +7266,139 @@ package body Sem_Prag is
Debug_Pragmas_Enabled := Debug_Pragmas_Enabled :=
Chars (Get_Pragma_Arg (Arg1)) = Name_Check; Chars (Get_Pragma_Arg (Arg1)) = Name_Check;
-----------------------------
-- Default_Component_Value --
-----------------------------
when Pragma_Default_Component_Value => declare
Arg : Node_Id;
E : Entity_Id;
begin
GNAT_Pragma;
Check_Arg_Count (2);
Check_Arg_Is_Local_Name (Arg1);
Arg := Get_Pragma_Arg (Arg1);
Analyze (Arg);
if Etype (Arg) = Any_Type then
return;
end if;
if not Is_Entity_Name (Arg)
or else not Is_Array_Type (Entity (Arg))
then
Error_Pragma_Arg ("pragma% requires an array type", Arg1);
end if;
Check_First_Subtype (Arg1);
E := Entity (Arg);
Check_Duplicate_Pragma (E);
-- Check for rep item too early or too late, but skip this if
-- the pragma comes from the corresponding aspect, since we do
-- not need the checks, and more importantly, the pragma is on
-- the rep item chain alreay, and must not be put there twice!
if not From_Aspect_Specification (N) then
if Rep_Item_Too_Early (E, N)
or else
Rep_Item_Too_Late (E, N)
then
return;
end if;
end if;
-- Analyze the default value
Arg := Get_Pragma_Arg (Arg2);
Analyze_And_Resolve (Arg, Component_Type (E));
if not Is_OK_Static_Expression (Arg) then
Flag_Non_Static_Expr
("non-static expression not allowed for " &
"Default_Component_Value",
Arg2);
raise Pragma_Exit;
end if;
-- Set the flag on the root type and then check for Rep_Item too
-- early or too late, the latter call chains the pragma onto the
-- Rep_Item chain.
Set_Has_Default_Component_Value (Base_Type (E));
end;
-------------------
-- Default_Value --
-------------------
when Pragma_Default_Value => declare
Arg : Node_Id;
E : Entity_Id;
begin
-- Error checks
GNAT_Pragma;
Check_Arg_Count (2);
Check_Arg_Is_Local_Name (Arg1);
Arg := Get_Pragma_Arg (Arg1);
Analyze (Arg);
if Etype (Arg) = Any_Type then
return;
end if;
if not Is_Entity_Name (Arg)
or else not Is_Scalar_Type (Entity (Arg))
then
Error_Pragma_Arg ("pragma% requires a scalar type", Arg1);
end if;
Check_First_Subtype (Arg1);
E := Entity (Arg);
Check_Duplicate_Pragma (E);
-- Check for rep item too early or too late, but skip this if
-- the pragma comes from the corresponding aspect, since we do
-- not need the checks, and more importantly, the pragma is on
-- the rep item chain alreay, and must not be put there twice!
if not From_Aspect_Specification (N) then
if Rep_Item_Too_Early (E, N)
or else
Rep_Item_Too_Late (E, N)
then
return;
end if;
end if;
-- Analyze the default value. Note that we must do that after
-- checking for Rep_Item_Too_Late since this resolution will
-- freeze the type involved.
Arg := Get_Pragma_Arg (Arg2);
Analyze_And_Resolve (Arg, E);
if not Is_OK_Static_Expression (Arg) then
Flag_Non_Static_Expr
("non-static expression not allowed for Default_Value",
Arg2);
raise Pragma_Exit;
end if;
-- Set the flag on the root type and then check for Rep_Item too
-- early or too late, the latter call chains the pragma onto the
-- Rep_Item chain.
Set_Has_Default_Value (Base_Type (E));
end;
--------------------- ---------------------
-- Detect_Blocking -- -- Detect_Blocking --
--------------------- ---------------------
...@@ -13910,6 +14043,8 @@ package body Sem_Prag is ...@@ -13910,6 +14043,8 @@ package body Sem_Prag is
Pragma_Convention_Identifier => 0, Pragma_Convention_Identifier => 0,
Pragma_Debug => -1, Pragma_Debug => -1,
Pragma_Debug_Policy => 0, Pragma_Debug_Policy => 0,
Pragma_Default_Value => -1,
Pragma_Default_Component_Value => -1,
Pragma_Detect_Blocking => -1, Pragma_Detect_Blocking => -1,
Pragma_Default_Storage_Pool => -1, Pragma_Default_Storage_Pool => -1,
Pragma_Dimension => -1, Pragma_Dimension => -1,
......
gcc/ada/snames.ads-tmpl
...@@ -448,6 +448,8 @@ package Snames is ...@@ -448,6 +448,8 @@ package Snames is
Name_CPP_Vtable : constant Name_Id := N + $; -- GNAT Name_CPP_Vtable : constant Name_Id := N + $; -- GNAT
Name_CPU : constant Name_Id := N + $; -- Ada 12 Name_CPU : constant Name_Id := N + $; -- Ada 12
Name_Debug : constant Name_Id := N + $; -- GNAT Name_Debug : constant Name_Id := N + $; -- GNAT
Name_Default_Value : constant Name_Id := N + $; -- GNAT
Name_Default_Component_Value : constant Name_Id := N + $; -- GNAT
Name_Dimension : constant Name_Id := N + $; -- GNAT Name_Dimension : constant Name_Id := N + $; -- GNAT
Name_Elaborate : constant Name_Id := N + $; -- Ada 83 Name_Elaborate : constant Name_Id := N + $; -- Ada 83
Name_Elaborate_All : constant Name_Id := N + $; Name_Elaborate_All : constant Name_Id := N + $;
...@@ -1554,6 +1556,8 @@ package Snames is ...@@ -1554,6 +1556,8 @@ package Snames is
Pragma_CPP_Vtable, Pragma_CPP_Vtable,
Pragma_CPU, Pragma_CPU,
Pragma_Debug, Pragma_Debug,
Pragma_Default_Value,
Pragma_Default_Component_Value,
Pragma_Dimension, Pragma_Dimension,
Pragma_Elaborate, Pragma_Elaborate,
Pragma_Elaborate_All, Pragma_Elaborate_All,
......
gcc/ada/sprint.adb
...@@ -1062,8 +1062,15 @@ package body Sprint is ...@@ -1062,8 +1062,15 @@ package body Sprint is
Write_Str_Sloc (" and then "); Write_Str_Sloc (" and then ");
Sprint_Right_Opnd (Node); Sprint_Right_Opnd (Node);
-- Note: the following code for N_Aspect_Specification is not
-- normally used, since we deal with aspects as part of a
-- declaration, but it is here in case we deliberately try
-- to print an N_Aspect_Speficiation node (e.g. from GDB).
when N_Aspect_Specification => when N_Aspect_Specification =>
raise Program_Error; Sprint_Node (Identifier (Node));
Write_Str (" => ");
Sprint_Node (Expression (Node));
when N_Assignment_Statement => when N_Assignment_Statement =>
Write_Indent; Write_Indent;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment