gmmproc: Check if signals and properties are deprecated appropriately

* tools/pm/GtkDefs.pm:
* tools/pm/Property.pm: Search for (deprecated #t) in the *_signals.defs file.
* tools/pm/Output.pm:
* tools/pm/WrapParser.pm: Warn if a signal, property or child property is
deprecated in the .defs file, but not in the _WRAP_* macro, and the whole
file is not deprecated (no _IS_DEPRECATED).

4 files changed, 68 insertions, 12 deletions

diff --git a/tools/pm/GtkDefs.pm b/tools/pm/GtkDefs.pm
index 5fdef5a9..f4d23bee 100644
--- a/tools/pm/GtkDefs.pm
+++ b/tools/pm/GtkDefs.pm
@@ -715,7 +715,8 @@ BEGIN { @GtkDefs::Signal::ISA=qw(GtkDefs::Function); }
 #       string rettype;
 #
 #       string when. e.g. first, last, or both.
-#       string entity_type. e.g. method or signal
+#       string entity_type. e.g. vfunc or signal
+#       bool deprecated; # optional
 #    }
 
 # "new" can't have prototype
@@ -770,6 +771,8 @@ sub new
     $$self{rettype} = "void"
   }
 
+  $$self{deprecated} = ($1 eq "#t") if ($def =~ s/\(deprecated (\S+)\)//);
+
   # signals always have a parameter
   push(@{$$self{param_types}}, "$$self{class}*");
   push(@{$$self{param_names}}, "self");
@@ -788,6 +791,13 @@ sub new
   return $self;
 }
 
+# bool get_deprecated()
+sub get_deprecated($)
+{
+  my ($self) = @_;
+  return $$self{deprecated}; # undef, 0 or 1
+}
+
 # bool has_same_types($objFunction)
 # Compares return types and argument types
 sub has_same_types($$)
diff --git a/tools/pm/Output.pm b/tools/pm/Output.pm
index 610ab15e..df0c9a0d 100644
--- a/tools/pm/Output.pm
+++ b/tools/pm/Output.pm
@@ -85,6 +85,32 @@ sub error
   printf STDERR "Output.pm, $main::source: $format",@_;
 }
 
+# void check_deprecation($file_deprecated, $defs_deprecated, $wrap_deprecated,
+#   $entity_name, $entity_type, $wrapper)
+sub check_deprecation($$$$$$)
+{
+  my ($file_deprecated, $defs_deprecated, $wrap_deprecated,
+      $entity_name, $entity_type, $wrapper) = @_;
+
+  # Don't print a warning if the whole .hg file is deprecated.
+  return if ($file_deprecated);
+
+  if ($defs_deprecated && !$wrap_deprecated)
+  {
+    print STDERR "Warning, $main::source: The $entity_name $entity_type" .
+      " is deprecated in the .defs file, but not in _WRAP_$wrapper.\n";
+  }
+  # Uncomment the following lines some time in the future, when most
+  # signal.defs files have been updated with deprecation information.
+  # generate_extra_defs.cc was updated to generate this info soon after
+  # glibmm 2.47.6.
+  #elsif (!$defs_deprecated && $wrap_deprecated)
+  #{
+  #  print STDERR "Warning, $main::source: The $entity_name $entity_type" .
+  #    " is deprecated in _WRAP_$wrapper, but not in the .defs file.\n";
+  #}
+}
+
 sub ifdef($$)
 {
 	my ($self, $ifdef) = @_;
@@ -893,11 +919,12 @@ sub output_wrap_any_property($$$$$$$$$$)
 }
 
 # _PROPERTY_PROXY(name, cpp_type)
-# void output_wrap_property($filename, $line_num, $name, $cpp_type, $deprecated, $deprecation_docs)
-sub output_wrap_property($$$$$$$$)
+# void output_wrap_property($filename, $line_num, $name, $cpp_type, $file_deprecated,
+#   $deprecated, $deprecation_docs)
+sub output_wrap_property($$$$$$$$$$)
 {
-  my ($self, $filename, $line_num, $name, $cpp_type, $c_class, $deprecated,
-      $deprecation_docs, $newin) = @_;
+  my ($self, $filename, $line_num, $name, $cpp_type, $c_class, $file_deprecated,
+      $deprecated, $deprecation_docs, $newin) = @_;
 
   my $objProperty = GtkDefs::lookup_property($c_class, $name);
   if($objProperty eq 0) #If the lookup failed:
@@ -906,17 +933,21 @@ sub output_wrap_property($$$$$$$$)
   }
   else
   {
+    Output::check_deprecation($file_deprecated, $objProperty->get_deprecated(),
+      $deprecated, $name, "property", "PROPERTY");
+
     $self->output_wrap_any_property($filename, $line_num, $name, $cpp_type, $c_class,
       $deprecated, $deprecation_docs, $newin, $objProperty, "_PROPERTY_PROXY");
   }
 }
 
 # _CHILD_PROPERTY_PROXY(name, cpp_type)
