mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-04 04:50:26 +08:00
Code Issues Packages Projects Releases Wiki Activity

exp_prag.adb (Expand_Pragma_Import_Or_Interface): Remove properly a default initialization on an imported object...

Browse Source 
2007-04-20  Ed Schonberg  <schonberg@adacore.com>
	    Arnaud Charlet  <charlet@adacore.com>
	    Robert Dewar  <dewar@adacore.com>
	    Gary Dismukes  <dismukes@adacore.com>

	* exp_prag.adb (Expand_Pragma_Import_Or_Interface): Remove properly a
	default initialization on an imported object, when there is no
	initialization call generated for it.
	(Expand_Pragma_Assert): Add handling of No_Exception_Propagation
	restriction

	* snames.h, snames.ads, snames.adb, par-prag.adb: New pragma
	Static_Elaboration_Desired.
	Remove pragma Thread_Body.
	Implement a new pragma No_Body
	Removes the Explicit_Overriding pragma
	Remove Optional_Overriding pragma
	(Prag): Deal with Universal_Aliasing.
	(Name_CIL, Name_CIL_Constructor, Convention_CIL,
	Pragma_CIL_Constructor): New names.

	* sem_cat.adb (Validate_Object_Declaration): An initialization that
	uses the equivalent aggregate of a type must be treated as an implicit
	initialization.
	(Get_Categorization): Check a unit for pragma Preelaborate only if it
	has none of the other categories.
	(Process_Import_Or_Interface_Pragma): Report an error for an attempt
	to apply Import to an object renaming declaration.

	* sem_prag.adb (Process_Import_Or_Interface): Warn that a type imported
	from a C++ class should be declared as limited and that it will be
	considererd limited.
	(Analyze_Pragma): Warn that a type specified with pragma CPP_Class
	should be declared as limited and that it will be considererd limited.
	(Ada_2005_Pragma): New procedure, used to deal with Ada 2005 pragmas
	(Analyze_Pragma, case Export): Diagnose export of enumeration literal
	(Analyze_Pragma): Deal with Universal_Aliasing.
	(Sig_Flags): Likewise.
	(Set_Encoded_Interface_Name): Suppress encoding when compiling for AAMP.
	(Overflow_Checks_Unsuppressed): New flag.
	(Process_Suppress_Unsuppress): Set Overflow_Checks_Unsuppressed.
	(Analyze_Pragma [case Pack]): Ignore pragma Pack and post warning in
	case of JVM or .NET targets, and compiling user code.
	Add debugging convenience routine rv

From-SVN: r125408
This commit is contained in:
Ed Schonberg 2007-06-06 12:27:41 +02:00 committed by Arnaud Charlet
parent 7d8b9c9990
commit 2fa9443ee9
7 changed files with 1173 additions and 971 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

97
gcc/ada/exp_prag.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2007, 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- --
@ -26,6 +26,7 @@
with Atree; use Atree;
with Casing; use Casing;
with Debug; use Debug;
with Einfo; use Einfo;
with Errout; use Errout;
with Exp_Ch11; use Exp_Ch11;
@ -36,6 +37,8 @@ with Namet; use Namet;
with Nlists; use Nlists;
with Nmake; use Nmake;
with Opt; use Opt;
with Restrict; use Restrict;
with Rident; use Rident;
with Rtsfind; use Rtsfind;
with Sem; use Sem;
with Sem_Eval; use Sem_Eval;
@ -239,7 +242,7 @@ package body Exp_Prag is
-- Since assertions are on, we rewrite the pragma with its
-- corresponding if statement, and then analyze the statement
-- The expansion transforms:
-- The normal case expansion transforms:
-- pragma Assert (condition [,message]);
@ -252,30 +255,70 @@ package body Exp_Prag is
-- where Str is the message if one is present, or the default of
-- file:line if no message is given.
-- First, we need to prepare the character literal
-- An alternative expansion is used when the No_Exception_Propagation
-- restriction is active and there is a local Assert_Failure handler.
-- This is not a common combination of circumstances, but it occurs in
-- the context of Aunit and the zero footprint profile. In this case we
-- generate:
if Present (Arg2 (N)) then
Msg := Strval (Expr_Value_S (Arg2 (N)));
else
Build_Location_String (Loc);
Msg := String_From_Name_Buffer;
end if;
-- if not condition then
-- raise Assert_Failure;
-- end if;
-- Now generate the if statement. Note that we consider this to be
-- an explicit conditional in the source, not an implicit if, so we
-- This will then be transformed into a goto, and the local handler will
-- be able to handle the assert error (which would not be the case if a
-- call is made to the Raise_Assert_Failure procedure).
-- Note that the reason we do not always generate a direct raise is that
-- the form in which the procedure is called allows for more efficient
-- breakpointing of assertion errors.
-- Generate the appropriate if statement. Note that we consider this to
-- be an explicit conditional in the source, not an implicit if, so we
-- do not call Make_Implicit_If_Statement.
Rewrite (N,
Make_If_Statement (Loc,
Condition =>
Make_Op_Not (Loc,
Right_Opnd => Cond),
Then_Statements => New_List (
Make_Procedure_Call_Statement (Loc,
Name =>
New_Reference_To (RTE (RE_Raise_Assert_Failure), Loc),
Parameter_Associations => New_List (
Make_String_Literal (Loc, Msg))))));
-- Case where we generate a direct raise
if (Debug_Flag_Dot_G
or else Restriction_Active (No_Exception_Propagation))
and then Present (Find_Local_Handler (RTE (RE_Assert_Failure), N))
then
Rewrite (N,
Make_If_Statement (Loc,
Condition =>
Make_Op_Not (Loc,
Right_Opnd => Cond),
Then_Statements => New_List (
Make_Raise_Statement (Loc,
Name =>
New_Reference_To (RTE (RE_Assert_Failure), Loc)))));
-- Case where we call the procedure
else
-- First, we need to prepare the string literal
if Present (Arg2 (N)) then
Msg := Strval (Expr_Value_S (Arg2 (N)));
else
Build_Location_String (Loc);
Msg := String_From_Name_Buffer;
end if;
-- Now rewrite as an if statement
Rewrite (N,
Make_If_Statement (Loc,
Condition =>
Make_Op_Not (Loc,
Right_Opnd => Cond),
Then_Statements => New_List (
Make_Procedure_Call_Statement (Loc,
Name =>
New_Reference_To (RTE (RE_Raise_Assert_Failure), Loc),
Parameter_Associations => New_List (
Make_String_Literal (Loc, Msg))))));
end if;
Analyze (N);
@ -284,9 +327,8 @@ package body Exp_Prag is
if Nkind (N) = N_Procedure_Call_Statement
and then Is_RTE (Entity (Name (N)), RE_Raise_Assert_Failure)
then
-- If original condition was a Standard.False, we assume
-- that this is indeed intented to raise assert error
-- and no warning is required.
-- If original condition was a Standard.False, we assume that this is
-- indeed intented to raise assert error and no warning is required.
if Is_Entity_Name (Original_Node (Cond))
and then Entity (Original_Node (Cond)) = Standard_False
@ -389,7 +431,8 @@ package body Exp_Prag is
if Ekind (Def_Id) = E_Variable then
Typ := Etype (Def_Id);
-- Loop to ???
-- Iterate from declaration of object to import pragma, to find
-- generated initialization call for object, if any.
Init_Call := Next (Parent (Def_Id));
while Present (Init_Call) and then Init_Call /= N loop
@ -411,7 +454,7 @@ package body Exp_Prag is
-- have explicit initialization, so the expression must have
-- been generated by the compiler.
if No (Init_Call)
if Init_Call = N
and then Present (Expression (Parent (Def_Id)))
then
Set_Expression (Parent (Def_Id), Empty);

