This is some preliminary checkins for aspect Unimplemented. No
functionality yet, so no test.
Tested on x86_64-pc-linux-gnu, committed on trunk
2015-03-13 Robert Dewar <de...@adacore.com>
* aspects.ads, aspects.adb: Add entries for aspect Unimplemented.
* einfo.ads, einfo.adb (Is_Unimplemented): New flag.
* sem_ch13.adb: Add dummy entry for aspect Unimplemented.
* snames.ads-tmpl: Add entry for Name_Unimplemented.
Index: einfo.adb
===================================================================
--- einfo.adb (revision 221417)
+++ einfo.adb (working copy)
@@ -584,8 +584,8 @@
-- Is_Static_Type Flag281
-- Has_Nested_Subprogram Flag282
-- Uplevel_Reference_Noted Flag283
+ -- Is_Unimplemented Flag284
- -- (unused) Flag284
-- (unused) Flag285
-- (unused) Flag286
-- (unused) Flag287
@@ -2456,6 +2456,11 @@
return Flag246 (Id);
end Is_Underlying_Record_View;
+ function Is_Unimplemented (Id : E) return B is
+ begin
+ return Flag284 (Id);
+ end Is_Unimplemented;
+
function Is_Unsigned_Type (Id : E) return B is
begin
pragma Assert (Is_Type (Id));
@@ -5398,6 +5403,11 @@
Set_Flag246 (Id, V);
end Set_Is_Underlying_Record_View;
+ procedure Set_Is_Unimplemented (Id : E; V : B := True) is
+ begin
+ Set_Flag284 (Id, V);
+ end Set_Is_Unimplemented;
+
procedure Set_Is_Unsigned_Type (Id : E; V : B := True) is
begin
pragma Assert (Is_Discrete_Or_Fixed_Point_Type (Id));
@@ -8767,6 +8777,7 @@
W ("Is_True_Constant", Flag163 (Id));
W ("Is_Unchecked_Union", Flag117 (Id));
W ("Is_Underlying_Record_View", Flag246 (Id));
+ W ("Is_Unimplemented", Flag284 (Id));
W ("Is_Unsigned_Type", Flag144 (Id));
W ("Is_Valued_Procedure", Flag127 (Id));
W ("Is_Visible_Formal", Flag206 (Id));
Index: einfo.ads
===================================================================
--- einfo.ads (revision 221417)
+++ einfo.ads (working copy)
@@ -2745,8 +2745,8 @@
-- including generic formal parameters.
-- Is_Obsolescent (Flag153)
--- Defined in all entities. Set for any entity for which a valid pragma
--- Obsolescent applies.
+-- Defined in all entities. Set for any entity to which a valid pragma
+-- or aspect Obsolescent applies.
-- Is_Only_Out_Parameter (Flag226)
-- Defined in formal parameter entities. Set if this parameter is the
@@ -3090,6 +3090,10 @@
-- as its corresponding record type, but whose parent is the full view
-- of the parent in the original type extension.
+-- Is_Unimplemented (Flag284)
+-- Defined in all entities. Set for any entity to which a valid pragma
+-- or aspect Unimplemented applies.
+
-- Is_Unsigned_Type (Flag144)
-- Defined in all types, but can be set only for discrete and fixed-point
-- type and subtype entities. This flag is only valid if the entity is
@@ -5299,6 +5303,7 @@
-- Is_Thunk (Flag225)
-- Is_Trivial_Subprogram (Flag235)
-- Is_Unchecked_Union (Flag117)
+ -- Is_Unimplemented (Flag284)
-- Is_Visible_Formal (Flag206)
-- Kill_Elaboration_Checks (Flag32)
-- Kill_Range_Checks (Flag33)
@@ -5784,6 +5789,7 @@
-- SPARK_Pragma (Node32)
-- Linker_Section_Pragma (Node33)
-- Contract (Node34)
+ -- Import_Pragma (Node35) (non-generic case only)
-- Body_Needed_For_SAL (Flag40)
-- Contains_Ignored_Ghost_Code (Flag279)
-- Default_Expressions_Processed (Flag108)
@@ -5951,6 +5957,7 @@
-- Subprograms_For_Type (Node29)
-- Linker_Section_Pragma (Node33)
-- Contract (Node34)
+ -- Import_Pragma (Node35)
-- Has_Invariants (Flag232)
-- Is_Machine_Code_Subprogram (Flag137)
-- Is_Pure (Flag44)
@@ -6089,6 +6096,7 @@
-- SPARK_Pragma (Node32)
-- Linker_Section_Pragma (Node33)
-- Contract (Node34)
+ -- Import_Pragma (Node35) (non-generic case only)
-- Body_Needed_For_SAL (Flag40)
-- Contains_Ignored_Ghost_Code (Flag279)
-- Delay_Cleanups (Flag114)
@@ -6894,6 +6902,7 @@
function Is_True_Constant (Id : E) return B;
function Is_Unchecked_Union (Id : E) return B;
function Is_Underlying_Record_View (Id : E) return B;
+ function Is_Unimplemented (Id : E) return B;
function Is_Unsigned_Type (Id : E) return B;
function Is_Valued_Procedure (Id : E) return B;
function Is_Visible_Formal (Id : E) return B;
@@ -7548,6 +7557,7 @@
procedure Set_Is_True_Constant (Id : E; V : B := True);
procedure Set_Is_Unchecked_Union (Id : E; V : B := True);
procedure Set_Is_Underlying_Record_View (Id : E; V : B := True);
+ procedure Set_Is_Unimplemented (Id : E; V : B := True);
procedure Set_Is_Unsigned_Type (Id : E; V : B := True);
procedure Set_Is_Valued_Procedure (Id : E; V : B := True);
procedure Set_Is_Visible_Formal (Id : E; V : B := True);
@@ -8352,6 +8362,7 @@
pragma Inline (Is_Type);
pragma Inline (Is_Unchecked_Union);
pragma Inline (Is_Underlying_Record_View);
+ pragma Inline (Is_Unimplemented);
pragma Inline (Is_Unsigned_Type);
pragma Inline (Is_Valued_Procedure);
pragma Inline (Is_Visible_Formal);
@@ -8807,6 +8818,7 @@
pragma Inline (Set_Is_True_Constant);
pragma Inline (Set_Is_Unchecked_Union);
pragma Inline (Set_Is_Underlying_Record_View);
+ pragma Inline (Set_Is_Unimplemented);
pragma Inline (Set_Is_Unsigned_Type);
pragma Inline (Set_Is_Valued_Procedure);
pragma Inline (Set_Is_Visible_Formal);
Index: aspects.adb
===================================================================
--- aspects.adb (revision 221417)
+++ aspects.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2010-2014, Free Software Foundation, Inc. --
+-- Copyright (C) 2010-2015, 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- --
@@ -595,6 +595,7 @@
Aspect_Thread_Local_Storage => Aspect_Thread_Local_Storage,
Aspect_Type_Invariant => Aspect_Invariant,
Aspect_Unchecked_Union => Aspect_Unchecked_Union,
+ Aspect_Unimplemented => Aspect_Unimplemented,
Aspect_Universal_Aliasing => Aspect_Universal_Aliasing,
Aspect_Universal_Data => Aspect_Universal_Data,
Aspect_Unmodified => Aspect_Unmodified,
Index: aspects.ads
===================================================================
--- aspects.ads (revision 221417)
+++ aspects.ads (working copy)
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 2010-2014, Free Software Foundation, Inc. --
+-- Copyright (C) 2010-2015, 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- --
@@ -140,6 +140,7 @@
Aspect_Synchronization,
Aspect_Test_Case, -- GNAT
Aspect_Type_Invariant,
+ Aspect_Unimplemented, -- GNAT
Aspect_Unsuppress,
Aspect_Value_Size, -- GNAT
Aspect_Variable_Indexing,
@@ -369,6 +370,7 @@
Aspect_Synchronization => Name,
Aspect_Test_Case => Expression,
Aspect_Type_Invariant => Expression,
+ Aspect_Unimplemented => Optional_Expression,
Aspect_Unsuppress => Name,
Aspect_Value_Size => Expression,
Aspect_Variable_Indexing => Name,
@@ -490,6 +492,7 @@
Aspect_Test_Case => Name_Test_Case,
Aspect_Type_Invariant => Name_Type_Invariant,
Aspect_Unchecked_Union => Name_Unchecked_Union,
+ Aspect_Unimplemented => Name_Unimplemented,
Aspect_Universal_Aliasing => Name_Universal_Aliasing,
Aspect_Universal_Data => Name_Universal_Data,
Aspect_Unmodified => Name_Unmodified,
@@ -717,6 +720,7 @@
Aspect_SPARK_Mode => Never_Delay,
Aspect_Synchronization => Never_Delay,
Aspect_Test_Case => Never_Delay,
+ Aspect_Unimplemented => Never_Delay,
Aspect_Warnings => Never_Delay,
Aspect_Alignment => Rep_Aspect,
Index: sem_ch13.adb
===================================================================
--- sem_ch13.adb (revision 221417)
+++ sem_ch13.adb (working copy)
@@ -1642,6 +1642,8 @@
-- Processing based on specific aspect
case A_Id is
+ when Aspect_Unimplemented =>
+ null; -- ??? temp for now
-- No_Aspect should be impossible
@@ -9024,7 +9026,8 @@
Aspect_Refined_Post |
Aspect_Refined_State |
Aspect_SPARK_Mode |
- Aspect_Test_Case =>
+ Aspect_Test_Case |
+ Aspect_Unimplemented =>
raise Program_Error;
end case;
Index: snames.ads-tmpl
===================================================================
--- snames.ads-tmpl (revision 221417)
+++ snames.ads-tmpl (working copy)
@@ -144,6 +144,7 @@
Name_Dynamic_Predicate : constant Name_Id := N + $;
Name_Static_Predicate : constant Name_Id := N + $;
Name_Synchronization : constant Name_Id := N + $;
+ Name_Unimplemented : constant Name_Id := N + $;
-- Some special names used by the expander. Note that the lower case u's
-- at the start of these names get translated to extra underscores. These
