+2013-02-06 Javier Miranda <miranda@adacore.com>
+
+ * exp_ch5.adb (Expand_N_Assignment_Statement): Do not generate the
+ runtime check on assignment to tagged types if compiling with checks
+ suppressed.
+
+2013-02-06 Robert Dewar <dewar@adacore.com>
+
+ * exp_util.adb, checks.adb, sem_ch12.adb, sem_res.adb, prj-conf.adb,
+ s-os_lib.adb: Minor reformatting
+
+2013-02-06 Vincent Celier <celier@adacore.com>
+
+ * ug_words: Add -gnateY = /IGNORE_STYLE_CHECKS_PRAGMAS.
+
+2013-02-06 Ed Schonberg <schonberg@adacore.com>
+
+ * snames.ads-tmpl: Add Name_Rational and pragma Rational.
+ * par-prag.adb: Recognize pragma Rational.
+ * opt.ads (Rational_Profile): flag to control compatibility mode
+ with Rational compiler.
+ * sem_ch8.adb (Analyze_Subprogram_Renaming): When Rational profile
+ is enable, accept renaming declarations where the new subprogram
+ and the renamed entity have the same name.
+ * sem_prag.adb (analyze_pragma): Add pragma Rational, and recognize
+ Rational as a profile.
+
2013-02-06 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch5.adb (Expand_Loop_Entry_Attributes): When
-- the constraints are constants. In this case, we can do the check
-- successfully at compile time.
- -- We skip this check for the case where the node is a rewritten`as
- -- an allocator, because it already carries the context subtype, and
- -- extracting the discriminants from the aggregate is messy.
+ -- We skip this check for the case where the node is rewritten`as
+ -- an allocator, because it already carries the context subtype,
+ -- and extracting the discriminants from the aggregate is messy.
if Is_Constrained (S_Typ)
and then Nkind (Original_Node (N)) /= N_Allocator
if Ekind (T_Typ) = E_Private_Subtype
and then Present (Full_View (T_Typ))
then
- DconT :=
+ DconT :=
First_Elmt (Discriminant_Constraint (Full_View (T_Typ)));
-
else
- DconT := First_Elmt (Discriminant_Constraint (T_Typ));
+ DconT :=
+ First_Elmt (Discriminant_Constraint (T_Typ));
end if;
while Present (Discr) loop
-- the assignment we generate run-time check to ensure that
-- the tags of source and target match.
- if Is_Class_Wide_Type (Typ)
+ if not Tag_Checks_Suppressed (Typ)
+ and then Is_Class_Wide_Type (Typ)
and then Is_Tagged_Type (Typ)
and then Is_Tagged_Type (Underlying_Type (Etype (Rhs)))
then
Par : Node_Id;
begin
- -- Locate an enclosing case or if expression. Note that these constructs
- -- appear as expression_with_actions, hence the test using the original
- -- node.
+ -- Locate an enclosing case or if expression. Note: these constructs can
+ -- get expanded into Expression_With_Actions, hence the need to test
+ -- using the original node.
Par := N;
while Present (Par) loop
-- Set to True if the tool should not have any output if there are no
-- errors or warnings.
+ Rational_Profile : Boolean := False;
+ -- GNAT
+ -- Set to True to enable compatibility mode with Rational compiler.
+
Replace_In_Comments : Boolean := False;
-- GNATPREP
-- Set to True if -C switch used
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
Pragma_Remote_Call_Interface |
Pragma_Remote_Types |
Pragma_Restricted_Run_Time |
+ Pragma_Rational |
Pragma_Ravenscar |
Pragma_Reviewable |
Pragma_Share_Generic |
Success : Boolean;
Conf_Project : Project_Id := No_Project;
- -- The object directory of this project will be used to store the config
- -- project file in auto-configuration. Set by procedure Check_Project
- -- below.
+ -- The object directory of this project is used to store the config
+ -- project file in auto-configuration. Set by Check_Project below.
procedure Check_Project (Project : Project_Id);
-- Look for a non aggregate project. If one is found, put its project Id
procedure Check_Project (Project : Project_Id) is
begin
if Project.Qualifier = Aggregate
- or else Project.Qualifier = Aggregate_Library
+ or else
+ Project.Qualifier = Aggregate_Library
then
declare
- List : Aggregated_Project_List :=
- Project.Aggregated_Projects;
+ List : Aggregated_Project_List := Project.Aggregated_Projects;
begin
-- Look for a non aggregate project until one is found
end if;
end Check_Project;
+ -- Start of processing for Process_Project_And_Apply_Config
+
begin
Main_Project := No_Project;
Automatically_Generated := False;
procedure Normalize_Arguments (Args : in out Argument_List) is
procedure Quote_Argument (Arg : in out String_Access);
- -- Add quote around argument if it contains spaces
+ -- Add quote around argument if it contains spaces (or HT characters)
C_Argument_Needs_Quote : Integer;
pragma Import (C, C_Argument_Needs_Quote, "__gnat_argument_needs_quote");
T : constant Entity_Id := Get_Instance_Of (Gen_T);
begin
+ -- Some detailed comments would be useful here ???
+
return ((Base_Type (T) = Act_T
or else Base_Type (T) = Base_Type (Act_T))
and then Subtypes_Statically_Match (T, Act_T))
or else (Is_Class_Wide_Type (Gen_T)
and then Is_Class_Wide_Type (Act_T)
- and then
- Subtypes_Match
- (Get_Instance_Of (Root_Type (Gen_T)),
- Root_Type (Act_T)))
+ and then Subtypes_Match
+ (Get_Instance_Of (Root_Type (Gen_T)),
+ Root_Type (Act_T)))
or else
- ((Ekind (Gen_T) = E_Anonymous_Access_Subprogram_Type
- or else Ekind (Gen_T) = E_Anonymous_Access_Type)
+ (Ekind_In (Gen_T, E_Anonymous_Access_Subprogram_Type,
+ E_Anonymous_Access_Type)
and then Ekind (Act_T) = Ekind (Gen_T)
- and then
- Subtypes_Statically_Match
- (Designated_Type (Gen_T), Designated_Type (Act_T)));
+ and then Subtypes_Statically_Match
+ (Designated_Type (Gen_T), Designated_Type (Act_T)));
end Subtypes_Match;
-----------------------------------------
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
end if;
end if;
- if not Is_Actual
- and then (Old_S = New_S
- or else
- (Nkind (Nam) /= N_Expanded_Name
- and then Chars (Old_S) = Chars (New_S))
- or else
- (Nkind (Nam) = N_Expanded_Name
- and then Entity (Prefix (Nam)) = Current_Scope
- and then
- Chars (Selector_Name (Nam)) = Chars (New_S)))
+ if Is_Actual then
+ null;
+
+ -- The following is illegal, because F hides whatever other F may
+ -- be around:
+ -- function F (..) renames F;
+
+ elsif Old_S = New_S
+ or else (Nkind (Nam) /= N_Expanded_Name
+ and then Chars (Old_S) = Chars (New_S))
+ then
+ Error_Msg_N ("subprogram cannot rename itself", N);
+
+ elsif Nkind (Nam) = N_Expanded_Name
+ and then Entity (Prefix (Nam)) = Current_Scope
+ and then Chars (Selector_Name (Nam)) = Chars (New_S)
+ and then not Rational_Profile
then
Error_Msg_N ("subprogram cannot rename itself", N);
end if;
-- pragma Profile (profile_IDENTIFIER);
- -- profile_IDENTIFIER => Restricted | Ravenscar
+ -- profile_IDENTIFIER => Restricted | Ravenscar | Rational
when Pragma_Profile =>
Ada_2005_Pragma;
(Restricted,
N, Warn => Treat_Restrictions_As_Warnings);
+ elsif Chars (Argx) = Name_Rational then
+ Rational_Profile := True;
+
elsif Chars (Argx) = Name_No_Implementation_Extensions then
Set_Profile_Restrictions
(No_Implementation_Extensions,
end if;
end;
+ --------------
+ -- Rational --
+ --------------
+
+ -- pragma Rational, for compatibility with foreign compiler
+
+ when Pragma_Rational =>
+ Rational_Profile := True;
+
-----------------------
-- Relative_Deadline --
-----------------------
Pragma_Pure_12 => -1,
Pragma_Pure_Function => -1,
Pragma_Queuing_Policy => -1,
+ Pragma_Rational => -1,
Pragma_Ravenscar => -1,
Pragma_Relative_Deadline => -1,
Pragma_Remote_Access_Type => -1,
-- * For a scalar type that has the Default_Value aspect
-- specified, the formal parameter is initialized from the
-- value of the actual, without checking that the value
- -- satisfies any constraint or any predicate;
+ -- satisfies any constraint or any predicate.
+ -- I do not understand why this case is included??? this is
+ -- not a case where an OUT parameter is treated as IN OUT.
-- * For a composite type with discriminants or that has
-- implicit initial values for any subcomponents, the
Present (Default_Aspect_Value (Etype (F))))
or else
(Is_Composite_Type (Etype (F))
- and then
- (Has_Discriminants (Etype (F))
- or else
- Is_Partially_Initialized_Type (Etype (F)))))
+ and then (Has_Discriminants (Etype (F))
+ or else Is_Partially_Initialized_Type
+ (Etype (F)))))
then
Generate_Reference (Orig_A, A);
end if;
-- --
-- T e m p l a t e --
-- --
--- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
Name_Profile_Warnings : constant Name_Id := N + $; -- GNAT
Name_Propagate_Exceptions : constant Name_Id := N + $; -- GNAT
Name_Queuing_Policy : constant Name_Id := N + $;
+ Name_Rational : constant Name_Id := N + $; -- GNAT
Name_Ravenscar : constant Name_Id := N + $; -- GNAT
Name_Restricted_Run_Time : constant Name_Id := N + $; -- GNAT
Name_Restrictions : constant Name_Id := N + $;
Pragma_Profile_Warnings,
Pragma_Propagate_Exceptions,
Pragma_Queuing_Policy,
+ Pragma_Rational,
Pragma_Ravenscar,
Pragma_Restricted_Run_Time,
Pragma_Restrictions,
-gnateS ^ /SCO_OUTPUT
-gnatet ^ /TARGET_DEPENDENT_INFO
-gnateV ^ /PARAMETER_VALIDITY_CHECK
+-gnateY ^ /IGNORE_STYLE_CHECKS_PRAGMAS
-gnatE ^ /CHECKS=ELABORATION
-gnatf ^ /REPORT_ERRORS=FULL
-gnatF ^ /UPPERCASE_EXTERNALS
projects / gcc.git / commitdiff