17
gcc/ada/par-prag.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2007, 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- --
@ -518,7 +518,7 @@ begin
Expr : Node_Id;
Index : Nat;
function Get_Fname (Arg : Node_Id) return Name_Id;
function Get_Fname (Arg : Node_Id) return File_Name_Type;
-- Process file name from unit name form of pragma
function Get_String_Argument (Arg : Node_Id) return String_Ptr;
@ -534,7 +534,7 @@ begin
-- Get_Fname --
---------------
function Get_Fname (Arg : Node_Id) return Name_Id is
function Get_Fname (Arg : Node_Id) return File_Name_Type is
begin
String_To_Name_Buffer (Strval (Expression (Arg)));
@ -803,7 +803,7 @@ begin
-- turn off semantic checking anyway if any parse errors are found.
when Pragma_Source_Reference => Source_Reference : declare
Fname : Name_Id;
Fname : File_Name_Type;
begin
if Arg_Count /= 1 then
@ -833,7 +833,7 @@ begin
Pragma_Sloc);
raise Error_Resync;
else
Fname := No_Name;
Fname := No_File;
end if;
-- File name present
@ -1054,6 +1054,7 @@ begin
Pragma_Atomic |
Pragma_Atomic_Components |
Pragma_Attach_Handler |
Pragma_CIL_Constructor |
Pragma_Compile_Time_Error |
Pragma_Compile_Time_Warning |
Pragma_Convention_Identifier |
@ -1077,7 +1078,6 @@ begin
Pragma_Elaborate_All |
Pragma_Elaborate_Body |
Pragma_Elaboration_Checks |
Pragma_Explicit_Overriding |
Pragma_Export |
Pragma_Export_Exception |
Pragma_Export_Function |
@ -1123,13 +1123,13 @@ begin
Pragma_Main |
Pragma_Main_Storage |
Pragma_Memory_Size |
Pragma_No_Body |
Pragma_No_Return |
Pragma_Obsolescent |
Pragma_No_Run_Time |
Pragma_No_Strict_Aliasing |
Pragma_Normalize_Scalars |
Pragma_Optimize |
Pragma_Optional_Overriding |
Pragma_Pack |
Pragma_Passive |
Pragma_Preelaborable_Initialization |
@ -1157,6 +1157,7 @@ begin
Pragma_Shared_Passive |
Pragma_Storage_Size |
Pragma_Storage_Unit |
Pragma_Static_Elaboration_Desired |
Pragma_Stream_Convert |
Pragma_Subtitle |
Pragma_Suppress |
@ -1169,11 +1170,11 @@ begin
Pragma_Task_Info |
Pragma_Task_Name |
Pragma_Task_Storage |
Pragma_Thread_Body |
Pragma_Time_Slice |
Pragma_Title |
Pragma_Unchecked_Union |
Pragma_Unimplemented_Unit |
Pragma_Universal_Aliasing |
Pragma_Universal_Data |
Pragma_Unreferenced |
Pragma_Unreferenced_Objects |