-# void output_wrap_child_property($filename, $line_num, $name, $cpp_type, $deprecated, $deprecation_docs)
-sub output_wrap_child_property($$$$$$$$)
+# void output_wrap_child_property($filename, $line_num, $name, $cpp_type, $file_deprecated,
+#   $deprecated, $deprecation_docs)
+sub output_wrap_child_property($$$$$$$$$$)
 {
-  my ($self, $filename, $line_num, $name, $cpp_type, $c_class, $deprecated,
-      $deprecation_docs, $newin) = @_;
+  my ($self, $filename, $line_num, $name, $cpp_type, $c_class, $file_deprecated,
+      $deprecated, $deprecation_docs, $newin) = @_;
 
   my $objChildProperty = GtkDefs::lookup_child_property($c_class, $name);
   if($objChildProperty eq 0) #If the lookup failed:
@@ -925,6 +956,9 @@ sub output_wrap_child_property($$$$$$$$)
   }
   else
   {
+    Output::check_deprecation($file_deprecated, $objChildProperty->get_deprecated(),
+      $deprecated, $name, "child property", "CHILD_PROPERTY");
+
     $self->output_wrap_any_property($filename, $line_num, $name, $cpp_type, $c_class,
       $deprecated, $deprecation_docs, $newin, $objChildProperty, "_CHILD_PROPERTY_PROXY");
   }
diff --git a/tools/pm/Property.pm b/tools/pm/Property.pm
index 8e2a131f..265a3f70 100644
--- a/tools/pm/Property.pm
+++ b/tools/pm/Property.pm
@@ -26,6 +26,7 @@ our @EXPORT_OK;
 #       bool readable;
 #       bool writable;
 #       bool construct_only;
+#       bool deprecated; # optional
 #       string docs;
 #    }
 
@@ -46,6 +47,7 @@ sub new
   $$self{readable} = ($1 eq "#t")       if ($def =~ s/\(readable (\S+)\)//);
   $$self{writable} = ($1 eq "#t")       if ($def =~ s/\(writable (\S+)\)//);
   $$self{construct_only} = ($1 eq "#t") if ($def =~ s/\(construct-only (\S+)\)//);
+  $$self{deprecated} = ($1 eq "#t")     if ($def =~ s/\(deprecated (\S+)\)//);
   $$self{entity_type} = 'property';
 
   # Property documentation:
@@ -110,6 +112,12 @@ sub get_writable($)
   return $$self{writable};
 }
 
+sub get_deprecated($)
+{
+  my ($self) = @_;
+  return $$self{deprecated}; # undef, 0 or 1
+}
+
 sub get_docs($$)
 {
   my ($self, $deprecation_docs, $newin) = @_;
diff --git a/tools/pm/WrapParser.pm b/tools/pm/WrapParser.pm
index b33ecb13..65fb9366 100644
--- a/tools/pm/WrapParser.pm
+++ b/tools/pm/WrapParser.pm
@@ -144,7 +144,8 @@ sub parse_and_build_output($)
       # _CLASS_OPAQUE_REFCOUNTED
     }
 
-    if ($token eq "namespace") { $self->on_namespace() };
+    if ($token eq "namespace") { $self->on_namespace(); }
+    if ($token eq "_IS_DEPRECATED") { $$self{deprecated} = 1; }
 
     # After all token manipulations
     if($bAppend)
@@ -1536,7 +1537,7 @@ sub on_wrap_property($)
       $deprecation_docs, $newin) = $self->on_wrap_any_property();
 
   $objOutputter->output_wrap_property($filename, $line_num, $argPropertyName,
-    $argCppType, $$self{c_class}, $argDeprecated, $deprecation_docs, $newin);
+    $argCppType, $$self{c_class}, $$self{deprecated}, $argDeprecated, $deprecation_docs, $newin);
 }
 
 sub on_wrap_child_property($)
@@ -1550,7 +1551,7 @@ sub on_wrap_child_property($)
       $deprecation_docs, $newin) = $self->on_wrap_any_property();
 
   $objOutputter->output_wrap_child_property($filename, $line_num, $argPropertyName,
-    $argCppType, $$self{c_class}, $argDeprecated, $deprecation_docs, $newin);
+    $argCppType, $$self{c_class}, $$self{deprecated}, $argDeprecated, $deprecation_docs, $newin);
 }
 
 sub output_wrap_check($$$$$$)
@@ -1613,6 +1614,9 @@ sub output_wrap_signal($$$$$$$$$$$$$$$$$)
     }
   }
 
+  Output::check_deprecation($$self{deprecated}, $objCSignal->get_deprecated(),
+    $deprecated, $signal_name, "signal", "SIGNAL");
+
   $objOutputter->output_wrap_sig_decl($filename, $line_num, $objCSignal, $objCppSignal,
     $signal_name, $bCustomCCallback, $ifdef, $commentblock,
     $deprecated, $deprecation_docs, $newin, $exceptionHandler,