diff options
author | Arnaud Charlet <charlet@gcc.gnu.org> | 2009-05-06 14:40:06 +0200 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2009-05-06 14:40:06 +0200 |
commit | 0c020ddef1f2574c03e6d49497e8b73d55824e22 (patch) | |
tree | e3ce289e52737a3b4799fbe363c1509f7c21e81d /gcc/ada | |
parent | c8ecfecfd4fcf6a2a4c70c92701fa588487c1301 (diff) | |
download | gcc-0c020ddef1f2574c03e6d49497e8b73d55824e22.zip gcc-0c020ddef1f2574c03e6d49497e8b73d55824e22.tar.gz gcc-0c020ddef1f2574c03e6d49497e8b73d55824e22.tar.bz2 |
[multiple changes]
2009-05-06 Robert Dewar <dewar@adacore.com>
* sem_warn.adb: Minor reformatting
2009-05-06 Javier Miranda <miranda@adacore.com>
* sem_prag.adb (Process_Import_Or_Interface): Imported CPP types must
not have discriminants or components with default expressions.
(Analyze_Pragma): For pragma CPP_Class check that imported types
have no discriminants and components have no default expression.
* sem_aggr.adb (Resolve_Aggr_Expr): Add missing check on wrong use of
class-wide types in the expression of a record component association.
2009-05-06 Sergey Rybin <rybin@adacore.com>
* vms_data.ads: Add qualifier for gnatmetric extra exit points metric
* gnat_ugn.texi: Add description for the new extra exit points metric
(gnatmetric section).
From-SVN: r147170
Diffstat (limited to 'gcc/ada')
-rw-r--r-- | gcc/ada/ChangeLog | 21 | ||||
-rw-r--r-- | gcc/ada/gnat_ugn.texi | 7 | ||||
-rw-r--r-- | gcc/ada/sem_aggr.adb | 8 | ||||
-rw-r--r-- | gcc/ada/sem_prag.adb | 106 | ||||
-rw-r--r-- | gcc/ada/sem_warn.adb | 4 | ||||
-rw-r--r-- | gcc/ada/vms_data.ads | 8 |
6 files changed, 147 insertions, 7 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c92aaf5..0256492 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,26 @@ 2009-05-06 Robert Dewar <dewar@adacore.com> + * sem_warn.adb: Minor reformatting + +2009-05-06 Javier Miranda <miranda@adacore.com> + + * sem_prag.adb (Process_Import_Or_Interface): Imported CPP types must + not have discriminants or components with default expressions. + (Analyze_Pragma): For pragma CPP_Class check that imported types + have no discriminants and components have no default expression. + + * sem_aggr.adb (Resolve_Aggr_Expr): Add missing check on wrong use of + class-wide types in the expression of a record component association. + +2009-05-06 Sergey Rybin <rybin@adacore.com> + + * vms_data.ads: Add qualifier for gnatmetric extra exit points metric + + * gnat_ugn.texi: Add description for the new extra exit points metric + (gnatmetric section). + +2009-05-06 Robert Dewar <dewar@adacore.com> + * s-fileio.adb: Minor comment update * sem_ch8.adb: Minor reformatting diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index 10ca8ff..e035ec6 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -14,7 +14,7 @@ @setfilename gnat_ugn.info @copying -Copyright @copyright{} 1995-2005, 2006, 2007, 2008 Free Software Foundation, +Copyright @copyright{} 1995-2009 Free Software Foundation, Inc. Permission is granted to copy, distribute and/or modify this document @@ -17636,6 +17636,11 @@ bodies, task bodies, entry bodies and statement sequences in package bodies Do not consider @code{exit} statements as @code{goto}s when computing Essential Complexity +@item ^--extra-exit-points^/EXTRA_EXIT_POINTS_ON^ +Report the extra exit points for subprogram bodies + +@item ^--no-extra-exit-points^/EXTRA_EXIT_POINTS_OFF^ +Do not report the extra exit points for subprogram bodies @end table diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index 34ad94f..2a855b2 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -2785,6 +2785,14 @@ package body Sem_Aggr is Check_Non_Static_Context (Expr); Check_Unset_Reference (Expr); + -- Check wrong use of class-wide types + + if Is_Class_Wide_Type (Etype (Expr)) + and then not Is_CPP_Constructor_Call (Expr) + then + Error_Msg_N ("dynamically tagged expression not allowed", Expr); + end if; + if not Has_Expansion_Delayed (Expr) then Aggregate_Constraint_Checks (Expr, Expr_Type); end if; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 926f750..6d12b8f 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -1967,7 +1967,8 @@ package body Sem_Prag is (Chars (Arg), Names (Index1)) then Error_Msg_Name_1 := Names (Index1); - Error_Msg_N ("\possible misspelling of%", Arg); + Error_Msg_N -- CODEFIX + ("\possible misspelling of%", Arg); exit; end if; end loop; @@ -3573,6 +3574,49 @@ package body Sem_Prag is Set_Is_CPP_Class (Def_Id); Set_Is_Limited_Record (Def_Id); + + -- Imported CPP types must not have discriminants (because C++ + -- classes do not have discriminants). + + if Has_Discriminants (Def_Id) then + Error_Msg_N + ("imported 'C'P'P type cannot have discriminants", + First (Discriminant_Specifications + (Declaration_Node (Def_Id)))); + end if; + + -- Components of imported CPP types must not have default + -- expressions because the constructor (if any) is in the + -- C++ side. + + declare + Tdef : constant Node_Id := + Type_Definition (Declaration_Node (Def_Id)); + Clist : Node_Id; + Comp : Node_Id; + + begin + if Nkind (Tdef) = N_Record_Definition then + Clist := Component_List (Tdef); + + else + pragma Assert (Nkind (Tdef) = N_Derived_Type_Definition); + Clist := Component_List (Record_Extension_Part (Tdef)); + end if; + + if Present (Clist) then + Comp := First (Component_Items (Clist)); + while Present (Comp) loop + if Present (Expression (Comp)) then + Error_Msg_N + ("component of imported 'C'P'P type cannot have" & + " default expression", Expression (Comp)); + end if; + + Next (Comp); + end loop; + end if; + end; end if; else @@ -4183,7 +4227,7 @@ package body Sem_Prag is Error_Msg_String (1 .. Rnm'Length) := Name_Buffer (1 .. Name_Len); Error_Msg_Strlen := Rnm'Length; - Error_Msg_N + Error_Msg_N -- CODEFIX ("\possible misspelling of ""~""", Get_Pragma_Arg (Arg)); exit; @@ -4937,7 +4981,7 @@ package body Sem_Prag is for PN in First_Pragma_Name .. Last_Pragma_Name loop if Is_Bad_Spelling_Of (Pname, PN) then Error_Msg_Name_1 := PN; - Error_Msg_N + Error_Msg_N -- CODEFIX ("\?possible misspelling of %!", Pragma_Identifier (N)); exit; end if; @@ -6159,6 +6203,62 @@ package body Sem_Prag is Set_Is_CPP_Class (Typ); Set_Is_Limited_Record (Typ); Set_Convention (Typ, Convention_CPP); + + -- Imported CPP types must not have discriminants (because C++ + -- classes do not have discriminants). + + if Has_Discriminants (Typ) then + Error_Msg_N + ("imported 'C'P'P type cannot have discriminants", + First (Discriminant_Specifications + (Declaration_Node (Typ)))); + end if; + + -- Components of imported CPP types must not have default + -- expressions because the constructor (if any) is in the + -- C++ side. + + if Is_Incomplete_Or_Private_Type (Typ) + and then No (Underlying_Type (Typ)) + then + -- It should be an error to apply pragma CPP to a private + -- type if the underlying type is not visible (as it is + -- for any representation item). For now, for backward + -- compatibility we do nothing but we cannot check components + -- because they are not available at this stage. All this code + -- will be removed when we cleanup this obsolete GNAT pragma??? + + null; + + else + declare + Tdef : constant Node_Id := + Type_Definition (Declaration_Node (Typ)); + Clist : Node_Id; + Comp : Node_Id; + + begin + if Nkind (Tdef) = N_Record_Definition then + Clist := Component_List (Tdef); + else + pragma Assert (Nkind (Tdef) = N_Derived_Type_Definition); + Clist := Component_List (Record_Extension_Part (Tdef)); + end if; + + if Present (Clist) then + Comp := First (Component_Items (Clist)); + while Present (Comp) loop + if Present (Expression (Comp)) then + Error_Msg_N + ("component of imported 'C'P'P type cannot have" & + " default expression", Expression (Comp)); + end if; + + Next (Comp); + end loop; + end if; + end; + end if; end CPP_Class; --------------------- diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index ec1d1d7..eca31f0 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -954,8 +954,8 @@ package body Sem_Warn is -- here (note that the dereference may not be explicit in -- the source, for example in the case of a dispatching call -- with an anonymous access controlling formal, or of an - -- assignment of a pointer involving discriminant check - -- on the designated object). + -- assignment of a pointer involving discriminant check on + -- the designated object). if not Warnings_Off_E1 then Error_Msg_NE ("?& may be null!", UR, E1); diff --git a/gcc/ada/vms_data.ads b/gcc/ada/vms_data.ads index d61a82e..f4841df 100644 --- a/gcc/ada/vms_data.ads +++ b/gcc/ada/vms_data.ads @@ -5116,7 +5116,11 @@ package VMS_Data is "AVERAGE_COMPLEXITY_ON " & "--complexity-average " & "AVERAGE_COMPLEXITY_OFF " & - "--no-complexity-average"; + "--no-complexity-average " & + "EXTRA_EXIT_POINTS_ON " & + "--extra-exit-points " & + "EXTRA_EXIT_POINTS_OFF " & + "--no-extra-exit-points"; -- /COMPLEXITY_METRICS=(option, option ...) -- Specifies the complexity metrics to be computed (if at least one @@ -5139,6 +5143,8 @@ package VMS_Data is -- executable bodies -- AVERAGE_COMPLEXITY_OFF Do not compute the average complexity for -- executable bodies + -- EXTRA_EXIT_POINTS_ON Compute extra exit points metric + -- EXTRA_EXIT_POINTS_OFF Do not compute extra exit points metric -- -- All combinations of line metrics options are allowed. |