71
gcc/ada/sem_cat.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2007, 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- --
@ -31,6 +31,7 @@ with Elists; use Elists;
with Errout; use Errout;
with Fname; use Fname;
with Lib; use Lib;
with Namet; use Namet;
with Nlists; use Nlists;
with Opt; use Opt;
with Sem; use Sem;
@ -120,9 +121,13 @@ package body Sem_Cat is
is
N : constant Node_Id := Info_Node;
-- Here we define an enumeration type to represent categorization
-- types, ordered so that a unit with a given categorization can
-- only WITH units with lower or equal categorization type.
-- Here we define an enumeration type to represent categorization types,
-- ordered so that a unit with a given categorization can only WITH
-- units with lower or equal categorization type.
-- Note that we take advantage of E.2(14) to define a category
-- Preelaborated and treat pragma Preelaborate as a categorization
-- pragma that defines that category.
type Categorization is
(Pure,
@ -132,12 +137,9 @@ package body Sem_Cat is
Preelaborated,
Normal);
Unit_Category : Categorization;
With_Category : Categorization;
function Get_Categorization (E : Entity_Id) return Categorization;
-- Check categorization flags from entity, and return in the form
-- of a corresponding enumeration value.
-- of the lowest value of the Categorization type that applies to E.
------------------------
-- Get_Categorization --
@ -145,12 +147,16 @@ package body Sem_Cat is
function Get_Categorization (E : Entity_Id) return Categorization is
begin
if Is_Preelaborated (E) then
return Preelaborated;
-- Get the lowest categorization that corresponds to E. Note that
-- nothing prevents several (different) categorization pragmas
-- to apply to the same library unit, in which case the unit has
-- all associated categories, so we need to be careful here to
-- check pragmas in proper Categorization order in order to
-- return the lowest appplicable value.
-- Ignore Pure specification if set by pragma Pure_Function
-- Ignore Pure specification if set by pragma Pure_Function
elsif Is_Pure (E)
if Is_Pure (E)
and then not
(Has_Pragma_Pure_Function (E) and not Has_Pragma_Pure (E))
then
@ -165,11 +171,17 @@ package body Sem_Cat is
elsif Is_Remote_Call_Interface (E) then
return Remote_Call_Interface;
elsif Is_Preelaborated (E) then
return Preelaborated;
else
return Normal;
end if;
end Get_Categorization;
Unit_Category : Categorization;
With_Category : Categorization;
-- Start of processing for Check_Categorization_Dependencies
begin
@ -1049,8 +1061,20 @@ package body Sem_Cat is
-- Check for default initialized variable case. Note that in
-- accordance with (RM B.1(24)) imported objects are not
-- subject to default initialization.
-- If the initialization does not come from source and is an
-- aggregate, it is a static initialization that replaces an
-- implicit call, and must be treated as such.
if No (E) and then not Is_Imported (Id) then
if Present (E)
and then
(Comes_From_Source (E) or else Nkind (E) /= N_Aggregate)
then
null;
elsif Is_Imported (Id) then
null;
else
declare
Ent : Entity_Id := T;
@ -1129,23 +1153,30 @@ package body Sem_Cat is
("private object not allowed in preelaborated unit",
N);
-- If we are in Ada 2005 mode, add a message if pragma
-- Add a message if it would help to provide a pragma
-- Preelaborable_Initialization on the type of the
-- object would help.
-- object (which would make it legal in Ada 2005).
-- If the type has no full view (generic type, or
-- previous error), the warning does not apply.
if Ada_Version >= Ada_05
and then Is_Private_Type (Ent)
if Is_Private_Type (Ent)
and then Present (Full_View (Ent))
and then
Has_Preelaborable_Initialization (Full_View (Ent))
then
Error_Msg_Sloc := Sloc (Ent);
Error_Msg_NE
("\would be legal if pragma Preelaborable_" &
"Initialization given for & #", N, Ent);
if Ada_Version >= Ada_05 then
Error_Msg_NE
("\would be legal if pragma Preelaborable_" &
"Initialization given for & #", N, Ent);
else
Error_Msg_NE
("\would be legal in Ada 2005 if pragma " &
"Preelaborable_Initialization given for & #",
N, Ent);
end if;
end if;
end if;
end if;

385
gcc/ada/sem_prag.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2007, 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- --
@ -37,7 +37,6 @@ with Debug; use Debug;
with Einfo; use Einfo;
with Errout; use Errout;
with Exp_Dist; use Exp_Dist;
with Hostparm; use Hostparm;
with Lib; use Lib;
with Lib.Writ; use Lib.Writ;
with Lib.Xref; use Lib.Xref;
@ -174,6 +173,12 @@ package body Sem_Prag is
-- (the original one, following the renaming chain) is returned.
-- Otherwise the entity is returned unchanged. Should be in Einfo???
procedure rv;
-- This is a dummy function called by the processing for pragma Reviewable.
-- It is there for assisting front end debugging. By placing a Reviewable
-- pragma in the source program, a breakpoint on rv catches this place in
-- the source, allowing convenient stepping to the point of interest.
procedure Set_Unit_Name (N : Node_Id; With_Item : Node_Id);
-- Place semantic information on the argument of an Elaborate or
-- Elaborate_All pragma. Entity name for unit and its parents is
@ -253,6 +258,11 @@ package body Sem_Prag is
type Args_List is array (Natural range <>) of Node_Id;
-- Types used for arguments to Check_Arg_Order and Gather_Associations
procedure Ada_2005_Pragma;
-- Called for pragmas defined in Ada 2005, that are not in Ada 95. In
-- Ada 95 mode, these are implementation defined pragmas, so should be
-- caught by the No_Implementation_Pragmas restriction
procedure Check_Ada_83_Warning;
-- Issues a warning message for the current pragma if operating in Ada
-- 83 mode (used for language pragmas that are not a standard part of
@ -482,8 +492,8 @@ package body Sem_Prag is
-- returned, otherwise Arg is returned unchanged.
procedure GNAT_Pragma;
-- Called for all GNAT defined pragmas to note the use of the feature,
-- and also check the relevant restriction (No_Implementation_Pragmas).
-- Called for all GNAT defined pragmas to check the relevant restriction
-- (No_Implementation_Pragmas).
function Is_Before_First_Decl
(Pragma_Node : Node_Id;
@ -633,6 +643,17 @@ package body Sem_Prag is
-- node, which is used for error messages on any constructs
-- that violate the profile.
---------------------
-- Ada_2005_Pragma --
---------------------
procedure Ada_2005_Pragma is
begin
if Ada_Version <= Ada_95 then
Check_Restriction (No_Implementation_Pragmas, N);
end if;
end Ada_2005_Pragma;
--------------------------
-- Check_Ada_83_Warning --
--------------------------
@ -1417,8 +1438,8 @@ package body Sem_Prag is
Pragma_Misplaced;
elsif (Nkind (Parent_Node) = N_Generic_Package_Declaration
or else Nkind (Parent_Node)
= N_Generic_Subprogram_Declaration)
or else Nkind (Parent_Node) =
N_Generic_Subprogram_Declaration)
and then Plist = Generic_Formal_Declarations (Parent_Node)
then
Pragma_Misplaced;
@ -2198,6 +2219,10 @@ package body Sem_Prag is
Error_Pragma_Arg ("entity name required", Arg2);
end if;
if Ekind (Entity (Id)) = E_Enumeration_Literal then
Error_Pragma ("enumeration literal not allowed for pragma%");
end if;
E := Entity (Id);
-- Go to renamed subprogram if present, since convention applies
@ -2207,8 +2232,8 @@ package body Sem_Prag is
if Is_Subprogram (E)
and then Present (Alias (E))
then
if Nkind (Parent (Declaration_Node (E)))
= N_Subprogram_Renaming_Declaration
if Nkind (Parent (Declaration_Node (E))) =
N_Subprogram_Renaming_Declaration
then
E := Alias (E);
@ -3078,14 +3103,20 @@ package body Sem_Prag is
or else
Ekind (Def_Id) = E_Constant
then
-- We do not permit Import to apply to a renaming declaration
if Present (Renamed_Object (Def_Id)) then
Error_Pragma_Arg
("pragma% not allowed for object renaming", Arg2);
-- User initialization is not allowed for imported object, but
-- the object declaration may contain a default initialization,
-- that will be discarded. Note that an explicit initialization
-- only counts if it comes from source, otherwise it is simply
-- the code generator making an implicit initialization explicit.
if Present (Expression (Parent (Def_Id)))
and then Comes_From_Source (Expression (Parent (Def_Id)))
elsif Present (Expression (Parent (Def_Id)))
and then Comes_From_Source (Expression (Parent (Def_Id)))
then
Error_Msg_Sloc := Sloc (Def_Id);
Error_Pragma_Arg
@ -3235,12 +3266,14 @@ package body Sem_Prag is
end if;
end loop;
-- When the convention is Java, we also allow Import to be given
-- for packages, exceptions, and record components.
-- When the convention is Java or CIL, we also allow Import to be
-- given for packages, generic packages, exceptions, and record
-- components.
elsif C = Convention_Java
elsif (C = Convention_Java or else C = Convention_CIL)
and then
(Ekind (Def_Id) = E_Package
or else Ekind (Def_Id) = E_Generic_Package
or else Ekind (Def_Id) = E_Exception
or else Nkind (Parent (Def_Id)) = N_Component_Declaration)
then
@ -3256,7 +3289,24 @@ package body Sem_Prag is
if not Is_Tagged_Type (Def_Id) then
Error_Msg_Sloc := Sloc (Def_Id);
Error_Pragma_Arg ("imported 'C'P'P type must be tagged", Arg2);
else
-- Types treated as CPP classes are treated as limited, but we
-- don't require them to be declared this way. A warning is
-- issued to encourage the user to declare them as limited.
-- This is not an error, for compatibility reasons, because
-- these types have been supported this way for some time.
if not Is_Limited_Type (Def_Id) then
Error_Msg_N
("imported 'C'P'P type should be " &
"explicitly declared limited?",
Get_Pragma_Arg (Arg2));
Error_Msg_N
("\type will be considered limited",
Get_Pragma_Arg (Arg2));
end if;
Set_Is_CPP_Class (Def_Id);
Set_Is_Limited_Record (Def_Id);
end if;
@ -3338,8 +3388,8 @@ package body Sem_Prag is
-- trivially possible.
elsif
Nkind (Unit_Declaration_Node (Corresponding_Body (Decl)))
= N_Subprogram_Renaming_Declaration
Nkind (Unit_Declaration_Node (Corresponding_Body (Decl))) =
N_Subprogram_Renaming_Declaration
then
return False;
@ -3569,9 +3619,11 @@ package body Sem_Prag is
C := Get_String_Char (S, J);
if Warn_On_Export_Import
and then (not In_Character_Range (C)
or else Get_Character (C) = ' '
or else Get_Character (C) = ',')
and then
(not In_Character_Range (C)
or else (Get_Character (C) = ' '
and then VM_Target /= CLI_Target)
or else Get_Character (C) = ',')
then
Error_Msg_N
("?interface name contains illegal character", SN);
@ -3584,6 +3636,18 @@ package body Sem_Prag is
begin
if No (Link_Arg) then
if No (Ext_Arg) then
if VM_Target = CLI_Target
and then Ekind (Subprogram_Def) = E_Package
and then Nkind (Parent (Subprogram_Def)) =
N_Package_Specification
and then Present (Generic_Parent (Parent (Subprogram_Def)))
then
Set_Interface_Name
(Subprogram_Def,
Interface_Name
(Generic_Parent (Parent (Subprogram_Def))));
end if;
return;
elsif Chars (Ext_Arg) = Name_Link_Name then
@ -3669,7 +3733,11 @@ package body Sem_Prag is
else
Start_String;
Store_String_Char (Get_Char_Code ('*'));
if VM_Target = No_VM then
Store_String_Char (Get_Char_Code ('*'));
end if;
String_Val := Strval (Expr_Value_S (Link_Nam));
for J in 1 .. String_Length (String_Val) loop
@ -3952,6 +4020,12 @@ package body Sem_Prag is
C := Get_Check_Id (Chars (Expression (Arg1)));
end if;
if not Suppress_Case
and then (C = All_Checks or else C = Overflow_Check)
then
Opt.Overflow_Checks_Unsuppressed := True;
end if;
if Arg_Count = 1 then
-- Make an entry in the local scope suppress table. This is the
@ -4665,6 +4739,7 @@ package body Sem_Prag is
Expr : Node_Id;
begin
Ada_2005_Pragma;
Check_At_Least_N_Arguments (1);
Check_At_Most_N_Arguments (2);
Check_Arg_Order ((Name_Check, Name_Message));
@ -4737,6 +4812,7 @@ package body Sem_Prag is
-- pragma Assertion_Policy (Check | Ignore)
when Pragma_Assertion_Policy =>
Ada_2005_Pragma;
Check_Arg_Count (1);
Check_Arg_Is_One_Of (Arg1, Name_Check, Name_Ignore);
Assertions_Enabled := Chars (Expression (Arg1)) = Name_Check;
@ -5413,6 +5489,22 @@ package body Sem_Prag is
Error_Pragma_Arg ("pragma% applicable to tagged types ", Arg1);
end if;
-- Types treated as CPP classes are treated as limited, but we
-- don't require them to be declared this way. A warning is issued
-- to encourage the user to declare them as limited. This is not
-- an error, for compatibility reasons, because these types have
-- been supported this way for some time.
if not Is_Limited_Type (Typ) then
Error_Msg_N
("imported 'C'P'P type should be " &
"explicitly declared limited?",
Get_Pragma_Arg (Arg1));
Error_Msg_N
("\type will be considered limited",
Get_Pragma_Arg (Arg1));
end if;
Set_Is_CPP_Class (Typ);
Set_Is_Limited_Record (Typ);
Set_Convention (Typ, Convention_CPP);
@ -5558,7 +5650,7 @@ package body Sem_Prag is
-- pragma Detect_Blocking;
when Pragma_Detect_Blocking =>
GNAT_Pragma;
Ada_2005_Pragma;
Check_Arg_Count (0);
Check_Valid_Configuration_Pragma;
Detect_Blocking := True;
@ -5591,7 +5683,8 @@ package body Sem_Prag is
-- If there is no parameter, then from now on this pragma
-- applies to any enumeration, exception or tagged type
-- defined in the current declarative part.
-- defined in the current declarative part, and recursively
-- to any nested scope.
Set_Discard_Names (Current_Scope);
return;
@ -5936,15 +6029,6 @@ package body Sem_Prag is
Source_Location);
end Eliminate;
-------------------------
-- Explicit_Overriding --
-------------------------
when Pragma_Explicit_Overriding =>
Check_Valid_Configuration_Pragma;
Check_Arg_Count (0);
Explicit_Overriding := True;
------------
-- Export --
------------
@ -7337,7 +7421,7 @@ package body Sem_Prag is
Error_Msg_Sloc :=
Interrupt_States.Table (IST_Num).Pragma_Loc;
Error_Pragma_Arg
("state conflicts with that given at #", Arg2);
("state conflicts with that given #", Arg2);
exit;
end if;
@ -7351,10 +7435,12 @@ package body Sem_Prag is
-- pragma Java_Constructor ([Entity =>] LOCAL_NAME);
when Pragma_Java_Constructor => Java_Constructor : declare
Id : Entity_Id;
Def_Id : Entity_Id;
Hom_Id : Entity_Id;
when Pragma_CIL_Constructor | Pragma_Java_Constructor =>
Java_Constructor : declare
Id : Entity_Id;
Def_Id : Entity_Id;
Hom_Id : Entity_Id;
Convention : Convention_Id;
begin
GNAT_Pragma;
@ -7371,6 +7457,12 @@ package body Sem_Prag is
return;
end if;
case Prag_Id is
when Pragma_CIL_Constructor => Convention := Convention_CIL;
when Pragma_Java_Constructor => Convention := Convention_Java;
when others => null;
end case;
Hom_Id := Entity (Id);
-- Loop through homonyms
@ -7378,26 +7470,37 @@ package body Sem_Prag is
loop
Def_Id := Get_Base_Subprogram (Hom_Id);
-- The constructor is required to be a function returning
-- an access type whose designated type has convention Java.
-- The constructor is required to be a function returning an
-- access type whose designated type has convention Java/CIL.
if Ekind (Def_Id) = E_Function
and then Ekind (Etype (Def_Id)) in Access_Kind
and then
(Atree.Convention
(Designated_Type (Etype (Def_Id))) = Convention_Java
or else
Atree.Convention
(Root_Type (Designated_Type (Etype (Def_Id))))
= Convention_Java)
(Is_Value_Type (Etype (Def_Id))
or else
(Ekind (Etype (Def_Id)) in Access_Kind
and then
(Atree.Convention
(Designated_Type (Etype (Def_Id))) = Convention
or else
Atree.Convention
(Root_Type (Designated_Type (Etype (Def_Id)))) =
Convention)))
then
Set_Is_Constructor (Def_Id);
Set_Convention (Def_Id, Convention_Java);
Set_Convention (Def_Id, Convention);
Set_Is_Imported (Def_Id);
else
Error_Pragma_Arg
("pragma% requires function returning a 'Java access type",
Arg1);
if Convention = Convention_Java then
Error_Pragma_Arg
("pragma% requires function returning a " &
"'Java access type", Arg1);
else
pragma Assert (Convention = Convention_CIL);
Error_Pragma_Arg
("pragma% requires function returning a " &
"'CIL access type", Arg1);
end if;
end if;
Hom_Id := Homonym (Hom_Id);
@ -7985,6 +8088,22 @@ package body Sem_Prag is
Check_Arg_Count (1);
Check_Arg_Is_Integer_Literal (Arg1);
-------------
-- No_Body --
-------------
-- pragma No_Body;
-- The only correct use of this pragma is on its own in a file, in
-- which case it is specially processed (see Gnat1drv.Check_Bad_Body
-- and Frontend, which use Sinput.L.Source_File_Is_Pragma_No_Body to
-- check for a file containing nothing but a No_Body pragma). If we
-- attempt to process it during normal semantics processing, it means
-- it was misplaced.
when Pragma_No_Body =>
Error_Pragma ("misplaced pragma %");
---------------
-- No_Return --
---------------
@ -8337,18 +8456,6 @@ package body Sem_Prag is
Check_Arg_Count (1);
Check_Arg_Is_One_Of (Arg1, Name_Time, Name_Space, Name_Off);
-------------------------
-- Optional_Overriding --
-------------------------
-- These pragmas are treated as part of the previous subprogram
-- declaration, and analyzed immediately after it (see sem_ch6,
-- Check_Overriding_Operation). If the pragma has not been analyzed
-- yet, it appears in the wrong place.
when Pragma_Optional_Overriding =>
Error_Msg_N ("pragma must appear immediately after subprogram", N);
----------
-- Pack --
----------
@ -8423,7 +8530,13 @@ package body Sem_Prag is
else
if not Rep_Item_Too_Late (Typ, N) then
Set_Is_Packed (Base_Type (Typ));
if VM_Target = No_VM then
Set_Is_Packed (Base_Type (Typ));
elsif not GNAT_Mode then
Error_Pragma
("?pragma% ignored in this configuration");
end if;
Set_Has_Pragma_Pack (Base_Type (Typ));
Set_Has_Non_Standard_Rep (Base_Type (Typ));
end if;
@ -8433,8 +8546,13 @@ package body Sem_Prag is
else pragma Assert (Is_Record_Type (Typ));
if not Rep_Item_Too_Late (Typ, N) then
if VM_Target = No_VM then
Set_Is_Packed (Base_Type (Typ));
elsif not GNAT_Mode then
Error_Pragma ("?pragma% ignored in this configuration");
end if;
Set_Has_Pragma_Pack (Base_Type (Typ));
Set_Is_Packed (Base_Type (Typ));
Set_Has_Non_Standard_Rep (Base_Type (Typ));
end if;
end if;
@ -8483,6 +8601,7 @@ package body Sem_Prag is
Ent : Entity_Id;
begin
Ada_2005_Pragma;
Check_Arg_Count (1);
Check_No_Identifiers;
Check_Arg_Is_Identifier (Arg1);
@ -8770,6 +8889,7 @@ package body Sem_Prag is
Upper_Val : Uint;
begin
Ada_2005_Pragma;
Check_Arg_Count (3);
Check_No_Identifiers;
Check_Arg_Is_Task_Dispatching_Policy (Arg1);
@ -8888,6 +9008,7 @@ package body Sem_Prag is
-- profile_IDENTIFIER => Protected | Ravenscar
when Pragma_Profile =>
Ada_2005_Pragma;
Check_Arg_Count (1);
Check_Valid_Configuration_Pragma;
Check_No_Identifiers;
@ -9388,6 +9509,7 @@ package body Sem_Prag is
when Pragma_Reviewable =>
Check_Ada_83_Warning;
Check_Arg_Count (0);
rv;
-------------------
-- Share_Generic --
@ -9537,6 +9659,25 @@ package body Sem_Prag is
when Pragma_Source_Reference =>
GNAT_Pragma;
--------------------------------
-- Static_Elaboration_Desired --
--------------------------------
-- Syntax ???
when Pragma_Static_Elaboration_Desired =>
-- GNAT_Pragma???
-- Check number of arguments ???
if Is_Compilation_Unit (Current_Scope)
and then Ekind (Current_Scope) = E_Package
then
Set_Static_Elaboration_Desired (Current_Scope, True);
else
Error_Pragma ("pragma% must apply to a library-level package");
end if;
------------------
-- Storage_Size --
------------------
@ -10078,80 +10219,6 @@ package body Sem_Prag is
end if;
end Task_Storage;
-----------------
-- Thread_Body --
-----------------
-- pragma Thread_Body
-- ( [Entity =>] LOCAL_NAME
-- [,[Secondary_Stack_Size =>] static_integer_EXPRESSION]);
when Pragma_Thread_Body => Thread_Body : declare
Id : Node_Id;
SS : Node_Id;
E : Entity_Id;
begin
GNAT_Pragma;
Check_Arg_Order ((Name_Entity, Name_Secondary_Stack_Size));
Check_At_Least_N_Arguments (1);
Check_At_Most_N_Arguments (2);
Check_Optional_Identifier (Arg1, Name_Entity);
Check_Arg_Is_Local_Name (Arg1);
Id := Expression (Arg1);
if not Is_Entity_Name (Id)
or else not Is_Subprogram (Entity (Id))
then
Error_Pragma_Arg ("subprogram name required", Arg1);
end if;
E := Entity (Id);
-- Go to renamed subprogram if present, since Thread_Body applies
-- to the actual renamed entity, not to the renaming entity.
if Present (Alias (E))
and then Nkind (Parent (Declaration_Node (E))) =
N_Subprogram_Renaming_Declaration
then
E := Alias (E);
end if;
-- Various error checks
if Nkind (Parent (Declaration_Node (E))) = N_Subprogram_Body then
Error_Pragma
("pragma% requires separate spec and must come before body");
elsif Rep_Item_Too_Early (E, N)
or else Rep_Item_Too_Late (E, N)
then
raise Pragma_Exit;
elsif Is_Thread_Body (E) then
Error_Pragma_Arg
("only one thread body pragma allowed", Arg1);
elsif Present (Homonym (E))
and then Scope (Homonym (E)) = Current_Scope
then
Error_Pragma_Arg
("thread body subprogram must not be overloaded", Arg1);
end if;
Set_Is_Thread_Body (E);
-- Deal with secondary stack argument
if Arg_Count = 2 then
Check_Optional_Identifier (Arg2, Name_Secondary_Stack_Size);
SS := Expression (Arg2);
Analyze_And_Resolve (SS, Any_Integer);
end if;
end Thread_Body;
----------------
-- Time_Slice --
----------------
@ -10373,6 +10440,31 @@ package body Sem_Prag is
end if;
end Unimplemented_Unit;
------------------------
-- Universal_Aliasing --
------------------------
-- pragma Universal_Aliasing [([Entity =>] type_LOCAL_NAME)];
when Pragma_Universal_Aliasing => Universal_Alias : declare
E_Id : Entity_Id;
begin
GNAT_Pragma;
Check_Arg_Count (1);
Check_Optional_Identifier (Arg2, Name_Entity);
Check_Arg_Is_Local_Name (Arg1);
E_Id := Entity (Expression (Arg1));
if E_Id = Any_Type then
return;
elsif No (E_Id) or else not Is_Type (E_Id) then
Error_Pragma_Arg ("pragma% requires type", Arg1);
end if;
Set_Universal_Aliasing (Implementation_Base_Type (E_Id));
end Universal_Alias;
--------------------
-- Universal_Data --
--------------------
@ -11012,6 +11104,7 @@ package body Sem_Prag is
Pragma_Atomic => 0,
Pragma_Atomic_Components => 0,
Pragma_Attach_Handler => -1,
Pragma_CIL_Constructor => -1,
Pragma_CPP_Class => 0,
Pragma_CPP_Constructor => 0,
Pragma_CPP_Virtual => 0,
@ -11036,7 +11129,6 @@ package body Sem_Prag is
Pragma_Elaborate_Body => -1,
Pragma_Elaboration_Checks => -1,
Pragma_Eliminate => -1,
Pragma_Explicit_Overriding => -1,
Pragma_Export => -1,
Pragma_Export_Exception => -1,
Pragma_Export_Function => -1,
@ -11085,12 +11177,12 @@ package body Sem_Prag is
Pragma_Main_Storage => -1,
Pragma_Memory_Size => -1,
Pragma_No_Return => 0,
Pragma_No_Body => 0,
Pragma_No_Run_Time => -1,
Pragma_No_Strict_Aliasing => -1,
Pragma_Normalize_Scalars => -1,
Pragma_Obsolescent => 0,
Pragma_Optimize => -1,
Pragma_Optional_Overriding => -1,
Pragma_Pack => 0,
Pragma_Page => -1,
Pragma_Passive => -1,
@ -11124,6 +11216,7 @@ package body Sem_Prag is
Pragma_Source_Reference => -1,
Pragma_Storage_Size => -1,
Pragma_Storage_Unit => -1,
Pragma_Static_Elaboration_Desired => -1,
Pragma_Stream_Convert => -1,
Pragma_Style_Checks => -1,
Pragma_Subtitle => -1,
@ -11137,11 +11230,11 @@ package body Sem_Prag is
Pragma_Task_Info => -1,
Pragma_Task_Name => -1,
Pragma_Task_Storage => 0,
Pragma_Thread_Body => +2,
Pragma_Time_Slice => -1,
Pragma_Title => -1,
Pragma_Unchecked_Union => 0,
Pragma_Unimplemented_Unit => -1,
Pragma_Universal_Aliasing => -1,
Pragma_Universal_Data => -1,
Pragma_Unreferenced => -1,
Pragma_Unreferenced_Objects => -1,
@ -11297,6 +11390,15 @@ package body Sem_Prag is
end;
end Process_Compilation_Unit_Pragmas;
--------
-- rv --
--------
procedure rv is
begin
null;
end rv;
--------------------------------
-- Set_Encoded_Interface_Name --
--------------------------------
@ -11337,11 +11439,12 @@ package body Sem_Prag is
-- If first character is asterisk, this is a link name, and we
-- leave it completely unmodified. We also ignore null strings
-- (the latter case happens only in error cases) and no encoding
-- should occur for Java interface names.
-- should occur for Java or AAMP interface names.
if Len = 0
or else Get_String_Char (Str, 1) = Get_Char_Code ('*')
or else Java_VM
or else VM_Target /= No_VM
or else AAMP_On_Target
then
Set_Interface_Name (E, S);

22
gcc/ada/snames.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2007, 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- --
@ -31,7 +31,6 @@
-- --
------------------------------------------------------------------------------
with Namet; use Namet;
with Opt; use Opt;
with Table;
@ -118,9 +117,11 @@ package body Snames is
"put#" &
"put_line#" &
"to#" &
"exception_traces#" &
"finalization#" &
"finalization_root#" &
"interfaces#" &
"most_recent_exception#" &
"standard#" &
"system#" &
"text_io#" &
@ -187,7 +188,6 @@ package body Snames is
"discard_names#" &
"elaboration_checks#" &
"eliminate#" &
"explicit_overriding#" &
"extend_system#" &
"extensions_allowed#" &
"external_name_casing#" &
@ -232,6 +232,7 @@ package body Snames is
"atomic#" &
"atomic_components#" &
"attach_handler#" &
"cil_constructor#" &
"comment#" &
"common_object#" &
"complete_representation#" &
@ -283,10 +284,10 @@ package body Snames is
"main#" &
"main_storage#" &
"memory_size#" &
"no_body#" &
"no_return#" &
"obsolescent#" &
"optimize#" &
"optional_overriding#" &
"pack#" &
"page#" &
"passive#" &
@ -303,6 +304,7 @@ package body Snames is
"shared#" &
"shared_passive#" &
"source_reference#" &
"static_elaboration_desired#" &
"stream_convert#" &
"subtitle#" &
"suppress_all#" &
@ -312,11 +314,11 @@ package body Snames is
"task_info#" &
"task_name#" &
"task_storage#" &
"thread_body#" &
"time_slice#" &
"title#" &
"unchecked_union#" &
"unimplemented_unit#" &
"universal_aliasing#" &
"unreferenced#" &
"unreferenced_objects#" &
"unreserve_all_interrupts#" &
@ -325,6 +327,7 @@ package body Snames is
"weak_external#" &
"ada#" &
"assembler#" &
"cil#" &
"cobol#" &
"cpp#" &
"fortran#" &
@ -670,13 +673,13 @@ package body Snames is
"archive_suffix#" &
"binder#" &
"binder_driver#" &
"binder_prefix#" &
"body_suffix#" &
"builder#" &
"builder_switches#" &
"compiler#" &
"compiler_driver#" &
"compiler_kind#" &
"compiler_minimum_options#" &
"compiler_pic_option#" &
"compute_dependency#" &
"config_body_file_name#" &
@ -690,6 +693,7 @@ package body Snames is
"default_global_compiler_switches#" &
"default_language#" &
"default_linker#" &
"default_minimum_linker_options#" &
"default_switches#" &
"dependency_file_kind#" &
"dependency_option#" &
@ -724,6 +728,7 @@ package body Snames is
"library_name#" &
"library_major_minor_id_supported#" &
"library_options#" &
"library_partial_linker#" &
"library_reference_symbol_file#" &
"library_src_dir#" &
"library_support#" &
@ -743,6 +748,8 @@ package body Snames is
"mapping_body_suffix#" &
"metrics#" &
"minimum_binder_options#" &
"minimum_compiler_options#" &
"minimum_linker_options#" &
"naming#" &
"objects_path#" &
"objects_path_file#" &
@ -767,6 +774,7 @@ package body Snames is
"stack#" &
"switches#" &
"symbolic_link_supported#" &
"toolchain_description#" &
"toolchain_version#" &
"unaligned_valid#" &
"interface#" &
@ -864,6 +872,7 @@ package body Snames is
when Name_Ada => return Convention_Ada;
when Name_Assembler => return Convention_Assembler;
when Name_C => return Convention_C;
when Name_CIL => return Convention_CIL;
when Name_COBOL => return Convention_COBOL;
when Name_CPP => return Convention_CPP;
when Name_Fortran => return Convention_Fortran;
@ -896,6 +905,7 @@ package body Snames is
when Convention_Ada => return Name_Ada;
when Convention_Assembler => return Name_Assembler;
when Convention_C => return Name_C;
when Convention_CIL => return Name_CIL;
when Convention_COBOL => return Name_COBOL;
when Convention_CPP => return Name_CPP;
when Convention_Entry => return Name_Entry;

1396
gcc/ada/snames.ads
View File

File diff suppressed because it is too large Load Diff

156
gcc/ada/snames.h
View File

@ -6,7 +6,7 @@
* *
* C Header File *
* *
* Copyright (C) 1992-2006, Free Software Foundation, Inc. *
* Copyright (C) 1992-2007, 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- *
@ -192,12 +192,13 @@ extern unsigned char Get_Attribute_Id (int);
#define Convention_Protected 3
#define Convention_Assembler 4
#define Convention_C 5
#define Convention_COBOL 6
#define Convention_CPP 7
#define Convention_Fortran 8
#define Convention_Java 9
#define Convention_Stdcall 10
#define Convention_Stubbed 11
#define Convention_CIL 6
#define Convention_COBOL 7
#define Convention_CPP 8
#define Convention_Fortran 9
#define Convention_Java 10
#define Convention_Stdcall 11
#define Convention_Stubbed 12
/* Define the function to check if a Name_Id value is a valid pragma */
@ -229,51 +230,51 @@ extern unsigned char Get_Pragma_Id (int);
#define Pragma_Discard_Names 12
#define Pragma_Elaboration_Checks 13
#define Pragma_Eliminate 14
#define Pragma_Explicit_Overriding 15
#define Pragma_Extend_System 16
#define Pragma_Extensions_Allowed 17
#define Pragma_External_Name_Casing 18
#define Pragma_Float_Representation 19
#define Pragma_Initialize_Scalars 20
#define Pragma_Interrupt_State 21
#define Pragma_License 22
#define Pragma_Locking_Policy 23
#define Pragma_Long_Float 24
#define Pragma_No_Run_Time 25
#define Pragma_No_Strict_Aliasing 26
#define Pragma_Normalize_Scalars 27
#define Pragma_Polling 28
#define Pragma_Persistent_BSS 29
#define Pragma_Priority_Specific_Dispatching 30
#define Pragma_Profile 31
#define Pragma_Profile_Warnings 32
#define Pragma_Propagate_Exceptions 33
#define Pragma_Queuing_Policy 34
#define Pragma_Ravenscar 35
#define Pragma_Restricted_Run_Time 36
#define Pragma_Restrictions 37
#define Pragma_Restriction_Warnings 38
#define Pragma_Reviewable 39
#define Pragma_Source_File_Name 40
#define Pragma_Source_File_Name_Project 41
#define Pragma_Style_Checks 42
#define Pragma_Suppress 43
#define Pragma_Suppress_Exception_Locations 44
#define Pragma_Task_Dispatching_Policy 45
#define Pragma_Universal_Data 46
#define Pragma_Unsuppress 47
#define Pragma_Use_VADS_Size 48
#define Pragma_Validity_Checks 49
#define Pragma_Warnings 50
#define Pragma_Wide_Character_Encoding 51
#define Pragma_Abort_Defer 52
#define Pragma_All_Calls_Remote 53
#define Pragma_Annotate 54
#define Pragma_Assert 55
#define Pragma_Asynchronous 56
#define Pragma_Atomic 57
#define Pragma_Atomic_Components 58
#define Pragma_Attach_Handler 59
#define Pragma_Extend_System 15
#define Pragma_Extensions_Allowed 16
#define Pragma_External_Name_Casing 17
#define Pragma_Float_Representation 18
#define Pragma_Initialize_Scalars 19
#define Pragma_Interrupt_State 20
#define Pragma_License 21
#define Pragma_Locking_Policy 22
#define Pragma_Long_Float 23
#define Pragma_No_Run_Time 24
#define Pragma_No_Strict_Aliasing 25
#define Pragma_Normalize_Scalars 26
#define Pragma_Polling 27
#define Pragma_Persistent_BSS 28
#define Pragma_Priority_Specific_Dispatching 29
#define Pragma_Profile 30
#define Pragma_Profile_Warnings 31
#define Pragma_Propagate_Exceptions 32
#define Pragma_Queuing_Policy 33
#define Pragma_Ravenscar 34
#define Pragma_Restricted_Run_Time 35
#define Pragma_Restrictions 36
#define Pragma_Restriction_Warnings 37
#define Pragma_Reviewable 38
#define Pragma_Source_File_Name 39
#define Pragma_Source_File_Name_Project 40
#define Pragma_Style_Checks 41
#define Pragma_Suppress 42
#define Pragma_Suppress_Exception_Locations 43
#define Pragma_Task_Dispatching_Policy 44
#define Pragma_Universal_Data 45
#define Pragma_Unsuppress 46
#define Pragma_Use_VADS_Size 47
#define Pragma_Validity_Checks 48
#define Pragma_Warnings 49
#define Pragma_Wide_Character_Encoding 50
#define Pragma_Abort_Defer 51
#define Pragma_All_Calls_Remote 52
#define Pragma_Annotate 53
#define Pragma_Assert 54
#define Pragma_Asynchronous 55
#define Pragma_Atomic 56
#define Pragma_Atomic_Components 57
#define Pragma_Attach_Handler 58
#define Pragma_CIL_Constructor 59
#define Pragma_Comment 60
#define Pragma_Common_Object 61
#define Pragma_Complete_Representation 62
@ -325,10 +326,10 @@ extern unsigned char Get_Pragma_Id (int);
#define Pragma_Main 108
#define Pragma_Main_Storage 109
#define Pragma_Memory_Size 110
#define Pragma_No_Return 111
#define Pragma_Obsolescent 112
#define Pragma_Optimize 113
#define Pragma_Optional_Overriding 114
#define Pragma_No_Body 111
#define Pragma_No_Return 112
#define Pragma_Obsolescent 113
#define Pragma_Optimize 114
#define Pragma_Pack 115
#define Pragma_Page 116
#define Pragma_Passive 117
@ -345,30 +346,31 @@ extern unsigned char Get_Pragma_Id (int);
#define Pragma_Shared 128
#define Pragma_Shared_Passive 129
#define Pragma_Source_Reference 130
#define Pragma_Stream_Convert 131
#define Pragma_Subtitle 132
#define Pragma_Suppress_All 133
#define Pragma_Suppress_Debug_Info 134
#define Pragma_Suppress_Initialization 135
#define Pragma_System_Name 136
#define Pragma_Task_Info 137
#define Pragma_Task_Name 138
#define Pragma_Task_Storage 139
#define Pragma_Thread_Body 140
#define Pragma_Static_Elaboration_Desired 131
#define Pragma_Stream_Convert 132
#define Pragma_Subtitle 133
#define Pragma_Suppress_All 134
#define Pragma_Suppress_Debug_Info 135
#define Pragma_Suppress_Initialization 136
#define Pragma_System_Name 137
#define Pragma_Task_Info 138
#define Pragma_Task_Name 139
#define Pragma_Task_Storage 140
#define Pragma_Time_Slice 141
#define Pragma_Title 142
#define Pragma_Unchecked_Union 143
#define Pragma_Unimplemented_Unit 144
#define Pragma_Unreferenced 145
#define Pragma_Unreferenced_Objects 146
#define Pragma_Unreserve_All_Interrupts 147
#define Pragma_Volatile 148
#define Pragma_Volatile_Components 149
#define Pragma_Weak_External 150
#define Pragma_AST_Entry 151
#define Pragma_Interface 152
#define Pragma_Priority 153
#define Pragma_Storage_Size 154
#define Pragma_Storage_Unit 155
#define Pragma_Universal_Aliasing 145
#define Pragma_Unreferenced 146
#define Pragma_Unreferenced_Objects 147
#define Pragma_Unreserve_All_Interrupts 148
#define Pragma_Volatile 149
#define Pragma_Volatile_Components 150
#define Pragma_Weak_External 151
#define Pragma_AST_Entry 152
#define Pragma_Interface 153
#define Pragma_Priority 154
#define Pragma_Storage_Size 155
#define Pragma_Storage_Unit 156
/* End of snames.h (C version of Snames package spec) */